From 85c8a88cbe609d39b4fb2b61edd65a0c94698f13 Mon Sep 17 00:00:00 2001 From: peter Date: Mon, 10 Aug 1998 14:49:33 +0000 Subject: [PATCH] + localswitches, moduleswitches, globalswitches splitting --- compiler/aasm.pas | 7 +- compiler/ag68kgas.pas | 13 +- compiler/ag68kmit.pas | 13 +- compiler/ag68kmot.pas | 11 +- compiler/asmutils.pas | 7 +- compiler/assemble.pas | 29 +- compiler/cg386add.pas | 7 +- compiler/cg386cal.pas | 22 +- compiler/cg386cnv.pas | 18 +- compiler/cg386ld.pas | 9 +- compiler/cg386mem.pas | 11 +- compiler/cg386set.pas | 13 +- compiler/cgi386.pas | 24 +- compiler/compiler.pas | 27 +- compiler/daopt386.pas | 1464 +---------------------------------------- compiler/files.pas | 11 +- compiler/hcodegen.pas | 17 +- compiler/link.pas | 40 +- compiler/opts386.pas | 17 +- compiler/opts68k.pas | 15 +- compiler/parser.pas | 28 +- compiler/pass_1.pas | 71 +- compiler/pdecl.pas | 25 +- compiler/pexpr.pas | 9 +- compiler/pmodules.pas | 47 +- compiler/popt386.pas | 25 +- compiler/pp.pas | 12 +- compiler/pstatmnt.pas | 9 +- compiler/psystem.pas | 11 +- compiler/ptconst.pas | 7 +- compiler/ra386att.pas | 25 +- compiler/ra68kmot.pas | 11 +- compiler/scandir.inc | 21 +- compiler/scanner.pas | 19 +- compiler/switches.pas | 132 ++-- compiler/symdef.inc | 15 +- compiler/symppu.inc | 7 +- compiler/symsym.inc | 31 +- compiler/tgeni386.pas | 9 +- compiler/tree.pas | 42 +- compiler/verbose.pas | 22 +- compiler/win_targ.pas | 9 +- 42 files changed, 517 insertions(+), 1845 deletions(-) diff --git a/compiler/aasm.pas b/compiler/aasm.pas index 35fd5483c7..4f35169349 100644 --- a/compiler/aasm.pas +++ b/compiler/aasm.pas @@ -755,7 +755,7 @@ uses end else begin - if (l^.is_data) and (cs_smartlink in aktswitches) then + if (l^.is_data) and (cs_smartlink in aktmoduleswitches) then lab2str:='_$'+current_module^.modulename^+'$_L'+tostr(l^.nb) else lab2str:=target_asm.labelprefix+tostr(l^.nb); @@ -832,7 +832,10 @@ uses end. { $Log$ - Revision 1.12 1998-07-14 14:46:36 peter + Revision 1.13 1998-08-10 14:49:33 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.12 1998/07/14 14:46:36 peter * released NEWINPUT Revision 1.11 1998/07/07 11:19:50 peter diff --git a/compiler/ag68kgas.pas b/compiler/ag68kgas.pas index 7a39be0db4..7733efd90c 100644 --- a/compiler/ag68kgas.pas +++ b/compiler/ag68kgas.pas @@ -245,7 +245,7 @@ unit ag68kgas; begin { write debugger informations } {$ifdef GDB} - if cs_debuginfo in aktswitches then + if cs_debuginfo in aktmoduleswitches then begin if not (hp^.typ in [ait_external,ait_stabn,ait_stabs, ait_label,ait_cut,ait_align,ait_stab_function_name]) then @@ -327,7 +327,7 @@ unit ag68kgas; { ------------------------------------------------------- } if pai_datablock(hp)^.size <> 1 then begin - if not(cs_littlesize in aktswitches) then + if not(cs_littlesize in aktglobalswitches) then AsmWriteLn(#9#9'.align 4') else AsmWriteLn(#9#9'.align 2'); @@ -432,7 +432,7 @@ unit ag68kgas; [ait_const_32bit,ait_const_16bit,ait_const_symbol, ait_real_64bit,ait_real_32bit,ait_string]) then begin - if not(cs_littlesize in aktswitches) then + if not(cs_littlesize in aktglobalswitches) then AsmWriteLn(#9#9'.align 4') else AsmWriteLn(#9#9'.align 2'); @@ -458,7 +458,7 @@ ait_labeled_instruction : begin [ait_const_32bit,ait_const_16bit,ait_const_symbol, ait_real_64bit,ait_real_32bit,ait_string]) then begin - if not(cs_littlesize in aktswitches) then + if not(cs_littlesize in aktglobalswitches) then AsmWriteLn(#9#9'.align 4') else AsmWriteLn(#9#9'.align 2'); @@ -605,7 +605,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str; end. { $Log$ - Revision 1.7 1998-07-14 14:46:38 peter + Revision 1.8 1998-08-10 14:49:36 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.7 1998/07/14 14:46:38 peter * released NEWINPUT Revision 1.6 1998/07/10 10:50:54 peter diff --git a/compiler/ag68kmit.pas b/compiler/ag68kmit.pas index 8d307ed871..3a54b1e75a 100644 --- a/compiler/ag68kmit.pas +++ b/compiler/ag68kmit.pas @@ -282,7 +282,7 @@ unit ag68kmit; begin { write debugger informations } {$ifdef GDB} - if cs_debuginfo in aktswitches then + if cs_debuginfo in aktmoduleswitches then begin if not (hp^.typ in [ait_external,ait_stabn,ait_stabs, ait_label,ait_cut,ait_align,ait_stab_function_name]) then @@ -363,7 +363,7 @@ unit ag68kmit; { ------------------------------------------------------- } if pai_datablock(hp)^.size <> 1 then begin - if not(cs_littlesize in aktswitches) then + if not(cs_littlesize in aktglobalswitches) then AsmWriteLn(#9#9'.align 4') else AsmWriteLn(#9#9'.align 2'); @@ -468,7 +468,7 @@ unit ag68kmit; [ait_const_32bit,ait_const_16bit,ait_const_symbol, ait_real_64bit,ait_real_32bit,ait_string]) then begin - if not(cs_littlesize in aktswitches) then + if not(cs_littlesize in aktglobalswitches) then AsmWriteLn(#9#9'.align 4') else AsmWriteLn(#9#9'.align 2'); @@ -494,7 +494,7 @@ ait_labeled_instruction : begin [ait_const_32bit,ait_const_16bit,ait_const_symbol, ait_real_64bit,ait_real_32bit,ait_string]) then begin - if not(cs_littlesize in aktswitches) then + if not(cs_littlesize in aktglobalswitches) then AsmWriteLn(#9#9'.align 4') else AsmWriteLn(#9#9'.align 2'); @@ -641,7 +641,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str; end. { $Log$ - Revision 1.7 1998-07-14 14:46:39 peter + Revision 1.8 1998-08-10 14:49:37 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.7 1998/07/14 14:46:39 peter * released NEWINPUT Revision 1.6 1998/07/10 10:50:55 peter diff --git a/compiler/ag68kmot.pas b/compiler/ag68kmot.pas index 535f244c9f..1e559fb7d2 100644 --- a/compiler/ag68kmot.pas +++ b/compiler/ag68kmot.pas @@ -290,7 +290,7 @@ unit ag68kmot; { ------------------------------------------------------- } if pai_datablock(hp)^.size <> 1 then begin - if not(cs_littlesize in aktswitches) then + if not(cs_littlesize in aktglobalswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); @@ -395,7 +395,7 @@ unit ag68kmot; [ait_const_32bit,ait_const_16bit,ait_const_symbol, ait_real_64bit,ait_real_32bit,ait_string]) then begin - if not(cs_littlesize in aktswitches) then + if not(cs_littlesize in aktglobalswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); @@ -429,7 +429,7 @@ ait_labeled_instruction : [ait_const_32bit,ait_const_16bit,ait_const_symbol, ait_real_64bit,ait_real_32bit,ait_string]) then begin - if not(cs_littlesize in aktswitches) then + if not(cs_littlesize in aktglobalswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); @@ -523,7 +523,10 @@ ait_labeled_instruction : end. { $Log$ - Revision 1.6 1998-07-10 10:50:56 peter + Revision 1.7 1998-08-10 14:49:38 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.6 1998/07/10 10:50:56 peter * m68k updates Revision 1.5 1998/06/05 17:46:06 peter diff --git a/compiler/asmutils.pas b/compiler/asmutils.pas index 4f7211a90f..a37d85ae2e 100644 --- a/compiler/asmutils.pas +++ b/compiler/asmutils.pas @@ -1019,7 +1019,7 @@ end; Procedure FWaitWarning; begin - if (target_info.target=target_GO32V2) and (cs_fp_emulation in aktswitches) then + if (target_info.target=target_GO32V2) and (cs_fp_emulation in aktmoduleswitches) then Message(assem_w_fwait_emu_prob); end; {$endif i386} @@ -1628,7 +1628,10 @@ end; end. { $Log$ - Revision 1.5 1998-07-14 21:46:38 peter + Revision 1.6 1998-08-10 14:49:40 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.5 1998/07/14 21:46:38 peter * updated messages file Revision 1.4 1998/06/04 23:51:31 peter diff --git a/compiler/assemble.pas b/compiler/assemble.pas index a41e1792d9..28a3bdbff8 100644 --- a/compiler/assemble.pas +++ b/compiler/assemble.pas @@ -127,7 +127,9 @@ end; Function DoPipe:boolean; begin - DoPipe:=use_pipe and (not WriteAsmFile) and (aktoutputformat=as_o); + DoPipe:=(cs_asm_pipe in aktglobalswitches) and + not(cs_asm_leave in aktglobalswitches) and + (aktoutputformat=as_o); end; @@ -143,10 +145,10 @@ begin begin lastas:=ord(target_asm.id); LastASBin:=FindExe(target_asm.asmbin,asfound); - if (not asfound) and (not externasm) then + if (not asfound) and not(cs_asm_extern in aktglobalswitches) then begin Message1(exec_w_assembler_not_found,LastASBin); - externasm:=true; + aktglobalswitches:=aktglobalswitches+[cs_asm_extern]; end; if asfound then Message1(exec_u_using_assembler,LastASBin); @@ -157,7 +159,7 @@ end; Function TAsmList.CallAssembler(const command,para:string):Boolean; begin - if not externasm then + if not(cs_asm_extern in aktglobalswitches) then begin swapvectors; exec(command,para); @@ -165,7 +167,7 @@ begin if (doserror<>0) then begin Message(exec_w_cant_call_assembler); - externasm:=true; + aktglobalswitches:=aktglobalswitches+[cs_asm_extern]; exit; end else @@ -175,7 +177,7 @@ begin callassembler:=false; end; end; - if externasm then + if cs_asm_extern in aktglobalswitches then AsmRes.AddAsmCommand(command,para,name); callassembler:=true; end; @@ -186,9 +188,9 @@ var g : file; i : word; begin - if writeasmfile then + if cs_asm_leave in aktglobalswitches then exit; - if ExternAsm then + if cs_asm_extern in aktglobalswitches then AsmRes.AddDeleteCommand(asmfile) else begin @@ -208,7 +210,7 @@ begin DoAssemble:=true; if DoPipe then exit; - if (SmartLinkFilesCnt<=1) and (not externasm) then + if (SmartLinkFilesCnt<=1) and not(cs_asm_extern in aktglobalswitches) then Message1(exec_i_assembling,name); s:=target_asm.asmcmd; Replace(s,'$ASM',AsmFile); @@ -297,7 +299,7 @@ end; procedure TAsmList.AsmCreate; begin - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then NextSmartName; {$ifdef linux} if DoPipe then @@ -375,7 +377,7 @@ begin OutCnt:=0; {Smartlinking} SmartLinkFilesCnt:=0; - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then begin path:=SmartLinkPath(name); {$I-} @@ -450,7 +452,10 @@ end; end. { $Log$ - Revision 1.13 1998-07-14 21:46:40 peter + Revision 1.14 1998-08-10 14:49:41 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.13 1998/07/14 21:46:40 peter * updated messages file Revision 1.12 1998/07/08 14:58:34 daniel diff --git a/compiler/cg386add.pas b/compiler/cg386add.pas index f4e5b9687f..fa541c277d 100644 --- a/compiler/cg386add.pas +++ b/compiler/cg386add.pas @@ -807,7 +807,7 @@ implementation { we must put it here directly, because sign of operation } { is in unsigned VAR!! } begin - if cs_check_overflow in aktswitches then + if cs_check_overflow in aktlocalswitches then begin getlabel(hl4); if unsigned then @@ -1198,7 +1198,10 @@ implementation end. { $Log$ - Revision 1.3 1998-06-25 08:48:04 florian + Revision 1.4 1998-08-10 14:49:42 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.3 1998/06/25 08:48:04 florian * first version of rtti support Revision 1.2 1998/06/08 13:13:28 pierre diff --git a/compiler/cg386cal.pas b/compiler/cg386cal.pas index 739e01498b..766212b78a 100644 --- a/compiler/cg386cal.pas +++ b/compiler/cg386cal.pas @@ -631,13 +631,14 @@ implementation { virtual methods too } ((p^.procdefinition^.options and povirtualmethod)=0) then begin - if ((p^.procdefinition^.options and poiocheck)<>0) - and (cs_iocheck in aktswitches) then + if ((p^.procdefinition^.options and poiocheck)<>0) and + (cs_check_io in aktlocalswitches) then begin getlabel(iolabel); emitl(A_LABEL,iolabel); end - else iolabel:=nil; + else + iolabel:=nil; { save all used registers } pushusedregisters(pushed,p^.procdefinition^.usedregisters); @@ -1048,7 +1049,7 @@ implementation if p^.procdefinition^.extnumber=-1 then internalerror($Da); r^.offset:=p^.procdefinition^.extnumber*4+12; - if (cs_rangechecking in aktswitches) then + if (cs_check_range in aktlocalswitches) then begin exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base))); emitcall('CHECK_OBJECT',true); @@ -1124,7 +1125,7 @@ implementation { the pentium has two pipes and pop reg is pairable } { but the registers must be different! } else if (pushedparasize=8) and - not(cs_littlesize in aktswitches) and + not(cs_littlesize in aktglobalswitches) and (aktoptprocessor=pentium) and (procinfo._class=nil) then begin @@ -1390,7 +1391,7 @@ implementation begin { I/O check } - if cs_iocheck in aktswitches then + if cs_check_io in aktlocalswitches then begin getlabel(iolabel); emitl(A_LABEL,iolabel); @@ -1810,7 +1811,7 @@ implementation secondpass(p^.left); if codegenerror then exit; - if cs_do_assertion in aktswitches then + if cs_do_assertion in aktlocalswitches then begin maketojumpbool(p^.left); emitl(A_LABEL,falselabel); @@ -2046,7 +2047,7 @@ implementation { write the add instruction } if addconstant then begin - if (addvalue=1) and not(cs_check_overflow in aktswitches) then + if (addvalue=1) and not(cs_check_overflow in aktlocalswitches) then exprasmlist^.concat(new(pai386,op_ref(incdecop[p^.inlinenumber],opsize, newreference(p^.left^.left^.location.reference)))) else @@ -2290,7 +2291,10 @@ implementation end. { $Log$ - Revision 1.12 1998-07-30 13:30:31 florian + Revision 1.13 1998-08-10 14:49:45 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.12 1998/07/30 13:30:31 florian * final implemenation of exception support, maybe it needs some fixes :) diff --git a/compiler/cg386cnv.pas b/compiler/cg386cnv.pas index fbe26dd218..e93c22bdb1 100644 --- a/compiler/cg386cnv.pas +++ b/compiler/cg386cnv.pas @@ -62,9 +62,9 @@ implementation exit; { range checking is different for u32bit } { lets try to generate it allways } - if (cs_rangechecking in aktswitches) and + if (cs_check_range in aktlocalswitches) and { with $R+ explicit type conversations in TP aren't range checked! } - (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and + (not(p^.explizit) or not(cs_tp_compatible in aktmoduleswitches)) and ((porddef(p1)^.low>porddef(p2)^.low) or (porddef(p1)^.high3*labels) then { a linear list is always smaller than a jump tree } @@ -763,7 +763,10 @@ implementation end. { $Log$ - Revision 1.3 1998-06-25 08:48:10 florian + Revision 1.4 1998-08-10 14:49:51 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.3 1998/06/25 08:48:10 florian * first version of rtti support Revision 1.2 1998/06/16 08:56:18 peter diff --git a/compiler/cgi386.pas b/compiler/cgi386.pas index 02d33fd187..dae028c942 100644 --- a/compiler/cgi386.pas +++ b/compiler/cgi386.pas @@ -230,17 +230,16 @@ implementation secondfail,secondadd,secondprocinline, secondnothing,secondloadvmt); var - oldcodegenerror : boolean; - oldswitches : Tcswitches; - oldpos : tfileposinfo; - + oldcodegenerror : boolean; + oldlocalswitches : tlocalswitches; + oldpos : tfileposinfo; begin oldcodegenerror:=codegenerror; - oldswitches:=aktswitches; + oldlocalswitches:=aktlocalswitches; oldpos:=aktfilepos; aktfilepos:=p^.fileinfo; - aktswitches:=p^.pragmas; + aktlocalswitches:=p^.localswitches; if not(p^.error) then begin codegenerror:=false; @@ -251,7 +250,7 @@ implementation else codegenerror:=true; - aktswitches:=oldswitches; + aktlocalswitches:=oldlocalswitches; aktfilepos:=oldpos; end; @@ -295,7 +294,7 @@ implementation { parameter get a less value } if parasym then begin - if cs_littlesize in aktswitches then + if cs_littlesize in aktglobalswitches then dec(j,1) else dec(j,100); @@ -332,7 +331,7 @@ implementation begin cleartempgen; { when size optimization only count occurrence } - if cs_littlesize in aktswitches then + if cs_littlesize in aktglobalswitches then t_times:=1 else { reference for repetition is 100 } @@ -358,7 +357,7 @@ implementation { max. optimizations } { only if no asm is used } { and no try statement } - if (cs_maxoptimieren in aktswitches) and + if (cs_maxoptimize in aktglobalswitches) and ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then begin { can we omit the stack frame ? } @@ -507,7 +506,10 @@ implementation end. { $Log$ - Revision 1.46 1998-08-10 10:18:23 peter + Revision 1.47 1998-08-10 14:49:53 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.46 1998/08/10 10:18:23 peter + Compiler,Comphook unit which are the new interface units to the compiler diff --git a/compiler/compiler.pas b/compiler/compiler.pas index cca8b5fdfc..d2581e0169 100644 --- a/compiler/compiler.pas +++ b/compiler/compiler.pas @@ -62,6 +62,12 @@ unit compiler; interface +{ Use exception catching so the compiler goes futher after a Stop } +{$ifdef i386} + {$define USEEXCEPT} +{$endif} + + uses {$ifdef fpc} {$ifdef GO32V2} @@ -72,9 +78,9 @@ uses catch, {$endif LINUX} {$endif} -{$ifdef TP} +{$ifdef USEEXCEPT} tpexcept, -{$endif} +{$endif USEEXCEPT} dos,verbose,comphook,systems, globals,options,parser,symtable,link,import; @@ -88,10 +94,12 @@ var CompilerInited : boolean; recoverpos : jmp_buf; +{$ifdef USEEXCEPT} procedure RecoverStop;{$ifndef FPC}far;{$endif} begin LongJmp(recoverpos,1); end; +{$endif USEEXCEPT} procedure DoneCompiler; @@ -135,12 +143,14 @@ function Compile(const cmd:string):longint; var starttime : real; +{$ifdef USEEXCEPT} olddo_stop : tstopprocedure; -{$ifdef TP} +{$endif} +{$ifdef TP} oldfreelist, oldheapptr, oldheaporg : pointer; -{$endif} +{$endif} {$IfDef Extdebug} EntryMemAvail : longint; {$EndIf} @@ -173,10 +183,12 @@ begin Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free'); {$endif} +{$ifdef USEEXCEPT} olddo_stop:=do_stop; do_stop:=recoverstop; if setjmp(recoverpos)=0 then begin +{$endif USEEXCEPT} starttime:=getrealtime; parser.compile(inputdir+inputfile+inputextension,false); if status.errorcount=0 then @@ -187,9 +199,11 @@ begin end; { Stop the compiler, frees also memory } DoneCompiler; +{$ifdef USEEXCEPT} end; { Stop is always called, so we come here when a program is compiled or not } do_stop:=olddo_stop; +{$endif USEEXCEPT} {$ifdef EXTDEBUG} Comment(V_Info,'Memory Lost = '+tostr(EntryMemAvail-MemAvail)); {$endif EXTDEBUG} @@ -210,7 +224,10 @@ end; end. { $Log$ - Revision 1.1 1998-08-10 10:18:24 peter + Revision 1.2 1998-08-10 14:49:56 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.1 1998/08/10 10:18:24 peter + Compiler,Comphook unit which are the new interface units to the compiler diff --git a/compiler/daopt386.pas b/compiler/daopt386.pas index dd0ec412f5..cc1deb4254 100644 --- a/compiler/daopt386.pas +++ b/compiler/daopt386.pas @@ -1,2909 +1,1459 @@ { - $Id$ - Copyright (c) 1997-98 by Jonas Maebe - - This unit contains the data flow analyzer and several helper procedures - and functions. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** - } - Unit DAOpt386; - - Interface - - Uses AAsm, CObjects - {$ifdef i386} - ,i386 - {$endif} - ; - - {*********************** Procedures and Functions ************************} - - Procedure InsertLLItem(AsmL: PAasmOutput; prev, foll, new_one: PLinkedList_Item); - - Function Reg32(Reg: TRegister): TRegister; - Function RefsEqual(Const R1, R2: TReference): Boolean; - Function IsGP32Reg(Reg: TRegister): Boolean; - Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean; - Function RegInInstruction(Reg: TRegister; p1: Pai): Boolean; - Function PowerOf2(L: Longint): Longint; - - Function GetNextInstruction(Current: Pai; Var Next: Pai): Boolean; - Function GetLastInstruction(Current: Pai; Var Last: Pai): Boolean; - - Function RegsSameContent(p1, p2: Pai; Reg: TRegister): Boolean; - Function InstructionsEqual(p1, p2: Pai): Boolean; - - Procedure DFAPass1(AsmL: PAasmOutput); - Function DFAPass2(AsmL: PAasmOutput): Pai; - Procedure ShutDownDFA; - - Function FindLabel(L: PLabel; Var hp: Pai): Boolean; - {Procedure FindLoHiLabels(AsmL: PAasmOutput; Var LoLab, HiLab, LabDif: Longint);} - - - {******************************* Constants *******************************} - - Const - - {ait_* types which don't result in executable code or which don't influence - the way the program runs/behaves} - - SkipInstr = [ait_comment - {$ifdef GDB} - ,ait_stabs, ait_stabn, ait_stab_function_name - {$endif GDB} - {$ifdef regalloc} - ,ait_regalloc, ait_regdealloc - {$endif regalloc} - ]; - - {the maximum number of things (registers, memory, ...) a single instruction - changes} - - MaxCh = 3; - - {Possible register content types} - con_Unknown = 0; - con_ref = 1; - con_const = 2; - - {********************************* Types *********************************} - - Type - - {What an instruction can change} - TChange = (C_None, - C_EAX, C_ECX, C_EDX, C_EBX, C_ESP, C_EBP, C_ESI, C_EDI, - C_CDirFlag {clear direction flag}, C_SDirFlag {set dir flag}, - C_Flags, C_FPU, C_Op1, C_Op2, C_Op3, C_MemEDI); - - {the possible states of a flag} - TFlagContents = (F_Unknown, F_NotSet, F_Set); - - {the properties of a cpu instruction} - TAsmInstrucProp = Record - {how many things it changes} - NCh: Byte; - {and what it changes} - Ch: Array[1..MaxCh] of TChange; - End; - - TContent = Record - {start and end of block instructions that defines the - content of this register. If Typ = con_const, then - Longint(StartMod) = value of the constant)} - StartMod: Pointer; - {starts at 1, gets increased everytime the register is modified} - State: Word; - {how many instructions starting with StarMod does the block consist of} - NrOfMods: Byte; - {if one register gets a block assigned from an other register, - this variable holds the name of that register (so it can be - substituted when checking the block afterwards)} - { ModReg: TRegister; } - {the tpye of the content of the register: constant, ...} - Typ: Byte; - End; - - {Contents of the integer registers} - TRegContent = Array[R_NO..R_EDI] Of TContent; - - {contents of the FPU registers} - TRegFPUContent = Array[R_ST..R_ST7] Of TContent; - - {information record with the contents of every register. Every Pai object - gets one of these assigned: a pointer to it is stored in the Line field and - the original line number is stored in LineSave} - TPaiProp = Record - Regs: TRegContent; - { FPURegs: TRegFPUContent;} {currently not yet used} - LineSave: Longint; - {status of the direction flag} - DirFlag: TFlagContents; - {can this instruction be removed?} - CanBeRemoved: Boolean; - End; - - PPaiProp = ^TPaiProp; - {$IfDef TP} - TPaiPropBlock = Array[1..(65520 div (((SizeOf(TPaiProp)+1)div 2)*2))] Of TPaiProp; - {$else} - TPaiPropBlock = Array[1..250000] Of TPaiProp; - {$EndIf TP} - PPaiPropBlock = ^TPaiPropBlock; - - TInstrSinceLastMod = Array[R_EAX..R_EDI] Of Byte; - - TLabelTableItem = Record - PaiObj: Pai; - {$IfNDef TP} - InstrNr: Longint; - RefsFound: Word; - JmpsProcessed: Word - {$EndIf TP} - End; - {$IfDef tp} - TLabelTable = Array[0..10000] Of TLabelTableItem; - {$Else tp} - TLabelTable = Array[0..2500000] Of TLabelTableItem; - {$Endif tp} - PLabelTable = ^TLabelTable; - TwoWords = Record - Word1, Word2: Word; - End; - - {******************************* Variables *******************************} - - Var - {the amount of PaiObjects in the current assembler list} - NrOfPaiObjs, - {for TP only: the amount of PPaiProps that can be stored in the PaiPropBlock} - NrOfPaiFast: Longint; - {Array which holds all (FPC) or as much as possible (TP) PPaiProps} - PaiPropBlock: PPaiPropBlock; - - LoLab, HiLab, LabDif: Longint; - - LTable: PLabelTable; - - {*********************** End of Interface section ************************} - - - Implementation - - Uses globals, systems, strings, verbose, hcodegen, - {$ifdef i386} - cgi386; - {$endif i386} - - Const AsmInstr: Array[tasmop] Of TAsmInstrucProp = ( - {MOV} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {MOVZX} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {MOVSX} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {LABEL} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {ADD} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {CALL} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {IDIV} (NCh: 3; Ch: (C_EAX, C_EDX, C_Flags)), - {IMUL} (NCh: 3; Ch: (C_EAX, C_EDX, C_Flags)), {handled separately, because several forms exist} - {JMP} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {LEA} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {MUL} (NCh: 3; Ch: (C_EAX, C_EDX, C_Flags)), - {NEG} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {NOT} (NCh: 2; Ch: (C_Op1, C_Flags, C_None)), - {POP} (NCh: 2; Ch: (C_Op1, C_ESP, C_None)), - {POPAD} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {PUSH} (NCh: 1; Ch: (C_ESP, C_None, C_None)), - {PUSHAD} (NCh: 1; Ch: (C_ESP, C_None, C_None)), - {RET} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {SUB} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {XCHG} (NCh: 2; Ch: (C_Op1, C_Op2, C_None)), {(will be) handled seperately} - {XOR} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {FILD} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {CMP} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {JZ} (NCh: 0; Ch: (C_None, C_None, C_None)), - {INC} (NCh: 2; Ch: (C_Op1, C_Flags, C_None)), - {DEC} (NCh: 2; Ch: (C_Op1, C_Flags, C_None)), - {SETE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETL} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETG} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETLE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETGE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {JE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JL} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JG} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JLE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JGE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {OR} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {FLD} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FADD} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FMUL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSUB} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FDIV} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FCHS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLD1} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIDIV} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {CLTD} (NCh: 1; Ch: (C_EDX, C_None, C_None)), - {JNZ} (NCh: 0; Ch: (C_None, C_None, C_None)), - {FSTP} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {AND} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {JNO} (NCh: 0; Ch: (C_None, C_None, C_None)), - {NOTH} (NCh: 0; Ch: (C_None, C_None, C_None)), {***???***} - {NONE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {ENTER} (NCh: 1; Ch: (C_ESP, C_None, C_None)), - {LEAVE} (NCh: 1; Ch: (C_ESP, C_None, C_None)), - {CLD} (NCh: 1; Ch: (C_CDirFlag, C_None, C_None)), - {MOVS} (NCh: 3; Ch: (C_ESI, C_EDI, C_MemEDI)), - {REP} (NCh: 1; Ch: (C_ECX, C_None, C_None)), - {SHL} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {SHR} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {BOUND} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNS} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JS} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JO} (NCh: 0; Ch: (C_None, C_None, C_None)), - {SAR} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {TEST} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {FCOM} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FCOMP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FCOMPP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FXCH} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FADDP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FMULP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSUBP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FDIVP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FNSTS} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SAHF} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {FDIVRP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSUBRP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {SETC} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNC} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {JC} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNC} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JA} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JAE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JB} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JBE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {SETA} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETAE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETB} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETBE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {AAA} (NCh: 2; Ch: (C_EAX, C_Flags, C_None)), - {AAD} (NCh: 2; Ch: (C_EAX, C_Flags, C_None)), - {AAM} (NCh: 2; Ch: (C_EAX, C_Flags, C_None)), - {AAS} (NCh: 2; Ch: (C_EAX, C_Flags, C_None)), - {CBW} (NCh: 1; Ch: (C_EAX, C_None, C_None)), - {CDQ} (NCh: 2; Ch: (C_EAX, C_EDX, C_None)), - {CLC} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {CLI} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {CLTS} (NCh: 0; Ch: (C_None, C_None, C_None)), - {CMC} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {CWD} (NCh: 2; Ch: (C_EAX, C_EDX, C_None)), - {CWDE} (NCh: 1; Ch: (C_EAX, C_None, C_None)), - {DAA} (NCh: 1; Ch: (C_EAX, C_None, C_None)), - {DAS} (NCh: 1; Ch: (C_EAX, C_None, C_None)), - {HLT} (NCh: 0; Ch: (C_None, C_None, C_None)), - {IRET} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {LAHF} (NCh: 1; Ch: (C_EAX, C_None, C_None)), - {LODS} (NCh: 2; Ch: (C_EAX, C_ESI, C_None)), - {LOCK} (NCh: 0; Ch: (C_None, C_None, C_None)), - {NOP} (NCh: 0; Ch: (C_None, C_None, C_None)), - {PUSHA} (NCh: 1; Ch: (C_ESP, C_None, C_None)), - {PUSHF} (NCh: 1; Ch: (C_ESP, C_None, C_None)), - {PUSHFD} (NCh: 1; Ch: (C_ESP, C_None, C_None)), - {STC} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {STD} (NCh: 1; Ch: (C_SDirFlag, C_None, C_None)), - {STI} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {STOS} (NCh: 2; Ch: (C_MemEDI, C_EDI, C_None)), - {WAIT} (NCh: 0; Ch: (C_None, C_None, C_None)), - {XLAT} (NCh: 1; Ch: (C_EAX, C_None, C_None)), - {XLATB} (NCh: 1; Ch: (C_EAX, C_None, C_None)), - {MOVSB} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {MOVSBL} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {MOVSBW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {MOVSWL} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {MOVZB} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {MOVZWL} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {POPA} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {IN} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {OUT} (NCh: 0; Ch: (C_None, C_None, C_None)), - {LDS} (NCh: 2; Ch: (C_Op2, C_None, C_None)), - {LCS} (NCh: 2; Ch: (C_Op2, C_None, C_None)), - {LES} (NCh: 2; Ch: (C_Op2, C_None, C_None)), - {LFS} (NCh: 2; Ch: (C_Op2, C_None, C_None)), - {LGS} (NCh: 2; Ch: (C_Op2, C_None, C_None)), - {LSS} (NCh: 2; Ch: (C_Op2, C_None, C_None)), - {POPF} (NCh: 2; Ch: (C_Flags, C_ESP, C_None)), - {SBB} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {ADC} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {DIV} (NCh: 3; Ch: (C_EAX, C_EDX, C_Flags)), - {ROR} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {ROL} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {RCL} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {RCR} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {SAL} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {SHLD} (NCh: 2; Ch: (C_Op3, C_Flags, C_None)), - {SHRD} (NCh: 2; Ch: (C_Op3, C_Flags, C_None)), - {LCALL} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {LJMP} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {LRET} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {JNAE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNB} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNA} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNBE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JP} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNP} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JPE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JPO} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNGE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNG} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNL} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JNLE} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JCXZ} (NCh: 0; Ch: (C_None, C_None, C_None)), - {JECXZ} (NCh: 0; Ch: (C_None, C_None, C_None)), - {LOOP} (NCh: 1; Ch: (C_ECX, C_None, C_None)), - {CMPS} (NCh: 3; Ch: (C_ESI, C_EDI, C_Flags)), - {INS} (NCh: 1; Ch: (C_EDI, C_None, C_None)), - {OUTS} (NCh: 1; Ch: (C_ESI, C_None, C_None)), - {SCAS} (NCh: 2; Ch: (C_EDI, C_Flags, C_None)), - {BSF} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {BSR} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {BT} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {BTC} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {BTR} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {BTS} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {INT} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {INT3} (NCh: 0; Ch: (C_None, C_None, C_None)), - {INTO} (NCh: 255; Ch: (C_None, C_None, C_None)), {don't know value of any register} - {BOUNDL} (NCh: 0; Ch: (C_None, C_None, C_None)), - {BOUNDW} (NCh: 0; Ch: (C_None, C_None, C_None)), - {LOOPZ} (NCh: 1; Ch: (C_ECX, C_None, C_None)), - {LOOPE} (NCh: 1; Ch: (C_ECX, C_None, C_None)), - {LOOPNZ} (NCh: 1; Ch: (C_ECX, C_None, C_None)), - {LOOPNE} (NCh: 1; Ch: (C_ECX, C_None, C_None)), - {SETO} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNO} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNAE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNB} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETZ} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNZ} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNA} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNBE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETS} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNS} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETP} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETPE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNP} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETPO} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNGE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNL} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNG} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SETNLE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {ARPL} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {LAR} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {LGDT} (NCh: 0; Ch: (C_None, C_None, C_None)), - {LIDT} (NCh: 0; Ch: (C_None, C_None, C_None)), - {LLDT} (NCh: 0; Ch: (C_None, C_None, C_None)), - {LMSW} (NCh: 0; Ch: (C_None, C_None, C_None)), - {LSL} (NCh: 2; Ch: (C_Op2, C_Flags, C_None)), - {LTR} (NCh: 0; Ch: (C_None, C_None, C_None)), - {SGDT} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SIDT} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SLDT} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {SMSW} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {STR} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {VERR} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {VERW} (NCh: 1; Ch: (C_Flags, C_None, C_None)), - {FABS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FBLD} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FBSTP} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FCLEX} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FNCLEX} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FCOS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FDECSTP}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FDISI} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FNDISI} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FDIVR} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FENI} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FNENI} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FFREE} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIADD} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FICOM} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FICOMP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIDIVR} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIMUL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FINCSTP}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FINIT} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FNINIT} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIST} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FISTP} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FISUB} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSUBR} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDCW} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDENV} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDLG2} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDLN2} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDL2E} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDL2T} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDPI} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDZ} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FNOP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FPATAN} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FPREM} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FPREM1} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FPTAN} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FRNDINT}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FRSTOR} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSAVE} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FNSAVE} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSCALE} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSETPM} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSIN} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSINCOS}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSQRT} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FST} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FSTCW} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FNSTCW} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FSTENV} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FNSTENV}(NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FSTSW} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FNSTSW} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FTST} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FUCOM} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FUCOMP} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FUCOMPP}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FWAIT} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FXAM} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FXTRACT}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FYL2X} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FYL2XP1}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {F2XM1} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FILDQ} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FILDS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FILDL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FLDT} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FISTQ} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FISTS} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FISTL} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FSTL} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FSTS} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FSTPS} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FISTPL} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FSTPL} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FISTPS} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FISTPQ} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FSTPT} (NCh: 1; Ch: (C_Op1, C_None, C_None)), - {FCOMPS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FICOMPL}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FCOMPL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FICOMPS}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FCOMS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FICOML} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FCOML} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FICOMS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIADDL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FADDL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIADDS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FISUBL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSUBL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FISUBS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSUBS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSUBR} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSUBRS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FISUBRL}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FSUBRL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FISUBRS}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FMULS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIMUL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FMULL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIMULS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIDIVS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIDIVL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FDIVL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIDIVS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FDIVRS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIDIVRL}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FDIVRL} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {FIDIVRS}(NCh: 1; Ch: (C_FPU, C_None, C_None)), - {REPE} (NCh: 0; Ch: (C_ECX, C_None, C_None)), - {REPNE} (NCh: 0; Ch: (C_ECX, C_None, C_None)), - {FADDS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {POPFD} (NCh: 2; Ch: (C_ESP, C_Flags, C_None)), - {below are the MMX instructions} - {A_EMMS} (NCh: 1; Ch: (C_FPU, C_None, C_None)), - {A_MOVD} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_MOVQ} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PACKSSDW} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PACKSSWB} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PACKUSWB} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PADDB} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PADDD} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PADDSB} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PADDSW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PADDUSB} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PADDUSW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PADDW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PAND} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PANDN} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PCMPEQB} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PCMPEQD} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PCMPEQW} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PCMPGTB} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PCMPGTD} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PCMPGTW} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PMADDWD} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PMULHW} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PMULLW} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_POR} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSLLD} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSLLQ} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSLLW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSRAD} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSRAW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSRLD} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSRLQ} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSRLW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSUBB} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSUBD} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSUBSB} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSUBSW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSUBUSB} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSUBUSW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PSUBW} (NCh: 1; Ch: (C_Op2, C_None, C_None)), - {A_PUNPCKHBW} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PUNPCKHDQ} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PUNPCKHWD} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PUNPCKLBW} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PUNPCKLDQ} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PUNPCKLWD} (NCh: 255; Ch: (C_FPU, C_None, C_None)), - {A_PXOR} (NCh: 1; Ch: (C_Op2, C_None, C_None))); - - Var - {How many instructions are betwen the current instruction and the last one - that modified the register} - NrOfInstrSinceLastMod: TInstrSinceLastMod; - - - {************************ Create the Label table ************************} - - Procedure FindLoHiLabels(AsmL: PAasmOutput; Var LowLabel, HighLabel, LabelDif: Longint); - {Walks through the paasmlist to find the lowest and highest label number; - Since 0.9.3: also removes unused labels} - Var LabelFound: Boolean; - P, hp1: Pai; - Begin - LabelFound := False; - LowLabel := MaxLongint; - HighLabel := 0; - P := Pai(AsmL^.first); - While Assigned(p) Do - Begin - If (Pai(p)^.typ = ait_label) Then - If (Pai_Label(p)^.l^.is_used) - Then - Begin - LabelFound := True; - If (Pai_Label(p)^.l^.nb < LowLabel) Then - LowLabel := Pai_Label(p)^.l^.nb; - If (Pai_Label(p)^.l^.nb > HighLabel) Then - HighLabel := Pai_Label(p)^.l^.nb; - End - Else - Begin - hp1 := pai(p^.next); - AsmL^.Remove(p); - Dispose(p, Done); - p := hp1; - continue; - End; - p := pai(p^.next); - End; - If LabelFound - Then LabelDif := HighLabel+1-LowLabel - Else LabelDif := 0; - End; - - Procedure BuildLabelTable(AsmL: PAasmOutput; Var LabelTable: PLabelTable; LowLabel: Longint; Var LabelDif: Longint); - {Builds a table with the locations of the labels in the paasmoutput} - Var p: Pai; - Begin - If (LabelDif <> 0) Then - Begin - {$IfDef TP} - If (MaxAvail >= LabelDif*SizeOf(Pai)) - Then - Begin - {$EndIf TP} - GetMem(LabelTable, LabelDif*SizeOf(TLabelTableItem)); - FillChar(LabelTable^, LabelDif*SizeOf(TLabelTableItem), 0); - p := pai(AsmL^.first); - While Assigned(p) Do - Begin - If (Pai(p)^.typ = ait_label) Then - LabelTable^[Pai_Label(p)^.l^.nb-LowLabel].PaiObj := p; - p := pai(p^.next); - End; - {$IfDef TP} - End - Else LabelDif := 0; - {$EndIf TP} - End; - End; - - {************************ Search the Label table ************************} - - Function FindLabel(L: PLabel; Var hp: Pai): Boolean; - - {searches for the specified label starting from hp as long as the - encountered instructions are labels, to be able to optimize constructs like - - jne l2 jmp l2 - jmp l3 and l1: - l1: l2: - l2:} - - Var TempP: Pai; - - Begin - TempP := hp; - While Assigned(TempP) and - (pai(TempP)^.typ In SkipInstr + [ait_label]) Do - If (pai_label(TempP)^.l <> L) - Then TempP := Pai(TempP^.next) - Else - Begin - hp := TempP; - FindLabel := True; - exit - End; - FindLabel := False - End; - - {************************ Some general functions ************************} - - Function Reg32(Reg: TRegister): TRegister; - {Returns the 32 bit component of Reg if it exists, otherwise Reg is returned} - Begin - Reg32 := Reg; - If (Reg >= R_AX) - Then - If (Reg <= R_DI) - Then Reg32 := Reg16ToReg32(Reg) - Else - If (Reg <= R_BL) - Then Reg32 := Reg8toReg32(Reg); - End; - - Function PowerOf2(L: Longint): Longint; - Var Counter, TempVal: Longint; - Begin - TempVal := 1; - For Counter := 1 to L Do - TempVal := TempVal * 2; - PowerOf2 := TempVal; - End; - - { inserts new_one between prev and foll } - Procedure InsertLLItem(AsmL: PAasmOutput; prev, foll, new_one: PLinkedList_Item); - Begin - If Assigned(prev) Then - If Assigned(foll) Then - Begin - If Assigned(new_one) Then - Begin - new_one^.previous := prev; - new_one^.next := foll; - prev^.next := new_one; - foll^.previous := new_one; - End; - End - Else AsmL^.Concat(new_one) - Else If Assigned(Foll) Then AsmL^.Insert(new_one) - End; - - {********************* Compare parts of Pai objects *********************} - - Function RefsEqual(Const R1, R2: TReference): Boolean; - Begin - If R1.IsIntValue - Then RefsEqual := R2.IsIntValue and (R1.Offset = R2.Offset) - Else If (R1.Offset = R2.Offset) And (R1.Base = R2.Base) And - (R1.Index = R2.Index) And (R1.Segment = R2.Segment) And - (R1.ScaleFactor = R2.ScaleFactor) - Then - Begin - If Assigned(R1.Symbol) - Then RefsEqual := Assigned(R2.Symbol) And (R1.Symbol^=R2.Symbol^) - Else RefsEqual := Not(Assigned(R2.Symbol)); - End - Else RefsEqual := False; - End; - - Function IsGP32Reg(Reg: TRegister): Boolean; - {Checks if the register is a 32 bit general purpose register} - Begin - If (Reg >= R_EAX) and (Reg <= R_EBX) - Then IsGP32Reg := True - Else IsGP32reg := False - End; - - Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean; - Begin {checks whether Ref contains a reference to Reg} - Reg := Reg32(Reg); - RegInRef := (Ref.Base = Reg) Or (Ref.Index = Reg) - End; - - Function RegInInstruction(Reg: TRegister; p1: Pai): Boolean; - {checks if Reg is used by the instruction p1} - Var TmpResult: Boolean; - Begin - TmpResult := False; - If (Pai(p1)^.typ = ait_instruction) Then - Begin - Case Pai386(p1)^.op1t Of - Top_Reg: TmpResult := Reg = TRegister(Pai386(p1)^.op1); - Top_Ref: TmpResult := RegInRef(Reg, TReference(Pai386(p1)^.op1^)) - End; - If Not(TmpResult) Then - Case Pai386(p1)^.op2t Of - Top_Reg: - if Pai386(p1)^.op3t<>Top_reg - then TmpResult := Reg = TRegister(Pai386(p1)^.op2) - else TmpResult := longint(Reg) = twowords(Pai386(p1)^.op2).word1; - Top_Ref: TmpResult := RegInRef(Reg, TReference(Pai386(p1)^.op2^)) - End; - If Not(TmpResult) Then - Case Pai386(p1)^.op3t Of - Top_Reg: TmpResult := longint(Reg) =twowords(Pai386(p1)^.op2).word2; - Top_none:; - else - internalerror($Da); - End - End; - RegInInstruction := TmpResult - End; - - {********************* GetNext and GetLastInstruction *********************} - - Function GetNextInstruction(Current: Pai; Var Next: Pai): Boolean; - {skips ait_regalloc, ait_regdealloc and ait_stab* objects and puts the - next pai object in Next. Returns false if there isn't any} - Begin - GetNextInstruction := False; - Current := Pai(Current^.Next); - While Assigned(Current) And - (Pai(Current)^.typ In SkipInstr) Do - Current := Pai(Current^.Next); - If Assigned(Current) - Then - Begin - Next := Current; - GetNextInstruction := True; - End; - End; - - Function GetLastInstruction(Current: Pai; Var Last: Pai): Boolean; - {skips the ait-types in SkipInstr puts the previous pai object in - Last. Returns false if there isn't any} - Begin - GetLastInstruction := False; - Current := Pai(Current^.previous); - While Assigned(Current) And - (Pai(Current)^.typ In SkipInstr) Do - Current := Pai(Current^.previous); - If Assigned(Current) - Then - Begin - Last := Current; - GetLastInstruction := True; - End; - End; - - {******************* The Data Flow Analyzer functions ********************} - - (*Function FindZeroreg(p: Pai; Var Result: TRegister): Boolean; - {Finds a register which contains the constant zero} - Var Counter: TRegister; - Begin - Counter := R_EAX; - FindZeroReg := True; - While (Counter <= R_EDI) And - ((PPaiProp(p^.fileinfo.line)^.Regs[Counter].Typ <> Con_Const) or - (PPaiProp(p^.fileinfo.line)^.Regs[Counter].StartMod <> Pointer(0))) Do - Inc(Byte(Counter)); - If (PPaiProp(p^.fileinfo.line)^.Regs[Counter].Typ = Con_Const) And - (PPaiProp(p^.fileinfo.line)^.Regs[Counter].StartMod = Pointer(0)) - Then Result := Counter - Else FindZeroReg := False; - End;*) - - Function TCh2Reg(Ch: TChange): TRegister; - {converts a TChange variable to a TRegister} - Begin - If (CH <= C_EDI) - Then TCh2Reg := TRegister(Byte(Ch)) - Else InternalError($db) - End; - - Procedure IncState(Var S: Word); - {Increases the state by 1, wraps around at $ffff to 0 (so we won't get - overflow errors} - Begin - If (s <> $ffff) - Then Inc(s) - Else s := 0 - End; - - Procedure DestroyReg(p1: PPaiProp; Reg: TRegister); - {Destroys the contents of the register Reg in the PPaiProp of P} - Var TmpState: Longint; - Begin - Reg := Reg32(Reg); - NrOfInstrSinceLastMod[Reg] := 0; - If (Reg >= R_EAX) And (Reg <= R_EDI) - Then - With p1^.Regs[Reg] Do - Begin - IncState(State); - TmpState := State; - FillChar(p1^.Regs[Reg], SizeOf(TContent), 0); - State := TmpState; - End; - End; - - Function OpsEqual(typ: Longint; op1, op2: Pointer): Boolean; - Begin {checks whether the two ops are equal} - Case typ Of - Top_Reg, Top_Const: OpsEqual := op1 = op2; - Top_Ref: OpsEqual := RefsEqual(TReference(op1^), TReference(op2^)); - Top_None: OpsEqual := True - Else OpsEqual := False - End; - End; - - Function RegsSameContent(p1, p2: Pai; Reg: TRegister): Boolean; - {checks whether Reg has the same content in the PPaiProp of p1 and p2} - Begin - Reg := Reg32(Reg); - RegsSameContent := - PPaiProp(p1^.fileinfo.line)^.Regs[Reg].State = - PPaiProp(p2^.fileinfo.line)^.Regs[Reg].State; - End; - - Function InstructionsEqual(p1, p2: Pai): Boolean; - Begin {checks whether two Pai386 instructions are equal} - InstructionsEqual := - Assigned(p1) And Assigned(p2) And - {$ifdef regalloc} - ((((Pai(p1)^.typ = ait_regalloc) And - (Pai(p2)^.typ = ait_regalloc)) Or - ((Pai(p1)^.typ = ait_regdealloc) And - (Pai(p2)^.typ = ait_regdealloc))) And - (PaiRegAlloc(p1)^.reg = PaiRegAlloc(p2)^.reg)) Or - {$endif regalloc} - ((Pai(p1)^.typ = ait_instruction) And - (Pai(p1)^.typ = ait_instruction) And - (Pai386(p1)^._operator = Pai386(p2)^._operator) And - (Pai386(p1)^.op1t = Pai386(p2)^.op1t) And - (Pai386(p1)^.op2t = Pai386(p2)^.op2t) And - OpsEqual(Pai386(p1)^.op1t, Pai386(p1)^.op1, Pai386(p2)^.op1) And - OpsEqual(Pai386(p1)^.op2t, Pai386(p1)^.op2, Pai386(p2)^.op2)) - End; - - - Procedure DestroyRefs(p: pai; Const Ref: TReference; WhichRegNot: TRegister); - {destroys all registers which possibly contain a reference to Ref} - Var Counter: TRegister; - Begin - WhichRegNot := Reg32(WhichRegNot); - If Not(Assigned(Ref.Symbol)) - Then - Begin - If (Ref.base = ProcInfo.FramePointer) And - (Ref.Index = R_NO) - Then - {write something to a parameter or a local variable} - For Counter := R_EAX to R_EDI Do - With PPaiProp(p^.fileinfo.line)^.Regs[Counter] Do - Begin - If (typ = Con_Ref) And - {StarMod is always of the type ait_instruction} - (Pai386(StartMod)^.op1t = top_ref) And - ((RefsEqual(TReference(Pai386(StartMod)^.op1^), Ref) And - ((Counter <> WhichRegNot) Or (NrOfMods <> 1))) Or - - (Not(cs_UncertainOpts in AktSwitches) And - + (Not(cs_UncertainOpts in aktglobalswitches) And (NrOfMods <> 1))) - Then DestroyReg(PPaiProp(p^.fileinfo.line), Counter) - End - Else - {writing something to a pointer location} - For Counter := R_EAX to R_EDI Do - With PPaiProp(p^.fileinfo.line)^.Regs[Counter] Do - If (typ = Con_Ref) And - - (Not(cs_UncertainOpts in AktSwitches) Or - + (Not(cs_UncertainOpts in aktglobalswitches) Or {for movsl} - (Ref.Base = R_EDI) Or - {don't destroy if reg contains a parameter or local variable} - (Not((NrOfMods = 1) And - (Pai386(StartMod)^.op1t = top_ref) And - (PReference(Pai386(StartMod)^.op1)^.base = ProcInfo.FramePointer)))) - Then - {we don't know what memory location the reference points to, so we just - destroy every register which contains a memory reference} - DestroyReg(PPaiProp(p^.FileInfo.Line), Counter) - End - Else {the ref is a var name or we just have a reference an absolute offset} - Begin - For Counter := R_EAX to R_EDI Do - If (Counter <> WhichRegNot) And - (PPaiProp(p^.fileinfo.line)^.Regs[Counter].typ = Con_Ref) And - - (Not(cs_UncertainOpts in AktSwitches) Or - + (Not(cs_UncertainOpts in aktglobalswitches) Or RefsEqual(Ref, - TReference(Pai386(PPaiProp(p^.fileinfo.line)^.Regs[Counter].StartMod)^.op1^))) Then - DestroyReg(PPaiProp(p^.fileinfo.line), Counter) - End; - End; - - Procedure DestroyAllRegs(p: PPaiProp); - Var Counter: TRegister; - Begin {initializes/desrtoys all registers} - For Counter := R_EAX To R_EDI Do - DestroyReg(p, Counter); - p^.DirFlag := F_Unknown; - End; - - Procedure Destroy(PaiObj: Pai; opt: Longint; Op: Pointer); - Begin - Case opt Of - top_reg: DestroyReg(PPaiProp(PaiObj^.fileinfo.line), TRegister(Op)); - top_ref: DestroyRefs(PaiObj, TReference(Op^), R_NO); - top_symbol:; - End; - End; - - Procedure DFAPass1(AsmL: PAasmOutput); - {gathers the RegAlloc data... still need to think about where to store it} - Begin - FindLoHiLabels(AsmL, LoLab, HiLab, LabDif); - BuildLabelTable(AsmL, LTable, LoLab, LabDif); - End; - - Function DoDFAPass2(First: Pai): Pai; - {Analyzes the Data Flow of an assembler list. Starts creating the reg - contents for the instructions starting with p. Returns the last pai which has - been processed} - Var - CurProp: PPaiProp; - Cnt, InstrCnt, TmpState: Longint; - InstrProp: TAsmInstrucProp; - p, hp: Pai; - TmpRef: TReference; - TmpReg: TRegister; - Begin - p := First; - InstrCnt := 1; - FillChar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0); - While Assigned(p) Do - Begin - DoDFAPass2 := p; - {$IfDef TP} - If (InstrCnt <= NrOfPaiFast) Then - {$EndIf TP} - CurProp := @PaiPropBlock^[InstrCnt] - {$IfDef TP} - Else New(CurProp) - {$EndIf TP} - ; - If (p <> First) - Then - {$ifndef TP} - Begin - If (p^.Typ <> ait_label) Then - {$endif TP} - Begin - CurProp^.Regs := PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs; - CurProp^.DirFlag := PPaiProp(Pai(p^.previous)^.fileinfo.line)^.DirFlag - End - {$ifndef TP} - End - {$endif TP} - Else - Begin - FillChar(CurProp^, SizeOf(CurProp^), 0); - { For TmpReg := R_EAX to R_EDI Do - CurProp^.Regs[TmpReg].State := 1;} - End; - CurProp^.CanBeRemoved := False; - {$IfDef TP} - CurProp^.linesave := p^.fileinfo.line; - PPaiProp(p^.fileinfo.line) := CurProp; - {$EndIf} - For TmpReg := R_EAX To R_EDI Do - Inc(NrOfInstrSinceLastMod[TmpReg]); - Case p^.typ Of - ait_label: - {$Ifdef TP} - DestroyAllRegs(CurProp); - {$Else TP} - Begin - With LTable^[Pai_Label(p)^.l^.nb-LoLab] Do - {$IfDef AnalyzeLoops} - If (RefsFound = Pai_Label(p)^.l^.RefCount) - {$Else AnalyzeLoops} - If (JmpsProcessed = Pai_Label(p)^.l^.RefCount) - {$EndIf AnalyzeLoops} - Then - {all jumps to this label have been found} - {$IfDef AnalyzeLoops} - If (JmpsProcessed > 0) - Then - {$EndIf} - {we've processed at least one jump to this label} - Begin - If Not(GetLastInstruction(p, hp) And - (hp^.typ = ait_labeled_instruction) And - (Pai_Labeled(hp)^._operator = A_JMP)) - Then - {previous instruction not a JMP -> the contents of the registers after the - previous intruction has been executed have to be taken into account as well} - For TmpReg := R_EAX to R_EDI Do - Begin - If (CurProp^.Regs[TmpReg].State <> - PPaiProp(Pai(p^.Previous)^.FileInfo.Line)^.Regs[TmpReg].State) - Then DestroyReg(CurProp, TmpReg) - End - End - {$IfDef AnalyzeLoops} - Else - {a label from a backward jump (e.g. a loop), no jump to this label has - already been processed} - If Not(GetLastInstruction(p, hp) And - (hp^.typ = ait_labeled_instruction) And - (Pai_Labeled(hp)^._operator = A_JMP)) - Then - {previous instruction not a jmp, so keep all the registers' contents from the - previous instruction} - Begin - CurProp^.Regs := PPaiProp(Pai(p^.Previous)^.FileInfo.Line)^.Regs; - CurProp^.DirFlag := PPaiProp(Pai(p^.Previous)^.FileInfo.Line)^.DirFlag; - End - Else - {previous instruction a jmp and no jump to this label processed yet} - Begin - hp := p; - Cnt := InstrCnt; - {continue until we find a jump to the label or a label which has already - been processed} - While GetNextInstruction(hp, hp) And - Not((hp^.typ = ait_labeled_instruction) And - (Pai_Labeled(hp)^.lab^.nb = Pai_Label(p)^.l^.nb)) And - Not((hp^.typ = ait_label) And - (LTable^[Pai_Label(hp)^.l^.nb-LoLab].RefsFound - = Pai_Label(hp)^.l^.RefCount) And - (LTable^[Pai_Label(hp)^.l^.nb-LoLab].JmpsProcessed > 0)) Do - Inc(Cnt); - If (hp^.typ = ait_label) - Then - {there's a processed label after the current one} - Begin - CurProp^.Regs := PaiPropBlock^[Cnt].Regs; - CurProp^.DirFlag := PaiPropBlock^[Cnt].DirFlag; - End - Else - {there's no label anymore after the current one, or they haven't been - processed yet} - Begin - CurProp^.Regs := PPaiProp(Pai(p^.Previous)^.FileInfo.Line)^.Regs; - CurProp^.DirFlag := PPaiProp(Pai(p^.Previous)^.FileInfo.Line)^.DirFlag; - DestroyAllRegs(PPaiProp(Pai(p^.Previous)^.FileInfo.Line)) - End - End - {$EndIf AnalyzeLoops} - Else - {not all references to this label have been found, so destroy all registers} - Begin - CurProp^.Regs := PPaiProp(Pai(p^.Previous)^.FileInfo.Line)^.Regs; - CurProp^.DirFlag := PPaiProp(Pai(p^.Previous)^.FileInfo.Line)^.DirFlag; - DestroyAllRegs(CurProp) - End; - End; - {$EndIf TP} - ait_labeled_instruction: - {$IfDef TP} - ; - {$Else TP} - With LTable^[Pai_Labeled(p)^.lab^.nb-LoLab] Do - If (RefsFound = Pai_Labeled(p)^.lab^.RefCount) Then - Begin - If (InstrCnt < InstrNr) - Then - {forward jump} - If (JmpsProcessed = 0) Then - {no jump to this label has been processed yet} - Begin - PaiPropBlock^[InstrNr].Regs := CurProp^.Regs; - PaiPropBlock^[InstrNr].DirFlag := CurProp^.DirFlag; - Inc(JmpsProcessed); - End - Else - Begin - For TmpReg := R_EAX to R_EDI Do - If (PaiPropBlock^[InstrNr].Regs[TmpReg].State <> - CurProp^.Regs[TmpReg].State) Then - DestroyReg(@PaiPropBlock^[InstrNr], TmpReg); - Inc(JmpsProcessed); - End - {$ifdef AnalyzeLoops} - Else - {backward jump, a loop for example} - { If (JmpsProcessed > 0) Or - Not(GetLastInstruction(PaiObj, hp) And - (hp^.typ = ait_labeled_instruction) And - (Pai_Labeled(hp)^._operator = A_JMP)) - Then} - {instruction prior to label is not a jmp, or at least one jump to the label - has yet been processed} - Begin - Inc(JmpsProcessed); - For TmpReg := R_EAX to R_EDI Do - If (PaiPropBlock^[InstrNr].Regs[TmpReg].State <> - CurProp^.Regs[TmpReg].State) - Then - Begin - TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].State; - Cnt := InstrNr; - While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].State) Do - Begin - DestroyReg(@PaiPropBlock^[Cnt], TmpReg); - Inc(Cnt); - End; - While (Cnt <= InstrCnt) Do - Begin - Inc(PaiPropBlock^[Cnt].Regs[TmpReg].State); - Inc(Cnt) - End - End; - End - { Else - {instruction prior to label is a jmp and no jumps to the label have yet been - processed} - Begin - Inc(JmpsProcessed); - For TmpReg := R_EAX to R_EDI Do - Begin - TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].State; - Cnt := InstrNr; - While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].State) Do - Begin - PaiPropBlock^[Cnt].Regs[TmpReg] := CurProp^.Regs[TmpReg]; - Inc(Cnt); - End; - TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].State; - While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].State) Do - Begin - DestroyReg(@PaiPropBlock^[Cnt], TmpReg); - Inc(Cnt); - End; - While (Cnt <= InstrCnt) Do - Begin - Inc(PaiPropBlock^[Cnt].Regs[TmpReg].State); - Inc(Cnt) - End - End - End} - {$endif AnalyzeLoops} - End; - {$EndIf TP} - {$ifdef GDB} - ait_stabs, ait_stabn, ait_stab_function_name:; - {$endif GDB} - {$ifdef regalloc} - ait_regalloc, ait_regdealloc:; - {$endif regalloc} - ait_instruction: - Begin - InstrProp := AsmInstr[Pai386(p)^._operator]; - Case Pai386(p)^._operator Of - A_MOV, A_MOVZX, A_MOVSX: - Begin - Case Pai386(p)^.op1t Of - Top_Reg: - Case Pai386(p)^.op2t Of - Top_Reg: - Begin - DestroyReg(CurProp, TRegister(Pai386(p)^.op2)); - { CurProp^.Regs[TRegister(Pai386(p)^.op2)] := - CurProp^.Regs[TRegister(Pai386(p)^.op1)]; - If (CurProp^.Regs[TRegister(Pai386(p)^.op2)].ModReg = R_NO) Then - CurProp^.Regs[TRegister(Pai386(p)^.op2)].ModReg := - Tregister(Pai386(p)^.op1);} - End; - Top_Ref: DestroyRefs(p, TReference(Pai386(p)^.op2^), TRegister(Pai386(p)^.op1)); - End; - Top_Ref: - Begin {destination is always a register in this case} - TmpReg := Reg32(TRegister(Pai386(p)^.op2)); - If (RegInRef(TmpReg, TReference(Pai386(p)^.op1^))) - Then - Begin - With CurProp^.Regs[TmpReg] Do - Begin - IncState(State); - If (typ <> Con_Ref) Then - Begin - typ := Con_Ref; - StartMod := p; - End; - {also store how many instructions are part of the sequence in the first - instructions PPaiProp, so it can be easily accessed from within - CheckSequence} - Inc(NrOfMods, NrOfInstrSinceLastMod[TmpReg]); - PPaiProp(Pai(StartMod)^.fileinfo.line)^.Regs[TmpReg].NrOfMods := NrOfMods; - NrOfInstrSinceLastMod[TmpReg] := 0; - End; - End - Else - Begin - DestroyReg(CurProp, TmpReg); - With CurProp^.Regs[TmpReg] Do - Begin - Typ := Con_Ref; - StartMod := p; - NrOfMods := 1; - End; - End; - End; - Top_Const: - Begin - Case Pai386(p)^.op2t Of - Top_Reg: - Begin - TmpReg := Reg32(TRegister(Pai386(p)^.op2)); - With CurProp^.Regs[TmpReg] Do - Begin - {it doesn't matter that the state is changed, - it isn't looked at when removing constant reloads} - DestroyReg(CurProp, TmpReg); - typ := Con_Const; - StartMod := Pai386(p)^.op1; - End - End; - Top_Ref: DestroyRefs(P, TReference(Pai386(p)^.op2^), R_NO); - End; - End; - End; - End; - A_IMUL: - Begin - If (Pai386(p)^.Op3t = top_none) - Then - If (Pai386(p)^.Op2t = top_none) - Then - Begin - DestroyReg(CurProp, R_EAX); - DestroyReg(CurProp, R_EDX) - End - Else - Begin - If (Pai386(p)^.Op2t = top_reg) Then - DestroyReg(CurProp, TRegister(Pai386(p)^.Op2)); - End - Else If (Pai386(p)^.Op3t = top_reg) Then - DestroyReg(CurProp, TRegister(longint(twowords(Pai386(p)^.Op2).word2))); - End; - A_XOR: - Begin - If (Pai386(p)^.op1t = top_reg) And - (Pai386(p)^.op2t = top_reg) And - (Pai386(p)^.op1 = Pai386(p)^.op2) - Then - Begin - DestroyReg(CurProp, Tregister(Pai386(p)^.op1)); - CurProp^.Regs[Reg32(Tregister(Pai386(p)^.op1))].typ := Con_Const; - CurProp^.Regs[Reg32(Tregister(Pai386(p)^.op1))].StartMod := Pointer(0) - End - Else Destroy(p, Pai386(p)^.op2t, Pai386(p)^.op2); - End - Else - Begin - If InstrProp.NCh <> 255 - Then - For Cnt := 1 To InstrProp.NCh Do - Case InstrProp.Ch[Cnt] Of - C_None:; - C_EAX..C_EDI: DestroyReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt])); - C_CDirFlag: CurProp^.DirFlag := F_NotSet; - C_SDirFlag: CurProp^.DirFlag := F_Set; - C_Op1: Destroy(p, Pai386(p)^.op1t, Pai386(p)^.op1); - C_Op2: Destroy(p, Pai386(p)^.op2t, Pai386(p)^.op2); - C_Op3: Destroy(p, Pai386(p)^.op2t, Pointer(Longint(TwoWords(Pai386(p)^.op2).word2))); - C_MemEDI: - Begin - FillChar(TmpRef, SizeOf(TmpRef), 0); - TmpRef.Base := R_EDI; - DestroyRefs(p, TmpRef, R_NO) - End; - C_Flags, C_FPU:; - End - Else - Begin - DestroyAllRegs(CurProp); - End; - End; - End; - End - Else - Begin - DestroyAllRegs(CurProp); - End; - End; - Inc(InstrCnt); - p := Pai(p^.next); - End; - End; - - Function InitDFAPass2(AsmL: PAasmOutput): Boolean; - {reserves memory for the PPaiProps in one big memory block when not using - TP, returns False if not enough memory is available for the optimizer in all - cases} - Var p: Pai; - Count: Longint; - TmpStr: String; - Begin - P := Pai(AsmL^.First); - NrOfPaiObjs := 1; - While (P <> Pai(AsmL^.last)) Do - Begin - {$IfNDef TP} - Case P^.Typ Of - ait_labeled_instruction: - begin - If (Pai_Labeled(P)^.lab^.nb >= LoLab) And - (Pai_Labeled(P)^.lab^.nb <= HiLab) Then - Inc(LTable^[Pai_Labeled(P)^.lab^.nb-LoLab].RefsFound); - end; - ait_label: - Begin - LTable^[Pai_Label(P)^.l^.nb-LoLab].InstrNr := NrOfPaiObjs - End; - { ait_instruction: - Begin - If (Pai386(p)^._operator = A_PUSH) And - (Pai386(p)^.op1t = top_symbol) And - (PCSymbol(Pai386(p)^.op1)^.offset = 0) Then - Begin - TmpStr := StrPas(PCSymbol(Pai386(p)^.op1)^.symbol); - If} - End; - {$EndIf TP} - Inc(NrOfPaiObjs); - P := Pai(P^.next) - End; - {$IfDef TP} - If (MemAvail < (SizeOf(TPaiProp)*NrOfPaiObjs)) - {this doesn't have to be one contiguous block} - Then InitDFAPass2 := False - Else - Begin - InitDFAPass2 := True; - If (MaxAvail < 65520) - Then NrOfPaiFast := MaxAvail Div (((SizeOf(TPaiProp)+1) div 2)*2) - Else NrOfPaiFast := 65520 Div (((SizeOf(TPaiProp)+1) div 2)*2); - If (NrOfPaiFast > 0) Then - GetMem(PaiPropBlock, NrOfPaiFast*(((SizeOf(TPaiProp)+1) div 2)*2)); - End; - {$Else} - {Uncomment the next line to see how much memory the reloading optimizer needs} - { Writeln((NrOfPaiObjs*(((SizeOf(TPaiProp)+3)div 4)*4)));} - {no need to check mem/maxavail, we've got as much virtual memory as we want} - InitDFAPass2 := True; - GetMem(PaiPropBlock, NrOfPaiObjs*(((SizeOf(TPaiProp)+3)div 4)*4)); - NrOfPaiFast := NrOfPaiObjs; - p := Pai(AsmL^.First); - For Count := 1 To NrOfPaiObjs Do - Begin - PaiPropBlock^[Count].LineSave := p^.fileinfo.line; - PPaiProp(p^.fileinfo.line) := @PaiPropBlock^[Count]; - p := Pai(p^.next); - End; - {$EndIf TP} - End; - - Function DFAPass2(AsmL: PAasmOutPut): Pai; - Begin - If InitDFAPass2(AsmL) - Then DFAPass2 := DoDFAPass2(Pai(AsmL^.First)) - Else DFAPass2 := Nil; - End; - - Procedure ShutDownDFA; - Begin - If LabDif <> 0 Then - FreeMem(LTable, LabDif*SizeOf(TLabelTableItem)); - End; - - End. - - { - $Log$ - Revision 1.5 1998-08-09 13:56:24 jonas + Revision 1.6 1998-08-10 14:49:57 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.5 1998/08/09 13:56:24 jonas * small bugfix for uncertain optimizations in DestroyRefs - Revision 1.4 1998/08/06 19:40:25 jonas - * removed $ before and after Log in comment - - Revision 1.3 1998/08/05 16:00:14 florian - * some fixes for ansi strings - * log to Log changed - - } - diff --git a/compiler/files.pas b/compiler/files.pas index b15fb04c15..8e8e6fc086 100644 --- a/compiler/files.pas +++ b/compiler/files.pas @@ -538,7 +538,7 @@ unit files; singlepathstring:=FixPath(copy(unitpath,start,i-start)); delete(unitpath,start,i-start+1); { Check for PPL file } - if not (cs_link_static in aktswitches) then + if not (cs_link_static in aktglobalswitches) then begin Found:=UnitExists(target_info.unitlibext); if Found then @@ -548,7 +548,7 @@ unit files; End; end; { Check for PPU file } - if not (cs_link_dynamic in aktswitches) and not Found then + if not (cs_link_dynamic in aktglobalswitches) and not Found then begin Found:=UnitExists(target_info.unitext); if Found then @@ -886,7 +886,7 @@ unit files; uses_imports:=false; imports:=new(plinkedlist,init); { set smartlink flag } - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then flags:=flags or uf_smartlink; { search the PPU file if it is an unit } if is_unit then @@ -1003,7 +1003,10 @@ unit files; end. { $Log$ - Revision 1.31 1998-07-14 14:46:48 peter + Revision 1.32 1998-08-10 14:49:58 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.31 1998/07/14 14:46:48 peter * released NEWINPUT Revision 1.30 1998/07/07 11:19:55 peter diff --git a/compiler/hcodegen.pas b/compiler/hcodegen.pas index bcb73e1c74..0e9e9d1584 100644 --- a/compiler/hcodegen.pas +++ b/compiler/hcodegen.pas @@ -150,7 +150,7 @@ unit hcodegen; { to be able to force to have a global label for const } const make_const_global : boolean = false; - + implementation uses @@ -364,7 +364,7 @@ implementation { we must use the number directly !!! (PM) } function constlabel2str(l : plabel;ctype:tconsttype):string; begin - if (cs_smartlink in aktswitches) or + if (cs_smartlink in aktmoduleswitches) or make_const_global {or (aktoutputformat in [as_tasm])} then constlabel2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(l^.nb) else @@ -373,7 +373,7 @@ implementation function constlabelnb2str(pnb : longint;ctype:tconsttype):string; begin - if (cs_smartlink in aktswitches) or + if (cs_smartlink in aktmoduleswitches) or make_const_global {or (aktoutputformat in [as_tasm])} then constlabelnb2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(pnb) else @@ -385,11 +385,11 @@ implementation var s : string; begin - if (cs_smartlink in aktswitches) or + if (cs_smartlink in aktmoduleswitches) or make_const_global {or (aktoutputformat in [as_tasm])} then begin s:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb); - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then begin consts^.concat(new(pai_cut,init)); consts^.concat(new(pai_symbol,init_global(s))) @@ -405,7 +405,10 @@ end. { $Log$ - Revision 1.11 1998-07-28 21:52:51 florian + Revision 1.12 1998-08-10 14:50:01 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.11 1998/07/28 21:52:51 florian + implementation of raise and try..finally + some misc. exception stuff @@ -423,8 +426,6 @@ end. Revision 1.7 1998/06/04 09:55:38 pierre * demangled name of procsym reworked to become independant of the mangling scheme - Come test_funcret improvements (not yet working)S: ---------------------------------------------------------------------- - Revision 1.6 1998/05/23 01:21:08 peter + aktasmmode, aktoptprocessor, aktoutputformat + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches diff --git a/compiler/link.pas b/compiler/link.pas index 3fcb8711f5..d1e0a4bf38 100644 --- a/compiler/link.pas +++ b/compiler/link.pas @@ -171,10 +171,10 @@ begin if LastLDBin='' then begin LastLDBin:=FindExe(target_link.linkbin,ldfound); - if (not ldfound) and (not externlink) then + if (not ldfound) and not(cs_link_extern in aktglobalswitches) then begin Message1(exec_w_linker_not_found,LastLDBin); - externlink:=true; + aktglobalswitches:=aktglobalswitches+[cs_link_extern]; end; if ldfound then Message1(exec_u_using_linker,LastLDBin); @@ -197,7 +197,7 @@ begin exit; end; findobjectfile:=search(s,'.;'+unitsearchpath+';'+exepath,found)+s; - if (not externlink) and (not found) then + if not(cs_link_extern in aktglobalswitches) and (not found) then Message1(exec_w_objfile_not_found,s); end; @@ -215,7 +215,7 @@ begin exit; end; findlibraryfile:=search(s,'.;'+librarysearchpath+';'+exepath,found)+s; - if (not externlink) and (not found) then + if not(cs_link_extern in aktglobalswitches) and (not found) then Message1(exec_w_libfile_not_found,s); end; @@ -242,7 +242,7 @@ end; Function TLinker.DoExec(const command,para:string;info,useshell:boolean):boolean; begin DoExec:=true; - if not externlink then + if not(cs_link_extern in aktglobalswitches) then begin swapvectors; if useshell then @@ -260,10 +260,11 @@ begin if (dosError<>0) then begin Message(exec_w_cant_call_linker); - ExternLink:=true; + aktglobalswitches:=aktglobalswitches+[cs_link_extern]; end; end; - if externlink then +{ Update asmres when externmode is set } + if cs_link_extern in aktglobalswitches then begin if info then AsmRes.AddLinkCommand(Command,Para,ExeName) @@ -291,10 +292,9 @@ begin prtobj:='prt0'; case target_info.target of {$ifdef i386} - target_Win32 : prtobj:=''; target_linux : begin - if cs_profile in aktswitches then + if cs_profile in aktmoduleswitches then begin prtobj:='gprt0'; AddSharedLibrary('gmon'); @@ -304,7 +304,7 @@ begin {$endif i386} {$ifdef m68k} target_linux : begin - if cs_profile in aktswitches then + if cs_profile in aktmoduleswitches then begin prtobj:='gprt0'; AddSharedLibrary('gmon'); @@ -312,7 +312,6 @@ begin end; end; {$endif} - end; { Fix command line options } @@ -404,7 +403,7 @@ begin WriteResponseFile; { Call linker } - if not externlink then + if not(cs_link_extern in aktglobalswitches) then Message1(exec_i_linking,ExeName); s:=target_link.linkcmd; Replace(s,'$EXE',exename); @@ -419,15 +418,15 @@ begin Replace(s,'$HEAPKB',tostr((heapsize+1023) shr 10)); Replace(s,'$STACKKB',tostr((stacksize+1023) shr 10)); bindbin:=FindExe(target_link.bindbin,bindfound); - if (not bindfound) and (not externlink) then + if (not bindfound) and not(cs_link_extern in aktglobalswitches) then begin Message1(exec_w_binder_not_found,bindbin); - externlink:=true; + aktglobalswitches:=aktglobalswitches+[cs_link_extern]; end; DoExec(bindbin,s,false,false); end; {Remove ReponseFile} - if (success) and (not externlink) then + if (success) and not(cs_link_extern in aktglobalswitches) then begin assign(dummy,LinkResName); {$I-} @@ -449,17 +448,17 @@ var f : file; begin arbin:=FindExe(target_ar.arbin,arfound); - if (not arfound) and (not externlink) then + if (not arfound) and not(cs_link_extern in aktglobalswitches) then begin Message(exec_w_ar_not_found); - externlink:=true; + aktglobalswitches:=aktglobalswitches+[cs_link_extern]; end; s:=target_ar.arcmd; Replace(s,'$LIB',staticlibname); Replace(s,'$FILES',FixPath(path)+'*'+target_info.objext); DoExec(arbin,s,false,true); { Clean up } - if (not writeasmfile) and (not externlink) then + if not(cs_asm_leave in aktglobalswitches) and not(cs_link_extern in aktglobalswitches) then begin for cnt:=1to filescnt do begin @@ -486,7 +485,10 @@ end; end. { $Log$ - Revision 1.14 1998-06-17 14:10:13 peter + Revision 1.15 1998-08-10 14:50:02 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.14 1998/06/17 14:10:13 peter * small os2 fixes * fixed interdependent units with newppu (remake3 under linux works now) diff --git a/compiler/opts386.pas b/compiler/opts386.pas index 77b3c9183a..ec3cfa9906 100644 --- a/compiler/opts386.pas +++ b/compiler/opts386.pas @@ -53,12 +53,12 @@ begin 'O' : begin for j:=3 to length(opt) do case opt[j] of - '-' : initswitches:=initswitches-[cs_optimize,cs_maxoptimieren,cs_littlesize]; - 'a' : initswitches:=initswitches+[cs_optimize]; - 'g' : initswitches:=initswitches+[cs_littlesize]; - 'G' : initswitches:=initswitches-[cs_littlesize]; - 'x' : initswitches:=initswitches+[cs_optimize,cs_maxoptimieren]; - 'z' : initswitches:=initswitches+[cs_optimize,cs_uncertainopts]; + '-' : initglobalswitches:=initglobalswitches-[cs_optimize,cs_maxoptimize,cs_littlesize]; + 'a' : initglobalswitches:=initglobalswitches+[cs_optimize]; + 'g' : initglobalswitches:=initglobalswitches+[cs_littlesize]; + 'G' : initglobalswitches:=initglobalswitches-[cs_littlesize]; + 'x' : initglobalswitches:=initglobalswitches+[cs_optimize,cs_maxoptimize]; + 'z' : initglobalswitches:=initglobalswitches+[cs_optimize,cs_uncertainopts]; '2' : initoptprocessor:=pentium2; '3' : initoptprocessor:=int386; '4' : initoptprocessor:=int486; @@ -89,7 +89,10 @@ end; end. { $Log$ - Revision 1.8 1998-06-16 08:56:22 peter + Revision 1.9 1998-08-10 14:50:04 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.8 1998/06/16 08:56:22 peter + targetcpu * cleaner pmodules for newppu diff --git a/compiler/opts68k.pas b/compiler/opts68k.pas index e93e86e2ea..3833e3363d 100644 --- a/compiler/opts68k.pas +++ b/compiler/opts68k.pas @@ -52,11 +52,11 @@ begin 'O' : begin for j:=3 to length(opt) do case opt[j] of - '-' : initswitches:=initswitches-[cs_optimize,cs_maxoptimieren,cs_littlesize]; - 'a' : initswitches:=initswitches+[cs_optimize]; - 'g' : initswitches:=initswitches+[cs_littlesize]; - 'G' : initswitches:=initswitches-[cs_littlesize]; - 'x' : initswitches:=initswitches+[cs_optimize,cs_maxoptimieren]; + '-' : initglobalswitches:=initglobalswitches-[cs_optimize,cs_maxoptimize,cs_littlesize]; + 'a' : initglobalswitches:=initglobalswitches+[cs_optimize]; + 'g' : initglobalswitches:=initglobalswitches+[cs_littlesize]; + 'G' : initglobalswitches:=initglobalswitches-[cs_littlesize]; + 'x' : initglobalswitches:=initglobalswitches+[cs_optimize,cs_maxoptimize]; '2' : initoptprocessor:=MC68020; else IllegalPara(opt); @@ -75,7 +75,10 @@ end; end. { $Log$ - Revision 1.2 1998-06-04 23:51:47 peter + Revision 1.3 1998-08-10 14:50:06 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.2 1998/06/04 23:51:47 peter * m68k compiles + .def file creation moved to gendef.pas so it could also be used for win32 diff --git a/compiler/parser.pas b/compiler/parser.pas index b32aea2ebf..355d2f2239 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -63,6 +63,9 @@ unit parser; usedunits.init; + { global switches } + aktglobalswitches:=initglobalswitches; + { memory sizes } if heapsize=0 then heapsize:=target_info.heapsize; @@ -122,7 +125,8 @@ unit parser; oldexternals, oldconsts : paasmoutput; { akt.. things } - oldaktswitches : tcswitches; + oldaktlocalswitches : tlocalswitches; + oldaktmoduleswitches : tmoduleswitches; oldaktfilepos : tfileposinfo; oldaktpackrecords : word; oldaktoutputformat : tasm; @@ -165,7 +169,8 @@ unit parser; oldexports:=exportssection; oldresource:=resourcesection; { save akt... state } - oldaktswitches:=aktswitches; + oldaktlocalswitches:=aktlocalswitches; + oldaktmoduleswitches:=aktmoduleswitches; oldaktpackrecords:=aktpackrecords; oldaktoutputformat:=aktoutputformat; oldaktoptprocessor:=aktoptprocessor; @@ -200,14 +205,15 @@ unit parser; end; { Load current state from the init values } - aktswitches:=initswitches; + aktlocalswitches:=initlocalswitches; + aktmoduleswitches:=initmoduleswitches; aktpackrecords:=initpackrecords; aktoutputformat:=initoutputformat; aktoptprocessor:=initoptprocessor; aktasmmode:=initasmmode; { we need this to make the system unit } if compile_system then - aktswitches:=aktswitches+[cs_compilesystem]; + aktmoduleswitches:=aktmoduleswitches+[cs_compilesystem]; { startup scanner } current_scanner:=new(pscannerfile,Init(filename)); @@ -259,7 +265,7 @@ unit parser; begin GenerateAsm(filename); - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then begin Linker.SetLibName(current_module^.libfilename^); Linker.MakeStaticLibrary(SmartLinkPath(FileName),SmartLinkFilesCnt); @@ -273,12 +279,10 @@ unit parser; { Check linking => we are at first level in compile } if (compile_level=1) then begin - if gendeffile then + if (cs_link_deffile in aktglobalswitches) then deffile.writefile; if (not current_module^.is_unit) then begin - if (cs_no_linking in initswitches) then - externlink:=true; if Linker.ExeName='' then Linker.SetExeName(FileName); Linker.MakeExecutable; @@ -356,7 +360,8 @@ done: aktprocsym:=oldaktprocsym; procprefix:=oldprocprefix; { restore current state } - aktswitches:=oldaktswitches; + aktlocalswitches:=oldaktlocalswitches; + aktmoduleswitches:=oldaktmoduleswitches; aktpackrecords:=oldaktpackrecords; aktoutputformat:=oldaktoutputformat; aktoptprocessor:=oldaktoptprocessor; @@ -390,7 +395,10 @@ done: end. { $Log$ - Revision 1.32 1998-08-10 10:18:28 peter + Revision 1.33 1998-08-10 14:50:07 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.32 1998/08/10 10:18:28 peter + Compiler,Comphook unit which are the new interface units to the compiler diff --git a/compiler/pass_1.pas b/compiler/pass_1.pas index 153de2e5e3..cc663f1bd9 100644 --- a/compiler/pass_1.pas +++ b/compiler/pass_1.pas @@ -36,7 +36,7 @@ unit pass_1; uses cobjects,verbose,comphook,systems,globals, - aasm,symtable,types,strings,hcodegen,files + aasm,symtable,types,strings,hcodegen,files {$ifdef i386} ,i386 ,tgeni386 @@ -488,7 +488,7 @@ unit pass_1; { procedure variable can be assigned to an void pointer } { Not anymore. Use the @ operator now.} else - if not (cs_tp_compatible in aktswitches) then + if not (cs_tp_compatible in aktmoduleswitches) then begin if (def_from^.deftype=procvardef) and (def_to^.deftype=pointerdef) and @@ -1149,12 +1149,12 @@ unit pass_1; equaln,unequaln : ; ltn,lten,gtn,gten: begin - if not(cs_extsyntax in aktswitches) then + if not(cs_extsyntax in aktmoduleswitches) then Message(sym_e_type_mismatch); end; subn: begin - if not(cs_extsyntax in aktswitches) then + if not(cs_extsyntax in aktmoduleswitches) then Message(sym_e_type_mismatch); p^.resulttype:=s32bitdef; exit; @@ -1249,7 +1249,7 @@ unit pass_1; calcregisters(p,1,0,0); if p^.treetype=addn then begin - if not(cs_extsyntax in aktswitches) then + if not(cs_extsyntax in aktmoduleswitches) then Message(sym_e_type_mismatch); end else Message(sym_e_type_mismatch); @@ -1261,7 +1261,7 @@ unit pass_1; firstpass(p^.right); calcregisters(p,1,0,0); case p^.treetype of - addn,subn : if not(cs_extsyntax in aktswitches) then + addn,subn : if not(cs_extsyntax in aktmoduleswitches) then Message(sym_e_type_mismatch); else Message(sym_e_type_mismatch); end; @@ -1287,7 +1287,7 @@ unit pass_1; end; end {$ifdef SUPPORT_MMX} - else if (cs_mmx in aktswitches) and is_mmx_able_array(ld) + else if (cs_mmx in aktmoduleswitches) and is_mmx_able_array(ld) and is_mmx_able_array(rd) and is_equal(ld,rd) then begin firstpass(p^.right); @@ -1498,7 +1498,7 @@ unit pass_1; {why this !!! lost of dummy type definitions one per const string !!! p^.resulttype:=new(pstringdef,init(length(p^.values^)));} - if cs_ansistrings in aktswitches then + if cs_ansistrings in aktlocalswitches then p^.resulttype:=cansistringdef else p^.resulttype:=cstringdef; @@ -1555,7 +1555,7 @@ unit pass_1; p^.location.loc:=LOC_FPU; end {$ifdef SUPPORT_MMX} - else if (cs_mmx in aktswitches) and + else if (cs_mmx in aktmoduleswitches) and is_mmx_able_array(p^.left^.resulttype) then begin if (p^.left^.location.loc<>LOC_MMXREGISTER) and @@ -1563,7 +1563,7 @@ unit pass_1; p^.registersmmx:=1; { if saturation is on, p^.left^.resulttype isn't "mmx able" (FK) - if (cs_mmx_saturation in aktswitches^) and + if (cs_mmx_saturation in aktmoduleswitches^) and (porddef(parraydef(p^.resulttype)^.definition)^.typ in [s32bit,u32bit]) then Message(sym_e_type_mismatch); @@ -1628,7 +1628,7 @@ unit pass_1; { result is a procedure variable } { No, to be TP compatible, you must return a pointer to the procedure that is stored in the procvar.} - if not(cs_tp_compatible in aktswitches) then + if not(cs_tp_compatible in aktmoduleswitches) then begin p^.resulttype:=new(pprocvardef,init); @@ -1653,7 +1653,7 @@ unit pass_1; end else begin - if not(cs_typed_addresses in aktswitches) then + if not(cs_typed_addresses in aktlocalswitches) then p^.resulttype:=voidpointerdef else p^.resulttype:=new(ppointerdef,init(p^.left^.resulttype)); end; @@ -1740,7 +1740,7 @@ unit pass_1; end else {$ifdef SUPPORT_MMX} - if (cs_mmx in aktswitches) and + if (cs_mmx in aktmoduleswitches) and is_mmx_able_array(p^.left^.resulttype) then begin if (p^.left^.location.loc<>LOC_MMXREGISTER) and @@ -1799,7 +1799,7 @@ unit pass_1; if ((p^.right^.treetype=addn) or (p^.right^.treetype=subn)) and equal_trees(p^.left,p^.right^.left) and (ret_in_acc(p^.left^.resulttype)) and - (not cs_rangechecking in aktswitches^) then + (not cs_rangechecking in aktmoduleswitches^) then begin disposetree(p^.right^.left); hp:=p^.right; @@ -2468,7 +2468,7 @@ unit pass_1; own resulttype. They will therefore always be incompatible with a procvar. Because isconvertable cannot check for procedures we use an extra check for them.} - if (cs_tp_compatible in aktswitches) and + if (cs_tp_compatible in aktmoduleswitches) and ((is_procsym_load(p^.left) or is_procsym_call(p^.left)) and (p^.resulttype^.deftype=procvardef)) then begin @@ -2654,7 +2654,7 @@ unit pass_1; if (p^.left^.treetype=ordconstn) and is_ordinal(p^.resulttype) then begin { perform range checking } - if not(p^.explizit and (cs_tp_compatible in aktswitches)) then + if not(p^.explizit and (cs_tp_compatible in aktmoduleswitches)) then testrange(p^.resulttype,p^.left^.value); hp:=genordinalconstnode(p^.left^.value,p^.resulttype); disposetree(p); @@ -2818,7 +2818,7 @@ unit pass_1; end; end; { check var strings } - if (cs_strict_var_strings in aktswitches) and + if (cs_strict_var_strings in aktlocalswitches) and is_shortstring(p^.left^.resulttype) and is_shortstring(defcoll^.data) and (defcoll^.paratyp=vs_var) and @@ -3434,7 +3434,7 @@ unit pass_1; else begin {$ifdef SUPPORT_MMX} - if (cs_mmx in aktswitches) and + if (cs_mmx in aktmoduleswitches) and is_mmx_able_array(p^.resulttype) then begin p^.location.loc:=LOC_MMXREGISTER; @@ -4294,7 +4294,7 @@ unit pass_1; cleartempgen; { right is the statement itself calln assignn or a complex one } firstpass(p^.right); - if (not (cs_extsyntax in aktswitches)) and + if (not (cs_extsyntax in aktmoduleswitches)) and assigned(p^.right^.resulttype) and (p^.right^.resulttype<>pdef(voiddef)) then Message(cg_e_illegal_expression); @@ -4331,7 +4331,7 @@ unit pass_1; hp:=p^.left; while assigned(hp) do begin - if cs_maxoptimieren in aktswitches then + if cs_maxoptimize in aktglobalswitches then begin { Codeumstellungen } @@ -4372,7 +4372,7 @@ unit pass_1; begin cleartempgen; firstpass(hp^.right); - if (not (cs_extsyntax in aktswitches)) and + if (not (cs_extsyntax in aktmoduleswitches)) and assigned(hp^.right^.resulttype) and (hp^.right^.resulttype<>pdef(voiddef)) then Message(cg_e_illegal_expression); @@ -4410,8 +4410,8 @@ unit pass_1; begin old_t_times:=t_times; - { Registergewichtung bestimmen } - if not(cs_littlesize in aktswitches ) then + { Registergewichtung bestimmen } + if not(cs_littlesize in aktglobalswitches ) then t_times:=t_times*8; cleartempgen; @@ -4481,7 +4481,7 @@ unit pass_1; {$endif SUPPORT_MMX} { determines registers weigths } - if not(cs_littlesize in aktswitches ) then + if not(cs_littlesize in aktglobalswitches) then t_times:=t_times div 2; if t_times=0 then t_times:=1; @@ -4589,7 +4589,7 @@ unit pass_1; { Registergewichtung bestimmen (nicht genau), } old_t_times:=t_times; - if not(cs_littlesize in aktswitches ) then + if not(cs_littlesize in aktglobalswitches) then t_times:=t_times*8; cleartempgen; @@ -4717,7 +4717,7 @@ unit pass_1; { estimates the repeat of each instruction } old_t_times:=t_times; - if not(cs_littlesize in aktswitches ) then + if not(cs_littlesize in aktglobalswitches) then begin t_times:=t_times div case_count_labels(p^.nodes); if t_times<1 then @@ -5093,12 +5093,12 @@ unit pass_1; firstnothing,firstadd,firstprocinline,firstnothing,firstloadvmt); var - oldcodegenerror : boolean; - oldswitches : Tcswitches; - oldpos : tfileposinfo; + oldcodegenerror : boolean; + oldlocalswitches : tlocalswitches; + oldpos : tfileposinfo; {$ifdef extdebug} str1,str2 : string; - oldp : ptree; + oldp : ptree; not_first : boolean; {$endif extdebug} @@ -5109,7 +5109,7 @@ unit pass_1; {$endif extdebug} oldcodegenerror:=codegenerror; oldpos:=aktfilepos; - oldswitches:=aktswitches; + oldlocalswitches:=aktlocalswitches; {$ifdef extdebug} if p^.firstpasscount>0 then begin @@ -5124,7 +5124,7 @@ unit pass_1; {$endif extdebug} aktfilepos:=p^.fileinfo; - aktswitches:=p^.pragmas; + aktlocalswitches:=p^.localswitches; if not p^.error then begin codegenerror:=false; @@ -5151,7 +5151,7 @@ unit pass_1; if count_ref then inc(p^.firstpasscount); {$endif extdebug} - aktswitches:=oldswitches; + aktlocalswitches:=oldlocalswitches; aktfilepos:=oldpos; end; @@ -5177,7 +5177,10 @@ unit pass_1; end. { $Log$ - Revision 1.51 1998-08-10 10:18:29 peter + Revision 1.52 1998-08-10 14:50:08 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.51 1998/08/10 10:18:29 peter + Compiler,Comphook unit which are the new interface units to the compiler diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index 74c5428f82..4a3971cbdb 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -163,7 +163,7 @@ unit pdecl; begin consume(_LABEL); - if not(cs_support_goto in aktswitches) then + if not(cs_support_goto in aktmoduleswitches) then Message(sym_e_goto_and_label_not_supported); repeat if not(token in [ID,INTCONST]) then @@ -306,7 +306,7 @@ unit pdecl; if (token=ID) then begin { Check for C Variable declarations } - if support_c_var and + if (cs_support_c_var in aktmoduleswitches) and not(is_record or is_object) and ((pattern='EXPORT') or (pattern='EXTERNAL') or @@ -372,7 +372,7 @@ unit pdecl; symdone:=true; end else - if (is_object) and (cs_static_keyword in aktswitches) and (pattern='STATIC') then + if (is_object) and (cs_static_keyword in aktglobalswitches) and (pattern='STATIC') then begin current_object_option:=current_object_option or sp_static; insert_syms(symtablestack,sc,p); @@ -489,7 +489,7 @@ unit pdecl; in ansistring mode ?? (PM) Yes!!! (FK) } else begin - if cs_ansistrings in aktswitches then + if cs_ansistrings in aktlocalswitches then d:=new(pstringdef,ansiinit(0)) else {$ifndef GDB} @@ -595,7 +595,7 @@ unit pdecl; { must be at same level as in implementation } _proc_head(poconstructor); - if (cs_checkconsname in aktswitches) and (aktprocsym^.name<>'INIT') then + if (cs_constructor_name in aktglobalswitches) and (aktprocsym^.name<>'INIT') then Message(parser_e_constructorname_must_be_init); consume(SEMICOLON); @@ -899,7 +899,7 @@ unit pdecl; begin consume(_DESTRUCTOR); _proc_head(podestructor); - if (cs_checkconsname in aktswitches) and (aktprocsym^.name<>'DONE') then + if (cs_constructor_name in aktglobalswitches) and (aktprocsym^.name<>'DONE') then Message(parser_e_destructorname_must_be_done); consume(SEMICOLON); if assigned(aktprocsym^.definition^.para1) then @@ -1085,7 +1085,7 @@ unit pdecl; begin aktclass^.options:=aktclass^.options or oois_class; - if (cs_generate_rtti in aktswitches) or + if (cs_generate_rtti in aktmoduleswitches) or (assigned(aktclass^.childof) and ((aktclass^.childof^.options and oo_can_have_published)<>0) ) then @@ -1184,7 +1184,7 @@ unit pdecl; { the method is defined } aktprocsym^.definition^.forwarddef:=false; end; - if (cs_static_keyword in aktswitches) and (pattern='STATIC') then + if (cs_static_keyword in aktglobalswitches) and (pattern='STATIC') then begin consume(ID); consume(SEMICOLON); @@ -1268,11 +1268,11 @@ unit pdecl; testcurobject:=0; curobjectname:=''; - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then datasegment^.concat(new(pai_cut,init)); {$ifdef GDB} { generate the VMT } - if cs_debuginfo in aktswitches then + if cs_debuginfo in aktmoduleswitches then begin do_count_dbx:=true; if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then @@ -1881,7 +1881,10 @@ unit pdecl; end. { $Log$ - Revision 1.35 1998-07-26 21:59:00 florian + Revision 1.36 1998-08-10 14:50:09 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.35 1998/07/26 21:59:00 florian + better support for switch $H + index access to ansi strings added + assigment of data (records/arrays) containing ansi strings diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 949e486072..75c0afaa7b 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -960,7 +960,7 @@ unit pexpr; begin { allow post fix operators } again:=true; - if (cs_delphi2_compatible in aktswitches) and + if (cs_delphi2_compatible in aktmoduleswitches) and (pattern='RESULT') and assigned(aktprocsym) and (procinfo.retdef<>pdef(voiddef)) then @@ -992,7 +992,7 @@ unit pexpr; ((procinfo.flags and pi_operator)<>0))}) and (procinfo.retdef<>pdef(voiddef)) and (token<>LKLAMMER) and - (not ((cs_tp_compatible in aktswitches) and + (not ((cs_tp_compatible in aktmoduleswitches) and (afterassignment or in_args))) then begin p1:=genzeronode(funcretn); @@ -1788,7 +1788,10 @@ unit pexpr; end. { $Log$ - Revision 1.30 1998-07-28 21:52:54 florian + Revision 1.31 1998-08-10 14:50:11 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.30 1998/07/28 21:52:54 florian + implementation of raise and try..finally + some misc. exception stuff diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 5c8c47b9c1..5ca19a66e5 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -70,14 +70,14 @@ unit pmodules; procedure fixseg(p:paasmoutput;sec:tsection); begin p^.insert(new(pai_section,init(sec))); - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then p^.insert(new(pai_cut,init)); p^.concat(new(pai_section,init(sec_none))); end; begin {Insert Ident of the compiler} - if (not (cs_smartlink in aktswitches)) + if (not (cs_smartlink in aktmoduleswitches)) {$ifndef EXTDEBUG} and (not current_module^.is_unit) {$endif} @@ -95,7 +95,7 @@ unit pmodules; procedure insertheap; begin - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then begin bsssegment^.concat(new(pai_cut,init)); datasegment^.concat(new(pai_cut,init)); @@ -608,7 +608,7 @@ unit pmodules; begin { if the current file isn't a system unit the the system unit will be loaded } - if not(cs_compilesystem in aktswitches) then + if not(cs_compilesystem in aktmoduleswitches) then begin {$ifndef OLDPPU} hp:=loadunit(upper(target_info.system_unit),true); @@ -687,7 +687,7 @@ unit pmodules; while assigned(hp) do begin {$IfDef GDB} - if (cs_debuginfo in aktswitches) and + if (cs_debuginfo in aktmoduleswitches) and not hp^.is_stab_written then begin punitsymtable(hp^.u^.symtable)^.concattypestabto(debuglist); @@ -771,9 +771,9 @@ unit pmodules; i:=pos('.',s2^); if i>0 then s2^:=Copy(s2^,1,i-1); - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then begin - if (cs_check_unit_name in aktswitches) and + if (cs_check_unit_name in aktglobalswitches) and ((length(current_module^.modulename^)>8) or (current_module^.modulename^<>s1^) or (current_module^.modulename^<>s2^)) then @@ -786,7 +786,7 @@ unit pmodules; dispose(s1); { Add Object File } - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then current_module^.linkstaticlibs.insert(current_module^.libfilename^) else current_module^.linkofiles.insert(current_module^.objfilename^); @@ -826,17 +826,17 @@ unit pmodules; if (compile_level=1) then begin loaded_units.insert(current_module); - if cs_unit_to_lib in initswitches then + if cs_createlib in initmoduleswitches then begin current_module^.flags:=current_module^.flags or uf_in_library; - if cs_shared_lib in initswitches then + if cs_shared_lib in initmoduleswitches then current_module^.flags:=current_module^.flags or uf_shared_library; end; end; { insert qualifier for the system unit (allows system.writeln) } - if not(cs_compilesystem in aktswitches) then + if not(cs_compilesystem in aktmoduleswitches) then begin { insert the system unit } { it is allways the first } @@ -878,7 +878,7 @@ unit pmodules; {$ifdef GDB} { add all used definitions even for implementation} - if (cs_debuginfo in aktswitches) then + if (cs_debuginfo in aktmoduleswitches) then begin { all types } punitsymtable(refsymtable)^.concattypestabto(debuglist); @@ -989,7 +989,7 @@ unit pmodules; {$ifdef GDB} { add all used definitions even for implementation} - if (cs_debuginfo in aktswitches) then + if (cs_debuginfo in aktmoduleswitches) then begin { all types } punitsymtable(symtablestack)^.concattypestabto(debuglist); @@ -1036,20 +1036,6 @@ unit pmodules; st : psymtable; names : Tstringcontainer; begin - { Trying to compile the system unit... } - { if no unit defined... then issue a } - { fatal error (avoids pointer problems)} - { when referencing the non-existant } - { system unit. } - - { System Unit should be compiled using proc_unit !! (PFV) } -{ if (cs_compilesystem in aktswitches) then - Begin - if token<>_UNIT then - Message1(scan_f_syn_expected,'UNIT'); - consume(_UNIT); - end;} - parse_only:=false; if islibrary then begin @@ -1143,7 +1129,7 @@ unit pmodules; consume(POINT); - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then current_module^.linkstaticlibs.insert(current_module^.libfilename^) else current_module^.linkofiles.insert(current_module^.objfilename^); @@ -1166,7 +1152,10 @@ unit pmodules; end. { $Log$ - Revision 1.37 1998-08-10 10:18:31 peter + Revision 1.38 1998-08-10 14:50:13 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.37 1998/08/10 10:18:31 peter + Compiler,Comphook unit which are the new interface units to the compiler diff --git a/compiler/popt386.pas b/compiler/popt386.pas index 733bf7af66..9c460e0589 100644 --- a/compiler/popt386.pas +++ b/compiler/popt386.pas @@ -294,7 +294,7 @@ Begin (Pai386(p)^.op3t = Top_None)) And (aktoptprocessor < PentiumPro) And (Longint(Pai386(p)^.op1) <= 12) And - Not(CS_LittleSize in AktSwitches) And + Not(CS_LittleSize in aktglobalswitches) And (Not(GetNextInstruction(p, hp1)) Or {GetNextInstruction(p, hp1) And} Not((Pai(hp1)^.typ = ait_labeled_instruction) And @@ -840,7 +840,7 @@ Begin S_BW: Begin If (TRegister(Pai386(p)^.op1) = Reg16ToReg8(TRegister(Pai386(p)^.op2))) And - Not(CS_LittleSize In AktSwitches) + Not(CS_LittleSize In aktglobalswitches) Then {Change "movzbw %al, %ax" to "andw $0x0ffh, %ax"} Begin @@ -869,7 +869,7 @@ Begin S_BL: Begin If (TRegister(Pai386(p)^.op1) = Reg32ToReg8(TRegister(Pai386(p)^.op2))) And - Not(CS_LittleSize in AktSwitches) + Not(CS_LittleSize in aktglobalswitches) Then {Change "movzbl %al, %eax" to "andl $0x0ffh, %eax"} Begin @@ -898,7 +898,7 @@ Begin S_WL: Begin If (TRegister(Pai386(p)^.op1) = Reg32ToReg16(TRegister(Pai386(p)^.op2))) And - Not(CS_LittleSize In AktSwitches) + Not(CS_LittleSize In aktglobalswitches) Then {Change "movzwl %ax, %eax" to "andl $0x0ffffh, %eax"} Begin @@ -967,7 +967,7 @@ Begin (Pai386(hp1)^._operator=A_PUSH) and (Pai386(hp1)^.op1t = top_reg) And (Pai386(hp1)^.op1=Pai386(p)^.op1) then - If (Not(cs_maxoptimieren in aktswitches)) Then + If (Not(cs_maxoptimize in aktglobalswitches)) Then Begin hp2:=pai(hp1^.next); asml^.remove(p); @@ -1067,7 +1067,7 @@ Begin If TmpBool2 Or ((aktoptprocessor < PentiumPro) And (Longint(Pai386(p)^.op1) <= 3) And - Not(CS_LittleSize in AktSwitches)) + Not(CS_LittleSize in aktglobalswitches)) Then Begin If Not(TmpBool2) And @@ -1137,7 +1137,7 @@ Begin Then If (Longint(Pai386(p)^.op1) > Longint(Pai386(hp1)^.op1)) And (Pai386(p)^.op2t = Top_reg) And - Not(CS_LittleSize In AktSwitches) And + Not(CS_LittleSize In aktglobalswitches) And ((Pai386(p)^.Size = S_B) Or (Pai386(p)^.Size = S_L)) Then @@ -1152,7 +1152,7 @@ Begin Else If (Longint(Pai386(p)^.op1) < Longint(Pai386(hp1)^.op1)) And (Pai386(p)^.op2t = Top_reg) And - Not(CS_LittleSize In AktSwitches) And + Not(CS_LittleSize In aktglobalswitches) And ((Pai386(p)^.Size = S_B) Or (Pai386(p)^.Size = S_L)) Then @@ -1312,7 +1312,7 @@ Begin S_BL: Begin If IsGP32Reg(TRegister(Pai386(p)^.op2)) And - Not(CS_LittleSize in AktSwitches) And + Not(CS_LittleSize in aktglobalswitches) And (aktoptprocessor >= Pentium) And (aktoptprocessor < PentiumPro) Then @@ -1336,7 +1336,7 @@ Begin If (Pai386(p)^.op1t = top_ref) And (PReference(Pai386(p)^.op1)^.base <> TRegister(Pai386(p)^.op2)) And (PReference(Pai386(p)^.op1)^.index <> TRegister(Pai386(p)^.op2)) And - Not(CS_LittleSize in AktSwitches) And + Not(CS_LittleSize in aktglobalswitches) And IsGP32Reg(TRegister(Pai386(p)^.op2)) And (aktoptprocessor >= Pentium) And (aktoptprocessor < PentiumPro) And @@ -1365,7 +1365,10 @@ End. { $Log$ - Revision 1.5 1998-08-06 19:40:28 jonas + Revision 1.6 1998-08-10 14:50:14 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.5 1998/08/06 19:40:28 jonas * removed $ before and after Log in comment Revision 1.4 1998/08/05 16:27:17 jonas diff --git a/compiler/pp.pas b/compiler/pp.pas index d9f7fc7507..cbc103e8b1 100644 --- a/compiler/pp.pas +++ b/compiler/pp.pas @@ -35,7 +35,7 @@ MMX which allows the compiler to generate MMX instructions EXTERN_MSG Don't compile the msgfiles in the compiler, always - use external messagefiles + use external messagefiles, default for TP NOAG386INT no Intel Assembler output NOAG386NSM no NASM output ----------------------------------------------------------------- @@ -236,14 +236,20 @@ begin end. { $Log$ - Revision 1.24 1998-08-10 10:18:32 peter + Revision 1.25 1998-08-10 14:50:16 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.24 1998/08/10 10:18:32 peter + Compiler,Comphook unit which are the new interface units to the compiler Revision 1.23 1998/08/05 16:00:16 florian * some fixes for ansi strings * $log$ to $Log$ - * $log$ to Revision 1.24 1998-08-10 10:18:32 peter + * $log$ to Revision 1.25 1998-08-10 14:50:16 peter + * $log$ to + localswitches, moduleswitches, globalswitches splitting + * $log$ to + * $log$ to Revision 1.24 1998/08/10 10:18:32 peter * $log$ to + Compiler,Comphook unit which are the new interface units to the * $log$ to compiler * $log$ to changed diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index 88d88f89f2..05ebcd63eb 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -963,7 +963,7 @@ unit pstatmnt; filepos:=tokenpos; case token of _GOTO : begin - if not(cs_support_goto in aktswitches)then + if not(cs_support_goto in aktmoduleswitches)then Message(sym_e_goto_and_label_not_supported); consume(_GOTO); if (token<>INTCONST) and (token<>ID) then @@ -1029,7 +1029,7 @@ unit pstatmnt; begin if (token=INTCONST) or ((token=ID) and - not((cs_delphi2_compatible in aktswitches) and + not((cs_delphi2_compatible in aktmoduleswitches) and (pattern='RESULT'))) then begin getsym(pattern,true); @@ -1240,7 +1240,10 @@ unit pstatmnt; end. { $Log$ - Revision 1.31 1998-08-02 16:41:59 florian + Revision 1.32 1998-08-10 14:50:17 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.31 1998/08/02 16:41:59 florian * on o : tobject do should also work now, the exceptsymtable shouldn't be disposed by dellexlevel diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 2b20e73267..195aef5496 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -108,11 +108,11 @@ begin p^.insert(new(ptypesym,init('s32real',c64floatdef))); { mappings... } p^.insert(new(ptypesym,init('REAL',new(pfloatdef,init(s32real))))); - if (cs_fp_emulation) in aktswitches then + if (cs_fp_emulation) in aktmoduleswitches then p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s32real))))) else p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s64real))))); - if (cs_fp_emulation) in aktswitches then + if (cs_fp_emulation) in aktmoduleswitches then p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s32real))))) else p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real))))); @@ -217,7 +217,7 @@ begin {$endif} {$ifdef m68k} c64floatdef:=new(pfloatdef,init(s32real)); - if (cs_fp_emulation in aktswitches) then + if (cs_fp_emulation in aktmoduleswitches) then s80floatdef:=new(pfloatdef,init(s32real)) else s80floatdef:=new(pfloatdef,init(s80real)); @@ -232,7 +232,10 @@ end; end. { $Log$ - Revision 1.4 1998-06-25 14:04:24 peter + Revision 1.5 1998-08-10 14:50:19 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.4 1998/06/25 14:04:24 peter + internal inc/dec Revision 1.3 1998/06/04 23:51:55 peter diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index 56fcae21a2..654de1463a 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -399,7 +399,7 @@ unit ptconst; exit; end else - if not(cs_tp_compatible in aktswitches) then + if not(cs_tp_compatible in aktmoduleswitches) then if token=KLAMMERAFFE then consume(KLAMMERAFFE); getsym(pattern,true); @@ -492,7 +492,10 @@ unit ptconst; end. { $Log$ - Revision 1.10 1998-07-21 11:16:25 florian + Revision 1.11 1998-08-10 14:50:20 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.10 1998/07/21 11:16:25 florian * bug0147 fixed Revision 1.9 1998/07/20 22:17:16 florian diff --git a/compiler/ra386att.pas b/compiler/ra386att.pas index bb073085d2..fec9c560e4 100644 --- a/compiler/ra386att.pas +++ b/compiler/ra386att.pas @@ -1523,7 +1523,7 @@ const { the att version only if the processor > i386 or we are compiling } { the system unit then this will be allowed... } if (instruc >= lastop_in_table) and - ((cs_compilesystem in aktswitches) or (aktoptprocessor>int386)) then + ((cs_compilesystem in aktmoduleswitches) or (aktoptprocessor>int386)) then begin Message1(assem_w_opcode_not_in_table,att_op2str[instruc]); fits:=true; @@ -2085,7 +2085,7 @@ const end; end else - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then begin for i:=1 to instr.numops do if instr.operands[i].operandtype=OPR_LABINSTR then @@ -3074,7 +3074,7 @@ const else { check for direct symbolic names } { only if compiling the system unit } - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then begin if not SearchDirectVar(instr,actasmpattern,operandnum) then Begin @@ -3130,7 +3130,7 @@ const begin { check for direct symbolic names } { only if compiling the system unit } - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then begin if not SearchDirectVar(instr,actasmpattern,operandnum) then Message(assem_e_invalid_seg_override); @@ -3437,7 +3437,7 @@ const ConcatLabel(p,A_LABEL, hl) else Begin - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then begin Message1(assem_e_unknown_label_identifer,actasmpattern); { once again we don't know what it represents } @@ -3457,7 +3457,7 @@ const { -- this should only be allowed for system development -- } { i think this should be fixed in the dos unit, and } { not here. } - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then p:=datasegment else Message(assem_e_switching_sections_not_allowed); @@ -3467,7 +3467,7 @@ const { -- this should only be allowed for system development -- } { i think this should be fixed in the dos unit, and } { not here. } - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then p:=store_p else Message(assem_e_switching_sections_not_allowed); @@ -3503,7 +3503,7 @@ const { direct label names like this... anyhow } { procedural calls in asm blocks are } { supposedely replaced automatically } - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then begin Consume(AS_GLOBAL); if actasmtoken <> AS_ID then @@ -3542,7 +3542,7 @@ const { -- this should only be allowed for system development -- } { -- otherwise may mess up future enhancements we might -- } { -- add. -- } - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then begin Consume(AS_LCOMM); if actasmtoken <> AS_ID then @@ -3576,7 +3576,7 @@ const { -- this should only be allowed for system development -- } { -- otherwise may mess up future enhancements we might -- } { -- add. -- } - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then begin Consume(AS_COMM); if actasmtoken <> AS_ID then @@ -3675,7 +3675,10 @@ end. { $Log$ - Revision 1.5 1998-07-14 14:46:58 peter + Revision 1.6 1998-08-10 14:50:21 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.5 1998/07/14 14:46:58 peter * released NEWINPUT Revision 1.4 1998/07/08 15:06:41 daniel diff --git a/compiler/ra68kmot.pas b/compiler/ra68kmot.pas index b9fa06d6a3..87c6591032 100644 --- a/compiler/ra68kmot.pas +++ b/compiler/ra68kmot.pas @@ -1641,7 +1641,7 @@ var Message(assem_e_cannot_use_SELF_outside_a_method); end else - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then Begin if not assigned(instr.operands[operandnum].ref.symbol) then Begin @@ -1782,7 +1782,7 @@ var { DIVSL/DIVS/MULS/MULU with long for MC68020 only } if (actasmtoken = AS_COLON) then Begin - if (aktoptprocessor = MC68020) or (cs_compilesystem in aktswitches) then + if (aktoptprocessor = MC68020) or (cs_compilesystem in aktmoduleswitches) then Begin Consume(AS_COLON); if (actasmtoken = AS_REGISTER) then @@ -2093,7 +2093,7 @@ var { direct label names like this... anyhow } { procedural calls in asm blocks are } { supposedely replaced automatically } - if (cs_compilesystem in aktswitches) then + if (cs_compilesystem in aktmoduleswitches) then begin Consume(AS_XDEF); if actasmtoken <> AS_ID then @@ -2177,7 +2177,10 @@ Begin end. { $Log$ - Revision 1.4 1998-07-14 14:47:02 peter + Revision 1.5 1998-08-10 14:50:23 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.4 1998/07/14 14:47:02 peter * released NEWINPUT Revision 1.3 1998/07/10 10:51:02 peter diff --git a/compiler/scandir.inc b/compiler/scandir.inc index fdc2b58a92..d9f6322c61 100644 --- a/compiler/scandir.inc +++ b/compiler/scandir.inc @@ -363,7 +363,7 @@ const mac^.buftext:=nil; end; end; - if support_macros then + if (cs_support_macro in aktmoduleswitches) then begin { key words are never substituted } hs2:=pattern; @@ -454,9 +454,9 @@ const end; - procedure dir_switch(t:tdirectivetoken); + procedure dir_moduleswitch(t:tdirectivetoken); var - sw : tcswitch; + sw : tmoduleswitch; begin case t of {$ifdef SUPPORT_MMX} @@ -467,9 +467,9 @@ const end; current_scanner^.skipspace; if c='-' then - aktswitches:=aktswitches-[sw] + aktmoduleswitches:=aktmoduleswitches-[sw] else - aktswitches:=aktswitches+[sw]; + aktmoduleswitches:=aktmoduleswitches+[sw]; end; @@ -640,12 +640,12 @@ const {_DIR_L} dir_linkobject, {_DIR_LINKLIB} dir_linklib, {_DIR_MESSAGE} dir_message, - {_DIR_MMX} dir_switch, + {_DIR_MMX} dir_moduleswitch, {_DIR_NOTE} dir_message, {_DIR_OUTPUT_FORMAT} dir_outputformat, {_DIR_PACKRECORDS} dir_packrecords, - {_DIR_SATURATION} dir_switch, - {_DIR_SMARTLINK} dir_switch, + {_DIR_SATURATION} dir_moduleswitch, + {_DIR_SMARTLINK} dir_moduleswitch, {_DIR_STOP} dir_message, {_DIR_UNDEF} dir_undef, {_DIR_WAIT} dir_wait, @@ -706,7 +706,10 @@ const { $Log$ - Revision 1.17 1998-08-10 09:56:04 peter + Revision 1.18 1998-08-10 14:50:25 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.17 1998/08/10 09:56:04 peter * path to the include file is also written to the debug output Revision 1.16 1998/08/04 22:03:44 michael diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 759502908c..2de68ced03 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -579,8 +579,8 @@ implementation procedure tscannerfile.dec_comment_level; begin - if (cs_tp_compatible in aktswitches) or - (cs_delphi2_compatible in aktswitches) then + if (cs_tp_compatible in aktmoduleswitches) or + (cs_delphi2_compatible in aktmoduleswitches) then comment_level:=0 else dec(comment_level); @@ -1046,7 +1046,7 @@ implementation else begin { this takes some time ... } - if support_macros then + if (cs_support_macro in aktmoduleswitches) then begin mac:=pmacrosym(macros^.search(pattern)); if assigned(mac) and (assigned(mac^.buftext)) then @@ -1182,7 +1182,7 @@ implementation end; '+' : begin readchar; - if (c='=') and support_c_operators then + if (c='=') and (cs_support_c_operators in aktmoduleswitches) then begin readchar; yylex:=_PLUSASN; @@ -1193,7 +1193,7 @@ implementation end; '-' : begin readchar; - if (c='=') and support_c_operators then + if (c='=') and (cs_support_c_operators in aktmoduleswitches) then begin readchar; yylex:=_MINUSASN; @@ -1215,7 +1215,7 @@ implementation end; '*' : begin readchar; - if (c='=') and support_c_operators then + if (c='=') and (cs_support_c_operators in aktmoduleswitches) then begin readchar; yylex:=_STARASN; @@ -1234,7 +1234,7 @@ implementation readchar; case c of '=' : begin - if support_c_operators then + if (cs_support_c_operators in aktmoduleswitches) then begin readchar; yylex:=_SLASHASN; @@ -1548,7 +1548,10 @@ exit_label: end. { $Log$ - Revision 1.38 1998-08-10 10:18:34 peter + Revision 1.39 1998-08-10 14:50:26 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.38 1998/08/10 10:18:34 peter + Compiler,Comphook unit which are the new interface units to the compiler diff --git a/compiler/switches.pas b/compiler/switches.pas index 20dc359ab1..9b2bd89cfa 100644 --- a/compiler/switches.pas +++ b/compiler/switches.pas @@ -30,66 +30,44 @@ function CheckSwitch(switch,state:char):boolean; implementation uses globals,verbose,files,systems; -{**************************************************************************** - Special functions for some switches -****************************************************************************} - -{$ifndef FPC} - {$F+} -{$endif} - -procedure sw_stackcheck; -begin -{$ifdef i386} - if target_info.target=target_Linux then - Message(scan_n_stack_check_global_under_linux); -{$endif} - -end; - -{$ifndef FPC} - {$F-} -{$endif} - {**************************************************************************** Main Switches Parsing ****************************************************************************} type - TSwitchType=(local,unitglobal,programglobal,illegal,unsupported); + TSwitchType=(localsw,modulesw,globalsw,illegalsw,unsupportedsw); SwitchRec=record typesw : TSwitchType; - setsw : tcswitch; - proc : procedure; + setsw : byte; end; const SwitchTable:array['A'..'Z'] of SwitchRec=( - {A} (typesw:unsupported; setsw:cs_none; proc:nil), - {B} (typesw:unsupported; setsw:cs_none; proc:nil), - {C} (typesw:local; setsw:cs_do_assertion; proc:nil), - {D} (typesw:unitglobal; setsw:cs_debuginfo; proc:nil), - {E} (typesw:programglobal; setsw:cs_fp_emulation; proc:nil), - {F} (typesw:unsupported; setsw:cs_none; proc:nil), - {G} (typesw:unsupported; setsw:cs_none; proc:nil), - {H} (typesw:local; setsw:cs_ansistrings; proc:nil), - {I} (typesw:local; setsw:cs_iocheck; proc:nil), - {J} (typesw:illegal; setsw:cs_none; proc:nil), - {K} (typesw:unsupported; setsw:cs_none; proc:nil), - {L} (typesw:unsupported; setsw:cs_none; proc:nil), - {M} (typesw:local; setsw:cs_generate_rtti; proc:nil), - {N} (typesw:unsupported; setsw:cs_none; proc:nil), - {O} (typesw:unsupported; setsw:cs_none; proc:nil), - {P} (typesw:unsupported; setsw:cs_none; proc:nil), - {Q} (typesw:local; setsw:cs_check_overflow; proc:nil), - {R} (typesw:local; setsw:cs_rangechecking; proc:nil), - {S} (typesw:local; setsw:cs_check_stack; proc:nil), - {T} (typesw:local; setsw:cs_typed_addresses; proc:nil), - {U} (typesw:illegal; setsw:cs_none; proc:nil), - {V} (typesw:local; setsw:cs_strict_var_strings; proc:nil), - {W} (typesw:unsupported; setsw:cs_none; proc:nil), - {X} (typesw:unitglobal; setsw:cs_extsyntax; proc:nil), - {Y} (typesw:unsupported; setsw:cs_none; proc:nil), - {Z} (typesw:illegal; setsw:cs_none; proc:nil) + {A} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {B} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {C} (typesw:localsw; setsw:ord(cs_do_assertion)), + {D} (typesw:modulesw; setsw:ord(cs_debuginfo)), + {E} (typesw:globalsw; setsw:ord(cs_fp_emulation)), + {F} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {G} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {H} (typesw:localsw; setsw:ord(cs_ansistrings)), + {I} (typesw:localsw; setsw:ord(cs_check_io)), + {J} (typesw:illegalsw; setsw:ord(cs_localnone)), + {K} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {L} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {M} (typesw:localsw; setsw:ord(cs_generate_rtti)), + {N} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {O} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {P} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {Q} (typesw:localsw; setsw:ord(cs_check_overflow)), + {R} (typesw:localsw; setsw:ord(cs_check_range)), + {S} (typesw:localsw; setsw:ord(cs_check_stack)), + {T} (typesw:localsw; setsw:ord(cs_typed_addresses)), + {U} (typesw:illegalsw; setsw:ord(cs_localnone)), + {V} (typesw:localsw; setsw:ord(cs_strict_var_strings)), + {W} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {X} (typesw:modulesw; setsw:ord(cs_extsyntax)), + {Y} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {Z} (typesw:illegalsw; setsw:ord(cs_localnone)) ); procedure HandleSwitch(switch,state:char); @@ -105,30 +83,35 @@ begin with SwitchTable[switch] do begin case typesw of - illegal : Message1(scan_w_illegal_switch,'$'+switch); - unsupported : Message1(scan_w_unsupported_switch,'$'+switch); - unitglobal, - programglobal, - local : begin - if (typesw=local) or - ((typesw=unitglobal) and current_module^.in_main) or - ((typesw=programglobal) and current_module^.in_main and (current_module=main_module)) then + illegalsw : Message1(scan_w_illegal_switch,'$'+switch); + unsupportedsw : Message1(scan_w_unsupported_switch,'$'+switch); + localsw : begin + if state='+' then + aktlocalswitches:=aktlocalswitches+[tlocalswitch(setsw)] + else + aktlocalswitches:=aktlocalswitches-[tlocalswitch(setsw)]; + end; + modulesw : begin + if current_module^.in_main then begin if state='+' then - aktswitches:=aktswitches+[setsw] + aktmoduleswitches:=aktmoduleswitches+[tmoduleswitch(setsw)] else - aktswitches:=aktswitches-[setsw]; + aktmoduleswitches:=aktmoduleswitches-[tmoduleswitch(setsw)]; + end + else + Message(scan_w_switch_is_global); + end; + globalsw : begin + if current_module^.in_main and (current_module=main_module) then + begin + if state='+' then + aktglobalswitches:=aktglobalswitches+[tglobalswitch(setsw)] + else + aktglobalswitches:=aktglobalswitches-[tglobalswitch(setsw)]; end else Message(scan_w_switch_is_global); - - {$ifdef FPC} - if assigned(proc) then - proc(); - {$else} - if @proc<>nil then - proc; - {$endif} end; end; end; @@ -150,7 +133,13 @@ begin { Check the switch } with SwitchTable[switch] do begin - found:=(setsw in aktswitches); + case typesw of + localsw : found:=(tlocalswitch(setsw) in aktlocalswitches); + modulesw : found:=(tmoduleswitch(setsw) in aktmoduleswitches); + globalsw : found:=(tglobalswitch(setsw) in aktglobalswitches); + else + found:=false; + end; if state='-' then found:=not found; CheckSwitch:=found; @@ -161,7 +150,10 @@ end; end. { $Log$ - Revision 1.7 1998-07-24 22:17:00 florian + Revision 1.8 1998-08-10 14:50:27 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.7 1998/07/24 22:17:00 florian * internal error 10 together with array access fixed. I hope that's the final fix. diff --git a/compiler/symdef.inc b/compiler/symdef.inc index 79b6097363..acdaf95152 100644 --- a/compiler/symdef.inc +++ b/compiler/symdef.inc @@ -674,7 +674,7 @@ begin { generate two constant for bounds } getlabelnr(rangenr); - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then datasegment^.concat(new(pai_symbol,init_global('R_'+current_module^.mainsource^+tostr(rangenr)))) else datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr)))); @@ -689,7 +689,7 @@ datasegment^.concat(new(pai_const,init_32bit(low))); datasegment^.concat(new(pai_const,init_32bit($7fffffff))); inc(nextlabelnr); - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then datasegment^.concat(new(pai_symbol,init_global('R_'+current_module^.mainsource^+tostr(rangenr+1)))) else datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr+1)))); @@ -1825,7 +1825,7 @@ defref:=nil; lastwritten:=nil; refcount:=0; - if (cs_browser in aktswitches) and make_ref then + if (cs_browser in aktmoduleswitches) and make_ref then begin defref:=new(pref,init(defref,@tokenpos)); inc(refcount); @@ -1873,7 +1873,7 @@ nextoverloaded:=pprocdef(readdefref); _class := pobjectdef(readdefref); - if gendeffile and ((options and poexports)<>0) then + if (cs_link_deffile in aktglobalswitches) and ((options and poexports)<>0) then deffile.AddExport(mangledname); parast:=nil; @@ -2359,7 +2359,7 @@ { handles the predefined class tobject } { the last TOBJECT which is loaded gets } { it ! } - if (name^='TOBJECT') and not(cs_compilesystem in aktswitches) and + if (name^='TOBJECT') and not(cs_compilesystem in aktmoduleswitches) and isclass and (childof=pointer($ffffffff)) then class_tobject:=@self; end; @@ -2666,7 +2666,10 @@ { $Log$ - Revision 1.20 1998-07-18 22:54:30 florian + Revision 1.21 1998-08-10 14:50:28 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.20 1998/07/18 22:54:30 florian * some ansi/wide/longstring support fixed: o parameter passing o returning as result from functions diff --git a/compiler/symppu.inc b/compiler/symppu.inc index 5efff8a8c5..266b93543f 100644 --- a/compiler/symppu.inc +++ b/compiler/symppu.inc @@ -177,7 +177,7 @@ { create unit flags } with Current_Module^ do begin - if cs_smartlink in aktswitches then + if cs_smartlink in aktmoduleswitches then begin flags:=flags or uf_smartlink; if SplitName(ppufilename^)<>SplitName(libfilename^) then @@ -697,7 +697,10 @@ { $Log$ - Revision 1.7 1998-07-14 14:47:07 peter + Revision 1.8 1998-08-10 14:50:29 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.7 1998/07/14 14:47:07 peter * released NEWINPUT Revision 1.6 1998/07/07 11:20:14 peter diff --git a/compiler/symsym.inc b/compiler/symsym.inc index 3521e34a58..512840ae80 100644 --- a/compiler/symsym.inc +++ b/compiler/symsym.inc @@ -39,7 +39,7 @@ defref:=nil; lastwritten:=nil; refcount:=0; - if (cs_browser in aktswitches) and make_ref then + if (cs_browser in aktmoduleswitches) and make_ref then begin defref:=new(pref,init(defref,@tokenpos)); inc(refcount); @@ -269,7 +269,7 @@ if object_options then writebyte(byte(properties)); {$ifdef UseBrowser} -{ if cs_browser in aktswitches then +{ if cs_browser in aktmoduleswitches then write_references; } {$endif UseBrowser} end; @@ -919,7 +919,7 @@ exit; end; case owner^.symtabletype of - staticsymtable : if (cs_smartlink in aktswitches) then + staticsymtable : if (cs_smartlink in aktmoduleswitches) then prefix:='_'+owner^.name^+'$$$_' else prefix:='_'; @@ -1005,13 +1005,13 @@ address:=owner^.datasize; end; staticsymtable : begin - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then bsssegment^.concat(new(pai_cut,init)); {$ifdef GDB} - if cs_debuginfo in aktswitches then + if cs_debuginfo in aktmoduleswitches then concatstabto(bsssegment); {$endif GDB} - if (cs_smartlink in aktswitches) or + if (cs_smartlink in aktmoduleswitches) or ((var_options and vo_is_c_var)<>0) then bsssegment^.concat(new(pai_datablock,init_global(mangledname,l))) else @@ -1022,10 +1022,10 @@ var_options:=var_options and not vo_regable; end; globalsymtable : begin - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then bsssegment^.concat(new(pai_cut,init)); {$ifdef GDB} - if cs_debuginfo in aktswitches then + if cs_debuginfo in aktmoduleswitches then concatstabto(bsssegment); {$endif GDB} bsssegment^.concat(new(pai_datablock,init_global(mangledname,l))); @@ -1262,10 +1262,10 @@ begin if owner^.symtabletype=globalsymtable then begin - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then datasegment^.concat(new(pai_cut,init)); {$ifdef GDB} - if cs_debuginfo in aktswitches then + if cs_debuginfo in aktmoduleswitches then concatstabto(datasegment); {$endif GDB} datasegment^.concat(new(pai_symbol,init_global(mangledname))); @@ -1273,13 +1273,13 @@ else if owner^.symtabletype<>unitsymtable then begin - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then datasegment^.concat(new(pai_cut,init)); {$ifdef GDB} - if cs_debuginfo in aktswitches then + if cs_debuginfo in aktmoduleswitches then concatstabto(datasegment); {$endif GDB} - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then datasegment^.concat(new(pai_symbol,init_global(mangledname))) else datasegment^.concat(new(pai_symbol,init(mangledname))); @@ -1652,7 +1652,10 @@ { $Log$ - Revision 1.26 1998-08-10 10:18:35 peter + Revision 1.27 1998-08-10 14:50:31 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.26 1998/08/10 10:18:35 peter + Compiler,Comphook unit which are the new interface units to the compiler diff --git a/compiler/tgeni386.pas b/compiler/tgeni386.pas index 743f5b24ac..4e5be3a5fb 100644 --- a/compiler/tgeni386.pas +++ b/compiler/tgeni386.pas @@ -185,7 +185,7 @@ unit tgeni386; procedure ungetregister32(r : tregister); begin - if cs_maxoptimieren in aktswitches then + if cs_maxoptimize in aktglobalswitches then begin { takes much time } if not(r in usableregs) then @@ -227,7 +227,7 @@ unit tgeni386; procedure ungetregistermmx(r : tregister); begin - if cs_maxoptimieren in aktswitches then + if cs_maxoptimize in aktglobalswitches then begin { takes much time } if not(r in usableregs) then @@ -313,7 +313,10 @@ begin end. { $Log$ - Revision 1.7 1998-06-08 13:13:47 pierre + Revision 1.8 1998-08-10 14:50:34 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.7 1998/06/08 13:13:47 pierre + temporary variables now in temp_gen.pas unit because it is processor independent * mppc68k.bat modified to undefine i386 and support_mmx diff --git a/compiler/tree.pas b/compiler/tree.pas index 777505d451..0b54163c18 100644 --- a/compiler/tree.pas +++ b/compiler/tree.pas @@ -194,7 +194,7 @@ unit tree; { line : longint; fileindex,colon : word; } fileinfo : tfileposinfo; - pragmas : Tcswitches; + localswitches : tlocalswitches; {$ifdef extdebug} firstpasscount : longint; {$endif extdebug} @@ -317,34 +317,29 @@ unit tree; begin new(hp); - { makes error tracking easier } - fillchar(hp^,sizeof(ttree),#0); + fillchar(hp^,sizeof(ttree),0); + { reset } hp^.location.loc:=LOC_INVALID; - - { new node is error free } - hp^.error:=false; - - { we know also the position } - hp^.fileinfo:=tokenpos; - hp^.pragmas:=aktswitches; + { save local info } + hp^.fileinfo:=aktfilepos; + hp^.localswitches:=aktlocalswitches; getnode:=hp; end; - procedure putnode(p : ptree); + procedure putnode(p : ptree); begin { clean up the contents of a node } - if p^.treetype=asmn then - if assigned(p^.p_asm) then - dispose(p^.p_asm,done); - - if p^.treetype=setconstrn then - if assigned(p^.constset) then - dispose(p^.constset); - - if (p^.location.loc=LOC_MEM) or (p^.location.loc=LOC_REFERENCE) and - assigned(p^.location.reference.symbol) then + case p^.treetype of + asmn : if assigned(p^.p_asm) then + dispose(p^.p_asm,done); + setconstrn : if assigned(p^.constset) then + dispose(p^.constset); + end; + { reference info } + if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and + assigned(p^.location.reference.symbol) then stringdispose(p^.location.reference.symbol); {$ifndef UseAnsiString} @@ -1562,7 +1557,10 @@ unit tree; end. { $Log$ - Revision 1.26 1998-08-10 09:57:19 peter + Revision 1.27 1998-08-10 14:50:35 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.26 1998/08/10 09:57:19 peter - Remove InitTree which was empty and obsolete Revision 1.25 1998/08/02 16:42:02 florian diff --git a/compiler/verbose.pas b/compiler/verbose.pas index 050b4d5b7c..2738691693 100644 --- a/compiler/verbose.pas +++ b/compiler/verbose.pas @@ -25,9 +25,12 @@ interface uses messages; -{$IFNDEF EXTERN_MSG} - {$i msgtxt.inc} -{$ENDIF} +{$ifndef TP} + {$ifndef EXTERN_MSG} + {$i msgtxt.inc} + {$endif} +{$endif} + {$i msgidx.inc} @@ -364,14 +367,19 @@ begin end; begin -{$IFNDEF EXTERN_MSG} - msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst))); -{$ENDIF} +{$ifndef TP} + {$ifndef EXTERN_MSG} + msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst))); + {$endif} +{$endif} end. { $Log$ - Revision 1.12 1998-08-10 10:18:37 peter + Revision 1.13 1998-08-10 14:50:37 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.12 1998/08/10 10:18:37 peter + Compiler,Comphook unit which are the new interface units to the compiler diff --git a/compiler/win_targ.pas b/compiler/win_targ.pas index bcedee7475..9df0e55961 100644 --- a/compiler/win_targ.pas +++ b/compiler/win_targ.pas @@ -91,13 +91,13 @@ unit win_targ; while assigned(hp1) do begin { Insert cuts for smartlinking } - if (cs_smartlink in aktswitches) then + if (cs_smartlink in aktmoduleswitches) then begin importssection^.concat(new(pai_cut,init)); codesegment^.concat(new(pai_cut,init)); end; {$IfDef GDB} - if (cs_debuginfo in aktswitches) then + if (cs_debuginfo in aktmoduleswitches) then codesegment^.concat(new(pai_stab_function_name,init(nil))); {$EndIf GDB} @@ -179,7 +179,10 @@ unit win_targ; end. { $Log$ - Revision 1.5 1998-06-10 10:43:18 peter + Revision 1.6 1998-08-10 14:50:38 peter + + localswitches, moduleswitches, globalswitches splitting + + Revision 1.5 1998/06/10 10:43:18 peter * write also the .dll extension (needed for NT) Revision 1.4 1998/06/08 22:59:56 peter