* use defines.inc

compiler/aasm.pas

@@ -22,13 +22,9 @@
 }
 unit aasm;
 
-{$ifdef FPC}
-  {$ifdef PACKENUMFIXED}
-    {$PACKENUM 1}
-  {$endif}
-{$endif}
+{$i defines.inc}
 
-  interface
+interface
 
     uses
        cutils,cobjects,
@@ -425,7 +421,11 @@ type
 implementation
 
 uses
+{$ifdef delphi}
+  sysutils,
+{$else}
   strings,
+{$endif}
   fmodule,verbose;
 
 {****************************************************************************
@@ -1180,7 +1180,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.12  2000-08-27 20:19:38  peter
+  Revision 1.13  2000-09-24 15:06:10  peter
+    * use defines.inc
+
+  Revision 1.12  2000/08/27 20:19:38  peter
     * store strings with case in ppu, when an internal symbol is created
       a '$' is prefixed so it's not automatic uppercased
 
@@ -1219,4 +1222,4 @@ end.
   Revision 1.2  2000/07/13 11:32:28  michael
   + removed logs
 
-}
+}

compiler/ag386att.pas

@@ -20,12 +20,11 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$N+,E+}
-{$endif}
 unit ag386att;
 
-    interface
+{$i defines.inc}
+
+interface
 
     uses cobjects,aasm,assemble;
 
@@ -44,11 +43,12 @@ unit ag386att;
 
     uses
 {$ifdef Delphi}
+      sysutils,
       dmisc,
 {$else Delphi}
+      strings,
       dos,
 {$endif Delphi}
-      strings,
       cutils,globtype,globals,systems,
       fmodule,finput,verbose,cpubase,cpuasm
 {$ifdef GDB}
@@ -440,19 +440,6 @@ unit ag386att;
                          infile^.linebuf^[hp^.fileinfo.line]:=-infile^.linebuf^[hp^.fileinfo.line]-1;
                      end;
                  end;
-{$ifdef LINEINFO}
-              { lineinfo }
-                if (cs_lineinfo in aktmoduleswitches) then
-                 begin
-                   if (infile<>lastinfile) then
-                    begin
-                      lineinfolist^.concat(new(pai_const(init_8bit
-                    end
-                   else
-                    begin
-                    end;
-                 end;
-{$endif LINEINFO}
                 lastfileinfo:=hp^.fileinfo;
                 lastinfile:=infile;
               end;
@@ -902,7 +889,10 @@ unit ag386att;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:49  peter
+  Revision 1.6  2000-09-24 15:06:10  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:49  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/ag386bin.pas

@@ -20,15 +20,14 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$N+,E+}
-{$endif}
 unit ag386bin;
 
+{$i defines.inc}
+
 {$define MULTIPASS}
 {$define EXTERNALBSS}
 
-  interface
+interface
 
     uses
        cpubase,cobjects,aasm,fmodule,finput,assemble;
@@ -57,9 +56,6 @@ unit ag386bin;
         funcname     : pasmsymbol;
         stabslastfileinfo : tfileposinfo;
         procedure convertstabs(p:pchar);
-{$ifdef unused}
-        procedure emitsymbolstabs(s : string;nidx,nother,line : longint;firstasm,secondasm : pasmsymbol);
-{$endif}
         procedure emitlineinfostabs(nidx,line : longint);
         procedure emitstabs(s:string);
         procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
@@ -77,7 +73,11 @@ unit ag386bin;
   implementation
 
     uses
+{$ifdef delphi}
+       sysutils,
+{$else}
        strings,
+{$endif}
        cutils,globtype,globals,systems,verbose,
        cpuasm,
 {$ifdef GDB}
@@ -227,36 +227,6 @@ unit ag386bin;
       end;
 
 
-{$ifdef unused}
-    procedure ti386binasmlist.emitsymbolstabs(s : string;nidx,nother,line : longint;
-                firstasm,secondasm : pasmsymbol);
-      var
-         hp : pchar;
-      begin
-        if s='' then
-          hp:=nil
-        else
-          begin
-            s:=s+#0;
-            hp:=@s[1];
-          end;
-        if not assigned(secondasm) then
-          begin
-            if not assigned(firstasm) then
-              internalerror(33009);
-            objectoutput^.WriteStabs(firstasm^.section,firstasm^.address,hp,nidx,nother,line,true);
-          end
-        else
-          begin
-            if firstasm^.section<>secondasm^.section then
-              internalerror(33010);
-            objectoutput^.WriteStabs(firstasm^.section,firstasm^.address-secondasm^.address,
-              hp,nidx,nother,line,false);
-          end;
-      end;
-{$endif}
-
-
     procedure ti386binasmlist.emitlineinfostabs(nidx,line : longint);
       var
          sec : tsection;
@@ -284,6 +254,7 @@ unit ag386bin;
           end;
       end;
 
+
     procedure ti386binasmlist.emitstabs(s:string);
       begin
         s:=s+#0;
@@ -347,6 +318,7 @@ unit ag386bin;
         WriteFileLineInfo(fileinfo);
       end;
 
+
     procedure ti386binasmlist.EndFileLineInfo;
       var
         hp : pasmsymbol;
@@ -1039,7 +1011,10 @@ unit ag386bin;
 end.
 {
   $Log$
-  Revision 1.7  2000-08-27 16:11:49  peter
+  Revision 1.8  2000-09-24 15:06:10  peter
+    * use defines.inc
+
+  Revision 1.7  2000/08/27 16:11:49  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/ag386int.pas

@@ -20,12 +20,11 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$N+,E+}
-{$endif}
 unit ag386int;
 
-    interface
+{$i defines.inc}
+
+interface
 
     uses aasm,assemble;
 
@@ -40,7 +39,11 @@ unit ag386int;
   implementation
 
     uses
+{$ifdef delphi}
+      sysutils,
+{$else}
       strings,
+{$endif}
       cutils,globtype,globals,systems,cobjects,
       fmodule,finput,verbose,cpubase,cpuasm
 {$ifdef GDB}
@@ -51,12 +54,6 @@ unit ag386int;
     const
       line_length = 70;
 
-{$ifdef EXTTYPE}
-      extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
-             ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
-              'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
-{$endif}
-
     function single2str(d : single) : string;
       var
          hs : string;
@@ -592,7 +589,7 @@ ait_stab_function_name : ;
     var
       currentasmlist : PAsmList;
 
-    procedure writeexternal(p:pnamedindexobject);{$ifndef FPC}far;{$endif}
+    procedure writeexternal(p:pnamedindexobject);
       begin
         if pasmsymbol(p)^.defbind=AB_EXTERNAL then
          currentasmlist^.AsmWriteln(#9'EXTRN'#9+p^.name);
@@ -601,7 +598,7 @@ ait_stab_function_name : ;
     procedure ti386intasmlist.WriteExternals;
       begin
         currentasmlist:=@self;
-        AsmSymbolList^.foreach({$ifndef VER70}@{$endif}writeexternal);
+        AsmSymbolList^.foreach({$ifdef fpcprocvar}@{$endif}writeexternal);
       end;
 
 
@@ -645,7 +642,10 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:49  peter
+  Revision 1.6  2000-09-24 15:06:10  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:49  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/ag386nsm.pas

@@ -21,12 +21,11 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$N+,E+}
-{$endif}
 unit ag386nsm;
 
-    interface
+{$i defines.inc}
+
+interface
 
     uses aasm,assemble;
 
@@ -41,7 +40,11 @@ unit ag386nsm;
   implementation
 
     uses
+{$ifdef delphi}
+      sysutils,
+{$else}
       strings,
+{$endif}
       cutils,globtype,globals,systems,cobjects,
       fmodule,finput,verbose,cpubase,cpuasm
 {$ifdef GDB}
@@ -56,11 +59,6 @@ unit ag386nsm;
       lastfileinfo : tfileposinfo;
       infile,
       lastinfile   : pinputfile;
-{$ifdef EXTTYPE}
-      extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
-             ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
-              'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
-{$endif}
 
    function fixline(s:string):string;
    {
@@ -723,7 +721,7 @@ unit ag386nsm;
     var
       currentasmlist : PAsmList;
 
-    procedure writeexternal(p:pnamedindexobject);{$ifndef FPC}far;{$endif}
+    procedure writeexternal(p:pnamedindexobject);
       begin
         if pasmsymbol(p)^.defbind=AB_EXTERNAL then
          currentasmlist^.AsmWriteln('EXTERN'#9+p^.name);
@@ -732,7 +730,7 @@ unit ag386nsm;
     procedure ti386nasmasmlist.WriteExternals;
       begin
         currentasmlist:=@self;
-        AsmSymbolList^.foreach({$ifndef TP}@{$endif}writeexternal);
+        AsmSymbolList^.foreach({$ifdef fpcprocvar}@{$endif}writeexternal);
       end;
 
 
@@ -774,7 +772,10 @@ unit ag386nsm;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:49  peter
+  Revision 1.6  2000-09-24 15:06:11  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:49  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/aopt386.pas

@@ -21,9 +21,10 @@
 
  ****************************************************************************
 }
-
 Unit aopt386;
 
+{$i defines.inc}
+
 Interface
 
 Uses
@@ -31,6 +32,7 @@ Uses
 
 Procedure Optimize(AsmL: PAasmOutput);
 
+
 Implementation
 
 Uses
@@ -104,10 +106,12 @@ Begin
 End;
 
 End.
-
 {
   $Log$
-  Revision 1.4  2000-08-19 09:10:08  jonas
+  Revision 1.5  2000-09-24 15:06:11  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/19 09:10:08  jonas
     * for all optimization levels > 1, all passes are done twice (the
       result improves the most if -Or is used as well)
 

compiler/assemble.pas

@@ -18,26 +18,26 @@
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
- ****************************************************************************}
-
+ ****************************************************************************
+}
 unit assemble;
 
+{$i defines.inc}
+
 interface
 
 uses
 {$ifdef Delphi}
+  sysutils,
   dmisc,
 {$else Delphi}
+  strings,
   dos,
 {$endif Delphi}
   cobjects,globtype,globals,aasm;
 
 const
-{$ifdef tp}
-  AsmOutSize=1024;
-{$else}
   AsmOutSize=32768;
-{$endif}
 
 type
   PAsmList=^TAsmList;
@@ -94,7 +94,6 @@ uses
 {$ifdef linux}
   ,linux
 {$endif}
-  ,strings
 {$ifdef i386}
   {$ifndef NoAg386Bin}
     ,ag386bin
@@ -444,9 +443,7 @@ begin
         RemoveFile(s+dirsep+dir.name);
         findnext(dir);
       end;
-{$ifdef fpc}
      findclose(dir);
-{$endif}
      { .s files }
      findfirst(s+dirsep+'*'+target_info.asmext,anyfile,dir);
      while (doserror=0) do
@@ -454,9 +451,7 @@ begin
         RemoveFile(s+dirsep+dir.name);
         findnext(dir);
       end;
-{$ifdef fpc}
      findclose(dir);
-{$endif}
    end
   else
    begin
@@ -579,11 +574,7 @@ begin
   {$endif NoAg68kMpw}
 {$endif}
   else
-{$ifdef TP}
-    exit;
-{$else}
     Message(asmw_f_assembler_output_not_supported);
-{$endif}
   end;
   a^.AsmCreate(cut_normal);
   a^.WriteAsmList;
@@ -606,7 +597,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 16:11:49  peter
+  Revision 1.5  2000-09-24 15:06:11  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:49  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/browcol.pas

@@ -21,10 +21,10 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$N+,E+}
-{$endif}
 unit browcol;
+
+{$i defines.inc}
+
 interface
 uses
   cobjects,cutils,objects,symconst,symtable,cpuinfo;
@@ -35,7 +35,7 @@ uses
 {$endif FPC}
 
 const
-  SymbolTypLen : integer = 6;
+  SymbolTypLen : sw_integer = 6;
 
   RecordTypes : set of tsymtyp =
     ([typesym,unitsym,programsym]);
@@ -460,9 +460,9 @@ begin
 end;
 
 function TSortedSymbolCollection.LookUp(const S: string; var Idx: sw_integer): string;
-var OLI,ORI,Left,Right,Mid: integer;
+var OLI,ORI,Left,Right,Mid: sw_integer;
     LeftP,RightP,MidP: PSymbol;
-    RL: integer;
+    RL: sw_integer;
     LeftS,MidS,RightS: string;
     FoundS: string;
     UpS : string;
@@ -587,9 +587,9 @@ begin
 end;
 
 function TObjectSymbolCollection.LookUp(const S: string; var Idx: sw_integer): string;
-var OLI,ORI,Left,Right,Mid: integer;
+var OLI,ORI,Left,Right,Mid: sw_integer;
     LeftP,RightP,MidP: PObjectSymbol;
-    RL: integer;
+    RL: sw_integer;
     LeftS,MidS,RightS: string;
     FoundS: string;
     UpS : string;
@@ -1171,7 +1171,7 @@ end;
   function GetEnumDefStr(def: penumdef): string;
   var Name: string;
       esym: penumsym;
-      Count: integer;
+      Count: sw_integer;
   begin
     Name:='(';
     esym:=def^.Firstenum; Count:=0;
@@ -1237,7 +1237,7 @@ end;
   function GetAbsProcParmDefStr(def: pabstractprocdef): string;
   var Name: string;
       dc: pparaitem;
-      Count: integer;
+      Count: sw_integer;
       CurName: string;
   begin
     Name:='';
@@ -1275,7 +1275,7 @@ end;
   end;
   function GetProcDefStr(def: pprocdef): string;
   var DName: string;
-      J: integer;
+      J: sw_integer;
   begin
 {    DName:='';
     if assigned(def) then
@@ -1729,7 +1729,7 @@ begin
         Inc(I);
     end;
 end;
-var Pass: integer;
+var Pass: sw_integer;
     I: sw_integer;
     P: PSymbol;
 begin
@@ -1870,7 +1870,7 @@ end;
 var
   oldexit : pointer;
 
-procedure browcol_exit;{$ifndef FPC}far;{$endif}
+procedure browcol_exit;
 begin
   exitproc:=oldexit;
   DisposeBrowserCol;
@@ -1927,7 +1927,7 @@ end;
 function TPointerDictionary.Compare(Key1, Key2: Pointer): sw_Integer;
 var K1: PPointerXRef absolute Key1;
     K2: PPointerXRef absolute Key2;
-    R: integer;
+    R: sw_integer;
 begin
   if longint(K1^.PtrValue)<longint(K2^.PtrValue) then R:=-1 else
   if longint(K1^.PtrValue)>longint(K2^.PtrValue) then R:= 1 else
@@ -1984,40 +1984,40 @@ end;
 
 function LoadBrowserCol(S: PStream): boolean;
 var PD: PPointerDictionary;
-procedure FixupPointers;
-procedure FixupReference(P: PReference); {$ifndef FPC}far;{$endif}
-begin
-  PD^.Resolve(P^.FileName);
-end;
-procedure FixupSymbol(P: PSymbol); {$ifndef FPC}far;{$endif}
-var I: sw_integer;
-begin
-  PD^.Resolve(P^.DType);
-  PD^.Resolve(P^.VType);
-  {PD^.Resolve(P^.Ancestor);}
-  if Assigned(P^.References) then
-    with P^.References^ do
-     for I:=0 to Count-1 do
-       FixupReference(At(I));
-  if Assigned(P^.Items) then
-    with P^.Items^ do
-     for I:=0 to Count-1 do
-       FixupSymbol(At(I));
-end;
-begin
-  Modules^.ForEach(@FixupSymbol);
-end;
-procedure ReadSymbolPointers(P: PSymbol); {$ifndef FPC}far;{$endif}
-var I: sw_integer;
-    PV: pointer;
-begin
-  S^.Read(PV, SizeOf(PV));
-  PD^.AddPtr(PV,P);
-  if Assigned(P^.Items) then
-    with P^.Items^ do
-     for I:=0 to Count-1 do
-       ReadSymbolPointers(At(I));
-end;
+  procedure FixupPointers;
+    procedure FixupReference(P: PReference);
+    begin
+      PD^.Resolve(P^.FileName);
+    end;
+    procedure FixupSymbol(P: PSymbol);
+    var I: sw_integer;
+    begin
+      PD^.Resolve(P^.DType);
+      PD^.Resolve(P^.VType);
+      {PD^.Resolve(P^.Ancestor);}
+      if Assigned(P^.References) then
+        with P^.References^ do
+         for I:=0 to Count-1 do
+           FixupReference(At(I));
+      if Assigned(P^.Items) then
+        with P^.Items^ do
+         for I:=0 to Count-1 do
+           FixupSymbol(At(I));
+    end;
+  begin
+    Modules^.ForEach(@FixupSymbol);
+  end;
+  procedure ReadSymbolPointers(P: PSymbol);
+  var I: sw_integer;
+      PV: pointer;
+  begin
+    S^.Read(PV, SizeOf(PV));
+    PD^.AddPtr(PV,P);
+    if Assigned(P^.Items) then
+      with P^.Items^ do
+       for I:=0 to Count-1 do
+         ReadSymbolPointers(At(I));
+  end;
 begin
   DisposeBrowserCol;
 
@@ -2051,7 +2051,7 @@ begin
 end;
 
 function StoreBrowserCol(S: PStream) : boolean;
-procedure WriteSymbolPointers(P: PSymbol); {$ifndef FPC}far;{$endif}
+procedure WriteSymbolPointers(P: PSymbol);
 var I: sw_integer;
 begin
   S^.Write(P, SizeOf(P));
@@ -2094,7 +2094,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2000-09-11 17:00:22  florian
+  Revision 1.9  2000-09-24 15:06:11  peter
+    * use defines.inc
+
+  Revision 1.8  2000/09/11 17:00:22  florian
     + first implementation of Netware Module support, thanks to
       Armin Diehl ([email protected]) for providing the patches
 

compiler/browlog.pas

@@ -20,21 +20,16 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$N+,E+}
-{$endif}
 unit browlog;
 
+{$i defines.inc}
+
 interface
 uses
   cobjects,globtype,fmodule,finput,symconst,symtable;
 
 const
-{$ifdef TP}
-  logbufsize   = 1024;
-{$else}
   logbufsize   = 16384;
-{$endif}
 
 type
   pbrowserlog=^tbrowserlog;
@@ -155,11 +150,11 @@ implementation
          else
            begin
              buf[bufidx]:=#0;
-{$ifndef TP}
+{$ifdef FPC}
              write(stderr,buf);
-{$else TP}
+{$else FPC}
              write(buf);
-{$endif TP}
+{$endif FPC}
            end;
         bufidx:=0;
       end;
@@ -448,7 +443,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-08-27 16:11:49  peter
+  Revision 1.4  2000-09-24 15:06:11  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/27 16:11:49  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/catch.pas

@@ -23,30 +23,29 @@
 }
 Unit catch;
 
+{$i defines.inc}
+
 {$ifdef go32v2}
   { go32v2 stack check goes nuts if ss is not the data selector (PM) }
   {$S-}
 {$endif}
 
-
 {$ifdef DEBUG}
   {$define NOCATCH}
 {$endif DEBUG}
 
-
 interface
 uses
 {$ifdef linux}
-{$define has_signal}
+  {$define has_signal}
   linux,
 {$endif}
 {$ifdef go32v2}
-{$define has_signal}
+  {$define has_signal}
   dpmiexcp,
 {$endif}
   verbose;
 
-
 {$ifdef has_signal}
 Var
   NewSignal,OldSigSegm,
@@ -59,7 +58,7 @@ Implementation
 
 {$ifdef has_signal}
 {$ifdef linux}
-Procedure CatchSignal(Sig : Integer);cdecl;
+Procedure CatchSignal(Sig : SmallInt);cdecl;
 {$else}
 Function CatchSignal(Sig : longint):longint;
 {$endif}
@@ -91,22 +90,21 @@ end;
 
 begin
 {$ifndef nocatch}
-{$ifdef has_signal}
-{$ifndef TP}
-  NewSignal:=SignalHandler(@CatchSignal);
-{$else TP}
-  NewSignal:=SignalHandler(CatchSignal);
-{$endif TP}
-  OldSigSegm:=Signal (SIGSEGV,NewSignal);
-  OldSigInt:=Signal (SIGINT,NewSignal);
-  OldSigFPE:=Signal (SIGFPE,NewSignal);
-{$endif}
+  {$ifdef has_signal}
+    NewSignal:=SignalHandler({$ifdef fpcprocvar}@{$endif}CatchSignal);
+    OldSigSegm:=Signal (SIGSEGV,NewSignal);
+    OldSigInt:=Signal (SIGINT,NewSignal);
+    OldSigFPE:=Signal (SIGFPE,NewSignal);
+  {$endif}
 {$endif nocatch}
 end.
 
 {
   $Log$
-  Revision 1.3  2000-09-10 20:26:55  peter
+  Revision 1.4  2000-09-24 15:06:11  peter
+    * use defines.inc
+
+  Revision 1.3  2000/09/10 20:26:55  peter
     * bsd patches from marco
 
   Revision 1.2  2000/07/13 11:32:32  michael

compiler/cg386inl.pas

@@ -45,7 +45,7 @@ implementation
 *****************************************************************************}
 
     { reverts the parameter list }
-    var nb_para : integer;
+    var nb_para : longint;
 
     function reversparameter(p : ptree) : ptree;
 
@@ -1537,7 +1537,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2000-08-27 16:11:49  peter
+  Revision 1.8  2000-09-24 15:06:11  peter
+    * use defines.inc
+
+  Revision 1.7  2000/08/27 16:11:49  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 
@@ -1559,4 +1562,4 @@ end.
   Revision 1.2  2000/07/13 11:32:34  michael
   + removed logs
 
-}
+}

compiler/cgai386.pas

@@ -18,11 +18,14 @@
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
- ****************************************************************************}
+ ****************************************************************************
+}
 
 unit cgai386;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
        cobjects,tree,
@@ -164,7 +167,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
   implementation
 
     uses
-       strings,cutils,globtype,systems,globals,verbose,fmodule,types,pbase,
+{$ifdef delphi}
+       sysutils,
+{$else}
+       strings,
+{$endif}
+       cutils,globtype,systems,globals,verbose,fmodule,types,pbase,
        tgeni386,temp_gen,hcodegen,ppu,regvars
 {$ifdef GDB}
        ,gdb
@@ -4075,7 +4083,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.14  2000-09-16 12:22:52  peter
+  Revision 1.15  2000-09-24 15:06:12  peter
+    * use defines.inc
+
+  Revision 1.14  2000/09/16 12:22:52  peter
     * freebsd support merged
 
   Revision 1.13  2000/08/27 16:11:49  peter
@@ -4135,4 +4146,4 @@ end.
   Revision 1.2  2000/07/13 11:32:37  michael
   + removed logs
 
-}
+}

compiler/cobjects.pas

@@ -20,35 +20,18 @@
 
  ****************************************************************************
 }
-
-{$ifdef tp}
-  {$E+,N+,D+,F+}
-{$endif}
-{$I-}
-{$R-}{ necessary for crc calculation and dynamicblock acessing }
-
-{$ifdef fpc}
-{$define USEREALLOCMEM}
-{$endif fpc}
-
-{$ifdef delphi}
-{$define USEREALLOCMEM}
-{$endif delphi}
-
 unit cobjects;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
       cutils;
 
     const
        { the real size will be [-hasharray..hasharray] ! }
-{$ifdef TP}
-       hasharraysize = 127;
-{$else}
        hasharraysize = 2047;
-{$endif}
 
     type
        pfileposinfo = ^tfileposinfo;
@@ -276,7 +259,7 @@ unit cobjects;
          function  size:longint;
          procedure align(i:longint);
          procedure seek(i:longint);
-         procedure write(var d;len:longint);
+         procedure write(const d;len:longint);
          function  read(var d;len:longint):longint;
          procedure blockwrite(var f:file);
        private
@@ -588,7 +571,6 @@ begin
 end;
 
 
-
 {****************************************************************************
                                    TCONTAINER
  ****************************************************************************}
@@ -1608,7 +1590,7 @@ end;
       end;
 
 
-    procedure tdynamicarray.write(var d;len:longint);
+    procedure tdynamicarray.write(const d;len:longint);
       var
         p : pchar;
         i,j : longint;
@@ -1771,23 +1753,10 @@ end;
     procedure tindexarray.grow(gsize:longint);
       var
         osize : longint;
-{$ifndef USEREALLOCMEM}
-        odata : Pnamedindexobjectarray;
-{$endif USEREALLOCMEM}
       begin
         osize:=size;
         inc(size,gsize);
-{$ifndef USEREALLOCMEM}
-        odata:=data;
-        getmem(data,size*4);
-        if assigned(odata) then
-         begin
-           move(odata^,data^,osize*4);
-           freemem(odata,osize*4);
-         end;
-{$else USEREALLOCMEM}
         reallocmem(data,size*4);
-{$endif USEREALLOCMEM}
         fillchar(data^[osize+1],gsize*4,0);
       end;
 
@@ -1872,7 +1841,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.12  2000-08-27 20:19:38  peter
+  Revision 1.13  2000-09-24 15:06:12  peter
+    * use defines.inc
+
+  Revision 1.12  2000/08/27 20:19:38  peter
     * store strings with case in ppu, when an internal symbol is created
       a '$' is prefixed so it's not automatic uppercased
 

compiler/comphook.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit comphook;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -127,13 +130,15 @@ const
 implementation
 
   uses
-{$ifdef USEEXCEPT}
-   tpexcept,
-{$endif USEEXCEPT}
 {$ifdef Linux}
    linux,
 {$endif}
-   dos;
+{$ifdef delphi}
+   dmisc
+{$else}
+   dos
+{$endif}
+   ;
 
 {****************************************************************************
                           Helper Routines
@@ -152,15 +157,7 @@ begin
       gccfilename[i]:=s[i];
      end;
    end;
-  {$ifndef TP}
-    {$ifopt H+}
-      setlength(gccfilename,length(s));
-    {$else}
-      gccfilename[0]:=s[0];
-    {$endif}
-  {$else}
-    gccfilename[0]:=s[0];
-  {$endif}
+  gccfilename[0]:=s[0];
 end;
 
 
@@ -180,11 +177,7 @@ end;
 { predefined handler when then compiler stops }
 procedure def_stop;
 begin
-{$ifndef USEEXCEPT}
   Halt(1);
-{$else USEEXCEPT}
-  Halt(1);
-{$endif USEEXCEPT}
 end;
 
 {$ifdef DEBUG}
@@ -217,9 +210,9 @@ begin
 {$ifdef FPC}
        WriteLn(status.currentline,' ',memavail shr 10,'/',system.heapsize shr 10,' Kb Free');
 {$else}
-{$ifndef Delphi}
+  {$ifndef Delphi}
        WriteLn(status.currentline,' ',memavail shr 10,' Kb Free');
-{$endif Delphi}
+  {$endif Delphi}
 {$endif}
    end
 end;
@@ -336,42 +329,40 @@ begin
   def_openinputfile:=new(pdosinputfile, init(filename));
 end;
 
-Function def_GetNamedFileTime (Const F : String) : Longint;
-   var
-     L : Longint;
-   {$ifndef linux}
-     info : SearchRec;
-   {$else}
-     info : stat;
-   {$endif}
-   begin
-     l:=-1;
-   {$ifdef linux}
-     if FStat (F,Info) then
-      L:=info.mtime;
-   {$else}
-{$ifdef delphi}
-     dmisc.FindFirst (F,archive+readonly+hidden,info);
-{$else delphi}
-     FindFirst (F,archive+readonly+hidden,info);
-{$endif delphi}
-     if DosError=0 then
-      l:=info.time;
-     {$ifdef Linux}
-       FindClose(info);
-     {$endif}
-     {$ifdef Win32}
-       FindClose(info);
-     {$endif}
-   {$endif}
-     def_GetNamedFileTime:=l;
-   end;
 
+Function def_GetNamedFileTime (Const F : String) : Longint;
+var
+  L : Longint;
+{$ifndef linux}
+  info : SearchRec;
+{$else}
+  info : stat;
+{$endif}
+begin
+  l:=-1;
+{$ifdef linux}
+  if FStat (F,Info) then
+   L:=info.mtime;
+{$else}
+  {$ifdef delphi}
+    dmisc.FindFirst (F,archive+readonly+hidden,info);
+  {$else delphi}
+    FindFirst (F,archive+readonly+hidden,info);
+  {$endif delphi}
+  if DosError=0 then
+   l:=info.time;
+  FindClose(info);
+{$endif linux}
+  def_GetNamedFileTime:=l;
+end;
 
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:50  peter
+  Revision 1.6  2000-09-24 15:06:13  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/compiler.pas

@@ -21,23 +21,9 @@
 
  ****************************************************************************}
 
-{
-  possible compiler switches:
-  -----------------------------------------------------------------
-  TP                  to compile the compiler with Turbo or Borland Pascal
-  I386                generate a compiler for the Intel i386+
-  M68K                generate a compiler for the M68000
-  GDB                 support of the GNU Debugger
-  EXTDEBUG            some extra debug code is executed
-  SUPPORT_MMX         only i386: releases the compiler switch
-                      MMX which allows the compiler to generate
-                      MMX instructions
-  EXTERN_MSG          Don't compile the msgfiles in the compiler, always
-                      use external messagefiles
-  NOAG386INT          no Intel Assembler output
-  NOAG386NSM          no NASM output
-  -----------------------------------------------------------------
-}
+unit compiler;
+
+{$i defines.inc}
 
 {$ifdef FPC}
    { One of Alpha, I386 or M68K must be defined }
@@ -82,27 +68,12 @@
    {$endif support_mmx}
 {$endif}
 
-unit compiler;
 interface
 
-{ Use exception catching so the compiler goes futher after a Stop }
-{$ifndef NOUSEEXCEPT}
-{$ifdef i386}
-  {$define USEEXCEPT}
-{$endif}
-
-{$ifdef TP}
-  {$ifdef DPMI}
-    {$undef USEEXCEPT}
-  {$endif}
-{$endif}
-{$endif ndef NOUSEEXCEPT}
-
 uses
 {$ifdef fpc}
   {$ifdef GO32V2}
     emu387,
-{    dpmiexcp, }
   {$endif GO32V2}
 {$endif}
 {$ifdef USEEXCEPT}
@@ -121,9 +92,6 @@ uses
 
 function Compile(const cmd:string):longint;
 
-Const
-       { do we need to link }
-       IsExe : boolean = false;
 
 implementation
 
@@ -136,8 +104,7 @@ var
   olddo_stop : tstopprocedure;
 
 {$ifdef USEEXCEPT}
-
-procedure RecoverStop;{$ifndef FPC}far;{$endif}
+procedure RecoverStop;
 begin
   if recoverpospointer<>nil then
     LongJmp(recoverpospointer^,1)
@@ -265,13 +232,8 @@ var
   recoverpos : jmp_buf;
 {$endif}
 begin
-
   olddo_stop:=do_stop;
-{$ifdef TP}
-  do_stop:=minimal_stop;
-{$else TP}
-  do_stop:=@minimal_stop;
-{$endif TP}
+  do_stop:={$ifdef FPCPROCVAR}@{$endif}minimal_stop;
 { Initialize the compiler }
   InitCompiler(cmd);
 
@@ -284,21 +246,12 @@ begin
   WritePathList(general_t_includepath,includesearchpath);
   WritePathList(general_t_librarypath,librarysearchpath);
   WritePathList(general_t_objectpath,objectsearchpath);
-{$ifdef TP}
-{$ifndef Delphi}
-  Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
-{$endif Delphi}
-{$endif}
 
 {$ifdef USEEXCEPT}
   if setjmp(recoverpos)=0 then
    begin
      recoverpospointer:=@recoverpos;
-{$ifdef TP}
-     do_stop:=recoverstop;
-{$else TP}
-     do_stop:=@recoverstop;
-{$endif TP}
+     do_stop:={$ifdef FPCPROCVAR}@{$endif}recoverstop;
 {$endif USEEXCEPT}
      starttime:=getrealtime;
      if parapreprocess then
@@ -331,31 +284,29 @@ begin
 
   DoneVerbose;
 {$ifdef EXTDEBUG}
-{$ifdef FPC}
-  LostMemory:=system.HeapSize-MemAvail-EntryMemUsed;
-  CheckMemory(LostMemory);
-{$endif FPC}
-{$ifndef newcg}
-  Writeln('Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
-{$endif newcg}
+  {$ifdef FPC}
+    LostMemory:=system.HeapSize-MemAvail-EntryMemUsed;
+    CheckMemory(LostMemory);
+  {$endif FPC}
+  {$ifndef newcg}
+    Writeln('Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
+  {$endif newcg}
 {$endif EXTDEBUG}
 {$ifdef MEMDEBUG}
   Writeln('Memory used: ',system.Heapsize);
 {$endif}
 {$ifdef fixLeaksOnError}
- {$ifdef tp}
-  do_stop;
- {$else tp}
-  do_stop();
- {$endif tp}
+  do_stop{$ifdef FPCPROCVAR}(){$endif};
 {$endif fixLeaksOnError}
 end;
 
-
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:50  peter
+  Revision 1.6  2000-09-24 15:06:14  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/comprsrc.pas

@@ -22,6 +22,8 @@
 }
 unit comprsrc;
 
+{$i defines.inc}
+
 interface
 
 type
@@ -140,7 +142,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 16:11:50  peter
+  Revision 1.5  2000-09-24 15:06:14  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/cpuasm.pas

@@ -25,21 +25,24 @@
  ****************************************************************************
 }
 unit cpuasm;
-interface
 
-uses
-  cobjects,
-  aasm,globals,verbose,
-  cpubase;
+{$i defines.inc}
 
+{ Optimize addressing and skip already passed nodes }
 {$ifndef NASMDEBUG}
   {$define OPTEA}
   {$define PASS2FLAG}
 {$endif ndef NASMDEBUG}
 
-{$ifndef TP}
-  {$define ASMDEBUG}
-{$endif}
+{ Give warnings when an immediate is found in the reference struct }
+{.$define REF_IMMEDIATE_WARN}
+
+interface
+
+uses
+  cobjects,
+  aasm,globals,verbose,
+  cpubase;
 
 const
   MaxPrefixes=4;
@@ -262,7 +265,7 @@ uses
             disposereference(ref);
            if p^.is_immediate then
              begin
-{$ifdef ASMDEBUG1}
+{$ifdef REF_IMMEDIATE_WARN}
                Comment(V_Warning,'Reference immediate');
 {$endif}
                val:=p^.offset;
@@ -553,11 +556,9 @@ uses
       var
         i : longint;
       begin
-{$ifndef nojmpfix}
         if is_jmp then
           dec(PasmLabel(oper[0].sym)^.refs)
         else
-{$endif nojmpfix}
           for i:=1 to ops do
             if (oper[i-1].typ=top_ref) then
               dispose(oper[i-1].ref);
@@ -589,14 +590,11 @@ uses
 
 
     function taicpu.GetString:string;
-{$ifdef ASMDEBUG}
       var
         i : longint;
         s : string;
         addsize : boolean;
-{$endif}
       begin
-{$ifdef ASMDEBUG}
         s:='['+int_op2str[opcode];
         for i:=1to ops do
          begin
@@ -653,9 +651,6 @@ uses
             end;
          end;
         GetString:=s+']';
-{$else}
-        GetString:='';
-{$endif ASMDEBUG}
       end;
 
 
@@ -972,11 +967,7 @@ begin
   i:=instabcache^[opcode];
   if i=-1 then
    begin
-{$ifdef TP}
-     Message1(asmw_e_opcode_not_in_table,'');
-{$else}
      Message1(asmw_e_opcode_not_in_table,att_op2str[opcode]);
-{$endif}
      exit;
    end;
   insentry:=@instab[i];
@@ -1674,7 +1665,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 16:11:50  peter
+  Revision 1.5  2000-09-24 15:06:14  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/cpubase.pas

@@ -26,20 +26,12 @@
 }
 unit cpubase;
 
+{$i defines.inc}
 
 interface
-{$ifdef TP}
-  {$L-,Y-}
-{$endif}
-
-{$ifdef FPC}
-  {$ifdef PACKENUMFIXED}
-    {$PACKENUM 1}
-  {$endif}
-{$endif}
 
 uses
-  globals,strings,cutils,cobjects,aasm;
+  globals,cutils,cobjects,aasm;
 
 const
 { Size of the instruction table converted by nasmconv.pas }
@@ -52,14 +44,8 @@ const
 {$define INTELOP}
 {$define ITTABLE}
 
-{ For TP we can't use asmdebug due the table sizes }
-{$ifndef TP}
-  {$define ASMDEBUG}
-{$endif}
-
 { We Don't need the intel style opcodes if we don't have a intel
   reader or generator }
-{$ifndef ASMDEBUG}
 {$ifdef NORA386INT}
   {$ifdef NOAG386NSM}
     {$ifdef NOAG386INT}
@@ -67,7 +53,6 @@ const
     {$endif}
   {$endif}
 {$endif}
-{$endif}
 
 { We Don't need the AT&T style opcodes if we don't have a AT&T
   reader or generator }
@@ -890,8 +875,8 @@ begin
 {$endif NOAG386BIN}
 end;
 
-procedure InitCpu;
 
+procedure InitCpu;
 begin
 {$ifndef NOAG386BIN}
   if not assigned(instabcache) then
@@ -902,7 +887,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:50  peter
+  Revision 1.6  2000-09-24 15:06:14  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/cpuinfo.pas

@@ -22,18 +22,18 @@
 }
 Unit CPUInfo;
 
+{$i defines.inc}
+
 Interface
 
 Type
-{$ifdef FPC}
-   AWord = dword;
-{$else FPC}
-   AWord = Longint;
-{$endif FPC}
+   AWord = Cardinal;
+
    { the ordinal type used when evaluating constant integer expressions }
    TConstExprInt = int64;
    { ... the same unsigned }
-   TConstExprUInt = qword;
+   TConstExprUInt = {$ifdef fpc}qword{$else}int64{$endif};
+
    { this must be an ordinal type with the same size as a pointer }
    { to allow some dirty type casts for example when using        }
    { tconstsym.value                                              }
@@ -48,7 +48,10 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-08-16 13:06:06  florian
+  Revision 1.5  2000-09-24 15:06:14  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/16 13:06:06  florian
     + support of 64 bit integer constants
 
   Revision 1.3  2000/08/12 06:45:08  florian
@@ -57,4 +60,4 @@ end.
   Revision 1.2  2000/07/13 11:32:39  michael
   + removed logs
 
-}
+}

compiler/crc.pas

@@ -22,7 +22,10 @@
 }
 Unit CRC;
 
+{$i defines.inc}
+
 Interface
+
 Function Crc32(Const HStr:String):longint;
 Function UpdateCrc32(InitCrc:longint;var InBuf;InLen:Longint):longint;
 Function UpdCrc32(InitCrc:longint;b:byte):longint;
@@ -108,7 +111,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-13 13:04:38  peter
+  Revision 1.4  2000-09-24 15:06:14  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/13 13:04:38  peter
     * new ppu version
 
   Revision 1.2  2000/07/13 11:32:39  michael

compiler/cresstr.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit cresstr;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -284,7 +287,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:50  peter
+  Revision 1.6  2000-09-24 15:06:14  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/csopt386.pas

@@ -23,6 +23,7 @@
 }
 Unit CSOpt386;
 
+{$i defines.inc}
 
 Interface
 
@@ -155,7 +156,7 @@ begin
       if modifiesMemLocation(hp) or
         { do not load the self pointer or a regvar before a (conditional)  }
         { jump with a new value, since if the jump is taken, the old value }
-        { is (probably) still necessary                                    } 
+        { is (probably) still necessary                                    }
         (passedJump and not(reg in (usableregs+[R_EDI]))) or
          not getLastInstruction(hp,hp) then
         break;
@@ -846,7 +847,7 @@ begin
            (rState = newRState) then
           begin
             incState(newRState,1);
-            prevRState := rState; 
+            prevRState := rState;
             doRState := true;
           end;
         { ditto for the write state }
@@ -856,7 +857,7 @@ begin
            (wState = newWState) then
           begin
             incState(newWState,1);
-            prevWState := wState; 
+            prevWState := wState;
             doWState := true;
           end;
       end;
@@ -956,7 +957,7 @@ begin
                          not(newRegModified and orgRegRead)) (* and
     { since newReg will be replaced by orgReg, we can't allow that newReg }
     { gets modified if orgRegCanBeModified = false                        }
-    
+
     { this now gets checked after the loop (JM) }
                          (orgRegCanBeModified or not(newRegModified)) *);
           tmpResult :=
@@ -1010,7 +1011,7 @@ begin
         begin
           if {not(PPaiProp(hp^.optInfo)^.canBeRemoved) and }
              (hp^.typ = ait_instruction) then
-            stateChanged := 
+            stateChanged :=
               doReplaceReg(orgReg,newReg,paicpu(hp)) or stateChanged;
             if stateChanged then
               updateStates(orgReg,newReg,hp,true);
@@ -1497,7 +1498,10 @@ End.
 
 {
   $Log$
-  Revision 1.9  2000-09-22 15:01:59  jonas
+  Revision 1.10  2000-09-24 15:06:14  peter
+    * use defines.inc
+
+  Revision 1.9  2000/09/22 15:01:59  jonas
     * fixed some bugs in the previous improvements: in some cases, esi was
       still being replaced before a conditional jump (the code that
       detected conditional jumps sometimes skipped over them)

compiler/cutils.pas

@@ -20,25 +20,20 @@
 
  ****************************************************************************
 }
-
-{$ifdef tp}
-  {$E+,N+}
-{$endif}
-
 unit cutils;
 
+{$i defines.inc}
+
 interface
 
+{$ifdef delphi}
     type
-       pstring = ^string;
-
-{$ifdef TP}
-       { redeclare dword only in case of emergency, some small things
-         of the compiler won't work then correctly (FK)
-       }
-       dword = longint;
-{$endif TP}
+       dword = cardinal;
+       qword = int64;
+{$endif}
 
+    type
+       pstring = ^string;
 
     function min(a,b : longint) : longint;
     function max(a,b : longint) : longint;
@@ -51,11 +46,7 @@ interface
     function trimspace(const s:string):string;
     procedure uppervar(var s : string);
     function hexstr(val : longint;cnt : byte) : string;
-    {$ifdef FPC}
     function tostru(i:cardinal) : string;
-    {$else}
-    function tostru(i:longint) : string;
-    {$endif}
     function tostr(i : longint) : string;
     function tostr_with_plus(i : longint) : string;
     procedure valint(S : string;var V : longint;var code : integer);
@@ -98,7 +89,12 @@ function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
 implementation
 
 uses
-  strings;
+{$ifdef delphi}
+  sysutils
+{$else}
+  strings
+{$endif}
+  ;
 
     function min(a,b : longint) : longint;
     {
@@ -261,7 +257,7 @@ uses
          end;
       end;
 
-{$ifdef FPC}
+
    function tostru(i:cardinal):string;
    {
      return string of value i, but for cardinals
@@ -272,12 +268,6 @@ uses
         str(i,hs);
         tostru:=hs;
       end;
-{$else FPC}
-    function tostru(i:longint):string;
-      begin
-        tostru:=tostr(i);
-      end;
-{$endif FPC}
 
 
    function trimspace(const s:string):string;
@@ -518,7 +508,7 @@ var
 begin
   if Crc32Tbl[1]=0 then
    MakeCrc32Tbl;
-  InitCrc:=$ffffffff;
+  InitCrc:=-1;
   for i:=1 to Length(s) do
    InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8);
   GetSpeedValue:=InitCrc;
@@ -592,7 +582,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2000-08-27 16:11:50  peter
+  Revision 1.2  2000-09-24 15:06:14  peter
+    * use defines.inc
+
+  Revision 1.1  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/daopt386.pas

@@ -22,13 +22,10 @@
 
  ****************************************************************************
 }
-
-{$ifDef TP}
-  {$UnDef JumpAnal}
-{$Endif TP}
-
 Unit DAOpt386;
 
+{$i defines.inc}
+
 Interface
 
 Uses
@@ -1559,7 +1556,7 @@ Begin
   RefInSequence := TmpResult
 End;
 
-Function ArrayRefsEq(const r1, r2: TReference): Boolean;{$ifdef tp}far;{$endif}
+Function ArrayRefsEq(const r1, r2: TReference): Boolean;
 Begin
   ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
                  (R1.Segment = R2.Segment) And
@@ -2341,7 +2338,10 @@ End.
 
 {
   $Log$
-  Revision 1.10  2000-09-22 15:00:20  jonas
+  Revision 1.11  2000-09-24 15:06:15  peter
+    * use defines.inc
+
+  Revision 1.10  2000/09/22 15:00:20  jonas
     * fixed bug in regsEquivalent (in some rare cases, registers with
       completely unrelated content were considered equivalent) (merged
       from fixes branch)

compiler/defines.inc

@@ -0,0 +1,27 @@
+{$ifdef FPC}
+  {$mode objfpc}
+  {$H-}
+  {$goto on}
+
+  { Packing of enumerated types to save space }
+  {$ifdef FPC}
+    {$ifdef PACKENUMFIXED}
+      {$PACKENUM 1}
+    {$endif}
+  {$endif}
+
+  {$define FPCPROCVAR}
+  {$ifdef I386}
+    {$define USEEXCEPT}
+  {$endif}
+{$endif}
+
+{$ifdef DELPHI}
+  {$H-}
+
+  { Packing of enumerated types to save space }
+  {$Z1}
+
+  {$undef FPCPROCVAR}
+  {$define USEEXCEPT}
+{$endif}

compiler/dmisc.pas

@@ -22,10 +22,12 @@
 }
 unit dmisc;
 
+{$i defines.inc}
+
 interface
 
 uses
-   windows,sysutils;
+  windows,sysutils;
 
 Const
   Max_Path = 255;
@@ -158,7 +160,21 @@ Procedure SetIntVec(intno: byte; vector: pointer);
 Procedure Keep(exitcode: word);
 
 implementation
-uses globals;
+
+    function upper(const s : string) : string;
+    {
+      return uppercased string of s
+    }
+      var
+         i  : longint;
+      begin
+         for i:=1 to length(s) do
+          if s[i] in ['a'..'z'] then
+           upper[i]:=char(byte(s[i])-32)
+          else
+           upper[i]:=s[i];
+        upper[0]:=s[0];
+      end;
 
 {******************************************************************************
                            --- Conversion ---
@@ -856,7 +872,10 @@ End;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:40  michael
+  Revision 1.3  2000-09-24 15:06:15  peter
+    * use defines.inc
+
+  Revision 1.2  2000/07/13 11:32:40  michael
   + removed logs
 
 }

compiler/export.pas

@@ -22,6 +22,8 @@
 }
 unit export;
 
+{$i defines.inc}
+
 interface
 
 uses
@@ -75,7 +77,7 @@ uses
     ,t_linux
   {$endif}
   {$ifndef NOTARGETFREEBSD}
-    ,t_freebsd
+    ,t_fbsd
   {$endif}
   {$ifndef NOTARGETOS2}
     ,t_os2
@@ -224,7 +226,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-09-16 12:22:52  peter
+  Revision 1.6  2000-09-24 15:06:16  peter
+    * use defines.inc
+
+  Revision 1.5  2000/09/16 12:22:52  peter
     * freebsd support merged
 
   Revision 1.4  2000/09/11 17:00:22  florian

compiler/finput.pas

@@ -22,30 +22,19 @@
 }
 unit finput;
 
-{$ifdef TP}
-  {$V+}
-{$endif}
+{$i defines.inc}
 
-  interface
+interface
 
     uses
       cutils;
 
     const
-{$ifdef FPC}
        InputFileBufSize=32*1024;
        linebufincrease=512;
-{$else}
-       InputFileBufSize=1024;
-       linebufincrease=64;
-{$endif}
 
     type
-{$ifdef TP}
-       tlongintarr = array[0..16000] of longint;
-{$else}
        tlongintarr = array[0..1000000] of longint;
-{$endif}
        plongintarr = ^tlongintarr;
 
        pinputfile = ^tinputfile;
@@ -374,15 +363,7 @@ uses
              getlinestr[i]:=c;
              inc(longint(p));
            until (i=255);
-           {$ifndef TP}
-             {$ifopt H+}
-               setlength(getlinestr,i);
-             {$else}
-               getlinestr[0]:=chr(i);
-             {$endif}
-           {$else}
-             getlinestr[0]:=chr(i);
-           {$endif}
+           getlinestr[0]:=chr(i);
          end;
       end;
 
@@ -451,7 +432,8 @@ uses
 
 
     function tdosinputfile.fileread(var databuf; maxsize: longint): longint;
-      var w: {$ifdef TP}word{$else}longint{$endif};
+      var
+        w : longint;
       begin
         blockread(f,databuf,maxsize,w);
         fileread:=w;
@@ -513,11 +495,9 @@ uses
          { update cache }
          cacheindex:=last_ref_index;
          cacheinputfile:=f;
-{$ifdef FPC}
-  {$ifdef heaptrc}
+{$ifdef heaptrc}
          writeln(stderr,f^.name^,' index ',current_module^.unit_index*100000+f^.ref_index);
-  {$endif heaptrc}
-{$endif FPC}
+{$endif heaptrc}
       end;
 
 
@@ -584,7 +564,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.1  2000-08-27 16:11:50  peter
+  Revision 1.2  2000-09-24 15:06:16  peter
+    * use defines.inc
+
+  Revision 1.1  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/fmodule.pas

@@ -22,13 +22,8 @@
 }
 unit fmodule;
 
-{$ifdef TP}
-  {$V+}
-{$endif}
+{$i defines.inc}
 
-{$ifdef TP}
-  {$define SHORTASMPREFIX}
-{$endif}
 {$ifdef go32v1}
   {$define SHORTASMPREFIX}
 {$endif}
@@ -42,19 +37,14 @@ unit fmodule;
   {$define SHORTASMPREFIX}
 {$endif}
 
-
-  interface
+interface
 
     uses
        cutils,cobjects,
        globals,ppu,finput;
 
     const
-{$ifdef tp}
-       maxunits = 128;
-{$else}
        maxunits = 1024;
-{$endif}
 
     type
        trecompile_reason = (rr_unknown,
@@ -911,7 +901,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2000-08-27 16:11:50  peter
+  Revision 1.2  2000-09-24 15:06:16  peter
+    * use defines.inc
+
+  Revision 1.1  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/gdb.pas

@@ -22,13 +22,20 @@
 }
 unit gdb;
 
-  interface
+{$i defines.inc}
 
-    uses
-      globtype,cpubase,
-      strings,cobjects,globals,aasm;
+interface
 
-    {stab constants }
+uses
+{$ifdef delphi}
+  sysutils,
+{$else}
+  strings,
+{$endif}
+  globtype,cpubase,
+  cobjects,globals,aasm;
+
+{stab constants }
 Const
     N_GSYM = $20;
     N_STSYM = 38; {initialized const }
@@ -251,7 +258,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:41  michael
+  Revision 1.3  2000-09-24 15:06:16  peter
+    * use defines.inc
+
+  Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
 }

compiler/gendef.pas

@@ -21,8 +21,12 @@
  ****************************************************************************
 }
 unit gendef;
+
+{$i defines.inc}
+
 interface
-uses cobjects;
+uses
+  cobjects;
 
 type
   pdeffile=^tdeffile;
@@ -164,7 +168,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-27 16:11:50  peter
+  Revision 1.4  2000-09-24 15:06:16  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/27 16:11:50  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/globals.pas

@@ -20,14 +20,11 @@
 
  ****************************************************************************
 }
-
-{$ifdef tp}
-  {$E+,N+}
-{$endif}
-
 unit globals;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
 {$ifdef win32}
@@ -40,10 +37,8 @@ unit globals;
       sysutils,
       dmisc,
 {$else}
-      strings,dos,
-{$endif}
-{$ifdef TP}
-      objects,
+      strings,
+      dos,
 {$endif}
       globtype,version,tokens,systems,cutils,cobjects;
 
@@ -141,10 +136,6 @@ unit globals;
        use_esp_stackframe : boolean;     { to test for call with ESP as stack frame }
        inlining_procedure : boolean;     { are we inlining a procedure }
 
-{$ifdef TP}
-       use_big      : boolean;
-{$endif}
-
      { commandline values }
        initdefines        : tlinkedlist;
        initglobalswitches : tglobalswitches;
@@ -220,10 +211,6 @@ unit globals;
        parser_current_file : string = '';
 
     procedure abstract;
-{$ifdef debug}
-    { if the pointer don't point to the heap then write an error }
-    function assigned(p : pointer) : boolean;
-{$endif}
 
     function bstoslash(const s : string) : string;
 
@@ -314,56 +301,8 @@ implementation
           bstoslash[i]:='/'
          else
           bstoslash[i]:=s[i];
-         {$ifndef TP}
-           {$ifopt H+}
-             setlength(bstoslash,length(s));
-           {$else}
-             bstoslash[0]:=s[0];
-           {$endif}
-         {$else}
-           bstoslash[0]:=s[0];
-         {$endif}
-      end;
-
-{$ifdef debug}
-
-    function assigned(p : pointer) : boolean;
-{$ifndef FPC}
-    {$ifndef DPMI}
-      type
-         ptrrec = record
-            ofs,seg : word;
-         end;
-      var
-         lp : longint;
-    {$endif DPMI}
-{$endif FPC}
-      begin
-{$ifdef FPC}
-          { Assigned is used for procvar and
-            stack stored temp records !! PM }
-         (* if (p<>nil) {and
-            ((p<heaporg) or
-            (p>heapptr))} then
-           do_internalerror(230); *)
-{$else}
-    {$ifdef DPMI}
-         assigned:=(p<>nil);
-         exit;
-    {$else DPMI}
-         if p=nil then
-           lp:=0
-         else
-           lp:=longint(ptrrec(p).seg)*16+longint(ptrrec(p).ofs);
-         if (lp<>0) and
-            ((lp<longint(seg(heaporg^))*16+longint(ofs(heaporg^))) or
-            (lp>longint(seg(heapptr^))*16+longint(ofs(heapptr^)))) then
-           do_internalerror(230);
-    {$endif DPMI}
-{$endif FPC}
-         assigned:=(p<>nil);
+         bstoslash[0]:=s[0];
       end;
-{$endif}
 
 
 {****************************************************************************
@@ -509,7 +448,7 @@ implementation
 {$endif}
       begin
 {$ifdef delphi}
-         FileExists:=sysutils.FileExists(f);
+        FileExists:=sysutils.FileExists(f);
 {$else}
         findfirst(F,readonly+archive+hidden,info);
         FileExists:=(doserror=0);
@@ -685,15 +624,7 @@ implementation
            FixFileName[i]:=s[i];
           end;
         end;
-       {$ifndef TP}
-         {$ifopt H+}
-           SetLength(FixFileName,length(s));
-         {$else}
-           FixFileName[0]:=s[0];
-         {$endif}
-       {$else}
-         FixFileName[0]:=s[0];
-       {$endif}
+       FixFileName[0]:=s[0];
      end;
 
 
@@ -723,11 +654,7 @@ implementation
        CurrentDir,
        CurrPath : string;
        dir      : searchrec;
-   {$IFDEF NEWST}
-       hp       : PStringItem;
-   {$ELSE}
        hp       : PStringQueueItem;
-   {$ENDIF}
 
        procedure addcurrpath;
        begin
@@ -819,11 +746,7 @@ implementation
      var
        s : string;
        hl : TSearchPathList;
-     {$IFDEF NEWST}
-       hp,hp2 : PStringItem;
-     {$ELSE}
        hp,hp2 : PStringQueueItem;
-     {$ENDIF}
      begin
        if list.empty then
         exit;
@@ -862,11 +785,7 @@ implementation
 
    function TSearchPathList.FindFile(const f : string;var b : boolean) : string;
      Var
-     {$IFDEF NEWST}
-       p : PStringItem;
-     {$ELSE}
        p : PStringQueueItem;
-     {$ENDIF}
      begin
        FindFile:='';
        b:=false;
@@ -1056,6 +975,7 @@ implementation
       {$endif}
       end;
 
+
     Procedure Shell(const command:string);
       { This is already defined in the linux.ppu for linux, need for the *
         expansion under linux }
@@ -1088,7 +1008,6 @@ implementation
      var
        hs1 : namestr;
        hs2 : extstr;
-       b: boolean;
      begin
 {$ifdef delphi}
        exepath:=dmisc.getenv('PPC_EXEC_PATH');
@@ -1097,8 +1016,7 @@ implementation
 {$endif delphi}
        if exepath='' then
         fsplit(FixFileName(paramstr(0)),exepath,hs1,hs2);
-{$ifndef VER0_99_15}
-   {$ifdef need_path_search}
+{$ifdef need_path_search}
        if exepath='' then
         begin
           if pos(source_os.exeext,hs1) <>
@@ -1110,8 +1028,7 @@ implementation
           exepath := findfile(hs1,dos.getenv('PATH'),b);
       {$endif delphi}
         end;
-   {$endif need_path_search}
-{$endif}
+{$endif need_path_search}
        exepath:=FixPath(exepath,false);
      end;
 
@@ -1137,10 +1054,7 @@ implementation
       { set global switches }
         do_build:=false;
         do_make:=true;
-{$ifdef tp}
-        use_big:=false;
-{$endif tp}
-       compile_level:=0;
+        compile_level:=0;
 
       { Output }
         OutputFile:='';
@@ -1208,14 +1122,17 @@ implementation
 begin
   get_exepath;
 {$ifdef EXTDEBUG}
-{$ifdef FPC}
-  EntryMemUsed:=system.HeapSize-MemAvail;
-{$endif FPC}
+  {$ifdef FPC}
+    EntryMemUsed:=system.HeapSize-MemAvail;
+  {$endif FPC}
 {$endif}
 end.
 {
   $Log$
-  Revision 1.9  2000-09-24 10:33:07  peter
+  Revision 1.10  2000-09-24 15:06:16  peter
+    * use defines.inc
+
+  Revision 1.9  2000/09/24 10:33:07  peter
     * searching of exe in path also for OS/2
     * fixed searching of exe in path.
 

compiler/globtype.pas

@@ -20,13 +20,10 @@
  ****************************************************************************
 }
 unit globtype;
-interface
 
-{$ifdef FPC}
-  {$ifdef PACKENUMFIXED}
-    {$PACKENUM 1}
-  {$endif}
-{$endif}
+{$i defines.inc}
+
+interface
 
     const
        maxidlen = 64;
@@ -174,15 +171,6 @@ interface
        pword      = ^word;
        plongint   = ^longint;
 
-    {$IFDEF TP}
-       Tconstant=record
-            case signed:boolean of
-                false:
-                    (valueu:longint);
-                true:
-                    (values:longint);
-       end;
-    {$ELSE}
        Tconstant=record
             case signed:boolean of
                 false:
@@ -190,7 +178,6 @@ interface
                 true:
                     (values:longint);
        end;
-    {$ENDIF}
 
     const
        { link options }
@@ -200,15 +187,15 @@ interface
        link_smart   = $4;
        link_shared  = $8;
 
-
 implementation
 
-
-begin
 end.
 {
   $Log$
-  Revision 1.6  2000-09-21 11:30:49  jonas
+  Revision 1.7  2000-09-24 15:06:16  peter
+    * use defines.inc
+
+  Revision 1.6  2000/09/21 11:30:49  jonas
     + support for full boolean evaluation (b+/b-), default remains short
       circuit boolean evaluation
 

compiler/hcgdata.pas

@@ -22,6 +22,9 @@
  ****************************************************************************
 }
 unit hcgdata;
+
+{$i defines.inc}
+
 interface
 
     uses
@@ -111,7 +114,7 @@ implementation
          dispose(p);
       end;
 
-    procedure insertmsgstr(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
+    procedure insertmsgstr(p : pnamedindexobject);
 
       var
          hp : pprocdef;
@@ -155,7 +158,7 @@ implementation
            end;
       end;
 
-    procedure insertmsgint(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
+    procedure insertmsgint(p : pnamedindexobject);
 
       var
          hp : pprocdef;
@@ -205,7 +208,7 @@ implementation
 
          if assigned(p^.r) then
            writestrentry(p^.r);
-      end;
+     end;
 
     function genstrmsgtab(_class : pobjectdef) : pasmlabel;
 
@@ -217,7 +220,7 @@ implementation
          root:=nil;
          count:=0;
          { insert all message handlers into a tree, sorted by name }
-         _class^.symtable^.foreach({$ifndef TP}@{$endif}insertmsgstr);
+         _class^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}insertmsgstr);
 
          { write all names }
          if assigned(root) then
@@ -259,7 +262,7 @@ implementation
          root:=nil;
          count:=0;
          { insert all message handlers into a tree, sorted by name }
-         _class^.symtable^.foreach({$ifndef TP}@{$endif}insertmsgint);
+         _class^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}insertmsgint);
 
          { now start writing of the message string table }
          getdatalabel(r);
@@ -275,7 +278,7 @@ implementation
 
 {$ifdef WITHDMT}
 
-    procedure insertdmtentry(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
+    procedure insertdmtentry(p : pnamedindexobject);
 
       var
          hp : pprocdef;
@@ -330,7 +333,7 @@ implementation
          count:=0;
          gendmt:=nil;
          { insert all message handlers into a tree, sorted by number }
-         _class^.symtable^.foreach({$ifndef TP}@{$endif}insertdmtentry);
+         _class^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}insertdmtentry);
 
          if count>0 then
            begin
@@ -353,14 +356,14 @@ implementation
 
 {$endif WITHDMT}
 
-    procedure do_count(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
+    procedure do_count(p : pnamedindexobject);
 
       begin
          if (psym(p)^.typ=procsym) and (sp_published in psym(p)^.symoptions) then
            inc(count);
       end;
 
-    procedure genpubmethodtableentry(p : pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
+    procedure genpubmethodtableentry(p : pnamedindexobject);
 
       var
          hp : pprocdef;
@@ -390,13 +393,13 @@ implementation
 
       begin
          count:=0;
-         _class^.symtable^.foreach({$ifndef TP}@{$endif}do_count);
+         _class^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}do_count);
          if count>0 then
            begin
               getdatalabel(l);
               datasegment^.concat(new(pai_label,init(l)));
               datasegment^.concat(new(pai_const,init_32bit(count)));
-              _class^.symtable^.foreach({$ifndef TP}@{$endif}genpubmethodtableentry);
+              _class^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}genpubmethodtableentry);
               genpublishedmethodstable:=l;
            end
          else
@@ -429,7 +432,7 @@ implementation
        _c : pobjectdef;
        has_constructor,has_virtual_method : boolean;
 
-    procedure eachsym(sym : pnamedindexobject);{$ifndef FPC}far;{$endif FPC}
+    procedure eachsym(sym : pnamedindexobject);
 
       var
          procdefcoll : pprocdefcoll;
@@ -657,7 +660,7 @@ implementation
            { no it wasn't correct, but I fixed it at  }
            { another place: your fix hides only a bug }
            { _c is only used to give correct warnings }
-           p^.symtable^.foreach({$ifndef TP}@{$endif}eachsym);
+           p^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}eachsym);
         end;
 
       var
@@ -739,11 +742,13 @@ implementation
            end;
       end;
 
-
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 16:11:51  peter
+  Revision 1.5  2000-09-24 15:06:17  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/hcodegen.pas

@@ -22,6 +22,8 @@
 }
 unit hcodegen;
 
+{$i defines.inc}
+
 {$ifdef newcg}
 interface
 
@@ -172,7 +174,7 @@ implementation
 implementation
 
      uses
-        systems,globals,strings,cresstr
+        systems,globals,cresstr
 {$ifdef fixLeaksOnError}
         ,comphook
 {$endif fixLeaksOnError}
@@ -435,7 +437,7 @@ implementation
 {$endif newcg}
 
 {$ifdef fixLeaksOnError}
-procedure hcodegen_do_stop; {$ifdef tp} far; {$endif tp}
+procedure hcodegen_do_stop;
 var p: pprocinfo;
 begin
   p := pprocinfo(procinfoStack.pop);
@@ -446,23 +448,21 @@ begin
     end;
   procinfoStack.done;
   do_stop := hcodegen_old_do_stop;
-{$ifdef tp}
-  do_stop;
-{$else tp}
-  do_stop();
-{$endif tp}
+  do_stop{$ifdef FPCPROCVAR}(){$endif};
 end;
 
 begin
   hcodegen_old_do_stop := do_stop;
-  do_stop := {$ifdef tp}@{$endif}hcodegen_do_stop;
+  do_stop := {$ifdef FPCPROCVAR}@{$endif}hcodegen_do_stop;
   procinfoStack.init;
 {$endif fixLeaksOnError}
 end.
-
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:51  peter
+  Revision 1.6  2000-09-24 15:06:17  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/htypechk.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit htypechk;
+
+{$i defines.inc}
+
 interface
 
     uses
@@ -1132,7 +1135,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:51  peter
+  Revision 1.6  2000-09-24 15:06:17  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 
@@ -1150,4 +1156,4 @@ end.
   Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
-}
+}

compiler/impdef.pas

@@ -1,18 +1,45 @@
-unit impdef;
 {
-C source code of DEWIN Windows disassembler (written by A. Milukov) was
-partially used
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    This unit finds the export defs from PE files
+
+    C source code of DEWIN Windows disassembler (written by A. Milukov) was
+    partially used
+
+    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 impdef;
+
+{$i defines.inc}
+
 interface
+
 function makedef(const binname,textname:string):longbool;
+
 implementation
 var
-f:file;
-t:text;
-TheWord:array[0..1]of char;
-PEoffset:cardinal;
-loaded:{$ifdef fpc}longint{$else}integer{$endif};
-FileCreated:longbool;
+  f:file;
+  t:text;
+  TheWord:array[0..1]of char;
+  PEoffset:cardinal;
+  loaded:longint;
+  FileCreated:longbool;
+
 function DOSstubOK(var x:cardinal):longbool;
 begin
   blockread(f,TheWord,2,loaded);
@@ -27,14 +54,16 @@ begin
      DOSstubOK:=false;
    end;
 end;
+
 function isPE(x:cardinal):longbool;
 begin
   seek(f,x);
   blockread(f,TheWord,2,loaded);
   isPE:=(loaded=2)and(TheWord='PE');
 end;
+
 var
-cstring:array[0..127]of char;
+  cstring:array[0..127]of char;
 
 function GetEdata(PE:cardinal):longbool;
 type
@@ -57,6 +86,7 @@ var
   APE_obj,APE_Optsize:word;
   ExportRVA:cardinal;
   delta:cardinal;
+
 procedure ProcessEdata;
   var
    j:cardinal;
@@ -122,6 +152,8 @@ begin
       end;
    end;
 end;
+
+
 function makedef(const binname,textname:string):longbool;
 var
   OldFileMode:longint;
@@ -143,8 +175,11 @@ begin
   if FileCreated then
    close(t);
 end;
-end.  $Log$
-end.  Revision 1.2  2000-07-13 11:32:43  michael
-end.  + removed logs
-end.
+{
+  $Log$
+  Revision 1.3  2000-09-24 15:06:17  peter
+    * use defines.inc
+
+  Revision 1.2  2000/07/13 11:32:43  michael
+  + removed logs
 }

compiler/import.pas

@@ -20,6 +20,9 @@
 
  ****************************************************************************}
 unit import;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -76,7 +79,7 @@ uses
     ,t_linux
   {$endif}
   {$ifndef NOTARGETFREEBSD}
-   ,t_freebsd
+   ,t_fbsd
   {$endif}
   {$ifndef NOTARGETOS2}
     ,t_os2
@@ -260,7 +263,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-09-16 12:22:52  peter
+  Revision 1.6  2000-09-24 15:06:18  peter
+    * use defines.inc
+
+  Revision 1.5  2000/09/16 12:22:52  peter
     * freebsd support merged
 
   Revision 1.4  2000/09/11 17:00:23  florian

compiler/link.pas

@@ -21,16 +21,18 @@
 
  ****************************************************************************
 }
-Unit link;
+unit link;
 
-Interface
+{$i defines.inc}
 
 { Needed for LFN support in path to the executable }
 {$ifdef GO32V2}
   {$define ALWAYSSHELL}
 {$endif}
 
-uses cobjects,fmodule;
+interface
+uses
+  cobjects,fmodule;
 
 Type
     TLinkerInfo=record
@@ -88,7 +90,7 @@ uses
     ,t_linux
   {$endif}
   {$ifndef NOTARGETFREEBSD}
-    ,t_FreeBSD
+    ,t_fbsd
   {$endif}
   {$ifndef NOTARGETOS2}
     ,t_os2
@@ -539,7 +541,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2000-09-16 12:22:52  peter
+  Revision 1.8  2000-09-24 15:06:18  peter
+    * use defines.inc
+
+  Revision 1.7  2000/09/16 12:22:52  peter
     * freebsd support merged
 
   Revision 1.6  2000/09/11 17:00:23  florian
@@ -556,8 +561,7 @@ end.
   Revision 1.3  2000/07/26 13:08:19  jonas
     * merged from fixes branch (v_hint to v_tried changed when attempting
       to smart/static/shared link)
-  Revision 1.1.2.1  2000/07/26 12:54:24  jonas
-    * changed V_Hint's to V_Tried's (for attempts to smart/shared/static link)
+
   Revision 1.2  2000/07/13 11:32:43  michael
   + removed logs
 }

compiler/mdppc386.bat

@@ -1,2 +1,2 @@
-dcc32 -Di386 -DGDB -Ddelphi -Ddelphi4 -ADOS=sysutils -ASTRINGS=sysutils -CC -$O+ -$H- ppc.dpr %1 %2 %3 %4 %5 %6 %7 %8 %9
+dcc32 -Di386 -DGDB -Ddelphi -CC -$O+ ppc.dpr %1 %2 %3 %4 %5 %6 %7 %8 %9
 

compiler/messages.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit Messages;
+
+{$i defines.inc}
+
 interface
 
 const
@@ -143,7 +146,7 @@ const
 var
   f       : text;
   error,multiline : boolean;
-  code : word;
+  code    : integer;
   numpart,numidx,
   line,i,j,num : longint;
   ptxt    : pchar;
@@ -305,7 +308,7 @@ procedure TMessage.CreateIdx;
 var
   hp1,
   hp,hpend : pchar;
-  code : word;
+  code : integer;
   num  : longint;
   number : string[5];
   i   : longint;
@@ -429,7 +432,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:43  michael
+  Revision 1.3  2000-09-24 15:06:18  peter
+    * use defines.inc
+
+  Revision 1.2  2000/07/13 11:32:43  michael
   + removed logs
 
 }

compiler/msgtxt.inc

@@ -645,7 +645,7 @@ const msgtxt : array[0..000126,1..240] of char=(
   '**1S<x>_syntax options:'#010+
   '**2S2_switch some Delphi 2 extensions on'#010+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#010+
-  '**2sa_include assertion code.'#010+
+  '**2Sa_include assertion code.'#010+
   '**2Sd_tries to be Delphi compatible'#010+
   '**2Se<x>_compiler stops after the <x> errors (defa','ult is 1)'#010+
   '**2Sg_allow LABEL and GOTO'#010+

compiler/n386add.pas

@@ -20,10 +20,11 @@
 
  ****************************************************************************
 }
-
 unit n386add;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
        nadd;
@@ -2325,7 +2326,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-09-22 22:42:52  florian
+  Revision 1.4  2000-09-24 15:06:18  peter
+    * use defines.inc
+
+  Revision 1.3  2000/09/22 22:42:52  florian
     * more fixes
 
   Revision 1.2  2000/09/21 12:24:22  jonas
@@ -2336,4 +2340,4 @@ end.
 
   Revision 1.1  2000/09/20 21:23:32  florian
     * initial revision
-}
+}

compiler/n386mat.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit cg386mat;
+
+{$i defines.inc}
+
 interface
 
     uses
@@ -997,7 +1000,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-09-22 22:24:37  florian
+  Revision 1.2  2000-09-24 15:06:18  peter
+    * use defines.inc
+
+  Revision 1.1  2000/09/22 22:24:37  florian
     * initial revision
 
 }

compiler/nadd.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit nadd;
+
+{$i defines.inc}
+
 interface
 
     uses
@@ -1227,7 +1230,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-09-22 22:42:52  florian
+  Revision 1.6  2000-09-24 15:06:19  peter
+    * use defines.inc
+
+  Revision 1.5  2000/09/22 22:42:52  florian
     * more fixes
 
   Revision 1.4  2000/09/21 12:22:42  jonas
@@ -1243,4 +1249,4 @@ end.
 
   Revision 1.1  2000/08/26 12:24:20  florian
     * initial release
-}
+}

compiler/ncal.pas

@@ -21,7 +21,9 @@
 }
 unit ncal;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
        node,symtable;
@@ -110,10 +112,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2000-09-20 21:52:38  florian
+  Revision 1.3  2000-09-24 15:06:19  peter
+    * use defines.inc
+
+  Revision 1.2  2000/09/20 21:52:38  florian
     * removed a lot of errors
 
   Revision 1.1  2000/09/20 20:52:16  florian
     * initial revision
 
-}
+}

compiler/ncon.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit ncon;
+
+{$i defines.inc}
+
 interface
 
     uses
@@ -172,7 +175,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  2000-09-22 21:44:48  florian
+  Revision 1.2  2000-09-24 15:06:19  peter
+    * use defines.inc
+
+  Revision 1.1  2000/09/22 21:44:48  florian
     + initial revision
 
 }

compiler/nflw.pas

@@ -22,6 +22,9 @@
  ****************************************************************************
 }
 unit nflw;
+
+{$i defines.inc}
+
 interface
 
     uses
@@ -839,7 +842,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-09-22 22:46:03  florian
+  Revision 1.2  2000-09-24 15:06:19  peter
+    * use defines.inc
+
+  Revision 1.1  2000/09/22 22:46:03  florian
     + initial revision
 
-}
+}

compiler/nmat.pas

@@ -22,7 +22,9 @@
 }
 unit nmat;
 
-  interface
+{$i defines}
+
+interface
 
     uses
        node,symtable;
@@ -57,7 +59,7 @@ unit nmat;
     uses
       globtype,systems,tokens,
       cobjects,verbose,globals,
-      symconst,symtable,aasm,types,
+      symconst,aasm,types,
       htypechk,pass_1,cpubase,cpuinfo,
 {$ifdef newcg}
       cgbase,
@@ -517,7 +519,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-09-22 22:48:54  florian
+  Revision 1.4  2000-09-24 15:06:19  peter
+    * use defines.inc
+
+  Revision 1.3  2000/09/22 22:48:54  florian
     * some fixes
 
   Revision 1.2  2000/09/22 22:09:54  florian
@@ -525,4 +530,4 @@ end.
 
   Revision 1.1  2000/09/20 21:35:12  florian
     * initial revision
-}
+}

compiler/node.pas

@@ -22,7 +22,9 @@
 }
 unit node;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
        globtype,globals,cobjects,aasm,cpubase,symtable,
@@ -30,7 +32,7 @@ unit node;
 
     {$I nodeh.inc}
 
-  implementation
+implementation
 
     uses
        htypechk,ncal,hcodegen,verbose,nmat,pass_1;
@@ -40,7 +42,10 @@ unit node;
 end.
 {
   $Log$
-  Revision 1.3  2000-09-22 21:45:35  florian
+  Revision 1.4  2000-09-24 15:06:19  peter
+    * use defines.inc
+
+  Revision 1.3  2000/09/22 21:45:35  florian
     * some updates e.g. getcopy added
 
   Revision 1.2  2000/09/20 21:52:38  florian
@@ -48,4 +53,4 @@ end.
 
   Revision 1.1  2000/08/26 12:27:35  florian
     * initial release
-}
+}

compiler/og386.pas

@@ -26,11 +26,16 @@
 }
 unit og386;
 
-  interface
+{$i defines.inc}
+
+interface
+
     uses
 {$ifdef Delphi}
+       sysutils,
        dmisc,
 {$else Delphi}
+       strings,
        dos,
 {$endif Delphi}
        owbase,owar,
@@ -90,7 +95,7 @@ unit og386;
   implementation
 
     uses
-      strings,comphook,
+      comphook,
       cutils,globtype,globals,verbose,fmodule,
       assemble;
 
@@ -279,7 +284,10 @@ unit og386;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:51  peter
+  Revision 1.6  2000-09-24 15:06:19  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/og386cff.pas

@@ -26,6 +26,8 @@
 }
 unit og386cff;
 
+{$i defines.inc}
+
 {
   Notes on COFF:
 
@@ -65,7 +67,8 @@ unit og386cff;
   we must fix up common variable references. Win32 seems to be
   sensible on this one.
 }
-  interface
+
+interface
 
     uses
        cobjects,
@@ -166,25 +169,24 @@ unit og386cff;
          function edata_flags : longint;virtual;
        end;
 
-  implementation
 
-      uses
-        cutils,strings,verbose,
+implementation
+
+    uses
+{$ifdef delphi}
+        sysutils,
+{$else}
+        strings,
+{$endif}
+        cutils,verbose,
         globtype,globals,fmodule;
 
     const
-{$ifdef TP}
-      symbolresize = 20*18;
-      strsresize   = 256;
-      DataResize   = 1024;
-{$else}
       symbolresize = 200*18;
       strsresize   = 8192;
       DataResize   = 8192;
-{$endif}
-
 
-      type
+    type
       { Structures which are written directly to the output file }
         coffheader=packed record
           mach   : word;
@@ -221,8 +223,8 @@ unit og386cff;
           name    : array[0..3] of char; { real is [0..7], which overlaps the strpos ! }
           strpos  : longint;
           value   : longint;
-          section : integer;
-          empty   : integer;
+          section : smallint;
+          empty   : smallint;
           typ     : byte;
           aux     : byte;
         end;
@@ -1038,7 +1040,10 @@ unit og386cff;
 end.
 {
   $Log$
-  Revision 1.6  2000-09-19 23:09:07  pierre
+  Revision 1.7  2000-09-24 15:06:19  peter
+    * use defines.inc
+
+  Revision 1.6  2000/09/19 23:09:07  pierre
    * problems wih extdebug cond. solved
 
   Revision 1.5  2000/08/27 16:11:51  peter
@@ -1055,4 +1060,4 @@ end.
   Revision 1.2  2000/07/13 11:32:43  michael
   + removed logs
 
-}
+}

compiler/og386dbg.pas

@@ -26,7 +26,10 @@
 }
 unit og386dbg;
 
-  interface
+{$i defines.inc}
+
+interface
+
     uses
        systems,aasm,cpubase,og386;
 
@@ -46,7 +49,8 @@ unit og386dbg;
          procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
        end;
 
-  implementation
+
+implementation
 
 {****************************************************************************
                                 Tdbgoutput
@@ -180,7 +184,10 @@ unit og386dbg;
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:26  michael
+  Revision 1.4  2000-09-24 15:06:20  peter
+    * use defines.inc
+
+  Revision 1.3  2000/07/13 12:08:26  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:43  michael

compiler/og386elf.pas

@@ -26,7 +26,9 @@
 }
 unit og386elf;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
        cobjects,
@@ -130,19 +132,18 @@ unit og386elf;
   implementation
 
       uses
-        strings,verbose,
+{$ifdef delphi}
+        sysutils,
+{$else}
+        strings,
+{$endif}
+        verbose,
         globtype,cutils,globals,fmodule;
 
     const
-{$ifdef TP}
-      symbolresize = 20*18;
-      strsresize   = 256;
-      DataResize   = 1024;
-{$else}
       symbolresize = 200*18;
       strsresize   = 8192;
       DataResize   = 8192;
-{$endif}
 
     const
       R_386_32 = 1;                    { ordinary absolute relocation }
@@ -1049,7 +1050,10 @@ unit og386elf;
 end.
 {
   $Log$
-  Revision 1.6  2000-08-27 16:11:51  peter
+  Revision 1.7  2000-09-24 15:06:20  peter
+    * use defines.inc
+
+  Revision 1.6  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/options.pas

@@ -22,6 +22,8 @@
 }
 unit options;
 
+{$i defines.inc}
+
 interface
 
 uses
@@ -244,9 +246,6 @@ begin
      if show then
       begin
         case s[2] of
-{$ifdef TP}
-         't',
-{$endif}
 {$ifdef GDB}
          'g',
 {$endif}
@@ -1491,7 +1490,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.8  2000-09-18 12:28:41  marco
+  Revision 1.9  2000-09-24 15:06:20  peter
+    * use defines.inc
+
+  Revision 1.8  2000/09/18 12:28:41  marco
    * Definition of multiple FreeBSD target defines moved to after error check
       commandline parsing
 

compiler/opts386.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit opts386;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -112,7 +115,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 16:11:51  peter
+  Revision 1.5  2000-09-24 15:06:20  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/opts68k.pas

@@ -20,6 +20,9 @@
     }
 
 unit opts68k;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -71,7 +74,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-27 16:11:51  peter
+  Revision 1.4  2000-09-24 15:06:20  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/owar.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit owar;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -44,7 +47,7 @@ type
     procedure create(const fn:string);virtual;
     procedure close;virtual;
     procedure writesym(const sym:string);virtual;
-    procedure write(var b;len:longint);virtual;
+    procedure write(const b;len:longint);virtual;
   private
     arfn        : string;
     arhdr       : tarhdr;
@@ -71,19 +74,11 @@ uses
 {$endif Delphi}
 
 const
-{$ifdef TP}
-  symrelocbufsize = 256;
-  symstrbufsize = 256;
-  lfnstrbufsize = 256;
-  arbufsize  = 256;
-  objbufsize = 256;
-{$else}
   symrelocbufsize = 4096;
   symstrbufsize = 8192;
   lfnstrbufsize = 4096;
   arbufsize  = 65536;
   objbufsize = 16384;
-{$endif}
 
 {*****************************************************************************
                                    Helpers
@@ -207,7 +202,7 @@ begin
 end;
 
 
-procedure tarobjectwriter.write(var b;len:longint);
+procedure tarobjectwriter.write(const b;len:longint);
 begin
   ardata^.write(b,len);
 end;
@@ -287,7 +282,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-19 18:44:27  peter
+  Revision 1.5  2000-09-24 15:06:20  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/19 18:44:27  peter
     * new tdynamicarray implementation using blocks instead of
       reallocmem (merged)
 

compiler/owbase.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit owbase;
+
+{$i defines.inc}
+
 interface
 
 type
@@ -31,7 +34,7 @@ type
     procedure create(const fn:string);virtual;
     procedure close;virtual;
     procedure writesym(const sym:string);virtual;
-    procedure write(var b;len:longint);virtual;
+    procedure write(const b;len:longint);virtual;
   private
     f      : file;
     opened : boolean;
@@ -48,12 +51,7 @@ uses
    verbose;
 
 const
-{$ifdef TP}
-  bufsize = 256;
-{$else}
   bufsize = 32768;
-{$endif}
-
 
 constructor tobjectwriter.init;
 begin
@@ -119,7 +117,7 @@ begin
 end;
 
 
-procedure tobjectwriter.write(var b;len:longint);
+procedure tobjectwriter.write(const b;len:longint);
 var
   p   : pchar;
   left,
@@ -152,7 +150,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-19 18:44:27  peter
+  Revision 1.4  2000-09-24 15:06:20  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/19 18:44:27  peter
     * new tdynamicarray implementation using blocks instead of
       reallocmem (merged)
 

compiler/parser.pas

@@ -20,32 +20,18 @@
 
  ****************************************************************************
 }
-{$ifdef tp}
-  {$E+,N+,D+,F+}
-{$endif}
 unit parser;
 
-{ Use exception catching so the compiler goes futher after a Stop }
-{$ifndef NOUSEEXCEPT}
-{$ifdef i386}
-  {$define USEEXCEPT}
-{$endif}
-
-{$ifdef TP}
-  {$ifdef DPMI}
-    {$undef USEEXCEPT}
-  {$endif}
-{$endif}
-{$endif ndef NOUSEEXCEPT}
+{$i defines.inc}
 
-  interface
+interface
 
     procedure preprocess(const filename:string);
     procedure compile(const filename:string;compile_system:boolean);
     procedure initparser;
     procedure doneparser;
 
-  implementation
+implementation
 
     uses
       globtype,version,tokens,systems,
@@ -607,7 +593,10 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 16:11:51  peter
+  Revision 1.5  2000-09-24 15:06:20  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/pass_1.pas

@@ -1,3 +1,4 @@
+{$ifndef cg11}
 {
     $Id$
     Copyright (c) 1998-2000 by Florian Klaempfl
@@ -20,10 +21,10 @@
 
  ****************************************************************************
 }
-{$ifdef tp}
-  {$F+}
-{$endif tp}
 unit pass_1;
+
+{$i defines.inc}
+
 interface
 
     uses
@@ -319,15 +320,7 @@ implementation
          if p^.firstpasscount>0 then
            begin
               move(p^,str1[1],sizeof(ttree));
-       {$ifndef TP}
-         {$ifopt H+}
-           SetLength(str1,sizeof(ttree));
-         {$else}
               str1[0]:=char(sizeof(ttree));
-         {$endif}
-       {$else}
-              str1[0]:=char(sizeof(ttree));
-       {$endif}
               new(oldp);
               oldp^:=p^;
               not_first:=true;
@@ -355,15 +348,7 @@ implementation
            begin
               { dirty trick to compare two ttree's (PM) }
               move(p^,str2[1],sizeof(ttree));
-       {$ifndef TP}
-         {$ifopt H+}
-           SetLength(str2,sizeof(ttree));
-         {$else}
-              str2[0]:=char(sizeof(ttree));
-         {$endif}
-       {$else}
               str2[0]:=char(sizeof(ttree));
-       {$endif}
               if str1<>str2 then
                 begin
                    comment(v_debug,'tree changed after first counting pass '
@@ -388,12 +373,373 @@ implementation
 
 
 end.
+{$else cg11}
+unit pass_1;
+
+{$i defines.inc}
+
+interface
+
+    uses
+       node;
+
+    procedure firstpass(var p : tnode);
+    function  do_firstpass(var p : tnode) : boolean;
+
+    type
+       tnothingnode = class(tnode)
+          constructor create;virtual;
+          function pass_1 : tnode;override;
+       end;
+
+       terrornode = class(tnode)
+          constructor create;virtual;
+          function pass_1 : tnode;override;
+       end;
+
+       tasmnode = class(tnode)
+          constructor create;virtual;
+          function pass_1 : tnode;override;
+       end;
+
+       tstatementnode = class(tbinarynode)
+          constructor create(l,r : tnode);virtual;
+          function pass_1 : tnode;override;
+       end;
+
+       tblocknode = class(tbinarynode)
+          constructor create(l,r : tnode);virtual;
+          function pass_1 : tnode;override;
+       end;
+
+    var
+       cnothingnode : class of tnothingnode;
+       cerrornode : class of terrornode;
+       casmnode : class of tasmnode;
+       cstatementnode : class of tstatementnode;
+       cblocknode : class of tblocknode;
+
+implementation
+
+    uses
+      globtype,systems,
+      cutils,cobjects,verbose,globals,
+      aasm,symtable,types,
+      htypechk,
+      cpubase,cpuasm
+{$ifdef newcg}
+      ,cgbase
+      ,tgcpu
+{$else newcg}
+      ,hcodegen
+{$ifdef i386}
+      ,tgeni386
+{$endif}
+{$ifdef m68k}
+      ,tgen68k
+{$endif}
+{$endif}
+      ;
+
+{*****************************************************************************
+                             TFIRSTNOTHING
+*****************************************************************************}
+
+    constructor tnothingnode.create;
+
+      begin
+         inherited create(nothingn);
+      end;
+
+    function tnothingnode.pass_1 : tnode;
+      begin
+         pass_1:=nil;
+         resulttype:=voiddef;
+      end;
+
+
+{*****************************************************************************
+                             TFIRSTERROR
+*****************************************************************************}
+
+    constructor terrornode.create;
+
+      begin
+         inherited create(errorn);
+      end;
+
+    function terrornode.pass_1 : tnode;
+      begin
+         pass_1:=nil;
+         include(flags,nf_error);
+         codegenerror:=true;
+         resulttype:=generrordef;
+      end;
+
+{*****************************************************************************
+                            TSTATEMENTNODE
+*****************************************************************************}
+
+    constructor tstatementnode.create(l,r : tnode);
+
+      begin
+         inherited create(statementn,l,r);
+      end;
+
+    function tstatementnode.pass_1 : tnode;
+      begin
+         pass_1:=nil;
+         { left is the next statement in the list }
+         resulttype:=voiddef;
+         { no temps over several statements }
+{$ifdef newcg}
+         tg.cleartempgen;
+{$else newcg}
+         cleartempgen;
+{$endif newcg}
+         { right is the statement itself calln assignn or a complex one }
+         {must_be_valid:=true; obsolete PM }
+         firstpass(right);
+         if (not (cs_extsyntax in aktmoduleswitches)) and
+            assigned(right.resulttype) and
+            (right.resulttype<>pdef(voiddef)) then
+           CGMessage(cg_e_illegal_expression);
+         if codegenerror then
+           exit;
+         registers32:=right.registers32;
+         registersfpu:=right.registersfpu;
+{$ifdef SUPPORT_MMX}
+         registersmmx:=right.registersmmx;
+{$endif SUPPORT_MMX}
+         { left is the next in the list }
+         firstpass(left);
+         if codegenerror then
+           exit;
+         if right.registers32>registers32 then
+           registers32:=right.registers32;
+         if right.registersfpu>registersfpu then
+           registersfpu:=right.registersfpu;
+{$ifdef SUPPORT_MMX}
+         if right.registersmmx>registersmmx then
+           registersmmx:=right.registersmmx;
+{$endif}
+      end;
+
+
+{*****************************************************************************
+                             TBLOCKNODE
+*****************************************************************************}
+
+    constructor tblocknode.create(l,r : tnode);
+
+      begin
+         inherited create(blockn,l,r);
+      end;
+
+    function tblocknode.pass_1 : tnode;
+      var
+         hp : tnode;
+         count : longint;
+      begin
+         pass_1:=nil;
+         count:=0;
+         hp:=left;
+         while assigned(hp) do
+           begin
+              if cs_regalloc in aktglobalswitches then
+                begin
+                   { node transformations }
+
+                   { concat function result to exit }
+                   { this is wrong for string or other complex
+                     result types !!! }
+                   if ret_in_acc(procinfo^.returntype.def) and
+                      assigned(hp.left) and
+                      assigned(hp.left.right) and
+                      (hp.left.right.treetype=exitn) and
+                      (hp.right.treetype=assignn) and
+                      (hp.right.left.treetype=funcretn) then
+                      begin
+                         if assigned(hp.left.right.left) then
+                           CGMessage(cg_n_inefficient_code)
+                         else
+                           begin
+                              hp.left.right.left:=hp.right.right;
+                              hp.right.right:=nil;
+                              disposetree(hp.right);
+                              hp.right:=nil;
+                           end;
+                      end
+                   { warning if unreachable code occurs and elimate this }
+                   else if (hp.right.treetype in
+                     [exitn,breakn,continuen,goton]) and
+                     { statement node (JM) }
+                     assigned(hp.left) and
+                     { kind of statement! (JM) }
+                     assigned(hp.left.right) and
+                     (hp.left.right.treetype<>labeln) then
+                     begin
+                        { use correct line number }
+                        aktfilepos:=hp.left.fileinfo;
+                        disposetree(hp.left);
+                        hp.left:=nil;
+                        CGMessage(cg_w_unreachable_code);
+                        { old lines }
+                        aktfilepos:=hp.right.fileinfo;
+                     end;
+                end;
+              if assigned(hp.right) then
+                begin
+{$ifdef newcg}
+                   tg.cleartempgen;
+{$else newcg}
+                   cleartempgen;
+{$endif newcg}
+                   codegenerror:=false;
+                   firstpass(hp.right);
+                   if (not (cs_extsyntax in aktmoduleswitches)) and
+                      assigned(hp.right.resulttype) and
+                      (hp.right.resulttype<>pdef(voiddef)) then
+                     CGMessage(cg_e_illegal_expression);
+                   {if codegenerror then
+                     exit;}
+                   hp.registers32:=hp.right.registers32;
+                   hp.registersfpu:=hp.right.registersfpu;
+{$ifdef SUPPORT_MMX}
+                   hp.registersmmx:=hp.right.registersmmx;
+{$endif SUPPORT_MMX}
+                end
+              else
+                hp.registers32:=0;
+
+              if hp.registers32>p^.registers32 then
+                registers32:=hp.registers32;
+              if hp.registersfpu>registersfpu then
+                registersfpu:=hp.registersfpu;
+{$ifdef SUPPORT_MMX}
+              if hp.registersmmx>registersmmx then
+                registersmmx:=hp.registersmmx;
+{$endif}
+              inc(count);
+              hp:=hp.left;
+           end;
+      end;
+
+
+{*****************************************************************************
+                             TASMNODE
+*****************************************************************************}
+
+    function tasmnode.pass_1 : tnode;
+      begin
+         pass_1:=nil;
+         procinfo^.flags:=procinfo^.flags or pi_uses_asm;
+      end;
+
+{*****************************************************************************
+                            Global procedures
+*****************************************************************************}
+
+    procedure firstpass(var p : pnode);
+
+      var
+         oldcodegenerror  : boolean;
+         oldlocalswitches : tlocalswitches;
+         oldpos    : tfileposinfo;
+         hp : tnode;
+{$ifdef extdebug}
+         str1,str2 : string;
+         oldp      : tnode;
+         not_first : boolean;
+{$endif extdebug}
+      begin
+{$ifdef extdebug}
+         inc(total_of_firstpass);
+         if (p^.firstpasscount>0) and only_one_pass then
+           exit;
+{$endif extdebug}
+         oldcodegenerror:=codegenerror;
+         oldpos:=aktfilepos;
+         oldlocalswitches:=aktlocalswitches;
+{$ifdef extdebug}
+         if p^.firstpasscount>0 then
+           begin
+              move(p^,str1[1],sizeof(ttree));
+              str1[0]:=char(sizeof(ttree));
+              new(oldp);
+              oldp^:=p^;
+              not_first:=true;
+              inc(firstpass_several);
+           end
+         else
+           not_first:=false;
+{$endif extdebug}
+
+         if not nf_error in p.flags then
+           begin
+              codegenerror:=false;
+              aktfilepos:=p.fileinfo;
+              aktlocalswitches:=p.localswitches;
+              hp:=p.pass_1;
+              { should the node be replaced? }
+              if assigned(hp) then
+                begin
+                   p.free;
+                   p:=hp;
+                end;
+              aktlocalswitches:=oldlocalswitches;
+              aktfilepos:=oldpos;
+              if codegenerror then
+                include(p.flags,nf_error);
+              codegenerror:=codegenerror or oldcodegenerror;
+           end
+         else
+           codegenerror:=true;
+{$ifdef extdebug}
+         if not_first then
+           begin
+              { dirty trick to compare two ttree's (PM) }
+              move(p^,str2[1],sizeof(ttree));
+              str2[0]:=char(sizeof(ttree));
+              if str1<>str2 then
+                begin
+                   comment(v_debug,'tree changed after first counting pass '
+                     +tostr(longint(p^.treetype)));
+                   compare_trees(oldp,p);
+                end;
+              dispose(oldp);
+           end;
+         if count_ref then
+           inc(p^.firstpasscount);
+{$endif extdebug}
+      end;
+
+
+    function do_firstpass(var p : tnode) : boolean;
+      begin
+         aktexceptblock:=nil;
+         codegenerror:=false;
+         firstpass(p);
+         do_firstpass:=codegenerror;
+      end;
+
+begin
+   cnothingnode:=tnothingnode;
+   cerrornode:=terrornode;
+   casmnode:=tasmnode;
+   cstatementnode:=tstatementnode;
+   cblocknode:=tblocknode;
+end.
+{$endif cg11}
 {
   $Log$
-  Revision 1.3  2000-09-19 23:09:07  pierre
+  Revision 1.4  2000-09-24 15:06:21  peter
+    * use defines.inc
+
+  Revision 1.3  2000/09/19 23:09:07  pierre
    * problems wih extdebug cond. solved
 
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
 
-}
+}

compiler/pass_2.pas

@@ -20,13 +20,10 @@
 
  ****************************************************************************
 }
-{$ifdef FPC}
-  {$goto on}
-{$endif FPC}
-{$ifdef TP}
-  {$E+,F+,N+}
-{$endif}
 unit pass_2;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -558,7 +555,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2000-08-27 16:11:51  peter
+  Revision 1.8  2000-09-24 15:06:21  peter
+    * use defines.inc
+
+  Revision 1.7  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/pbase.pas

@@ -22,7 +22,9 @@
 }
 unit pbase;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
        cobjects,tokens,globals,symtable
@@ -167,7 +169,7 @@ unit pbase;
       end;
 
 {$ifdef fixLeaksOnError}
-procedure pbase_do_stop; {$ifdef tp} far; {$endif tp}
+procedure pbase_do_stop;
 var names: PStringContainer;
 begin
   names := PStringContainer(strContStack.pop);
@@ -178,23 +180,22 @@ begin
     end;
   strContStack.done;
   do_stop := pbase_old_do_stop;
-{$ifdef tp}
-  do_stop;
-{$else tp}
-  do_stop();
-{$endif tp}
+  do_stop{$ifdef FPCPROCVAR}(){$endif};
 end;
 
 begin
   strContStack.init;
   pbase_old_do_stop := do_stop;
-  do_stop := {$ifndef tp}@{$endif}pbase_do_stop;
+  do_stop := {$ifdef FPCPROCVAR}(){$endif}pbase_do_stop;
 {$endif fixLeaksOnError}
 end.
 
 {
   $Log$
-  Revision 1.4  2000-08-27 20:19:39  peter
+  Revision 1.5  2000-09-24 15:06:21  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 20:19:39  peter
     * store strings with case in ppu, when an internal symbol is created
       a '$' is prefixed so it's not automatic uppercased
 

compiler/pdecl.pas

@@ -22,9 +22,11 @@
 }
 unit pdecl;
 
+{$i defines.inc}
+
 {$define UseUnionSymtable}
 
-  interface
+interface
 
     uses
       globtype,tokens,globals,symtable;
@@ -1022,7 +1024,7 @@ unit pdecl;
                   end;
                end;
              recorddef :
-               precorddef(pd)^.symtable^.foreach({$ifndef TP}@{$endif}resolve_type_forward);
+               precorddef(pd)^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
              objectdef :
                begin
                  if not(m_fpc in aktmodeswitches) and
@@ -1038,7 +1040,7 @@ unit pdecl;
                       check objectdefs in objects/records, because these
                       can't exist (anonymous objects aren't allowed) }
                     if not(psym(p)^.owner^.symtabletype in [objectsymtable,recordsymtable]) then
-                     pobjectdef(pd)^.symtable^.foreach({$ifndef TP}@{$endif}resolve_type_forward);
+                     pobjectdef(pd)^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
                   end;
                end;
           end;
@@ -1123,7 +1125,7 @@ unit pdecl;
             consume(_SEMICOLON);
          until token<>_ID;
          typecanbeforward:=false;
-         symtablestack^.foreach({$ifndef TP}@{$endif}resolve_type_forward);
+         symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
          block_type:=old_block_type;
       end;
 
@@ -1297,7 +1299,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.14  2000-09-11 17:00:23  florian
+  Revision 1.15  2000-09-24 15:06:21  peter
+    * use defines.inc
+
+  Revision 1.14  2000/09/11 17:00:23  florian
     + first implementation of Netware Module support, thanks to
       Armin Diehl ([email protected]) for providing the patches
 
@@ -1342,4 +1347,4 @@ end.
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
 
-}
+}

compiler/pexports.pas

@@ -22,12 +22,14 @@
 }
 unit pexports;
 
-  interface
+{$i defines.inc}
+
+interface
 
     { reads an exports statement in a library }
     procedure read_exports;
 
-  implementation
+implementation
 
     uses
       globtype,systems,tokens,
@@ -153,7 +155,10 @@ end.
 
 {
   $Log$
-  Revision 1.3  2000-08-27 16:11:51  peter
+  Revision 1.4  2000-09-24 15:06:21  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/pexpr.pas

@@ -22,7 +22,9 @@
 }
 unit pexpr;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses symtable,tree;
 
@@ -43,7 +45,7 @@ unit pexpr;
 
     function get_stringconst:string;
 
-  implementation
+implementation
 
     uses
        globtype,systems,tokens,
@@ -56,7 +58,9 @@ unit pexpr;
 {$endif}
        types,verbose,strings,
 {$ifndef newcg}
+   {$ifndef CG11}
        tccal,
+   {$endif}
 {$endif newcg}
        pass_1,
        { parser specific stuff }
@@ -910,8 +914,9 @@ unit pexpr;
                                Factor
 ****************************************************************************}
 {$ifdef fpc}
-{$maxfpuregisters 0}
+  {$maxfpuregisters 0}
 {$endif fpc}
+
     function factor(getaddr : boolean) : ptree;
       var
          l      : longint;
@@ -2019,7 +2024,7 @@ _LECKKLAMMER : begin
         check_tokenpos;
       end;
 {$ifdef fpc}
-{$maxfpuregisters default}
+  {$maxfpuregisters default}
 {$endif fpc}
 
 {****************************************************************************
@@ -2214,7 +2219,10 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.7  2000-08-27 16:11:51  peter
+  Revision 1.8  2000-09-24 15:06:22  peter
+    * use defines.inc
+
+  Revision 1.7  2000/08/27 16:11:51  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 
@@ -2234,4 +2242,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
-}
+}

compiler/pmodules.pas

@@ -21,24 +21,27 @@
  ****************************************************************************
 }
 unit pmodules;
-            { close old_current_ppu on system that are
-              short on file handles like DOS system PM }
+
+{$i defines.inc}
+
+{ close old_current_ppu on system that are
+  short on file handles like DOS system PM }
 {$ifdef GO32V1}
-{$define SHORT_ON_FILE_HANDLES}
+  {$define SHORT_ON_FILE_HANDLES}
 {$endif GO32V1}
 {$ifdef GO32V2}
-{$define SHORT_ON_FILE_HANDLES}
+  {$define SHORT_ON_FILE_HANDLES}
 {$endif GO32V2}
 
 {$define New_GDB}
 
-  interface
+interface
 
     procedure proc_unit;
     procedure proc_program(islibrary : boolean);
 
 
-  implementation
+implementation
 
     uses
        globtype,version,systems,tokens,
@@ -990,8 +993,6 @@ unit pmodules;
 
       begin
          consume(_UNIT);
-         if Compile_Level=1 then
-           IsExe:=false;
 
          if token=_ID then
           begin
@@ -1444,7 +1445,6 @@ unit pmodules;
 {$endif fixLeaksOnError}
       begin
          DLLsource:=islibrary;
-         IsExe:=true;
          parse_only:=false;
          { relocation works only without stabs under win32 !! PM }
          { internal assembler uses rva for stabs info
@@ -1714,7 +1714,10 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.9  2000-08-31 07:53:02  michael
+  Revision 1.10  2000-09-24 15:06:22  peter
+    * use defines.inc
+
+  Revision 1.9  2000/08/31 07:53:02  michael
   + Applied patch from Peter
 
   Revision 1.8  2000/08/29 19:00:01  peter
@@ -1741,4 +1744,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:45  michael
   + removed logs
-}
+}

compiler/popt386.pas

@@ -22,6 +22,7 @@
 }
 Unit POpt386;
 
+{$i defines.inc}
 
 Interface
 
@@ -1945,7 +1946,10 @@ End.
 
 {
   $Log$
-  Revision 1.11  2000-09-18 11:28:36  jonas
+  Revision 1.12  2000-09-24 15:06:23  peter
+    * use defines.inc
+
+  Revision 1.11  2000/09/18 11:28:36  jonas
     * fixed web bug 1133 (merged from fixes branch)
 
   Revision 1.10  2000/08/18 10:09:13  jonas

compiler/pp.pas

@@ -18,7 +18,9 @@
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
- ****************************************************************************}
+ ****************************************************************************
+}
+program pp;
 
 {
   possible compiler switches (* marks a currently required switch):
@@ -55,6 +57,8 @@
   GDB;M68k;TP
 }
 
+{$i defines.inc}
+
 {$ifdef FPC}
    {$ifndef GDB}
       { people can try to compile without GDB }
@@ -79,180 +83,38 @@
    {$endif support_mmx}
 {$endif}
 
-{$ifdef TP}
-  {$IFNDEF DPMI}
-    {$M 24000,0,655360}
-  {$ELSE}
-    {$M 65000}
-  {$ENDIF DPMI}
-  {$E+,N+,F+,S-,R-}
-{$endif TP}
-
-
-program pp;
-
-{$IFDEF TP}
-  {$UNDEF PROFILE}
-  {$IFDEF DPMI}
-    {$UNDEF USEOVERLAY}
-  {$ENDIF}
-  {$DEFINE NOAG386BIN}
-{$ENDIF}
-{$ifdef FPC}
-  {$UNDEF USEOVERLAY}
-{$ENDIF}
-
 uses
-{$ifdef useoverlay}
-  {$ifopt o+}
-    Overlay,ppovin,
-  {$else}
-    {$error You must compile with the $O+ switch}
-  {$endif}
-{$endif useoverlay}
-{$ifdef profile}
-  profile,
-{$endif profile}
 {$ifdef FPC}
-{$ifdef heaptrc}
-  ppheap,
-{$endif heaptrc}
-{$ifdef linux}
-  catch,
-{$endif}
-{$ifdef go32v2}
+  {$ifdef profile}
+    profile,
+  {$endif profile}
+  {$ifdef heaptrc}
+    ppheap,
+  {$endif heaptrc}
+  {$ifdef linux}
+    catch,
+  {$endif}
+  {$ifdef go32v2}
+    {$ifdef DEBUG}
+      {$define NOCATCH}
+    {$endif DEBUG}
+    catch,
+  {$endif}
+  { we've now a lineinfo unit for all OSes }
   {$ifdef DEBUG}
-    {$define NOCATCH}
+    lineinfo,
   {$endif DEBUG}
-  catch,
-{$endif}
-{ we've now a lineinfo unit for all OSes }
-{$ifdef DEBUG}
-lineinfo,
-{$endif DEBUG}
 {$endif FPC}
-  globals,compiler
-{$ifdef logmemblocks}
-{$ifdef fpc}
-  ,memlog
-{$endif fpc}
-{$endif logmemblocks}
-  ;
-
-{$ifdef useoverlay}
-  {$O files}
-  {$O globals}
-  {$O hcodegen}
-  {$O pass_1}
-  {$O pass_2}
-  {$O tree}
-  {$O types}
-  {$O objects}
-  {$O options}
-  {$O cobjects}
-  {$O globals}
-  {$O systems}
-  {$O parser}
-  {$O pbase}
-  {$O pdecl}
-  {$O pexports}
-  {$O pexpr}
-  {$O pmodules}
-  {$O pstatmnt}
-  {$O psub}
-  {$O psystem}
-  {$O ptconst}
-  {$O script}
-  {$O switches}
-  {$O temp_gen}
-  {$O comphook}
-  {$O dos}
-  {$O scanner}
-  {$O symtable}
-  {$O objects}
-  {$O aasm}
-  {$O link}
-  {$O assemble}
-  {$O messages}
-  {$O gendef}
-  {$O import}
-  {$ifdef gdb}
-        {$O gdb}
-  {$endif gdb}
-  {$ifdef i386}
-        {$O cpubase}
-        {$O cgai386}
-        {$O tgeni386}
-        {$O cg386add}
-        {$O cg386cal}
-        {$O cg386cnv}
-        {$O cg386con}
-        {$O cg386flw}
-        {$O cg386ld}
-        {$O cg386inl}
-        {$O cg386mat}
-        {$O cg386set}
-        {$ifndef NOOPT}
-          {$O aopt386}
-          {$O opts386}
-        {$endif}
-        {$IfNDef Nora386dir}
-          {$O ra386dir}
-        {$endif}
-        {$IfNDef Nora386int}
-          {$O ra386int}
-        {$endif}
-        {$IfNDef Nora386att}
-          {$O ra386att}
-        {$endif}
-        {$ifndef NoAg386Int}
-          {$O ag386int}
-        {$endif}
-        {$ifndef NoAg386Att}
-          {$O ag386att}
-        {$endif}
-        {$ifndef NoAg386Nsm}
-          {$O ag386nsm}
-        {$endif}
-  {$endif}
-  {$ifdef m68k}
-        {$O opts68k}
-        {$O cpubase}
-        {$O cga68k}
-        {$O tgen68k}
-        {$O cg68kadd}
-        {$O cg68kcal}
-        {$O cg68kcnv}
-        {$O cg68kcon}
-        {$O cg68kflw}
-        {$O cg68kld}
-        {$O cg68kinl}
-        {$O cg68kmat}
-        {$O cg68kset}
-        {$IfNDef Nora68kMot}
-          {$O ra68kmot}
-        {$endif}
-        {$IfNDef Noag68kGas}
-          {$O ag68kgas}
-        {$endif}
-        {$IfNDef Noag68kMot}
-          {$O ag68kmot}
-        {$endif}
-        {$IfNDef Noag68kMit}
-          {$O ag68kmit}
-        {$endif}
-  {$endif}
-{$endif useoverlay}
+  globals,compiler;
 
 var
   oldexit : pointer;
-procedure myexit;{$ifndef FPC}far;{$endif}
+procedure myexit;
 begin
   exitproc:=oldexit;
 { Show Runtime error if there was an error }
   if (erroraddr<>nil) then
    begin
-
      case exitcode of
       100:
         begin
@@ -285,16 +147,16 @@ end;
 begin
   oldexit:=exitproc;
   exitproc:=@myexit;
-{$ifdef UseOverlay}
-  InitOverlay;
-{$endif}
 
 { Call the compiler with empty command, so it will take the parameters }
   Halt(compiler.Compile(''));
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:45  michael
+  Revision 1.3  2000-09-24 15:06:23  peter
+    * use defines.inc
+
+  Revision 1.2  2000/07/13 11:32:45  michael
   + removed logs
 
 }

compiler/ppc.dpr

@@ -1,7 +1,3 @@
-{$MINSTACKSIZE $00004000}
-{$MAXSTACKSIZE $00100000}
-{$IMAGEBASE $00400000}
-{$APPTYPE CONSOLE}
 {
     $Id$
     Copyright (c) 1998-2000 by Florian Klaempfl
@@ -22,7 +18,14 @@
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
- ****************************************************************************}
+ ****************************************************************************
+}
+program pp;
+
+{$MINSTACKSIZE $00004000}
+{$MAXSTACKSIZE $00100000}
+{$IMAGEBASE $00400000}
+{$APPTYPE CONSOLE}
 
 {
   possible compiler switches (* marks a currently required switch):
@@ -34,6 +37,7 @@
   I386                generate a compiler for the Intel i386+
   M68K                generate a compiler for the M68000
   USEOVERLAY          compiles a TP version which uses overlays
+  DEBUG               version with debug code is generated
   EXTDEBUG            some extra debug code is executed
   SUPPORT_MMX         only i386: releases the compiler switch
                       MMX which allows the compiler to generate
@@ -42,6 +46,10 @@
                       use external messagefiles, default for TP
   NOAG386INT          no Intel Assembler output
   NOAG386NSM          no NASM output
+  NOAG386BIN          leaves out the binary writer, default for TP
+  LOGMEMBLOCKS        adds memory manager which logs the size of
+                      each allocated memory block, the information
+                      is written to memuse.log after compiling
   -----------------------------------------------------------------
 
   Required switches for a i386 compiler be compiled by Free Pascal Compiler:
@@ -52,11 +60,10 @@
 
   Required switches for a 68000 compiler be compiled by Turbo Pascal:
   GDB;M68k;TP
-
-  To compile the compiler with Delphi do the following:
-
 }
 
+{$i defines.inc}
+
 {$ifdef FPC}
    {$ifndef GDB}
       { people can try to compile without GDB }
@@ -81,293 +88,79 @@
    {$endif support_mmx}
 {$endif}
 
-{$ifndef DELPHI}
-{$ifdef TP}
-  {$IFNDEF DPMI}
-    {$M 24000,0,655360}
-  {$ELSE}
-    {$M 65000}
-  {$ENDIF DPMI}
-  {$E+,N+,F+,S-,R-}
-{$endif TP}
-{$endif DELPHI}
-
-
-program pp;
-
-{$IFDEF TP}
-  {$UNDEF PROFILE}
-  {$IFDEF DPMI}
-    {$UNDEF USEOVERLAY}
-  {$ENDIF}
-{$ENDIF}
-{$ifdef FPC}
-  {$UNDEF USEOVERLAY}
-{$ENDIF}
-
 uses
-{$ifdef useoverlay}
-  {$ifopt o+}
-    Overlay,ppovin,
-  {$else}
-    {$error You must compile with the $O+ switch}
-  {$endif}
-{$endif useoverlay}
-{$ifdef profile}
-  profile,
-{$endif profile}
-  globals,compiler;
-
-{$ifdef useoverlay}
-  {$O files}
-  {$O globals}
-  {$O hcodegen}
-  {$O pass_1}
-  {$O tree}
-  {$O types}
-  {$O objects}
-  {$O options}
-  {$O cobjects}
-  {$O globals}
-  {$O systems}
-  {$O parser}
-  {$O pbase}
-  {$O pdecl}
-  {$O pexports}
-  {$O pexpr}
-  {$O pmodules}
-  {$O pstatmnt}
-  {$O psub}
-  {$O psystem}
-  {$O ptconst}
-  {$O script}
-  {$O switches}
-  {$O temp_gen}
-  {$O comphook}
-  {$O dos}
-  {$O scanner}
-  {$O symtable}
-  {$O objects}
-  {$O aasm}
-  {$O link}
-  {$O assemble}
-  {$O messages}
-  {$O gendef}
-  {$O import}
-  {$O os2_targ}
-  {$O win_targ}
-  {$O asmutils}
-  {$ifdef gdb}
-        {$O gdb}
-  {$endif gdb}
-  {$ifdef i386}
-        {$O opts386}
-        {$O cgi386}
-        {$O cg386add}
-        {$O cg386cal}
-        {$O cg386cnv}
-        {$O cg386con}
-        {$O cg386flw}
-        {$O cg386ld}
-        {$O cg386mat}
-        {$O cg386set}
-{$ifndef NOOPT}
-        {$O aopt386}
-{$endif NOOPT}
-        {$O cgai386}
-        {$O i386}
-{$IfNDef Nora386dir}
-        {$O ra386dir}
-{$endif Nora386dir}
-{$IfNDef Nora386int}
-        {$O ra386int}
-{$endif Nora386int}
-{$IfNDef Nora386att}
-        {$O ra386att}
-{$endif Nora386att}
-        {$O tgeni386}
-{$ifndef NoAg386Int}
-        {$O ag386int}
-{$endif NoAg386Int}
-        {$O ag386att}
-{$ifndef NoAg386Nsm}
-        {$O ag386nsm}
-{$endif}
+{$ifdef FPC}
+  {$ifdef profile}
+    profile,
+  {$endif profile}
+  {$ifdef heaptrc}
+    ppheap,
+  {$endif heaptrc}
+  {$ifdef linux}
+    catch,
   {$endif}
-  {$ifdef m68k}
-        {$O opts68k}
-        {$O cg68k}
-        {$O ra68kmot}
-        {$O ag68kgas}
-        {$O ag68kmot}
-        {$O ag68kmit}
+  {$ifdef go32v2}
+    {$ifdef DEBUG}
+      {$define NOCATCH}
+    {$endif DEBUG}
+    catch,
   {$endif}
-{$endif useoverlay}
+  { we've now a lineinfo unit for all OSes }
+  {$ifdef DEBUG}
+    lineinfo,
+  {$endif DEBUG}
+{$endif FPC}
+  globals,compiler;
 
 var
   oldexit : pointer;
-procedure myexit;{$ifndef FPC}far;{$endif}
+procedure myexit;
 begin
   exitproc:=oldexit;
 { Show Runtime error if there was an error }
   if (erroraddr<>nil) then
    begin
      case exitcode of
-      202 : begin
-              erroraddr:=nil;
-              Writeln('Error: Stack Overflow');
-            end;
-      203 : begin
-              erroraddr:=nil;
-              Writeln('Error: Out of memory');
-            end;
+      100:
+        begin
+           erroraddr:=nil;
+           writeln('Error while reading file');
+        end;
+      101:
+        begin
+           erroraddr:=nil;
+           writeln('Error while writing file');
+        end;
+      202:
+        begin
+           erroraddr:=nil;
+           writeln('Error: Stack Overflow');
+        end;
+      203:
+        begin
+           erroraddr:=nil;
+           writeln('Error: Out of memory');
+        end;
      end;
-     Writeln('Compilation aborted at line ',aktfilepos.line);
+     { we cannot use aktfilepos.file because all memory might have been
+       freed already !
+       But we can use global parser_current_file var }
+     Writeln('Compilation aborted ',parser_current_file,':',aktfilepos.line);
    end;
 end;
 
 begin
   oldexit:=exitproc;
   exitproc:=@myexit;
-{$ifndef VER0_99_5}
-  {$ifndef TP}
-  {$ifndef Delphi}
-    heapblocks:=true;
-  {$endif Delphi}
-  {$endif}
-{$endif}
-{$ifdef UseOverlay}
-  InitOverlay;
-{$endif}
 
 { Call the compiler with empty command, so it will take the parameters }
-  Halt(Compile(''));
+  Halt(compiler.Compile(''));
 end.
 {
   $Log$
-  Revision 1.1  2000-07-13 06:29:54  michael
-  + Initial import
-
-  Revision 1.4  2000/01/07 01:14:30  peter
-    * updated copyright to 2000
+  Revision 1.2  2000-09-24 15:06:24  peter
+    * use defines.inc
 
-  Revision 1.3  1999/07/18 10:20:00  florian
-    * made it compilable with Dlephi 4 again
-    + fixed problem with large stack allocations on win32
-
-  Revision 1.2  1999/05/04 21:44:58  florian
-    * changes to compile it with Delphi 4.0
-
-  Revision 1.1  1998/09/18 16:03:44  florian
-    * some changes to compile with Delphi
-
-  Revision 1.28  1998/08/26 15:31:17  peter
-    * heapblocks for >0.99.5
-
-  Revision 1.27  1998/08/11 00:00:00  peter
-    * fixed dup log
-
-  Revision 1.26  1998/08/10 15:49:40  peter
-    * small fixes for 0.99.5
-
-  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
-
-  Revision 1.22  1998/08/04 16:28:40  jonas
-  * added support for NoRa386* in the $O ... section
-
-  Revision 1.21  1998/07/18 17:11:12  florian
-    + ansi string constants fixed
-    + switch $H partial implemented
-
-  Revision 1.20  1998/07/14 14:46:55  peter
-    * released NEWINPUT
-
-  Revision 1.19  1998/07/07 11:20:04  peter
-    + NEWINPUT for a better inputfile and scanner object
-
-  Revision 1.18  1998/06/24 14:06:33  peter
-    * fixed the name changes
-
-  Revision 1.17  1998/06/23 08:59:22  daniel
-    * Recommitted.
-
-  Revision 1.16  1998/06/17 14:10:17  peter
-    * small os2 fixes
-    * fixed interdependent units with newppu (remake3 under linux works now)
-
-  Revision 1.15  1998/06/16 11:32:18  peter
-    * small cosmetic fixes
-
-  Revision 1.14  1998/06/15 13:43:45  daniel
-
-
-  * Updated overlays.
-
-  Revision 1.12  1998/05/23 01:21:23  peter
-    + aktasmmode, aktoptprocessor, aktoutputformat
-    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
-    + $LIBNAME to set the library name where the unit will be put in
-    * splitted cgi386 a bit (codeseg to large for bp7)
-    * nasm, tasm works again. nasm moved to ag386nsm.pas
-
-  Revision 1.11  1998/05/20 09:42:35  pierre
-    + UseTokenInfo now default
-    * unit in interface uses and implementation uses gives error now
-    * only one error for unknown symbol (uses lastsymknown boolean)
-      the problem came from the label code !
-    + first inlined procedures and function work
-      (warning there might be allowed cases were the result is still wrong !!)
-    * UseBrower updated gives a global list of all position of all used symbols
-      with switch -gb
-
-  Revision 1.10  1998/05/12 10:47:00  peter
-    * moved printstatus to verb_def
-    + V_Normal which is between V_Error and V_Warning and doesn't have a
-      prefix like error: warning: and is included in V_Default
-    * fixed some messages
-    * first time parameter scan is only for -v and -T
-    - removed old style messages
-
-  Revision 1.9  1998/05/11 13:07:56  peter
-    + $ifdef NEWPPU for the new ppuformat
-    + $define GDB not longer required
-    * removed all warnings and stripped some log comments
-    * no findfirst/findnext anymore to remove smartlink *.o files
-
-  Revision 1.8  1998/05/08 09:21:57  michael
-  + Librarysearchpath is now a linker object field;
-
-  Revision 1.7  1998/05/04 17:54:28  peter
-    + smartlinking works (only case jumptable left todo)
-    * redesign of systems.pas to support assemblers and linkers
-    + Unitname is now also in the PPU-file, increased version to 14
-
-  Revision 1.6  1998/04/29 13:40:23  peter
-    + heapblocks:=true
-
-  Revision 1.5  1998/04/29 10:33:59  pierre
-    + added some code for ansistring (not complete nor working yet)
-    * corrected operator overloading
-    * corrected nasm output
-    + started inline procedures
-    + added starstarn : use ** for exponentiation (^ gave problems)
-    + started UseTokenInfo cond to get accurate positions
-
-  Revision 1.3  1998/04/21 10:16:48  peter
-    * patches from strasbourg
-    * objects is not used anymore in the fpc compiled version
-
-  Revision 1.2  1998/04/07 13:19:47  pierre
-    * bugfixes for reset_gdb_info
-      in MEM parsing for go32v2
-      better external symbol creation
-      support for rhgdb.exe (lowercase file names)
+  Revision 1.1  2000/07/13 06:29:54  michael
+  + Initial import
 }

compiler/ppheap.pas

@@ -22,7 +22,9 @@
  ****************************************************************************}
 unit ppheap;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses heaptrc;
 
@@ -31,7 +33,7 @@ unit ppheap;
 
     procedure pp_heap_init;
 
-  implementation
+implementation
 
     uses
        globtype,globals,files;
@@ -57,22 +59,21 @@ unit ppheap;
        if not pp_heap_inited then
          begin
             setheaptraceoutput('heap.log');
-{$ifndef TP}
-            SetExtraInfo(12,@ppextra_info);
-{$else TP}
-            SetExtraInfo(12,ppextra_info);
-{$endif TP}
+            SetExtraInfo(12,{$ifdef FPCPROCVAR}@{$endif}ppextra_info);
          end;
        pp_heap_inited:=true;
     end;
 
-  begin
-     pp_heap_init;
-  end.
 
+begin
+  pp_heap_init;
+end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:45  michael
+  Revision 1.3  2000-09-24 15:06:24  peter
+    * use defines.inc
+
+  Revision 1.2  2000/07/13 11:32:45  michael
   + removed logs
 
 }

compiler/ppovin.pas

@@ -1,93 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Daniel Mantione
-
-    Handles the overlay initialisation for a TP7 compiled version
-
-    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 ppovin;
-
-interface
-
-var
-  ovrminsize:longint;
-
-procedure InitOverlay;
-
-implementation
-uses overlay;
-
-
-function _heaperror(size:word):integer;far;
-type
-  heaprecord=record
-    next:pointer;
-    values:longint;
-  end;
-var
-  l,m:longint;
-begin
-  l:=ovrgetbuf-ovrminsize;
-  if (size>maxavail) and (l>=size) then
-   begin
-     m:=((longint(size)+$3fff) and $ffffc000);
-     {Clear the overlay buffer.}
-     ovrclearbuf;
-     {Shrink it.}
-     ovrheapend:=ovrheapend-m shr 4;
-     heaprecord(ptr(ovrheapend,0)^).next:=freelist;
-     heaprecord(ptr(ovrheapend,0)^).values:=m shl 12;
-     heaporg:=ptr(ovrheapend,0);
-     freelist:=heaporg;
-     Writeln('Warning: Overlay buffer was shrunk because of memory shortage');
-     _heaperror:=2;
-   end
-  else
-   _heaperror:=0;
-end;
-
-procedure InitOverlay;
-begin
-  heaperror:=@_heaperror;
-end;
-
-
-var
-  s:string;
-begin
-  s:=paramstr(0);
-  ovrinit(copy(s,1,length(s)-3)+'ovr');
-  if ovrresult=ovrok then
-   begin
-     {May fail if no EMS memory is available. No need for error
-      checking, though, as the overlay manager happily runs without
-      EMS.}
-     ovrinitEMS;
-     ovrminsize:=ovrgetbuf;
-     ovrsetbuf(ovrminsize+$20000);
-   end
-  else
-  { only for real mode TP : runerror ok here PM }
-   runerror($da);
-end.
-{
-  $Log$
-  Revision 1.2  2000-07-13 11:32:45  michael
-  + removed logs
-
-}

compiler/ppu.pas

@@ -20,10 +20,10 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$N+,E+}
-{$endif}
 unit ppu;
+
+{$i defines.inc}
+
 interface
 
 { Also write the ppu if only crc if done, this can be used with ppudump to
@@ -58,11 +58,7 @@ const
 
 { buffer sizes }
   maxentrysize = 1024;
-{$ifdef TP}
-  ppubufsize   = 1024;
-{$else}
   ppubufsize   = 16384;
-{$endif}
 
 {ppu entries}
   mainentryid         = 1;
@@ -351,11 +347,7 @@ end;
 function tppufile.open:boolean;
 var
   ofmode : byte;
-{$ifdef delphi}
-  i      : integer;
-{$else delphi}
-  i      : word;
-{$endif delphi}
+  i      : longint;
 begin
   open:=false;
   assign(f,fname);
@@ -388,18 +380,9 @@ end;
 
 
 procedure tppufile.reloadbuf;
-{$ifdef TP}
-var
-  i : word;
-{$endif}
 begin
   inc(bufstart,bufsize);
-{$ifdef TP}
-  blockread(f,buf^,ppubufsize,i);
-  bufsize:=i;
-{$else}
   blockread(f,buf^,ppubufsize,bufsize);
-{$endif}
   bufidx:=0;
 end;
 
@@ -585,15 +568,7 @@ function tppufile.getstring:string;
 var
   s : string;
 begin
-  {$ifndef TP}
-    {$ifopt H+}
-      setlength(s,getbyte);
-    {$else}
-      s[0]:=chr(getbyte);
-    {$endif}
-  {$else}
-    s[0]:=chr(getbyte);
-  {$endif}
+  s[0]:=chr(getbyte);
   if entryidx+length(s)>entry.size then
    begin
      error:=true;
@@ -923,7 +898,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-13 13:04:38  peter
+  Revision 1.4  2000-09-24 15:06:24  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/13 13:04:38  peter
     * new ppu version
 
   Revision 1.2  2000/07/13 11:32:45  michael

compiler/pstatmnt.pas

@@ -20,13 +20,11 @@
 
  ****************************************************************************
 }
-{$ifdef FPC}
-  {$goto on}
-{$endif FPC}
-
 unit pstatmnt;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses tree;
 
@@ -381,9 +379,7 @@ unit pstatmnt;
          i,levelcount : longint;
          withsymtable,symtab : psymtable;
          obj : pobjectdef;
-{$ifdef tp}
          hp : ptree;
-{$endif}
       begin
          p:=comp_expr(true);
          do_firstpass(p);
@@ -441,7 +437,7 @@ unit pstatmnt;
             if token=_COMMA then
              begin
                consume(_COMMA);
-               right:=_with_statement{$ifndef tp}(){$endif};
+               right:=_with_statement{$ifdef FPCPROCVAR}(){$endif};
              end
             else
              begin
@@ -462,11 +458,8 @@ unit pstatmnt;
             if token=_COMMA then
              begin
                consume(_COMMA);
-{$ifdef tp}
-               hp:=_with_statement;
-{$else}
-               _with_statement();
-{$endif}
+               hp:=_with_statement{$ifdef FPCPROCVAR}(){$endif};
+               if (hp=nil) then; { remove warning about unused }
              end
             else
              begin
@@ -1160,7 +1153,7 @@ unit pstatmnt;
                         lastsymknown:=false;
                         { the pointer to the following instruction }
                         { isn't a very clean way                   }
-                        code:=gensinglenode(labeln,statement{$ifndef tp}(){$endif});
+                        code:=gensinglenode(labeln,statement{$ifdef FPCPROCVAR}(){$endif});
                         code^.labelnr:=labelnr;
                         sr^.code:=code;
                         { sorry, but there is a jump the easiest way }
@@ -1382,7 +1375,10 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.6  2000-08-27 16:11:52  peter
+  Revision 1.7  2000-09-24 15:06:24  peter
+    * use defines.inc
+
+  Revision 1.6  2000/08/27 16:11:52  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/psub.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit psub;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -487,10 +490,6 @@ end;
                         Procedure directive handlers
 ****************************************************************************}
 
-{$ifdef tp}
-  {$F+}
-{$endif}
-
 procedure pd_far(const procnames:Tstringcontainer);
 begin
   Message(parser_w_proc_far_ignored);
@@ -661,7 +660,7 @@ begin
 end;
 
 
-procedure resetvaluepara(p:pnamedindexobject);{$ifndef FPC}far;{$endif}
+procedure resetvaluepara(p:pnamedindexobject);
 begin
   if psym(p)^.typ=varsym then
     with pvarsym(p)^ do
@@ -677,7 +676,7 @@ begin
   { do not copy on local !! }
   if (aktprocsym^.definition^.deftype=procdef) and
      assigned(aktprocsym^.definition^.parast) then
-    aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}resetvaluepara);
+    aktprocsym^.definition^.parast^.foreach({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
 end;
 
 
@@ -800,16 +799,6 @@ begin
     end;
 end;
 
-{$ifdef TP}
-  {$F-}
-{$endif}
-
-{$ifdef Delphi}
-  {$define TP}
-{$endif Delphi}
-
-{const
-   namelength=15;}
 type
    pd_handler=procedure(const procnames:Tstringcontainer);
    proc_dir_rec=record
@@ -830,7 +819,7 @@ const
     (
       idtok:_ABSTRACT;
       pd_flags : pd_interface+pd_object;
-      handler  : {$ifndef TP}@{$endif}pd_abstract;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_abstract;
       pocall   : [];
       pooption : [po_abstractmethod];
       mutexclpocall : [pocall_internproc,pocall_inline];
@@ -839,7 +828,7 @@ const
     ),(
       idtok:_ALIAS;
       pd_flags : pd_implemen+pd_body;
-      handler  : {$ifndef TP}@{$endif}pd_alias;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_alias;
       pocall   : [];
       pooption : [];
       mutexclpocall : [pocall_inline];
@@ -848,7 +837,7 @@ const
     ),(
       idtok:_ASMNAME;
       pd_flags : pd_interface+pd_implemen;
-      handler  : {$ifndef TP}@{$endif}pd_asmname;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_asmname;
       pocall   : [pocall_cdecl,pocall_clearstack];
       pooption : [po_external];
       mutexclpocall : [pocall_internproc];
@@ -866,7 +855,7 @@ const
     ),(
       idtok:_CDECL;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifndef TP}@{$endif}pd_cdecl;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_cdecl;
       pocall   : [pocall_cdecl,pocall_clearstack];
       pooption : [po_savestdregs];
       mutexclpocall : [pocall_internproc,pocall_leftright,pocall_inline];
@@ -875,7 +864,7 @@ const
     ),(
       idtok:_DYNAMIC;
       pd_flags : pd_interface+pd_object;
-      handler  : {$ifndef TP}@{$endif}pd_virtual;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
       pocall   : [];
       pooption : [po_virtualmethod];
       mutexclpocall : [pocall_internproc,pocall_inline];
@@ -884,7 +873,7 @@ const
     ),(
       idtok:_EXPORT;
       pd_flags : pd_body+pd_global+pd_interface+pd_implemen{??};
-      handler  : {$ifndef TP}@{$endif}pd_export;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_export;
       pocall   : [];
       pooption : [po_exports];
       mutexclpocall : [pocall_internproc,pocall_inline];
@@ -893,7 +882,7 @@ const
     ),(
       idtok:_EXTERNAL;
       pd_flags : pd_implemen+pd_interface;
-      handler  : {$ifndef TP}@{$endif}pd_external;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_external;
       pocall   : [];
       pooption : [po_external];
       mutexclpocall : [pocall_internproc,pocall_inline,pocall_palmossyscall];
@@ -902,7 +891,7 @@ const
     ),(
       idtok:_FAR;
       pd_flags : pd_implemen+pd_body+pd_interface+pd_procvar;
-      handler  : {$ifndef TP}@{$endif}pd_far;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_far;
       pocall   : [];
       pooption : [];
       mutexclpocall : [pocall_internproc,pocall_inline];
@@ -911,7 +900,7 @@ const
     ),(
       idtok:_FORWARD;
       pd_flags : pd_implemen;
-      handler  : {$ifndef TP}@{$endif}pd_forward;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_forward;
       pocall   : [];
       pooption : [];
       mutexclpocall : [pocall_internproc,pocall_inline];
@@ -920,7 +909,7 @@ const
     ),(
       idtok:_INLINE;
       pd_flags : pd_implemen+pd_body;
-      handler  : {$ifndef TP}@{$endif}pd_inline;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_inline;
       pocall   : [pocall_inline];
       pooption : [];
       mutexclpocall : [pocall_internproc];
@@ -929,7 +918,7 @@ const
     ),(
       idtok:_INTERNCONST;
       pd_flags : pd_implemen+pd_body;
-      handler  : {$ifndef TP}@{$endif}pd_intern;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
       pocall   : [pocall_internconst];
       pooption : [];
       mutexclpocall : [];
@@ -938,7 +927,7 @@ const
     ),(
       idtok:_INTERNPROC;
       pd_flags : pd_implemen;
-      handler  : {$ifndef TP}@{$endif}pd_intern;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
       pocall   : [pocall_internproc];
       pooption : [];
       mutexclpocall : [pocall_inline,pocall_clearstack,pocall_leftright,pocall_cdecl];
@@ -947,7 +936,7 @@ const
     ),(
       idtok:_INTERRUPT;
       pd_flags : pd_implemen+pd_body;
-      handler  : {$ifndef TP}@{$endif}pd_interrupt;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_interrupt;
       pocall   : [];
       pooption : [po_interrupt];
       mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_clearstack,pocall_leftright,pocall_inline];
@@ -965,7 +954,7 @@ const
     ),(
       idtok:_MESSAGE;
       pd_flags : pd_interface+pd_object;
-      handler  : {$ifndef TP}@{$endif}pd_message;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_message;
       pocall   : [];
       pooption : []; { can be po_msgstr or po_msgint }
       mutexclpocall : [pocall_inline,pocall_internproc];
@@ -974,7 +963,7 @@ const
     ),(
       idtok:_NEAR;
       pd_flags : pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifndef TP}@{$endif}pd_near;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_near;
       pocall   : [];
       pooption : [];
       mutexclpocall : [pocall_internproc];
@@ -983,7 +972,7 @@ const
     ),(
       idtok:_OVERLOAD;
       pd_flags : pd_implemen+pd_interface+pd_body;
-      handler  : {$ifndef TP}@{$endif}pd_overload;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_overload;
       pocall   : [];
       pooption : [po_overload];
       mutexclpocall : [pocall_internproc];
@@ -992,7 +981,7 @@ const
     ),(
       idtok:_OVERRIDE;
       pd_flags : pd_interface+pd_object;
-      handler  : {$ifndef TP}@{$endif}pd_override;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_override;
       pocall   : [];
       pooption : [po_overridingmethod,po_virtualmethod];
       mutexclpocall : [pocall_inline,pocall_internproc];
@@ -1001,7 +990,7 @@ const
     ),(
       idtok:_PASCAL;
       pd_flags : pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifndef TP}@{$endif}pd_pascal;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_pascal;
       pocall   : [pocall_leftright];
       pooption : [];
       mutexclpocall : [pocall_internproc];
@@ -1028,7 +1017,7 @@ const
     ),(
       idtok:_REGISTER;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifndef TP}@{$endif}pd_register;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_register;
       pocall   : [pocall_register];
       pooption : [];
       mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_internproc];
@@ -1037,7 +1026,7 @@ const
     ),(
       idtok:_REINTRODUCE;
       pd_flags : pd_interface+pd_object;
-      handler  : {$ifndef TP}@{$endif}pd_reintroduce;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_reintroduce;
       pocall   : [];
       pooption : [];
       mutexclpocall : [];
@@ -1046,7 +1035,7 @@ const
     ),(
       idtok:_SAFECALL;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifndef TP}@{$endif}pd_safecall;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_safecall;
       pocall   : [pocall_safecall];
       pooption : [po_savestdregs];
       mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_internproc,pocall_inline];
@@ -1064,7 +1053,7 @@ const
     ),(
       idtok:_STATIC;
       pd_flags : pd_interface+pd_object;
-      handler  : {$ifndef TP}@{$endif}pd_static;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_static;
       pocall   : [];
       pooption : [po_staticmethod];
       mutexclpocall : [pocall_inline,pocall_internproc];
@@ -1073,7 +1062,7 @@ const
     ),(
       idtok:_STDCALL;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifndef TP}@{$endif}pd_stdcall;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_stdcall;
       pocall   : [pocall_stdcall];
       pooption : [po_savestdregs];
       mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_inline,pocall_internproc];
@@ -1082,7 +1071,7 @@ const
     ),(
       idtok:_SYSCALL;
       pd_flags : pd_interface;
-      handler  : {$ifndef TP}@{$endif}pd_syscall;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_syscall;
       pocall   : [pocall_palmossyscall];
       pooption : [];
       mutexclpocall : [pocall_cdecl,pocall_inline,pocall_internproc];
@@ -1091,7 +1080,7 @@ const
     ),(
       idtok:_SYSTEM;
       pd_flags : pd_implemen;
-      handler  : {$ifndef TP}@{$endif}pd_system;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_system;
       pocall   : [pocall_clearstack];
       pooption : [];
       mutexclpocall : [pocall_leftright,pocall_inline,pocall_internproc];
@@ -1100,7 +1089,7 @@ const
     ),(
       idtok:_VIRTUAL;
       pd_flags : pd_interface+pd_object;
-      handler  : {$ifndef TP}@{$endif}pd_virtual;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
       pocall   : [];
       pooption : [po_virtualmethod];
       mutexclpocall : [pocall_inline,pocall_internproc];
@@ -1865,7 +1854,7 @@ begin
     Message(parser_e_self_in_non_message_handler);
 end;
 
-procedure checkvaluepara(p:pnamedindexobject);{$ifndef FPC}far;{$endif}
+procedure checkvaluepara(p:pnamedindexobject);
 var
   vs : pvarsym;
   s  : string;
@@ -2029,7 +2018,7 @@ begin
      the parameter and insert a copy in the localst. This is not done
      for assembler procedures }
    if (not parse_only) and (not aktprocsym^.definition^.forwarddef) then
-     aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}checkvaluepara);
+     aktprocsym^.definition^.parast^.foreach({$ifdef FPCPROCVAR}@{$endif}checkvaluepara);
 
 { restore file pos }
    aktfilepos:=oldfilepos;
@@ -2081,10 +2070,12 @@ begin
 end;
 
 end.
-
 {
   $Log$
-  Revision 1.12  2000-09-10 20:11:07  peter
+  Revision 1.13  2000-09-24 15:06:24  peter
+    * use defines.inc
+
+  Revision 1.12  2000/09/10 20:11:07  peter
     * overload checking in implementation removed (merged)
 
   Revision 1.11  2000/09/04 20:15:19  peter

compiler/psystem.pas

@@ -21,8 +21,12 @@
  ****************************************************************************
 }
 unit psystem;
+
+{$i defines.inc}
+
 interface
-uses symtable;
+uses
+  symtable;
 
 procedure insertinternsyms(p : psymtable);
 procedure insert_intern_types(p : psymtable);
@@ -30,6 +34,7 @@ procedure insert_intern_types(p : psymtable);
 procedure readconstdefs;
 procedure createconstdefs;
 
+
 implementation
 
 uses
@@ -250,7 +255,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 20:19:39  peter
+  Revision 1.5  2000-09-24 15:06:24  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 20:19:39  peter
     * store strings with case in ppu, when an internal symbol is created
       a '$' is prefixed so it's not automatic uppercased
 
@@ -260,4 +268,4 @@ end.
   Revision 1.2  2000/07/13 11:32:47  michael
   + removed logs
 
-}
+}

compiler/ptconst.pas

@@ -22,7 +22,9 @@
 }
 unit ptconst;
 
-  interface
+{$i defines.inc}
+
+interface
 
    uses symtable;
 
@@ -31,7 +33,7 @@ unit ptconst;
     { the assembler label is in the middle (PM) }
     procedure readtypedconst(def : pdef;sym : ptypedconstsym;no_change_allowed : boolean);
 
-  implementation
+implementation
 
     uses
 {$ifdef Delphi}
@@ -57,7 +59,7 @@ unit ptconst;
 
 
 {$ifdef fpc}
-{$maxfpuregisters 0}
+  {$maxfpuregisters 0}
 {$endif fpc}
     { this procedure reads typed constants }
     procedure readtypedconst(def : pdef;sym : ptypedconstsym;no_change_allowed : boolean);
@@ -541,15 +543,7 @@ unit ptconst;
                        len:=255
                       else
                        len:=p^.length;
-                      {$ifndef TP}
-                        {$ifopt H+}
-                          setlength(s,len);
-                        {$else}
-                          s[0]:=chr(len);
-                        {$endif}
-                      {$else}
-                        s[0]:=chr(len);
-                      {$endif}
+                      s[0]:=chr(len);
                       move(p^.value_str^,s[1],len);
                     end
                    else
@@ -803,13 +797,16 @@ unit ptconst;
          end;
       end;
 {$ifdef fpc}
-{$maxfpuregisters default}
+  {$maxfpuregisters default}
 {$endif fpc}
 
 end.
 {
   $Log$
-  Revision 1.6  2000-08-27 16:11:52  peter
+  Revision 1.7  2000-09-24 15:06:25  peter
+    * use defines.inc
+
+  Revision 1.6  2000/08/27 16:11:52  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 
@@ -825,4 +822,4 @@ end.
   Revision 1.2  2000/07/13 11:32:47  michael
   + removed logs
 
-}
+}

compiler/ptype.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit ptype;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -49,15 +52,9 @@ uses
 
     { reads a string, file type or a type id and returns a name and }
     { pdef }
-{$IFDEF NEWST}
-    procedure single_type(var tt:Tdef;var s : string;isforwarddef:boolean);
-
-    procedure read_type(var tt:Tdef;const name : stringid);
-{$ELSE}
     procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
 
     procedure read_type(var tt:ttype;const name : stringid);
-{$ENDIF NEWST}
 
 
 implementation
@@ -1602,7 +1599,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.8  2000-08-27 20:19:39  peter
+  Revision 1.9  2000-09-24 15:06:25  peter
+    * use defines.inc
+
+  Revision 1.8  2000/08/27 20:19:39  peter
     * store strings with case in ppu, when an internal symbol is created
       a '$' is prefixed so it's not automatic uppercased
 

compiler/ra386.pas

@@ -20,7 +20,10 @@
 
  ****************************************************************************
 }
-Unit Ra386;
+unit Ra386;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -453,7 +456,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-09-16 12:22:52  peter
+  Revision 1.5  2000-09-24 15:06:25  peter
+    * use defines.inc
+
+  Revision 1.4  2000/09/16 12:22:52  peter
     * freebsd support merged
 
   Revision 1.3  2000/09/03 11:44:00  peter

compiler/ra386att.pas

@@ -20,10 +20,10 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$N+,E+}
-{$endif TP}
 Unit Ra386att;
+
+{$i defines.inc}
+
 Interface
 
 uses
@@ -2086,13 +2086,13 @@ end;
 var
   old_exit : pointer;
 
-procedure ra386att_exit;{$ifndef FPC}far;{$endif}
+procedure ra386att_exit;
 begin
+  exitproc:=old_exit;
   if assigned(iasmops) then
     dispose(iasmops,done);
   if assigned(iasmregs) then
     dispose(iasmregs);
-  exitproc:=old_exit;
 end;
 
 
@@ -2102,7 +2102,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-08-27 16:11:52  peter
+  Revision 1.4  2000-09-24 15:06:26  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/27 16:11:52  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/ra386dir.pas

@@ -22,7 +22,9 @@
 }
 unit Ra386dir;
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
       tree;
@@ -58,15 +60,7 @@ unit Ra386dir;
            i:=length(s);
            while (i>0) and (s[i] in [' ',#9]) do
             dec(i);
-           {$ifndef TP}
-             {$ifopt H+}
-               setlength(s,i);
-             {$else}
-               s[0]:=chr(i);
-             {$endif}
-           {$else}
-             s[0]:=chr(i);
-           {$endif}
+           s[0]:=chr(i);
            if s<>'' then
             code^.concat(new(pai_direct,init(strpnew(s))));
             { consider it set function set if the offset was loaded }
@@ -107,15 +101,7 @@ unit Ra386dir;
                            hs[i]:=c;
                            c:=current_scanner^.asmgetchar;
                         end;
-                      {$ifndef TP}
-                        {$ifopt H+}
-                          setlength(hs,i);
-                        {$else}
-                          hs[0]:=chr(i);
-                        {$endif}
-                      {$else}
-                         hs[0]:=chr(i);
-                      {$endif}
+                      hs[0]:=chr(i);
                       if upper(hs)='END' then
                          ende:=true
                       else
@@ -276,15 +262,7 @@ unit Ra386dir;
              else
                begin
                  current_scanner^.gettokenpos;
-                 {$ifndef TP}
-                   {$ifopt H+}
-                     setlength(s,length(s)+1);
-                   {$else}
-                     inc(byte(s[0]));
-                   {$endif}
-                 {$else}
-                    inc(byte(s[0]));
-                 {$endif}
+                 inc(byte(s[0]));
                  s[length(s)]:=c;
                  c:=current_scanner^.asmgetchar;
                end;
@@ -297,7 +275,10 @@ unit Ra386dir;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-27 16:11:52  peter
+  Revision 1.4  2000-09-24 15:06:26  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/27 16:11:52  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/ra386int.pas

@@ -20,17 +20,16 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$E+,N+}
-{$endif}
 Unit Ra386int;
+
+{$i defines.inc}
+
 Interface
 
 uses
   tree;
 
-   function assemble: ptree;
-
+function assemble: ptree;
 
 
 Implementation
@@ -1890,13 +1889,13 @@ end;
 var
   old_exit : pointer;
 
-procedure ra386int_exit;{$ifndef FPC}far;{$endif}
+procedure ra386int_exit;
 begin
+  exitproc:=old_exit;
   if assigned(iasmops) then
     dispose(iasmops,done);
   if assigned(iasmregs) then
     dispose(iasmregs);
-  exitproc:=old_exit;
 end;
 
 
@@ -1906,7 +1905,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:52  peter
+  Revision 1.6  2000-09-24 15:06:26  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:52  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/rautils.pas

@@ -21,6 +21,9 @@
 
  **********************************************************************}
 Unit RAUtils;
+
+{$i defines.inc}
+
 Interface
 
 Uses
@@ -144,12 +147,12 @@ type
      Constructor Init;
      Destructor Done;
      Function Evaluate(Expr:  String): longint;
-     Function Priority(_Operator: Char): Integer; virtual;
+     Function Priority(_Operator: Char): longint; virtual;
     private
      RPNStack   : Array[1..RPNMax] of longint;        { Stack For RPN calculator }
-     RPNTop     : Integer;
+     RPNTop     : longint;
      OpStack    : Array[1..OpMax] of TExprOperator;    { Operator stack For conversion }
-     OpTop      : Integer;
+     OpTop      : longint;
      Procedure RPNPush(Num: Longint);
      Function RPNPop: Longint;
      Procedure RPNCalc(token: String15; prefix: boolean);
@@ -373,7 +376,7 @@ begin
 end;
 
 
-Function TExprParse.Priority(_Operator : Char) : Integer;
+Function TExprParse.Priority(_Operator : Char) : longint;
 { Return priority of operator }
 { The greater the priority, the higher the precedence }
 begin
@@ -394,7 +397,7 @@ end;
 
 Function TExprParse.Evaluate(Expr : String):longint;
 Var
-  I     : Integer;
+  I     : LongInt;
   Token : String15;
   opr   : TExprOperator;
 begin
@@ -981,7 +984,6 @@ end;
 
 { looks for internal names of variables and routines }
 Function TOperand.SetupDirectVar(const hs:string): Boolean;
-{$ifndef OLDDIRECTVAR}
 var
   p : pasmsymbol;
 begin
@@ -994,37 +996,7 @@ begin
      SetupDirectVar:=true;
    end;
 end;
-{$else}
-var
-  p : pai_external;
-Begin
-   SearchDirectVar:=false;
-   { search in the list of internals }
-   p:=search_assembler_symbol(internals,hs,EXT_ANY);
-     if p=nil then
-       p:=search_assembler_symbol(externals,hs,EXT_ANY);
-   if p<>nil then
-     begin
-       instr.operands[operandnum].opr.ref.symbol:=p^.sym;
-        case p^.exttyp of
-           EXT_BYTE   : instr.operands[operandnum].size:=S_B;
-           EXT_WORD   : instr.operands[operandnum].size:=S_W;
-           EXT_NEAR,EXT_FAR,EXT_PROC,EXT_DWORD,EXT_CODEPTR,EXT_DATAPTR:
-           instr.operands[operandnum].size:=S_L;
-           EXT_QWORD  : instr.operands[operandnum].size:=S_FL;
-           EXT_TBYTE  : instr.operands[operandnum].size:=S_FX;
-         else
-           { this is in the case where the instruction is LEA }
-           { or something like that, in that case size is not }
-           { important.                                       }
-             instr.operands[operandnum].size:=S_NO;
-         end;
-       instr.operands[operandnum].hasvar:=true;
-       SearchDirectVar:=TRUE;
-       Exit;
-     end;
-end;
-{$endif}
+
 
 procedure TOperand.InitRef;
 {*********************************************************************}
@@ -1146,7 +1118,7 @@ end;
                              TLocalLabelList
 ***************************************************************************}
 
-procedure LocalLabelEmitted(p:PNamedIndexObject);{$ifndef FPC}far;{$endif}
+procedure LocalLabelEmitted(p:PNamedIndexObject);
 begin
   if not PLocalLabel(p)^.emitted  then
    Message1(asmr_e_unknown_label_identifier,p^.name);
@@ -1154,7 +1126,7 @@ end;
 
 procedure TLocalLabelList.CheckEmitted;
 begin
-  ForEach({$ifndef TP}@{$endif}LocalLabelEmitted)
+  ForEach({$ifdef FPCPROCVAR}@{$endif}LocalLabelEmitted)
 end;
 
 
@@ -1566,7 +1538,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 16:11:52  peter
+  Revision 1.5  2000-09-24 15:06:26  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:52  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/regvars.pas

@@ -20,12 +20,10 @@
 
  ****************************************************************************
 }
-{$ifdef TP}
-  {$E+,F+,N+}
-{$endif}
-
 unit regvars;
 
+{$i defines.inc}
+
 interface
 
 uses aasm, tree;
@@ -42,7 +40,9 @@ implementation
      symconst,symtable,types,
      hcodegen,temp_gen,cpubase,cpuasm
 {$ifndef newcg}
+   {$ifndef CG11}
      ,tcflw
+   {$endif}
 {$endif newcg}
 {$ifdef GDB}
      ,gdb
@@ -183,10 +183,10 @@ implementation
           if (p^.registers32<4) then
             begin
               parasym:=false;
-              symtablestack^.foreach({$ifndef TP}@{$endif}searchregvars);
+              symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
               { copy parameter into a register ? }
               parasym:=true;
-              symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
+              symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
               { hold needed registers free }
               for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
                 begin
@@ -255,11 +255,11 @@ implementation
             if ((p^.registersfpu+1)<maxfpuvarregs) then
               begin
                 parasym:=false;
-                symtablestack^.foreach({$ifndef TP}@{$endif}searchfpuregvars);
+                symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchfpuregvars);
 {$ifdef dummy}
                 { copy parameter into a register ? }
                 parasym:=true;
-                symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
+                symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
 {$endif dummy}
                 { hold needed registers free }
 
@@ -441,7 +441,10 @@ end.
 
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:52  peter
+  Revision 1.6  2000-09-24 15:06:27  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:52  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/scandir.inc

@@ -205,15 +205,7 @@ const
                                end
                              else
                                len:=mac^.buflen;
-                             {$ifndef TP}
-                               {$ifopt H+}
-                                 setlength(hs,len);
-                               {$else}
-                                 hs[0]:=char(len);
-                               {$endif}
-                             {$else}
-                               hs[0]:=char(len);
-                             {$endif}
+                             hs[0]:=char(len);
                              move(mac^.buftext^,hs[1],len);
                           end
                         else
@@ -765,13 +757,13 @@ const
                      dllminor:=minor;
                      dllrevision:=revision;
                      dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
-                  end 
+                  end
                 else
-                  begin                
+                  begin
                      dllmajor:=major;
                      dllminor:=minor;
                      dllversion:=tostr(major)+'.'+tostr(minor);
-                  end; 
+                  end;
               end
             else
               dllversion:=tostr(major);
@@ -1442,11 +1434,7 @@ const
             if t<>_DIR_NONE then
              begin
                p:=directiveproc[t];
-             {$ifndef TP}
-               if assigned(p) then
-             {$else}
-               if @p<>nil then
-             {$endif}
+               if {$ifndef FPCPROCVAR}@{$endif}p<>nil then
                 p(t);
              end
             else
@@ -1464,7 +1452,10 @@ const
 
 {
   $Log$
-  Revision 1.6  2000-09-11 17:00:23  florian
+  Revision 1.7  2000-09-24 15:06:27  peter
+    * use defines.inc
+
+  Revision 1.6  2000/09/11 17:00:23  florian
     + first implementation of Netware Module support, thanks to
       Armin Diehl ([email protected]) for providing the patches
 

compiler/scanner.pas

@@ -20,15 +20,11 @@
 
  ****************************************************************************
 }
-{$ifdef tp}
-  {$F+,N+,E+,R-}
-{$endif}
 unit scanner;
-{$ifdef FPC}
-  {$goto on}
-{$endif FPC}
 
-  interface
+{$i defines.inc}
+
+interface
 
     uses
 {$ifdef Delphi}
@@ -38,13 +34,8 @@ unit scanner;
        cobjects,globals,verbose,comphook,finput;
 
     const
-{$ifdef TP}
-       maxmacrolen=1024;
-       preprocbufsize=1024;
-{$else}
        maxmacrolen=16*1024;
        preprocbufsize=32*1024;
-{$endif}
        Newline = #10;
 
 
@@ -723,18 +714,8 @@ implementation
            break;
           end;
         until false;
-        {$ifndef TP}
-          {$ifopt H+}
-            setlength(orgpattern,i);
-            setlength(pattern,i);
-          {$else}
-            orgpattern[0]:=chr(i);
-            pattern[0]:=chr(i);
-          {$endif}
-        {$else}
-          orgpattern[0]:=chr(i);
-          pattern[0]:=chr(i);
-        {$endif}
+        orgpattern[0]:=chr(i);
+        pattern[0]:=chr(i);
       end;
 
 
@@ -784,15 +765,7 @@ implementation
          #10,
          #13 : linebreak;
         end;
-        {$ifndef TP}
-          {$ifopt H+}
-            setlength(pattern,i);
-          {$else}
-            pattern[0]:=chr(i);
-          {$endif}
-        {$else}
-          pattern[0]:=chr(i);
-        {$endif}
+        pattern[0]:=chr(i);
       end;
 
 
@@ -885,15 +858,7 @@ implementation
           if c in [#10,#13] then
            linebreak;
         until false;
-        {$ifndef TP}
-          {$ifopt H+}
-            setlength(readcomment,i);
-          {$else}
-            readcomment[0]:=chr(i);
-          {$endif}
-        {$else}
-          readcomment[0]:=chr(i);
-        {$endif}
+        readcomment[0]:=chr(i);
       end;
 
 
@@ -1835,7 +1800,10 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:53  peter
+  Revision 1.6  2000-09-24 15:06:28  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:53  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/script.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit Script;
+
+{$i defines.inc}
+
 interface
 
 uses
@@ -142,12 +145,12 @@ end;
 
 Procedure TAsmScript.AddAsmCommand (Const Command, Options,FileName : String);
 begin
-  {$ifdef linux}
+{$ifdef linux}
   if FileName<>'' then
    Add('echo Assembling '+FileName);
   Add (Command+' '+Options);
   Add('if [ $? != 0 ]; then DoExitAsm '+FileName+'; fi');
-  {$else}
+{$else}
   if FileName<>'' then
    begin
      Add('SET THEFILE='+FileName);
@@ -155,18 +158,18 @@ begin
    end;
   Add(command+' '+Options);
   Add('if errorlevel 1 goto asmend');
-  {$endif}
+{$endif}
 end;
 
 
 Procedure TasmScript.AddLinkCommand (Const Command, Options, FileName : String);
 begin
-  {$ifdef linux}
+{$ifdef linux}
   if FileName<>'' then
    Add('echo Linking '+FileName);
   Add (Command+' '+Options);
   Add('if [ $? != 0 ]; then DoExitLink '+FileName+'; fi');
-  {$else}
+{$else}
   if FileName<>'' then
    begin
      Add('SET THEFILE='+FileName);
@@ -174,17 +177,17 @@ begin
    end;
   Add (Command+' '+Options);
   Add('if errorlevel 1 goto linkend');
-  {$endif}
+{$endif}
 end;
 
 
 Procedure TAsmScript.AddDeleteCommand (Const FileName : String);
 begin
- {$ifdef linux}
- Add('rm '+FileName);
- {$else}
- Add('Del '+FileName);
- {$endif}
+{$ifdef linux}
+  Add('rm '+FileName);
+{$else}
+  Add('Del '+FileName);
+{$endif}
 end;
 
 
@@ -234,7 +237,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:49  michael
+  Revision 1.3  2000-09-24 15:06:28  peter
+    * use defines.inc
+
+  Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
 
 }

compiler/switches.pas

@@ -21,6 +21,9 @@
  ****************************************************************************
 }
 unit switches;
+
+{$i defines.inc}
+
 interface
 
 procedure HandleSwitch(switch,state:char);
@@ -174,7 +177,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-09-21 11:30:49  jonas
+  Revision 1.5  2000-09-24 15:06:28  peter
+    * use defines.inc
+
+  Revision 1.4  2000/09/21 11:30:49  jonas
     + support for full boolean evaluation (b+/b-), default remains short
       circuit boolean evaluation
 

compiler/symconst.pas

@@ -20,13 +20,10 @@
  ****************************************************************************
 }
 unit symconst;
-interface
 
-{$ifdef FPC}
-  {$ifdef PACKENUMFIXED}
-    {$PACKENUM 1}
-  {$endif}
-{$endif}
+{$i defines.inc}
+
+interface
 
 const
   def_alignment = 4;
@@ -283,7 +280,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-08-21 11:27:44  pierre
+  Revision 1.7  2000-09-24 15:06:28  peter
+    * use defines.inc
+
+  Revision 1.6  2000/08/21 11:27:44  pierre
    * fix the stabs problems
 
   Revision 1.5  2000/08/06 19:39:28  peter

compiler/symdef.inc

@@ -2084,7 +2084,7 @@
          { procedure of needs_rtti !                         }
          oldb:=binittable;
          binittable:=false;
-         symtable^.foreach({$ifndef TP}@{$endif}check_rec_inittable);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}check_rec_inittable);
          needs_inittable:=binittable;
          binittable:=oldb;
       end;
@@ -2213,7 +2213,7 @@
         stabrecsize:=memsizeinc;
         strpcopy(stabRecString,'s'+tostr(size));
         RecOffset := 0;
-        symtable^.foreach({$ifndef TP}@{$endif}addname);
+        symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}addname);
         { FPC doesn't want to convert a char to a pchar}
         { is this a bug ? }
         strpcopy(strend(StabRecString),';');
@@ -2236,7 +2236,7 @@
     var
        count : longint;
 
-    procedure count_inittable_fields(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
+    procedure count_inittable_fields(sym : pnamedindexobject);
       begin
          if ((psym(sym)^.typ=varsym) and
             pvarsym(sym)^.vartype.def^.needs_inittable)
@@ -2246,13 +2246,13 @@
       end;
 
 
-    procedure count_fields(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
+    procedure count_fields(sym : pnamedindexobject);
       begin
             inc(count);
       end;
 
 
-    procedure write_field_inittable(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
+    procedure write_field_inittable(sym : pnamedindexobject);
       begin
          if ((psym(sym)^.typ=varsym) and
             pvarsym(sym)^.vartype.def^.needs_inittable) and
@@ -2265,14 +2265,14 @@
       end;
 
 
-    procedure write_field_rtti(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
+    procedure write_field_rtti(sym : pnamedindexobject);
       begin
          rttilist^.concat(new(pai_const_symbol,initname(pvarsym(sym)^.vartype.def^.get_rtti_label)));
          rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
       end;
 
 
-    procedure generate_child_inittable(sym:pnamedindexobject);{$ifndef fpc}far;{$endif}
+    procedure generate_child_inittable(sym:pnamedindexobject);
       begin
          if (psym(sym)^.typ=varsym) and
             pvarsym(sym)^.vartype.def^.needs_inittable then
@@ -2281,7 +2281,7 @@
       end;
 
 
-    procedure generate_child_rtti(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
+    procedure generate_child_rtti(sym : pnamedindexobject);
       begin
          pvarsym(sym)^.vartype.def^.get_rtti_label;
       end;
@@ -2289,13 +2289,13 @@
 
     procedure trecorddef.write_child_rtti_data;
       begin
-         symtable^.foreach({$ifndef TP}@{$endif}generate_child_rtti);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}generate_child_rtti);
       end;
 
 
     procedure trecorddef.write_child_init_data;
       begin
-         symtable^.foreach({$ifndef TP}@{$endif}generate_child_inittable);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}generate_child_inittable);
       end;
 
 
@@ -2305,9 +2305,9 @@
          write_rtti_name;
          rttilist^.concat(new(pai_const,init_32bit(size)));
          count:=0;
-         symtable^.foreach({$ifndef TP}@{$endif}count_fields);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_fields);
          rttilist^.concat(new(pai_const,init_32bit(count)));
-         symtable^.foreach({$ifndef TP}@{$endif}write_field_rtti);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}write_field_rtti);
       end;
 
 
@@ -2317,9 +2317,9 @@
          write_rtti_name;
          rttilist^.concat(new(pai_const,init_32bit(size)));
          count:=0;
-         symtable^.foreach({$ifndef TP}@{$endif}count_inittable_fields);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_inittable_fields);
          rttilist^.concat(new(pai_const,init_32bit(count)));
-         symtable^.foreach({$ifndef TP}@{$endif}write_field_inittable);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}write_field_inittable);
       end;
 
     function trecorddef.gettypename : string;
@@ -2654,8 +2654,6 @@
 
 
     constructor tprocdef.load;
-      var
-         s : string;
       begin
          inherited load;
          deftype:=procdef;
@@ -2670,8 +2668,7 @@
          usedregisters:=readword;
 {$endif}
 {$endif newcg}
-         s:=readstring;
-         setstring(_mangledname,s);
+         _mangledname:=stringdup(readstring);
 
          extnumber:=readlong;
          nextoverloaded:=pprocdef(readdefref);
@@ -2878,12 +2875,8 @@ Const local_symtable_index : longint = $8001;
            dispose(pregvarinfo(regvarinfo));
          if (po_msgstr in procoptions) then
            strdispose(messageinf.str);
-         if
-{$ifdef tp}
-         not(use_big) and
-{$endif}
-           assigned(_mangledname) then
-           strdispose(_mangledname);
+         if assigned(_mangledname) then
+           stringdispose(_mangledname);
          inherited done;
       end;
 
@@ -2998,7 +2991,7 @@ Const local_symtable_index : longint = $8001;
         strpcopy(strend(StabRecString),','+tostr(i)+';');
         (* confuse gdb !! PM
         if assigned(parast) then
-          parast^.foreach({$ifndef TP}@{$endif}addparaname)
+          parast^.foreach({$ifdef FPCPROCVAR}@{$endif}addparaname)
           else
           begin
           param := para1;
@@ -3050,27 +3043,11 @@ Const local_symtable_index : longint = $8001;
 
 
     function tprocdef.mangledname : string;
-{$ifdef tp}
-      var
-         oldpos : longint;
-         s : string;
-         b : byte;
-{$endif tp}
-      begin
-{$ifndef Delphi}
-{$ifdef tp}
-         if use_big then
-           begin
-              symbolstream.seek(longint(_mangledname));
-              symbolstream.read(b,1);
-              symbolstream.read(s[1],b);
-              s[0]:=chr(b);
-              mangledname:=s;
-           end
+      begin
+         if assigned(_mangledname) then
+           mangledname:=_mangledname^
          else
-{$endif}
-{$endif Delphi}
-          mangledname:=strpas(_mangledname);
+           mangledname:='';
          if count then
            is_used:=true;
       end;
@@ -3173,14 +3150,14 @@ Const local_symtable_index : longint = $8001;
 
     procedure tprocdef.setmangledname(const s : string);
       begin
-         if {$ifdef tp}not(use_big) and{$endif} (assigned(_mangledname)) then
+         if assigned(_mangledname) then
            begin
 {$ifdef MEMDEBUG}
               dec(manglenamesize,length(_mangledname^));
 {$endif}
-              strdispose(_mangledname);
+              stringdispose(_mangledname);
            end;
-         setstring(_mangledname,s);
+         _mangledname:=stringdup(s);
 {$ifdef MEMDEBUG}
          inc(manglenamesize,length(s));
 {$endif}
@@ -3562,7 +3539,7 @@ Const local_symtable_index : longint = $8001;
    var
       sd : pprocdef;
 
-   procedure _searchdestructor(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
+   procedure _searchdestructor(sym : pnamedindexobject);
 
      var
         p : pprocdef;
@@ -3597,7 +3574,7 @@ Const local_symtable_index : longint = $8001;
         sd:=nil;
         while assigned(o) do
           begin
-             symtable^.foreach({$ifndef TP}@{$endif}_searchdestructor);
+             symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}_searchdestructor);
              if assigned(sd) then
                begin
                   searchdestructor:=sd;
@@ -3807,7 +3784,7 @@ Const local_symtable_index : longint = $8001;
             {virtual table to implement yet}
             RecOffset := 0;
             inc(globalnb);
-            symtable^.foreach({$ifndef TP}@{$endif}addname);
+            symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}addname);
             dec(globalnb);
             if (oo_has_vmt in objectoptions) then
               if not assigned(childof) or not(oo_has_vmt in childof^.objectoptions) then
@@ -3815,7 +3792,7 @@ Const local_symtable_index : longint = $8001;
                     strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
                       +','+tostr(vmt_offset*8)+';');
                  end;
-            symtable^.foreach({$ifndef TP}@{$endif}addprocname);
+            symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}addprocname);
             if (oo_has_vmt in objectoptions) then
               begin
                  anc := @self;
@@ -3906,7 +3883,7 @@ Const local_symtable_index : longint = $8001;
 
     procedure tobjectdef.write_child_init_data;
       begin
-         symtable^.foreach({$ifndef TP}@{$endif}generate_child_inittable);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}generate_child_inittable);
       end;
 
 
@@ -3923,9 +3900,9 @@ Const local_symtable_index : longint = $8001;
 
          rttilist^.concat(new(pai_const,init_32bit(size)));
          count:=0;
-         symtable^.foreach({$ifndef TP}@{$endif}count_inittable_fields);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_inittable_fields);
          rttilist^.concat(new(pai_const,init_32bit(count)));
-         symtable^.foreach({$ifndef TP}@{$endif}write_field_inittable);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}write_field_inittable);
       end;
 
 
@@ -3943,7 +3920,7 @@ Const local_symtable_index : longint = $8001;
               { procedure of needs_rtti !                              }
               oldb:=binittable;
               binittable:=false;
-              symtable^.foreach({$ifndef TP}@{$endif}check_rec_inittable);
+              symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}check_rec_inittable);
               needs_inittable:=binittable;
               binittable:=oldb;
            end;
@@ -3951,7 +3928,6 @@ Const local_symtable_index : longint = $8001;
 
 
     procedure count_published_properties(sym:pnamedindexobject);
-      {$ifndef fpc}far;{$endif}
       begin
          if needs_prop_entry(psym(sym)) and
           (psym(sym)^.typ<>varsym) then
@@ -3959,7 +3935,7 @@ Const local_symtable_index : longint = $8001;
       end;
 
 
-    procedure write_property_info(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
+    procedure write_property_info(sym : pnamedindexobject);
       var
          proctypesinfo : byte;
 
@@ -4063,7 +4039,7 @@ Const local_symtable_index : longint = $8001;
       end;
 
 
-    procedure generate_published_child_rtti(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
+    procedure generate_published_child_rtti(sym : pnamedindexobject);
       begin
          if needs_prop_entry(psym(sym)) then
            case psym(sym)^.typ of
@@ -4082,7 +4058,7 @@ Const local_symtable_index : longint = $8001;
 
     procedure tobjectdef.write_child_rtti_data;
       begin
-         symtable^.foreach({$ifndef TP}@{$endif}generate_published_child_rtti);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}generate_published_child_rtti);
       end;
 
 
@@ -4130,11 +4106,8 @@ Const local_symtable_index : longint = $8001;
       end;
 
     procedure count_published_fields(sym:pnamedindexobject);
-      {$ifndef fpc}far;{$endif}
-
       var
          hp : pclasslistitem;
-
       begin
          if needs_prop_entry(psym(sym)) and
           (psym(sym)^.typ=varsym) then
@@ -4155,11 +4128,8 @@ Const local_symtable_index : longint = $8001;
       end;
 
     procedure writefields(sym:pnamedindexobject);
-      {$ifndef fpc}far;{$endif}
-
       var
          hp : pclasslistitem;
-
       begin
          if needs_prop_entry(psym(sym)) and
           (psym(sym)^.typ=varsym) then
@@ -4216,7 +4186,7 @@ Const local_symtable_index : longint = $8001;
          else
            i:=0;
          count:=0;
-         symtable^.foreach({$ifndef TP}@{$endif}count_published_properties);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_published_properties);
          next_free_name_index:=i+count;
       end;
 
@@ -4248,7 +4218,7 @@ Const local_symtable_index : longint = $8001;
            count:=0;
 
          { write it }
-         symtable^.foreach({$ifndef TP}@{$endif}count_published_properties);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_published_properties);
          rttilist^.concat(new(pai_const,init_16bit(count)));
 
          { write unit name }
@@ -4262,7 +4232,7 @@ Const local_symtable_index : longint = $8001;
 
          { write published properties count }
          count:=0;
-         symtable^.foreach({$ifndef TP}@{$endif}count_published_properties);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_published_properties);
          rttilist^.concat(new(pai_const,init_16bit(count)));
 
          { count is used to write nameindex   }
@@ -4273,7 +4243,7 @@ Const local_symtable_index : longint = $8001;
          else
            count:=0;
 
-         symtable^.foreach({$ifndef TP}@{$endif}write_property_info);
+         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}write_property_info);
       end;
 
 
@@ -4341,7 +4311,10 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.17  2000-09-19 23:08:02  pierre
+  Revision 1.18  2000-09-24 15:06:28  peter
+    * use defines.inc
+
+  Revision 1.17  2000/09/19 23:08:02  pierre
    * fixes for local class debuggging problem (merged)
 
   Revision 1.16  2000/09/10 20:13:37  peter
@@ -4402,4 +4375,4 @@ Const local_symtable_index : longint = $8001;
   Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
 
-}
+}

compiler/symdefh.inc

@@ -406,7 +406,7 @@
 
        tprocdef = object(tabstractprocdef)
        private
-          _mangledname : pchar;
+          _mangledname : pstring;
        public
           extnumber  : longint;
           messageinf : tmessageinf;
@@ -554,7 +554,10 @@
 
 {
   $Log$
-  Revision 1.9  2000-09-19 23:08:03  pierre
+  Revision 1.10  2000-09-24 15:06:29  peter
+    * use defines.inc
+
+  Revision 1.9  2000/09/19 23:08:03  pierre
    * fixes for local class debuggging problem (merged)
 
   Revision 1.8  2000/08/21 11:27:44  pierre
@@ -585,4 +588,4 @@
   Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
 
-}
+}

compiler/symtable.pas

@@ -19,27 +19,26 @@
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  ****************************************************************************
 }
-{$ifdef TP}
-  {$N+,E+,F+,L-}
-{$endif}
 unit symtable;
 
-  interface
+{$i defines.inc}
+
+interface
 
-    uses
-{$ifdef TP}
-{$ifndef Delphi}
-       objects,
-{$endif Delphi}
+uses
+{$ifdef delphi}
+   sysutils,
+{$else}
+   strings,
 {$endif}
-       strings,cutils,cobjects,
-       globtype,globals,tokens,systems,
-       symconst,
-       aasm,cpubase,cpuinfo
+   cutils,cobjects,
+   globtype,globals,tokens,systems,
+   symconst,
+   aasm,cpubase,cpuinfo
 {$ifdef GDB}
-       ,gdb
+   ,gdb
 {$endif}
-       ;
+   ;
 
 {************************************************
            Some internal constants
@@ -47,12 +46,7 @@ unit symtable;
 
    const
        hasharraysize    = 256;
-  {$ifdef TP}
-       indexgrowsize    = 16;
-  {$else}
        indexgrowsize    = 64;
-  {$endif}
-
 
 {************************************************
             Needed forward pointers
@@ -500,15 +494,6 @@ implementation
 {$ifdef GDB}
      asmoutput : paasmoutput;
 {$endif GDB}
-{$ifdef TP}
-{$ifndef Delphi}
-   {$ifndef dpmi}
-       symbolstream : temsstream;  { stream which is used to store some info }
-   {$else}
-       symbolstream : tmemorystream;
-   {$endif}
-{$endif Delphi}
-{$endif}
 
    {to dispose the global symtable of a unit }
   const
@@ -528,47 +513,6 @@ implementation
                              Helper Routines
 *****************************************************************************}
 
-{$ifdef unused}
-    function demangledparas(s : string) : string;
-      var
-         r : string;
-         l : longint;
-      begin
-         demangledparas:='';
-         r:=',';
-         { delete leading $$'s }
-         l:=pos('$$',s);
-         while l<>0 do
-           begin
-              delete(s,1,l+1);
-              l:=pos('$$',s);
-           end;
-         { delete leading _$'s }
-         l:=pos('_$',s);
-         while l<>0 do
-           begin
-              delete(s,1,l+1);
-              l:=pos('_$',s);
-           end;
-         l:=pos('$',s);
-         if l=0 then
-           exit;
-         delete(s,1,l);
-         while s<>'' do
-          begin
-            l:=pos('$',s);
-            if l=0 then
-             l:=length(s)+1;
-            r:=r+copy(s,1,l-1)+',';
-            delete(s,1,l);
-          end;
-         delete(r,1,1);
-         delete(r,length(r),1);
-         demangledparas:=r;
-      end;
-{$endif}
-
-
     procedure numberunits;
       var
         counter : longint;
@@ -626,24 +570,6 @@ implementation
       end;
 
 
-   procedure setstring(var p : pchar;const s : string);
-     begin
-{$ifndef Delphi}
-{$ifdef TP}
-
-       if use_big then
-        begin
-          p:=pchar(symbolstream.getsize);
-          symbolstream.seek(longint(p));
-          symbolstream.writestr(@s);
-        end
-       else
-{$endif TP}
-{$endif Delphi}
-        p:=strpnew(s);
-     end;
-
-
      procedure duplicatesym(sym:psym);
        var
          st : psymtable;
@@ -1196,7 +1122,7 @@ implementation
             (ptypesym(p)^.restype.def^.deftype=objectdef) and
             (ptypesym(p)^.restype.def^.typesym=ptypesym(p)) then
            pobjectdef(ptypesym(p)^.restype.def)^.symtable^.foreach(
-             {$ifndef TP}@{$endif}TestPrivate);
+             {$ifdef FPCPROCVAR}@{$endif}TestPrivate);
       end;
 
 {$ifdef GDB}
@@ -1818,7 +1744,7 @@ implementation
              end;
          end;
        { order procsym overloads }
-         foreach({$ifndef TP}@{$endif}Order_overloads);
+         foreach({$ifdef FPCPROCVAR}@{$endif}Order_overloads);
          { write definitions }
          writedefs;
          { write symbols }
@@ -2192,7 +2118,7 @@ implementation
               aktlocalsymtable:=@self;
            end;
          current_ppu^.writeentry(ibbeginsymtablebrowser);
-         foreach({$ifndef TP}@{$endif}write_refs);
+         foreach({$ifdef FPCPROCVAR}@{$endif}write_refs);
          current_ppu^.writeentry(ibendsymtablebrowser);
         if symtabletype in [recordsymtable,objectsymtable] then
           aktrecordsymtable:=oldrecsyms;
@@ -2217,7 +2143,7 @@ implementation
                   Browserlog.AddLog('---Symtable with no name');
              end;
            Browserlog.Ident;
-           foreach({$ifndef TP}@{$endif}add_to_browserlog);
+           foreach({$ifdef FPCPROCVAR}@{$endif}add_to_browserlog);
            browserlog.Unident;
          end;
       end;
@@ -2231,12 +2157,12 @@ implementation
     { checks, if all procsyms and methods are defined }
     procedure tsymtable.check_forwards;
       begin
-         foreach({$ifndef TP}@{$endif}check_forward);
+         foreach({$ifdef FPCPROCVAR}@{$endif}check_forward);
       end;
 
     procedure tsymtable.checklabels;
       begin
-         foreach({$ifndef TP}@{$endif}labeldefined);
+         foreach({$ifdef FPCPROCVAR}@{$endif}labeldefined);
       end;
 
     procedure tsymtable.set_alignment(_alignment : longint);
@@ -2282,23 +2208,23 @@ implementation
 
     procedure tsymtable.allunitsused;
       begin
-         foreach({$ifndef TP}@{$endif}unitsymbolused);
+         foreach({$ifdef FPCPROCVAR}@{$endif}unitsymbolused);
       end;
 
     procedure tsymtable.allsymbolsused;
       begin
-         foreach({$ifndef TP}@{$endif}varsymbolused);
+         foreach({$ifdef FPCPROCVAR}@{$endif}varsymbolused);
       end;
 
     procedure tsymtable.allprivatesused;
       begin
-         foreach({$ifndef TP}@{$endif}objectprivatesymbolused);
+         foreach({$ifdef FPCPROCVAR}@{$endif}objectprivatesymbolused);
       end;
 
 {$ifdef CHAINPROCSYMS}
     procedure tsymtable.chainprocsyms;
       begin
-         foreach({$ifndef TP}@{$endif}chainprocsym);
+         foreach({$ifdef FPCPROCVAR}@{$endif}chainprocsym);
       end;
 {$endif CHAINPROCSYMS}
 
@@ -2307,9 +2233,9 @@ implementation
       begin
         asmoutput:=asmlist;
         if symtabletype in [inlineparasymtable,inlinelocalsymtable] then
-          foreach({$ifndef TP}@{$endif}resetstab);
+          foreach({$ifdef FPCPROCVAR}@{$endif}resetstab);
 
-        foreach({$ifndef TP}@{$endif}concatstab);
+        foreach({$ifdef FPCPROCVAR}@{$endif}concatstab);
       end;
 {$endif}
 
@@ -2582,7 +2508,7 @@ implementation
                   end;
              end;
            asmoutput:=asmlist;
-           foreach({$ifndef TP}@{$endif}concattypestab);
+           foreach({$ifdef FPCPROCVAR}@{$endif}concattypestab);
            if cs_gdb_dbx in aktglobalswitches then
              begin
                 if (current_module^.globalsymtable<>@Self) then
@@ -2742,7 +2668,7 @@ implementation
         _defaultprop:=nil;
         while assigned(pd) do
           begin
-             pd^.symtable^.foreach({$ifndef TP}@{$endif}testfordefaultproperty);
+             pd^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}testfordefaultproperty);
              if assigned(_defaultprop) then
                break;
              pd:=pd^.childof;
@@ -2910,42 +2836,10 @@ implementation
                            Init/Done Symtable
 ****************************************************************************}
 
-{$ifndef Delphi}
-{$ifdef tp}
-   procedure do_streamerror;
-     begin
-       if symbolstream.status=-2 then
-        WriteLn('Error: Not enough EMS memory')
-       else
-        WriteLn('Error: EMS Error ',symbolstream.status);
-       halt(1);
-     end;
-{$endif TP}
-{$endif Delphi}
-
    procedure InitSymtable;
      var
        token : ttoken;
      begin
-{$ifndef Delphi}
-{$ifdef TP}
-     { Allocate stream }
-        if use_big then
-         begin
-           streamerror:=@do_streamerror;
-         { symbolstream.init('TMPFILE',stcreate,16000); }
-         {$ifndef dpmi}
-           symbolstream.init(10000,4000000); {using ems streams}
-         {$else}
-           symbolstream.init(1000000,16000); {using memory streams}
-         {$endif}
-           if symbolstream.errorinfo=stiniterror then
-            do_streamerror;
-         { write something, because pos 0 means nil pointer }
-           symbolstream.writestr(@inputfile);
-         end;
-{$endif tp}
-{$endif Delphi}
       { Reset symbolstack }
         registerdef:=false;
         read_member:=false;
@@ -2976,13 +2870,6 @@ implementation
 {$ifdef UNITALIASES}
         dispose(unitaliases,done);
 {$endif}
-{$ifndef Delphi}
-{$ifdef TP}
-      { close the stream }
-        if use_big then
-         symbolstream.done;
-{$endif}
-{$endif Delphi}
 {$ifdef MEMDEBUG}
        writeln('Manglednames: ',manglenamesize,' bytes');
 {$endif}
@@ -2991,7 +2878,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2000-08-27 16:11:54  peter
+  Revision 1.8  2000-09-24 15:06:29  peter
+    * use defines.inc
+
+  Revision 1.7  2000/08/27 16:11:54  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 
@@ -3013,4 +2903,4 @@ end.
   Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
 
-}
+}

compiler/systems.pas

@@ -23,7 +23,9 @@
 }
 unit systems;
 
-  interface
+{$i defines.inc}
+
+interface
 
    type
        tendian = (endian_little,endian_big);
@@ -243,6 +245,9 @@ unit systems;
 
 implementation
 
+    uses
+      cutils;
+
     const
 
 {****************************************************************************
@@ -1445,47 +1450,6 @@ implementation
                                 Helpers
 ****************************************************************************}
 
-function upper(const s : string) : string;
-var
-  i  : longint;
-begin
-  for i:=1 to length(s) do
-   if s[i] in ['a'..'z'] then
-    upper[i]:=char(byte(s[i])-32)
-   else
-    upper[i]:=s[i];
-{$ifndef TP}
-  {$ifopt H+}
-    SetLength(upper,length(s));
-  {$else}
-    upper[0]:=s[0];
-  {$endif}
-{$else}
-  upper[0]:=s[0];
-{$endif}
-end;
-
-function lower(const s : string) : string;
-var
-  i : longint;
-begin
-  for i:=1 to length(s) do
-   if s[i] in ['A'..'Z'] then
-    lower[i]:=char(byte(s[i])+32)
-   else
-    lower[i]:=s[i];
-  {$ifndef TP}
-    {$ifopt H+}
-      setlength(lower,length(s));
-    {$else}
-      lower[0]:=s[0];
-    {$endif}
-  {$else}
-    lower[0]:=s[0];
-  {$endif}
-end;
-
-
 function set_target_os(t:tos):boolean;
 var
   i : longint;
@@ -1761,7 +1725,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2000-09-20 10:49:39  marco
+  Revision 1.9  2000-09-24 15:06:30  peter
+    * use defines.inc
+
+  Revision 1.8  2000/09/20 10:49:39  marco
    * Set writer to elf. (Only a prob for smart with -OG3p3r)
 
   Revision 1.7  2000/09/16 12:22:52  peter

compiler/t_freebsd.pas

@@ -1,553 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Peter Vreman (original Linux)
-              (c) 2000      by Marco van de Voort (FreeBSD mods)
-
-    This unit implements support import,export,link routines
-    for the (i386)FreeBSD target
-
-    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 t_freebsd;
-interface
-
-  uses
-    import,export,link;
-
-  type
-    pimportlibfreebsd=^timportlibfreebsd;
-    timportlibfreebsd=object(timportlib)
-      procedure preparelib(const s:string);virtual;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
-      procedure importvariable(const varname,module:string;const name:string);virtual;
-      procedure generatelib;virtual;
-    end;
-
-    pexportlibfreebsd=^texportlibfreebsd;
-    texportlibfreebsd=object(texportlib)
-      procedure preparelib(const s : string);virtual;
-      procedure exportprocedure(hp : pexported_item);virtual;
-      procedure exportvar(hp : pexported_item);virtual;
-      procedure generatelib;virtual;
-    end;
-
-    plinkerfreebsd=^tlinkerfreebsd;
-    tlinkerfreebsd=object(tlinker)
-    private
-      Glibc2,
-      Glibc21 : boolean;
-      Function  WriteResponseFile(isdll:boolean) : Boolean;
-    public
-      constructor Init;
-      procedure SetDefaultInfo;virtual;
-      function  MakeExecutable:boolean;virtual;
-      function  MakeSharedLibrary:boolean;virtual;
-    end;
-
-
-implementation
-
-  uses
-    cutils,verbose,strings,cobjects,systems,globtype,globals,
-    symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
-
-{*****************************************************************************
-                               TIMPORTLIBLINUX
-*****************************************************************************}
-
-procedure timportlibfreebsd.preparelib(const s : string);
-begin
-end;
-
-
-procedure timportlibfreebsd.importprocedure(const func,module : string;index : longint;const name : string);
-begin
-  { insert sharedlibrary }
-{$IFDEF NEWST}
-  current_module^.linkothersharedlibs.
-   insert(new(Plinkitem,init(SplitName(module),link_allways)));
-  { do nothing with the procedure, only set the mangledname }
-  if name<>'' then
-    aktprocdef^.setmangledname(name)
-  else
-    message(parser_e_empty_import_name);
-{$ELSE}
-  current_module^.linkothersharedlibs.
-   insert(SplitName(module),link_allways);
-  { do nothing with the procedure, only set the mangledname }
-  if name<>'' then
-    aktprocsym^.definition^.setmangledname(name)
-  else
-    message(parser_e_empty_import_name);
-{$ENDIF NEWST}
-end;
-
-
-procedure timportlibfreebsd.importvariable(const varname,module:string;const name:string);
-begin
-  { insert sharedlibrary }
-{$IFDEF NEWST}
-  current_module^.linkothersharedlibs.
-   insert(new(Plinkitem,init(SplitName(module),link_allways)));
-{$ELSE}
-  current_module^.linkothersharedlibs.
-   insert(SplitName(module),link_allways);
-{$ENDIF NEWST}
-  { reset the mangledname and turn off the dll_var option }
-  aktvarsym^.setmangledname(name);
-{$IFDEF NEWST}
-  exclude(aktvarsym^.properties,vo_is_dll_var);
-{$ELSE}
-{$ifdef INCLUDEOK}
-  exclude(aktvarsym^.varoptions,vo_is_dll_var);
-{$else}
-  aktvarsym^.varoptions:=aktvarsym^.varoptions-[vo_is_dll_var];
-{$endif}
-{$ENDIF NEWST}
-end;
-
-
-procedure timportlibfreebsd.generatelib;
-begin
-end;
-
-
-{*****************************************************************************
-                               TEXPORTLIBLINUX
-*****************************************************************************}
-
-procedure texportlibfreebsd.preparelib(const s:string);
-begin
-end;
-
-
-procedure texportlibfreebsd.exportprocedure(hp : pexported_item);
-var
-  hp2 : pexported_item;
-begin
-  { first test the index value }
-  if (hp^.options and eo_index)<>0 then
-   begin
-     Comment(V_Error,'can''t export with index under linux');
-     exit;
-   end;
-  { use pascal name is none specified }
-  if (hp^.options and eo_name)=0 then
-    begin
-       hp^.name:=stringdup(hp^.sym^.name);
-       hp^.options:=hp^.options or eo_name;
-    end;
-  { now place in correct order }
-  hp2:=pexported_item(current_module^._exports^.first);
-  while assigned(hp2) and
-     (hp^.name^>hp2^.name^) do
-    hp2:=pexported_item(hp2^.next);
-  { insert hp there !! }
-  if assigned(hp2) and (hp2^.name^=hp^.name^) then
-    begin
-      { this is not allowed !! }
-      Message1(parser_e_export_name_double,hp^.name^);
-      exit;
-    end;
-  if hp2=pexported_item(current_module^._exports^.first) then
-    current_module^._exports^.insert(hp)
-  else if assigned(hp2) then
-    begin
-       hp^.next:=hp2;
-       hp^.previous:=hp2^.previous;
-       if assigned(hp2^.previous) then
-         hp2^.previous^.next:=hp;
-       hp2^.previous:=hp;
-    end
-  else
-    current_module^._exports^.concat(hp);
-end;
-
-
-procedure texportlibfreebsd.exportvar(hp : pexported_item);
-begin
-  hp^.is_var:=true;
-  exportprocedure(hp);
-end;
-
-
-procedure texportlibfreebsd.generatelib;
-var
-  hp2 : pexported_item;
-begin
-  hp2:=pexported_item(current_module^._exports^.first);
-  while assigned(hp2) do
-   begin
-     if not hp2^.is_var then
-      begin
-{$ifdef i386}
-        { place jump in codesegment }
-        codesegment^.concat(new(pai_align,init_op(4,$90)));
-        codesegment^.concat(new(pai_symbol,initname_global(hp2^.name^,0)));
-        codesegment^.concat(new(paicpu,op_sym(A_JMP,S_NO,newasmsymbol(hp2^.sym^.mangledname))));
-        codesegment^.concat(new(pai_symbol_end,initname(hp2^.name^)));
-{$endif i386}
-      end
-     else
-      Comment(V_Error,'Exporting of variables is not supported under linux');
-     hp2:=pexported_item(hp2^.next);
-   end;
-end;
-
-
-{*****************************************************************************
-                                  TLINKERLINUX
-*****************************************************************************}
-
-Constructor TLinkerFreeBSD.Init;
-begin
-  Inherited Init;
-  LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
-end;
-
-
-procedure TLinkerFreeBSD.SetDefaultInfo;
-{
-  This will also detect which libc version will be used
-}
-begin
-  Glibc2:=false;
-  Glibc21:=false;
-  with Info do
-   begin
-     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
-     DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';
-     DllCmd[2]:='strip --strip-unneeded $EXE';
-     { first try glibc2 }
-     {$ifndef BSD} {Keep linux code in place. FBSD might go to a different
-                                glibc too once}
-     DynamicLinker:='/lib/ld-linux.so.2';
-     if FileExists(DynamicLinker) then
-      begin
-        Glibc2:=true;
-        { Check for 2.0 files, else use the glibc 2.1 stub }
-        if FileExists('/lib/ld-2.0.*') then
-         Glibc21:=false
-        else
-         Glibc21:=true;
-      end
-     else
-      DynamicLinker:='/lib/ld-linux.so.1';
-     {$ELSE}
-      DynamicLinker:='';
-     {$endif}
-   end;
-
-end;
-
-
-Function TLinkerFreeBSD.WriteResponseFile(isdll:boolean) : Boolean;
-Var
-  linkres      : TLinkRes;
-  i            : longint;
-  cprtobj,
-  gprtobj,
-  prtobj       : string[80];
-{$IFDEF NEWST}
-  HPath        : PStringItem;
-{$ELSE}
-  HPath        : PStringQueueItem;
-{$ENDIF NEWST}
-  s            : string;
-  found,
-  linkdynamic,
-  linklibc     : boolean;
-begin
-  WriteResponseFile:=False;
-{ set special options for some targets }
-  linkdynamic:=not(SharedLibFiles.empty);
-  linklibc:=SharedLibFiles.Find('c');
-  prtobj:='prt0';
-  cprtobj:='cprt0';
-  gprtobj:='gprt0';
-  if glibc21 then
-   begin
-     cprtobj:='cprt21';
-     gprtobj:='gprt21';
-   end;
-  if cs_profile in aktmoduleswitches then
-   begin
-     prtobj:=gprtobj;
-     if not glibc2 then
-      AddSharedLibrary('gmon');
-     AddSharedLibrary('c');
-     linklibc:=true;
-   end
-  else
-   begin
-     if linklibc then
-      prtobj:=cprtobj;
-   end;
-
-  { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
-
-  { Write path to search libraries }
-  HPath:=current_module^.locallibrarysearchpath.First;
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('SEARCH_DIR('+HPath^.Data^+')');
-     HPath:=HPath^.Next;
-   end;
-  HPath:=LibrarySearchPath.First;
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('SEARCH_DIR('+HPath^.Data^+')');
-     HPath:=HPath^.Next;
-   end;
-
-  LinkRes.Add('INPUT(');
-  { add objectfiles, start with prt0 always }
-  if prtobj<>'' then
-   LinkRes.AddFileName(FindObjectFile(prtobj,''));
-  { try to add crti and crtbegin if linking to C }
-  if linklibc then
-   begin
-     s:=librarysearchpath.FindFile('crtbegin.o',found)+'crtbegin.o';
-     if found then
-      LinkRes.AddFileName(s);
-     s:=librarysearchpath.FindFile('crti.o',found)+'crti.o';
-     if found then
-      LinkRes.AddFileName(s);
-   end;
-  { main objectfiles }
-  while not ObjectFiles.Empty do
-   begin
-     s:=ObjectFiles.Get;
-     if s<>'' then
-      LinkRes.AddFileName(s);
-   end;
-  { objects which must be at the end }
-  if linklibc then
-   begin
-     s:=librarysearchpath.FindFile('crtend.o',found)+'crtend.o';
-     if found then
-      LinkRes.AddFileName(s);
-     s:=librarysearchpath.FindFile('crtn.o',found)+'crtn.o';
-     if found then
-      LinkRes.AddFileName(s);
-   end;
-  LinkRes.Add(')');
-
-  { Write staticlibraries }
-  if not StaticLibFiles.Empty then
-   begin
-     LinkRes.Add('GROUP(');
-     While not StaticLibFiles.Empty do
-      begin
-        S:=StaticLibFiles.Get;
-        LinkRes.AddFileName(s)
-      end;
-     LinkRes.Add(')');
-   end;
-
-  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
-    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
-  if not SharedLibFiles.Empty then
-   begin
-     LinkRes.Add('INPUT(');
-     While not SharedLibFiles.Empty do
-      begin
-        S:=SharedLibFiles.Get;
-        if s<>'c' then
-         begin
-           i:=Pos(target_os.sharedlibext,S);
-           if i>0 then
-            Delete(S,i,255);
-           LinkRes.Add('-l'+s);
-         end
-        else
-         begin
-           linklibc:=true;
-           linkdynamic:=false; { libc will include the ld-linux for us }
-         end;
-      end;
-     { be sure that libc is the last lib }
-     if linklibc then
-      LinkRes.Add('-lc');
-     { when we have -static for the linker the we also need libgcc }
-     if (cs_link_staticflag in aktglobalswitches) then
-      LinkRes.Add('-lgcc');
-     if linkdynamic and (Info.DynamicLinker<>'') then
-      LinkRes.AddFileName(Info.DynamicLinker);
-     LinkRes.Add(')');
-   end;
-{ Write and Close response }
-  linkres.writetodisk;
-  linkres.done;
-
-  WriteResponseFile:=True;
-end;
-
-
-function TLinkerFreeBSD.MakeExecutable:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  success : boolean;
-  DynLinkStr : string[60];
-  StaticStr,
-  StripStr   : string[40];
-begin
-  if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.exefilename^);
-
-{ Create some replacements }
-  StaticStr:='';
-  StripStr:='';
-  DynLinkStr:='';
-  if (cs_link_staticflag in aktglobalswitches) then
-   StaticStr:='-static';
-  if (cs_link_strip in aktglobalswitches) then
-   StripStr:='-s';
-  If (cs_profile in aktmoduleswitches) or
-     ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
-   DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
-
-{ Write used files and libraries }
-  WriteResponseFile(false);
-
-{ Call linker }
-  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module^.exefilename^);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-  Replace(cmdstr,'$STATIC',StaticStr);
-  Replace(cmdstr,'$STRIP',StripStr);
-  Replace(cmdstr,'$DYNLINK',DynLinkStr);
-  success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   RemoveFile(outputexedir+Info.ResName);
-
-  MakeExecutable:=success;   { otherwise a recursive call to link method }
-end;
-
-
-Function TLinkerFreeBSD.MakeSharedLibrary:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  success : boolean;
-begin
-  MakeSharedLibrary:=false;
-  if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.sharedlibfilename^);
-
-{ Write used files and libraries }
-  WriteResponseFile(true);
-
-{ Call linker }
-  SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-  success:=DoExec(FindUtil(binstr),cmdstr,true,false);
-
-{ Strip the library ? }
-  if success and (cs_link_strip in aktglobalswitches) then
-   begin
-     SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
-     Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
-     success:=DoExec(FindUtil(binstr),cmdstr,true,false);
-   end;
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   RemoveFile(outputexedir+Info.ResName);
-
-  MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
-end;
-
-
-end.
-{
-  $Log$
-  Revision 1.2  2000-09-16 12:24:00  peter
-    * freebsd support routines
-
-  Revision 1.1.2.1  2000/09/13 14:08:28  marco
-   Initial FreeBSD version
-
-  Revision 1.1.2.1  2000/09/10 16:11:59  marco
-  Dynamic linker name is always empty for BSD
-
-  Revision 1.1  2000/07/13 06:29:57  michael
-  + Initial import
-
-  Revision 1.15  2000/07/08 20:43:38  peter
-    * findobjectfile gets extra arg with directory where the unit is found
-      and the .o should be looked first
-
-  Revision 1.14  2000/03/21 21:36:52  peter
-    * only include crtbegin when linking to libc
-
-  Revision 1.13  2000/03/12 08:24:03  daniel
-    * Modification for new symtable
-
-  Revision 1.12  2000/03/02 13:12:37  daniel
-    * Removed a comment to fix gtk.
-
-  Revision 1.11  2000/02/28 17:23:57  daniel
-  * Current work of symtable integration committed. The symtable can be
-    activated by defining 'newst', but doesn't compile yet. Changes in type
-    checking and oop are completed. What is left is to write a new
-    symtablestack and adapt the parser to use it.
-
-  Revision 1.10  2000/02/27 14:46:04  peter
-    * check for ld-so.2.0.* then no glibc21 is used, else glibc21 is used
-
-  Revision 1.9  2000/02/09 10:35:48  peter
-    * -Xt option to link staticly against c libs
-
-  Revision 1.8  2000/01/11 09:52:07  peter
-    * fixed placing of .sl directories
-    * use -b again for base-file selection
-    * fixed group writing for linux with smartlinking
-
-  Revision 1.7  2000/01/09 00:55:51  pierre
-    * GROUP of smartlink units put before the C libraries
-      to allow for smartlinking code that uses C code.
-
-  Revision 1.6  2000/01/07 01:14:42  peter
-    * updated copyright to 2000
-
-  Revision 1.5  1999/11/16 23:39:04  peter
-    * use outputexedir for link.res location
-
-  Revision 1.4  1999/11/12 11:03:50  peter
-    * searchpaths changed to stringqueue object
-
-  Revision 1.3  1999/11/05 13:15:00  florian
-    * some fixes to get the new cg compiling again
-
-  Revision 1.2  1999/11/04 10:55:31  peter
-    * TSearchPathString for the string type of the searchpaths, which is
-      ansistring under FPC/Delphi
-
-  Revision 1.1  1999/10/21 14:29:38  peter
-    * redesigned linker object
-    + library support for linux (only procedures can be exported)
-
-}

compiler/t_go32v1.pas

@@ -23,7 +23,10 @@
 }
 unit t_go32v1;
 
-  interface
+{$i defines.inc}
+
+interface
+
   uses
     link;
 
@@ -72,11 +75,7 @@ Function TLinkergo32v1.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
   i        : longint;
-{$IFDEF NEWST}
-  HPath    : PStringItem;
-{$ELSE}
   HPath    : PStringQueueItem;
-{$ENDIF}
   s        : string;
   linklibc : boolean;
 begin
@@ -190,7 +189,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-27 16:11:54  peter
+  Revision 1.4  2000-09-24 15:06:30  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/27 16:11:54  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/t_go32v2.pas

@@ -23,7 +23,10 @@
 }
 unit t_go32v2;
 
-  interface
+{$i defines.inc}
+
+interface
+
   uses
     link;
 
@@ -43,7 +46,7 @@ unit t_go32v2;
   implementation
 
     uses
-       cutils,strings,globtype,globals,cobjects,systems,verbose,script,fmodule;
+       cutils,globtype,globals,cobjects,systems,verbose,script,fmodule;
 
 
 {****************************************************************************
@@ -79,11 +82,7 @@ Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
   i        : longint;
-{$IFDEF NEWST}
-  HPath    : PStringItem;
-{$ELSE}
   HPath    : PStringQueueItem;
-{$ENDIF NEWST}
   s        : string;
   linklibc : boolean;
 begin
@@ -164,11 +163,6 @@ Function TLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
 Var
   scriptres  : TLinkRes;
   i        : longint;
-{$IFDEF NEWST}
-  HPath    : PStringItem;
-{$ELSE}
-  HPath    : PStringQueueItem;
-{$ENDIF NEWST}
   s        : string;
   linklibc : boolean;
 begin
@@ -435,7 +429,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 16:11:54  peter
+  Revision 1.5  2000-09-24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:54  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 
@@ -445,4 +442,4 @@ end.
   Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
 
-}
+}

compiler/t_linux.pas

@@ -22,6 +22,9 @@
  ****************************************************************************
 }
 unit t_linux;
+
+{$i defines.inc}
+
 interface
 
   uses
@@ -61,7 +64,7 @@ interface
 implementation
 
   uses
-    cutils,verbose,strings,cobjects,systems,globtype,globals,
+    cutils,verbose,cobjects,systems,globtype,globals,
     symconst,script,
     fmodule,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
 
@@ -77,43 +80,22 @@ end;
 procedure timportliblinux.importprocedure(const func,module : string;index : longint;const name : string);
 begin
   { insert sharedlibrary }
-{$IFDEF NEWST}
-  current_module^.linkothersharedlibs.
-   insert(new(Plinkitem,init(SplitName(module),link_allways)));
-  { do nothing with the procedure, only set the mangledname }
-  if name<>'' then
-    aktprocdef^.setmangledname(name)
-  else
-    message(parser_e_empty_import_name);
-{$ELSE}
-  current_module^.linkothersharedlibs.
-   insert(SplitName(module),link_allways);
+  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
     aktprocsym^.definition^.setmangledname(name)
   else
     message(parser_e_empty_import_name);
-{$ENDIF NEWST}
 end;
 
 
 procedure timportliblinux.importvariable(const varname,module:string;const name:string);
 begin
   { insert sharedlibrary }
-{$IFDEF NEWST}
-  current_module^.linkothersharedlibs.
-   insert(new(Plinkitem,init(SplitName(module),link_allways)));
-{$ELSE}
-  current_module^.linkothersharedlibs.
-   insert(SplitName(module),link_allways);
-{$ENDIF NEWST}
+  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
   aktvarsym^.setmangledname(name);
-{$IFDEF NEWST}
-  exclude(aktvarsym^.properties,vo_is_dll_var);
-{$ELSE}
   exclude(aktvarsym^.varoptions,vo_is_dll_var);
-{$ENDIF NEWST}
 end;
 
 
@@ -256,11 +238,7 @@ Var
   cprtobj,
   gprtobj,
   prtobj       : string[80];
-{$IFDEF NEWST}
-  HPath        : PStringItem;
-{$ELSE}
   HPath        : PStringQueueItem;
-{$ENDIF NEWST}
   s            : string;
   found,
   linkdynamic,
@@ -477,7 +455,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-09-10 20:26:55  peter
+  Revision 1.6  2000-09-24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.5  2000/09/10 20:26:55  peter
     * bsd patches from marco
 
   Revision 1.4  2000/08/27 16:11:54  peter

compiler/t_nwm.pas

@@ -18,48 +18,48 @@
     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.
-    
+
     First Implementation 10 Sept 2000 Armin Diehl
-    
+
     Currently generating NetWare-NLM's only work under Linux. This is
     because nlmconf from binutils does not work with i.e. win32 coff
     object files. It works fine with ELF-Objects.
-    
+
     The following compiler-swiches are supported for NetWare:
     $DESCRIPTION    : NLM-Description, will be displayed at load-time
     $M              : For Stack-Size, Heap-Size will be ignored
     $VERSION x.x.x  : Sets Major, Minor and Revision
-    
+
     Sorry, Displaying copyright does not work with nlmconv from gnu bunutils.
-    
+
     Exports will be handled like in win32:
     procedure bla;
     begin
     end;
-    
+
     exports bla name 'bla';
-    
+
     Without Name 'bla' this will be exported in upper-case.
-    
+
     The path to the import-Files (from netware-sdk, see developer.novell.com)
     must be specified by the library-path. All external modules are defined
     as autoload.
-    
+
     i.e. Procedure ConsolePrintf (p:pchar); cdecl; external 'clib.nlm';
     sets IMPORT @clib.imp and MODULE clib.
-    
+
     If you dont have nlmconv, compile gnu-binutils with
        ./configure --enable-targets=i386-linux,i386-netware
        make all
-       
+
     Debugging is currently only possible at assembler level with nwdbg, written
     by Jan Beulich. Nwdbg supports symbols but it's not a source-level
-    debugger. You can get nwdbg from developer.novell.com. To enter the 
+    debugger. You can get nwdbg from developer.novell.com. To enter the
     debugger from your program, define "EnterDebugger" as external cdecl and
     call it. Int3 will not work with Netware 5.
-    
+
     A sample program:
-    
+
     Program Hello;
     (*$DESCRIPTION HelloWorldNlm*)
     (*$VERSION 1.2.2*)
@@ -67,17 +67,20 @@
     begin
       writeLn ('hello world');
     end.
-    
+
     compile with:
     ppc386 -Tnetware hello
-    
+
     ToDo:
       - No duplicate imports and autoloads
       - Screen and Thread-Names
-    
+
 ****************************************************************************
 }
 unit t_nwm;
+
+{$i defines.inc}
+
 interface
 
   uses
@@ -114,7 +117,7 @@ interface
 implementation
 
   uses
-    cutils,verbose,strings,cobjects,systems,globtype,globals,
+    cutils,verbose,cobjects,systems,globtype,globals,
     symconst,script,
     fmodule,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
 
@@ -130,43 +133,22 @@ end;
 procedure timportlibnetware.importprocedure(const func,module : string;index : longint;const name : string);
 begin
   { insert sharedlibrary }
-{$IFDEF NEWST}
-  current_module^.linkothersharedlibs.
-   insert(new(Plinkitem,init(SplitName(module),link_allways)));
-  { do nothing with the procedure, only set the mangledname }
-  if name<>'' then
-    aktprocdef^.setmangledname(name)
-  else
-    message(parser_e_empty_import_name);
-{$ELSE}
-  current_module^.linkothersharedlibs.
-   insert(SplitName(module),link_allways);
+  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
     aktprocsym^.definition^.setmangledname(name)
   else
     message(parser_e_empty_import_name);
-{$ENDIF NEWST}
 end;
 
 
 procedure timportlibnetware.importvariable(const varname,module:string;const name:string);
 begin
   { insert sharedlibrary }
-{$IFDEF NEWST}
-  current_module^.linkothersharedlibs.
-   insert(new(Plinkitem,init(SplitName(module),link_allways)));
-{$ELSE}
-  current_module^.linkothersharedlibs.
-   insert(SplitName(module),link_allways);
-{$ENDIF NEWST}
+  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
   aktvarsym^.setmangledname(name);
-{$IFDEF NEWST}
-  exclude(aktvarsym^.properties,vo_is_dll_var);
-{$ELSE}
   exclude(aktvarsym^.varoptions,vo_is_dll_var);
-{$ENDIF NEWST}
 end;
 
 
@@ -321,7 +303,7 @@ begin
      if s<>'' then
       LinkRes.Add ('INPUT ' + FindObjectFile (s,''));
    end;
-   
+
   { output file (nlm) }
   LinkRes.Add ('OUTPUT ' + NlmNam);
 
@@ -359,8 +341,8 @@ begin
          names but nlmconv ignores that.
          Here we are setting the import-files for nlmconv. I.e. for
          the module clib or clib.nlm we add IMPORT @clib.imp and also
-	 the module clib.nlm (autoload) 
-	 ? may it be better to set autoload's via StaticLibFiles ? }
+         the module clib.nlm (autoload)
+         ? may it be better to set autoload's via StaticLibFiles ? }
         S:=lower (SharedLibFiles.Get);
         if s<>'' then
          begin
@@ -442,7 +424,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2000-09-11 17:00:23  florian
+  Revision 1.2  2000-09-24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.1  2000/09/11 17:00:23  florian
     + first implementation of Netware Module support, thanks to
       Armin Diehl ([email protected]) for providing the patches
 

compiler/t_os2.pas

@@ -30,6 +30,8 @@
 }
 unit t_os2;
 
+{$i defines.inc}
+
 interface
 uses
   import,link,comprsrc;
@@ -61,11 +63,13 @@ implementation
 
   uses
 {$ifdef Delphi}
+     sysutils,
      dmisc,
 {$else Delphi}
+     strings,
      dos,
 {$endif Delphi}
-     cutils,globtype,strings,cobjects,comphook,systems,
+     cutils,globtype,cobjects,comphook,systems,
      globals,verbose,fmodule,script;
 
 const   profile_flag:boolean=false;
@@ -371,11 +375,7 @@ Function TLinkeros2.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
   i        : longint;
-{$IFDEF NEWST}
-  HPath    : PStringItem;
-{$ELSE}
   HPath    : PStringQueueItem;
-{$ENDIF NEWST}
   s        : string;
 begin
   WriteResponseFile:=False;
@@ -503,7 +503,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-09-20 19:38:34  peter
+  Revision 1.5  2000-09-24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.4  2000/09/20 19:38:34  peter
     * fixed staticlib filename and unitlink instead of otherlinky
 
   Revision 1.3  2000/08/27 16:11:54  peter

compiler/t_win32.pas

@@ -23,7 +23,9 @@
 }
 unit t_win32;
 
-  interface
+{$i defines.inc}
+
+interface
 
   uses
     import,export,link;
@@ -64,7 +66,7 @@ unit t_win32;
     end;
 
 
-  implementation
+implementation
 
     uses
 {$ifdef PAVEL_LINKLIB}
@@ -659,11 +661,7 @@ Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
   i        : longint;
-{$IFDEF NEWST}
-  HPath    : PStringItem;
-{$ELSE}
   HPath    : PStringQueueItem;
-{$ENDIF NEWST}
   s,s2        : string;
   found,linklibc : boolean;
 begin
@@ -764,9 +762,9 @@ end;
 Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
-  HPath    : {$ifdef NEWST} PStringItem {$else} PStringQueueItem {$endif};
-  s,s2        : string;
-  success : boolean;
+  HPath    : PStringQueueItem;
+  s,s2     : string;
+  success  : boolean;
 function ExpandName(const s:string):string;
 var
   sysdir:string;
@@ -1303,7 +1301,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-08-27 16:11:54  peter
+  Revision 1.5  2000-09-24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:54  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule