+ new tlinkedlist class (merge of old tstringqueue,tcontainer and

    tlinkedlist objects)

compiler/aasm.pas

@@ -27,7 +27,7 @@ unit aasm;
 interface
 
     uses
-       cutils,cobjects,
+       cutils,cobjects,cclasses,
        globtype,globals,systems;
 
     type
@@ -129,7 +129,7 @@ interface
        pasmlabel = ^tasmlabel;
        tasmlabel = object(tasmsymbol)
 {$ifdef PACKENUMFIXED}
-         { this is set by the pai_label.init }
+         { this is set by the tai_label.Init }
          is_set,
          { is the label only there for getting an address (e.g. for i/o }
          { checks -> true) or is it a jump target (false)               }
@@ -148,8 +148,7 @@ interface
 
 
        { the short name makes typing easier }
-       pai = ^tai;
-       tai = object(tlinkedlist_item)
+       tai = class(tlinkedlistitem)
 {$ifndef PACKENUMFIXED}
           typ      : tait;
 {$endif}
@@ -160,23 +159,21 @@ interface
           { still 3 bytes left after the next field }
           typ      : tait;
 {$endif}
-          constructor init;
+          constructor Create;
        end;
 
-       pai_string = ^tai_string;
-       tai_string = object(tai)
+       tai_string = class(tai)
           str : pchar;
           { extra len so the string can contain an \0 }
           len : longint;
-          constructor init(const _str : string);
-          constructor init_pchar(_str : pchar);
-          constructor init_length_pchar(_str : pchar;length : longint);
-          destructor done;virtual;
+          constructor Create(const _str : string);
+          constructor Create_pchar(_str : pchar);
+          constructor Create_length_pchar(_str : pchar;length : longint);
+          destructor Destroy;override;
        end;
 
        { generates a common label }
-       pai_symbol = ^tai_symbol;
-       tai_symbol = object(tai)
+       tai_symbol = class(tai)
 {$ifdef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
@@ -185,22 +182,20 @@ interface
 {$ifndef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
-          constructor init(_sym:PAsmSymbol;siz:longint);
-          constructor initname(const _name : string;siz:longint);
-          constructor initname_global(const _name : string;siz:longint);
-          constructor initdataname(const _name : string;siz:longint);
-          constructor initdataname_global(const _name : string;siz:longint);
+          constructor Create(_sym:PAsmSymbol;siz:longint);
+          constructor Createname(const _name : string;siz:longint);
+          constructor Createname_global(const _name : string;siz:longint);
+          constructor Createdataname(const _name : string;siz:longint);
+          constructor Createdataname_global(const _name : string;siz:longint);
        end;
 
-       pai_symbol_end = ^tai_symbol_end;
-       tai_symbol_end = object(tai)
+       tai_symbol_end = class(tai)
           sym : pasmsymbol;
-          constructor init(_sym:PAsmSymbol);
-          constructor initname(const _name : string);
+          constructor Create(_sym:PAsmSymbol);
+          constructor Createname(const _name : string);
        end;
 
-       pai_label = ^tai_label;
-       tai_label = object(tai)
+       tai_label = class(tai)
 {$ifdef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
@@ -208,56 +203,48 @@ interface
 {$ifndef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
-          constructor init(_l : pasmlabel);
+          constructor Create(_l : pasmlabel);
        end;
 
-       pai_direct = ^tai_direct;
-       tai_direct = object(tai)
+       tai_direct = class(tai)
           str : pchar;
-          constructor init(_str : pchar);
-          destructor done; virtual;
+          constructor Create(_str : pchar);
+          destructor Destroy; override;
        end;
 
-
        { to insert a comment into the generated assembler file }
-       pai_asm_comment = ^tai_asm_comment;
-       tai_asm_comment = object(tai)
+       tai_asm_comment = class(tai)
           str : pchar;
-          constructor init(_str : pchar);
-          destructor done; virtual;
+          constructor Create(_str : pchar);
+          destructor Destroy; override;
        end;
 
 
        { alignment for operator }
-
 {$ifdef i386}
-       pai_align_abstract = ^tai_align_abstract;
-       tai_align_abstract = object(tai)
+       tai_align_abstract = class(tai)
 {$else i386}
-       pai_align = ^tai_align;
-       tai_align = object(tai)
+       tai_align = class(tai)
 {$endif i386}
           buf       : array[0..63] of char; { buf used for fill }
           aligntype : byte;   { 1 = no align, 2 = word align, 4 = dword align }
           fillsize  : byte;   { real size to fill }
           fillop    : byte;   { value to fill with - optional }
           use_op    : boolean;
-          constructor init(b:byte);
-          constructor init_op(b: byte; _op: byte);
+          constructor Create(b:byte);
+          constructor Create_op(b: byte; _op: byte);
           function getfillbuf:pchar;
        end;
 
        { Insert a section/segment directive }
-       pai_section = ^tai_section;
-       tai_section = object(tai)
+       tai_section = class(tai)
           sec : tsection;
-          constructor init(s : tsection);
+          constructor Create(s : tsection);
        end;
 
 
        { generates an uninitializised data block }
-       pai_datablock = ^tai_datablock;
-       tai_datablock = object(tai)
+       tai_datablock = class(tai)
 {$ifdef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
@@ -266,83 +253,76 @@ interface
 {$ifndef PACKENUMFIXED}
           is_global : boolean;
 {$endif}
-          constructor init(const _name : string;_size : longint);
-          constructor init_global(const _name : string;_size : longint);
+          constructor Create(const _name : string;_size : longint);
+          constructor Create_global(const _name : string;_size : longint);
        end;
 
 
        { generates a long integer (32 bit) }
-       pai_const = ^tai_const;
-       tai_const = object(tai)
+       tai_const = class(tai)
           value : longint;
-          constructor init_32bit(_value : longint);
-          constructor init_16bit(_value : word);
-          constructor init_8bit(_value : byte);
+          constructor Create_32bit(_value : longint);
+          constructor Create_16bit(_value : word);
+          constructor Create_8bit(_value : byte);
        end;
 
-       pai_const_symbol = ^tai_const_symbol;
-       tai_const_symbol = object(tai)
+       tai_const_symbol = class(tai)
           sym    : pasmsymbol;
           offset : longint;
-          constructor init(_sym:PAsmSymbol);
-          constructor init_offset(_sym:PAsmSymbol;ofs:longint);
-          constructor init_rva(_sym:PAsmSymbol);
-          constructor initname(const name:string);
-          constructor initname_offset(const name:string;ofs:longint);
-          constructor initname_rva(const name:string);
+          constructor Create(_sym:PAsmSymbol);
+          constructor Create_offset(_sym:PAsmSymbol;ofs:longint);
+          constructor Create_rva(_sym:PAsmSymbol);
+          constructor Createname(const name:string);
+          constructor Createname_offset(const name:string;ofs:longint);
+          constructor Createname_rva(const name:string);
        end;
 
        { generates a single (32 bit real) }
-       pai_real_32bit = ^tai_real_32bit;
-       tai_real_32bit = object(tai)
+       tai_real_32bit = class(tai)
           value : ts32real;
-          constructor init(_value : ts32real);
+          constructor Create(_value : ts32real);
        end;
 
        { generates a double (64 bit real) }
-       pai_real_64bit = ^tai_real_64bit;
-       tai_real_64bit = object(tai)
+       tai_real_64bit = class(tai)
           value : ts64real;
-          constructor init(_value : ts64real);
+          constructor Create(_value : ts64real);
        end;
 
        { generates an extended (80 bit real) }
-       pai_real_80bit = ^tai_real_80bit;
-       tai_real_80bit = object(tai)
+       tai_real_80bit = class(tai)
           value : ts80real;
-          constructor init(_value : ts80real);
+          constructor Create(_value : ts80real);
        end;
 
        { generates an comp (integer over 64 bits) }
-       pai_comp_64bit = ^tai_comp_64bit;
-       tai_comp_64bit = object(tai)
+       tai_comp_64bit = class(tai)
           value : ts64comp;
-          constructor init(_value : ts64comp);
+          constructor Create(_value : ts64comp);
        end;
 
        { insert a cut to split into several smaller files }
 
        tcutplace=(cut_normal,cut_begin,cut_end);
 
-       pai_cut = ^tai_cut;
-       tai_cut = object(tai)
+       tai_cut = class(tai)
           place : tcutplace;
-          constructor init;
-          constructor init_begin;
-          constructor init_end;
+          constructor Create;
+          constructor Create_begin;
+          constructor Create_end;
        end;
 
        TMarker = (NoPropInfoStart, NoPropInfoEnd,
          AsmBlockStart, AsmBlockEnd,
-         InlineStart,InlineEnd);
-       pai_marker = ^tai_marker;
-       tai_marker = object(tai)
+         InlineStart,InlineEnd
+       );
+
+       tai_marker = class(tai)
          Kind: TMarker;
-         Constructor init(_Kind: TMarker);
+         Constructor Create(_Kind: TMarker);
        end;
 
-       paitempalloc = ^taitempalloc;
-       taitempalloc = object(tai)
+       taitempalloc = class(tai)
 {$ifdef PACKENUMFIXED}
           allocation : boolean;
 {$endif}
@@ -361,20 +341,16 @@ interface
 const
        ait_bestreal = ait_real_80bit;
 type
-       pai_bestreal = pai_real_80bit;
        tai_bestreal = tai_real_80bit;
 {$endif i386}
 {$ifdef m68k}
 const
        ait_bestreal = ait_real_32bit;
 type
-       pai_bestreal = pai_real_32bit;
        tai_bestreal = tai_real_32bit;
 {$endif m68k}
 
-
-       paasmoutput = ^taasmoutput;
-       taasmoutput = object(tlinkedlist)
+       taasmoutput = class(tlinkedlist)
          function getlasttaifilepos : pfileposinfo;
        end;
 
@@ -390,7 +366,7 @@ type
       debuglist,withdebuglist,consts,
       importssection,exportssection,
       resourcesection,rttilist,
-      resourcestringlist         : paasmoutput;
+      resourcestringlist         : taasmoutput;
     { asm symbol list }
       asmsymbollist : pdictionary;
       usedasmsymbollist : psinglelist;
@@ -414,8 +390,8 @@ type
     function  getasmsymbol(const s : string) : pasmsymbol;
     function  renameasmsymbol(const sold, snew : string):pasmsymbol;
 
-    procedure InitUsedAsmSymbolList;
-    procedure DoneUsedAsmSymbolList;
+    procedure CreateUsedAsmSymbolList;
+    procedure DestroyUsedAsmSymbolList;
     procedure UsedAsmSymbolListInsert(p:pasmsymbol);
     procedure UsedAsmSymbolListReset;
     procedure UsedAsmSymbolListResetAltSym;
@@ -436,7 +412,7 @@ uses
                              TAI
  ****************************************************************************}
 
-    constructor tai.init;
+    constructor tai.Create;
       begin
         optinfo := nil;
         fileinfo:=aktfilepos;
@@ -446,9 +422,9 @@ uses
                              TAI_SECTION
  ****************************************************************************}
 
-    constructor tai_section.init(s : tsection);
+    constructor tai_section.Create(s : tsection);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_section;
          sec:=s;
       end;
@@ -458,10 +434,10 @@ uses
                              TAI_DATABLOCK
  ****************************************************************************}
 
-    constructor tai_datablock.init(const _name : string;_size : longint);
+    constructor tai_datablock.Create(const _name : string;_size : longint);
 
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_datablock;
          sym:=newasmsymboltype(_name,AB_LOCAL,AT_DATA);
          { keep things aligned }
@@ -472,9 +448,9 @@ uses
       end;
 
 
-    constructor tai_datablock.init_global(const _name : string;_size : longint);
+    constructor tai_datablock.Create_global(const _name : string;_size : longint);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_datablock;
          sym:=newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
          { keep things aligned }
@@ -489,45 +465,45 @@ uses
                                TAI_SYMBOL
  ****************************************************************************}
 
-    constructor tai_symbol.init(_sym:PAsmSymbol;siz:longint);
+    constructor tai_symbol.Create(_sym:PAsmSymbol;siz:longint);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_symbol;
          sym:=_sym;
          size:=siz;
          is_global:=(sym^.defbind=AB_GLOBAL);
       end;
 
-    constructor tai_symbol.initname(const _name : string;siz:longint);
+    constructor tai_symbol.Createname(const _name : string;siz:longint);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_symbol;
          sym:=newasmsymboltype(_name,AB_LOCAL,AT_FUNCTION);
          size:=siz;
          is_global:=false;
       end;
 
-    constructor tai_symbol.initname_global(const _name : string;siz:longint);
+    constructor tai_symbol.Createname_global(const _name : string;siz:longint);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_symbol;
          sym:=newasmsymboltype(_name,AB_GLOBAL,AT_FUNCTION);
          size:=siz;
          is_global:=true;
       end;
 
-    constructor tai_symbol.initdataname(const _name : string;siz:longint);
+    constructor tai_symbol.Createdataname(const _name : string;siz:longint);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_symbol;
          sym:=newasmsymboltype(_name,AB_LOCAL,AT_DATA);
          size:=siz;
          is_global:=false;
       end;
 
-    constructor tai_symbol.initdataname_global(const _name : string;siz:longint);
+    constructor tai_symbol.Createdataname_global(const _name : string;siz:longint);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_symbol;
          sym:=newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
          size:=siz;
@@ -539,16 +515,16 @@ uses
                                TAI_SYMBOL
  ****************************************************************************}
 
-    constructor tai_symbol_end.init(_sym:PAsmSymbol);
+    constructor tai_symbol_end.Create(_sym:PAsmSymbol);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_symbol_end;
          sym:=_sym;
       end;
 
-    constructor tai_symbol_end.initname(const _name : string);
+    constructor tai_symbol_end.Createname(const _name : string);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_symbol_end;
          sym:=newasmsymboltype(_name,AB_GLOBAL,AT_NONE);
       end;
@@ -558,26 +534,26 @@ uses
                                TAI_CONST
  ****************************************************************************}
 
-    constructor tai_const.init_32bit(_value : longint);
+    constructor tai_const.Create_32bit(_value : longint);
 
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_const_32bit;
          value:=_value;
       end;
 
-    constructor tai_const.init_16bit(_value : word);
+    constructor tai_const.Create_16bit(_value : word);
 
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_const_16bit;
          value:=_value;
       end;
 
-    constructor tai_const.init_8bit(_value : byte);
+    constructor tai_const.Create_8bit(_value : byte);
 
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_const_8bit;
          value:=_value;
       end;
@@ -587,9 +563,9 @@ uses
                                TAI_CONST_SYMBOL_OFFSET
  ****************************************************************************}
 
-    constructor tai_const_symbol.init(_sym:PAsmSymbol);
+    constructor tai_const_symbol.Create(_sym:PAsmSymbol);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_const_symbol;
          sym:=_sym;
          offset:=0;
@@ -597,9 +573,9 @@ uses
          inc(sym^.refs);
       end;
 
-    constructor tai_const_symbol.init_offset(_sym:PAsmSymbol;ofs:longint);
+    constructor tai_const_symbol.Create_offset(_sym:PAsmSymbol;ofs:longint);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_const_symbol;
          sym:=_sym;
          offset:=ofs;
@@ -607,9 +583,9 @@ uses
          inc(sym^.refs);
       end;
 
-    constructor tai_const_symbol.init_rva(_sym:PAsmSymbol);
+    constructor tai_const_symbol.Create_rva(_sym:PAsmSymbol);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_const_rva;
          sym:=_sym;
          offset:=0;
@@ -617,9 +593,9 @@ uses
          inc(sym^.refs);
       end;
 
-    constructor tai_const_symbol.initname(const name:string);
+    constructor tai_const_symbol.Createname(const name:string);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_const_symbol;
          sym:=newasmsymbol(name);
          offset:=0;
@@ -627,9 +603,9 @@ uses
          inc(sym^.refs);
       end;
 
-    constructor tai_const_symbol.initname_offset(const name:string;ofs:longint);
+    constructor tai_const_symbol.Createname_offset(const name:string;ofs:longint);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_const_symbol;
          sym:=newasmsymbol(name);
          offset:=ofs;
@@ -637,9 +613,9 @@ uses
          inc(sym^.refs);
       end;
 
-    constructor tai_const_symbol.initname_rva(const name:string);
+    constructor tai_const_symbol.Createname_rva(const name:string);
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_const_rva;
          sym:=newasmsymbol(name);
          offset:=0;
@@ -652,10 +628,10 @@ uses
                                TAI_real_32bit
  ****************************************************************************}
 
-    constructor tai_real_32bit.init(_value : ts32real);
+    constructor tai_real_32bit.Create(_value : ts32real);
 
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_real_32bit;
          value:=_value;
       end;
@@ -664,10 +640,10 @@ uses
                                TAI_real_64bit
  ****************************************************************************}
 
-    constructor tai_real_64bit.init(_value : ts64real);
+    constructor tai_real_64bit.Create(_value : ts64real);
 
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_real_64bit;
          value:=_value;
       end;
@@ -676,10 +652,10 @@ uses
                                TAI_real_80bit
  ****************************************************************************}
 
-    constructor tai_real_80bit.init(_value : ts80real);
+    constructor tai_real_80bit.Create(_value : ts80real);
 
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_real_80bit;
          value:=_value;
       end;
@@ -688,10 +664,10 @@ uses
                                Tai_comp_64bit
  ****************************************************************************}
 
-    constructor tai_comp_64bit.init(_value : ts64comp);
+    constructor tai_comp_64bit.Create(_value : ts64comp);
 
       begin
-         inherited init;
+         inherited Create;
          typ:=ait_comp_64bit;
          value:=_value;
       end;
@@ -701,41 +677,41 @@ uses
                                TAI_STRING
  ****************************************************************************}
 
-     constructor tai_string.init(const _str : string);
+     constructor tai_string.Create(const _str : string);
 
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_string;
           getmem(str,length(_str)+1);
           strpcopy(str,_str);
           len:=length(_str);
        end;
 
-     constructor tai_string.init_pchar(_str : pchar);
+     constructor tai_string.Create_pchar(_str : pchar);
 
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_string;
           str:=_str;
           len:=strlen(_str);
        end;
 
-    constructor tai_string.init_length_pchar(_str : pchar;length : longint);
+    constructor tai_string.Create_length_pchar(_str : pchar;length : longint);
 
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_string;
           str:=_str;
           len:=length;
        end;
 
-    destructor tai_string.done;
+    destructor tai_string.destroy;
 
       begin
          { you can have #0 inside the strings so }
          if str<>nil then
            freemem(str,len+1);
-         inherited done;
+         inherited Destroy;
       end;
 
 
@@ -743,9 +719,9 @@ uses
                                TAI_LABEL
  ****************************************************************************}
 
-    constructor tai_label.init(_l : pasmlabel);
+    constructor tai_label.create(_l : pasmlabel);
       begin
-        inherited init;
+        inherited Create;
         typ:=ait_label;
         l:=_l;
         l^.is_set:=true;
@@ -757,38 +733,38 @@ uses
                               TAI_DIRECT
  ****************************************************************************}
 
-     constructor tai_direct.init(_str : pchar);
+     constructor tai_direct.Create(_str : pchar);
 
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_direct;
           str:=_str;
        end;
 
-    destructor tai_direct.done;
+    destructor tai_direct.destroy;
 
       begin
          strdispose(str);
-         inherited done;
+         inherited Destroy;
       end;
 
 {****************************************************************************
           TAI_ASM_COMMENT  comment to be inserted in the assembler file
  ****************************************************************************}
 
-     constructor tai_asm_comment.init(_str : pchar);
+     constructor tai_asm_comment.Create(_str : pchar);
 
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_comment;
           str:=_str;
        end;
 
-    destructor tai_asm_comment.done;
+    destructor tai_asm_comment.destroy;
 
       begin
          strdispose(str);
-         inherited done;
+         inherited Destroy;
       end;
 
 {****************************************************************************
@@ -796,12 +772,12 @@ uses
  ****************************************************************************}
 
 {$ifdef i386}
-     constructor tai_align_abstract.init(b: byte);
+     constructor tai_align_abstract.Create(b: byte);
 {$else i386}
-     constructor tai_align.init(b: byte);
+     constructor tai_align.Create(b: byte);
 {$endif i386}
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_align;
           if b in [1,2,4,8,16,32] then
             aligntype := b
@@ -814,12 +790,12 @@ uses
 
 
 {$ifdef i386}
-     constructor tai_align_abstract.init_op(b: byte; _op: byte);
+     constructor tai_align_abstract.Create_op(b: byte; _op: byte);
 {$else i386}
-     constructor tai_align.init_op(b: byte; _op: byte);
+     constructor tai_align.Create_op(b: byte; _op: byte);
 {$endif i386}
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_align;
           if b in [1,2,4,8,16,32] then
             aligntype := b
@@ -845,25 +821,25 @@ uses
                               TAI_CUT
  ****************************************************************************}
 
-     constructor tai_cut.init;
+     constructor tai_cut.Create;
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_cut;
           place:=cut_normal;
        end;
 
 
-     constructor tai_cut.init_begin;
+     constructor tai_cut.Create_begin;
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_cut;
           place:=cut_begin;
        end;
 
 
-     constructor tai_cut.init_end;
+     constructor tai_cut.Create_end;
        begin
-          inherited init;
+          inherited Create;
           typ:=ait_cut;
           place:=cut_end;
        end;
@@ -873,9 +849,9 @@ uses
                              Tai_Marker
  ****************************************************************************}
 
-     Constructor Tai_Marker.Init(_Kind: TMarker);
+     Constructor Tai_Marker.Create(_Kind: TMarker);
      Begin
-       Inherited Init;
+       Inherited Create;
        typ := ait_marker;
        Kind := _Kind;
      End;
@@ -886,7 +862,7 @@ uses
 
     constructor taitempalloc.alloc(pos,size:longint);
       begin
-        inherited init;
+        inherited Create;
         typ:=ait_tempalloc;
         allocation:=true;
         temppos:=pos;
@@ -896,7 +872,7 @@ uses
 
     constructor taitempalloc.dealloc(pos,size:longint);
       begin
-        inherited init;
+        inherited Create;
         typ:=ait_tempalloc;
         allocation:=false;
         temppos:=pos;
@@ -909,7 +885,7 @@ uses
                                   AsmSymbol
 *****************************************************************************}
 
-    constructor tasmsymbol.init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
+    constructor tasmsymbol.Init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
       begin;
         inherited initname(s);
         reset;
@@ -963,7 +939,7 @@ uses
                                   AsmLabel
 *****************************************************************************}
 
-    constructor tasmlabel.init;
+    constructor tasmlabel.Init;
       begin;
         labelnr:=nextlabelnr;
         inc(nextlabelnr);
@@ -974,12 +950,12 @@ uses
       end;
 
 
-    constructor tasmlabel.initdata;
+    constructor tasmlabel.Initdata;
       begin;
         labelnr:=nextlabelnr;
         inc(nextlabelnr);
         if (cs_create_smart in aktmoduleswitches) then
-          inherited init('_$'+current_module^.modulename^+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
+          inherited init('_$'+current_module.modulename^+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
         else
           inherited init(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
         is_set:=false;
@@ -988,9 +964,9 @@ uses
         refs:=1;
       end;
 
-    constructor tasmlabel.initaddr;
+    constructor tasmlabel.Initaddr;
       begin;
-        init;
+        Init;
         is_addr := true;
       end;
 
@@ -1054,7 +1030,7 @@ uses
                               Used AsmSymbolList
 *****************************************************************************}
 
-    procedure InitUsedAsmSymbolList;
+    procedure CreateUsedAsmSymbolList;
       begin
         if assigned(usedasmsymbollist) then
          internalerror(78455782);
@@ -1062,7 +1038,7 @@ uses
       end;
 
 
-    procedure DoneUsedAsmSymbolList;
+    procedure DestroyUsedAsmSymbolList;
       begin
         dispose(usedasmsymbollist,done);
         usedasmsymbollist:=nil;
@@ -1176,7 +1152,7 @@ uses
     function taasmoutput.getlasttaifilepos : pfileposinfo;
       begin
          if assigned(last) then
-           getlasttaifilepos:=@pai(last)^.fileinfo
+           getlasttaifilepos:=@tai(last).fileinfo
          else
            getlasttaifilepos:=nil;
       end;
@@ -1184,7 +1160,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.14  2000-11-29 00:30:30  florian
+  Revision 1.15  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.14  2000/11/29 00:30:30  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/assemble.pas

@@ -77,7 +77,7 @@ type
     procedure AsmCreate(Aplace:tcutplace);
     procedure AsmClose;
     procedure Synchronize;
-    procedure WriteTree(p:paasmoutput);virtual;
+    procedure WriteTree(p:TAAsmoutput);virtual;
     procedure WriteAsmList;virtual;
   end;
 
@@ -259,12 +259,12 @@ begin
     cut_begin :
       begin
         inc(SmartHeaderCount);
-        s:=current_module^.asmprefix^+tostr(SmartHeaderCount)+'h';
+        s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'h';
       end;
     cut_normal :
-      s:=current_module^.asmprefix^+tostr(SmartHeaderCount)+'s';
+      s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'s';
     cut_end :
-      s:=current_module^.asmprefix^+tostr(SmartHeaderCount)+'t';
+      s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'t';
   end;
   AsmFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
   ObjFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
@@ -386,9 +386,9 @@ begin
 {$endif}
    begin
    {Touch Assembler time to ppu time is there is a ppufilename}
-     if Assigned(current_module^.ppufilename) then
+     if Assigned(current_module.ppufilename) then
       begin
-        Assign(f,current_module^.ppufilename^);
+        Assign(f,current_module.ppufilename^);
         {$I-}
          reset(f,1);
         {$I+}
@@ -409,16 +409,16 @@ end;
 procedure TAsmList.Synchronize;
 begin
 {Touch Assembler time to ppu time is there is a ppufilename}
-  if Assigned(current_module^.ppufilename) then
+  if Assigned(current_module.ppufilename) then
    begin
-     SynchronizeFileTime(current_module^.ppufilename^,asmfile);
+     SynchronizeFileTime(current_module.ppufilename^,asmfile);
      if not(cs_asm_extern in aktglobalswitches) then
-       SynchronizeFileTime(current_module^.ppufilename^,objfile);
+       SynchronizeFileTime(current_module.ppufilename^,objfile);
    end;
 end;
 
 
-procedure TAsmList.WriteTree(p:paasmoutput);
+procedure TAsmList.WriteTree(p:TAAsmoutput);
 begin
 end;
 
@@ -465,9 +465,9 @@ end;
 Constructor TAsmList.Init(smart:boolean);
 begin
 { load start values }
-  asmfile:=current_module^.asmfilename^;
-  objfile:=current_module^.objfilename^;
-  name:=FixFileName(current_module^.modulename^);
+  asmfile:=current_module.asmfilename^;
+  objfile:=current_module.objfilename^;
+  name:=FixFileName(current_module.modulename^);
   OutCnt:=0;
   SmartFilesCount:=0;
   SmartLinkOFiles.Clear;
@@ -477,12 +477,12 @@ begin
 { Which path will be used ? }
   if SmartAsm then
    begin
-     path:=current_module^.outputpath^+FixFileName(current_module^.modulename^)+target_info.smartext;
+     path:=current_module.outputpath^+FixFileName(current_module.modulename^)+target_info.smartext;
      CreateSmartLinkPath(path);
      path:=FixPath(path,false);
    end
   else
-   path:=current_module^.outputpath^;
+   path:=current_module.outputpath^;
 end;
 
 
@@ -525,12 +525,12 @@ begin
          end;
          b^.WriteBin;
          dispose(b,done);
-         if assigned(current_module^.ppufilename) then
+         if assigned(current_module.ppufilename) then
           begin
             if smart then
-              SynchronizeFileTime(current_module^.ppufilename^,current_module^.staticlibfilename^)
+              SynchronizeFileTime(current_module.ppufilename^,current_module.staticlibfilename^)
             else
-              SynchronizeFileTime(current_module^.ppufilename^,current_module^.objfilename^);
+              SynchronizeFileTime(current_module.ppufilename^,current_module.objfilename^);
           end;
          exit;
        end;
@@ -596,7 +596,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2000-11-13 15:26:12  marco
+  Revision 1.8  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.7  2000/11/13 15:26:12  marco
    * Renamefest
 
   Revision 1.6  2000/10/01 19:48:23  peter

compiler/browcol.pas

@@ -1612,7 +1612,7 @@ begin
            if Assigned(hp^.loaded_from) then
              if assigned(hp^.loaded_from^.globalsymtable) then
                UnitS^.SetLoadedFrom(psymtable(hp^.loaded_from^.globalsymtable)^.name^);
-{           pimportlist(current_module^.imports^.first);}
+{           pimportlist(current_module.imports^.first);}
 
            if assigned(hp^.sourcefiles) then
            begin
@@ -2095,7 +2095,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2000-11-08 09:27:45  pierre
+  Revision 1.14  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.13  2000/11/08 09:27:45  pierre
    * fix for new is_class function
 
   Revision 1.12  2000/11/02 15:01:22  pierre

compiler/browlog.pas

@@ -26,7 +26,8 @@ unit browlog;
 
 interface
 uses
-  cobjects,globtype,
+  cobjects,cclasses,
+  globtype,
   fmodule,finput,
   symbase,symconst,symtype,symsym,symdef,symtable;
 
@@ -40,7 +41,7 @@ type
     logopen  : boolean;
     stderrlog : boolean;
     f        : file;
-    elements_to_list : pstringqueue;
+    elements_to_list : tstringlist;
     buf      : pchar;
     bufidx   : longint;
     identidx : longint;
@@ -77,7 +78,7 @@ implementation
 
     function get_file_line(ref:pref): string;
       var
-         inputfile : pinputfile;
+         inputfile : tinputfile;
       begin
         get_file_line:='';
         with ref^ do
@@ -88,10 +89,10 @@ implementation
              { for use with rhide
                add warning so that it does not interpret
                this as an error !! }
-               get_file_line:=lower(inputfile^.name^)
+               get_file_line:=lower(inputfile.name^)
                  +':'+tostr(posinfo.line)+': warning: '+tostr(posinfo.column)+':'
              else
-               get_file_line:=inputfile^.name^
+               get_file_line:=inputfile.name^
                  +'('+tostr(posinfo.line)+','+tostr(posinfo.column)+')'
            else
              if status.use_gccoutput then
@@ -111,7 +112,7 @@ implementation
       begin
         fname:=FixFileName('browser.log');
         logopen:=false;
-        elements_to_list:=new(pstringqueue,init);
+        elements_to_list:=TStringList.Create;
       end;
 
 
@@ -119,7 +120,7 @@ implementation
       begin
         if logopen then
          closelog;
-        dispose(elements_to_list,done);
+        elements_to_list.free;
       end;
 
 
@@ -182,8 +183,8 @@ implementation
          stderrlog:=true;
          getmem(buf,logbufsize);
          logopen:=true;
-         while not elements_to_list^.empty do
-           browse_symbol(elements_to_list^.get);
+         while not elements_to_list.empty do
+           browse_symbol(elements_to_list.getfirst);
          flushlog;
          logopen:=false;
          freemem(buf,logbufsize);
@@ -196,20 +197,20 @@ implementation
       end;
 {$else debug}
       var
-         hp : pmodule;
-         ff : pinputfile;
+         hp : tmodule;
+         ff : tinputfile;
       begin
-         hp:=pmodule(loaded_units.first);
+         hp:=tmodule(loaded_units.first);
          while assigned(hp) do
            begin
-              addlog('Unit '+hp^.modulename^+' has index '+tostr(hp^.unit_index));
-              ff:=hp^.sourcefiles^.files;
+              addlog('Unit '+hp.modulename^+' has index '+tostr(hp.unit_index));
+              ff:=hp.sourcefiles.files;
               while assigned(ff) do
                 begin
-                   addlog('File '+ff^.name^+' index '+tostr(ff^.ref_index));
-                   ff:=ff^.ref_next;
+                   addlog('File '+ff.name^+' index '+tostr(ff.ref_index));
+                   ff:=ff.ref_next;
                 end;
-              hp:=pmodule(hp^.next);
+              hp:=tmodule(hp.next);
            end;
       end;
 {$endif debug}
@@ -261,7 +262,7 @@ implementation
       var
          sym,symb : pstoredsym;
          symt : psymtable;
-         hp : pmodule;
+         hp : tmodule;
          s,ss : string;
          p : byte;
 
@@ -311,15 +312,15 @@ implementation
            begin
               symt:=nil;
               { try all loaded_units }
-              hp:=pmodule(loaded_units.first);
+              hp:=tmodule(loaded_units.first);
               while assigned(hp) do
                 begin
-                   if hp^.modulename^=upper(ss) then
+                   if hp.modulename^=upper(ss) then
                      begin
-                        symt:=hp^.globalsymtable;
+                        symt:=hp.globalsymtable;
                         break;
                      end;
-                   hp:=pmodule(hp^.next);
+                   hp:=tmodule(hp.next);
                 end;
               if not assigned(symt) then
                 begin
@@ -452,7 +453,7 @@ implementation
                         begin
                           browserlog.AddLog('***'+prdef^.mangledname);
                           browserlog.AddLogRefs(prdef^.defref);
-                          if (current_module^.flags and uf_local_browser)<>0 then
+                          if (current_module.flags and uf_local_browser)<>0 then
                             begin
                                if assigned(prdef^.parast) then
                                  writesymtable(prdef^.parast);
@@ -483,23 +484,23 @@ implementation
    procedure WriteBrowserLog;
      var
        p : pstoredsymtable;
-       hp : pmodule;
+       hp : tmodule;
      begin
        browserlog.CreateLog;
        browserlog.list_debug_infos;
-       hp:=pmodule(loaded_units.first);
+       hp:=tmodule(loaded_units.first);
        while assigned(hp) do
          begin
-            p:=pstoredsymtable(hp^.globalsymtable);
+            p:=pstoredsymtable(hp.globalsymtable);
             if assigned(p) then
               writesymtable(p);
             if cs_local_browser in aktmoduleswitches then
               begin
-                 p:=pstoredsymtable(hp^.localsymtable);
+                 p:=pstoredsymtable(hp.localsymtable);
                  if assigned(p) then
                    writesymtable(p);
               end;
-            hp:=pmodule(hp^.next);
+            hp:=tmodule(hp.next);
          end;
        browserlog.CloseLog;
      end;
@@ -518,7 +519,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2000-10-31 22:02:46  peter
+  Revision 1.6  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/10/31 22:02:46  peter
     * symtable splitted, no real code changes
 
   Revision 1.4  2000/09/24 15:06:11  peter
@@ -531,4 +536,4 @@ end.
   Revision 1.2  2000/07/13 11:32:32  michael
   + removed logs
 
-}
+}

compiler/cobjects.pas

@@ -34,13 +34,6 @@ interface
        hasharraysize = 2047;
 
     type
-       pfileposinfo = ^tfileposinfo;
-       tfileposinfo = record
-         line      : longint;
-         column    : word;
-         fileindex : word;
-       end;
-
        pmemdebug = ^tmemdebug;
        tmemdebug = object
           constructor init(const s:string);
@@ -51,133 +44,6 @@ interface
           infostr  : string[40];
        end;
 
-       plinkedlist_item = ^tlinkedlist_item;
-       tlinkedlist_item = object
-          next,previous : plinkedlist_item;
-          { does nothing }
-          constructor init;
-          destructor done;virtual;
-          function getcopy:plinkedlist_item;virtual;
-       end;
-
-       pstring_item = ^tstring_item;
-       tstring_item = object(tlinkedlist_item)
-          str : pstring;
-          constructor init(const s : string);
-          destructor done;virtual;
-       end;
-
-
-       { this implements a double linked list }
-       plinkedlist = ^tlinkedlist;
-       tlinkedlist = object
-          first,last : plinkedlist_item;
-          constructor init;
-          destructor done;
-
-          { disposes the items of the list }
-          procedure clear;
-
-          { concats a new item at the end }
-          procedure concat(p : plinkedlist_item);
-
-          { inserts a new item at the begin }
-          procedure insert(p : plinkedlist_item);
-
-          { inserts another list at the begin and make this list empty }
-          procedure insertlist(p : plinkedlist);
-
-          { concats another list at the end and make this list empty }
-          procedure concatlist(p : plinkedlist);
-
-          procedure concatlistcopy(p : plinkedlist);
-
-          { removes p from the list (p isn't disposed) }
-          { it's not tested if p is in the list !      }
-          procedure remove(p : plinkedlist_item);
-
-          { is the linkedlist empty ? }
-          function  empty:boolean;
-
-          { items in the list }
-          function  count:longint;
-       end;
-
-       { some help data types }
-       pstringqueueitem = ^tstringqueueitem;
-       tstringqueueitem = object
-          data : pstring;
-          next : pstringqueueitem;
-       end;
-
-       { String Queue}
-       PStringQueue=^TStringQueue;
-       TStringQueue=object
-         first,last : PStringqueueItem;
-         constructor Init;
-         destructor Done;
-         function Empty:boolean;
-         function Get:string;
-         function Find(const s:string):PStringqueueItem;
-         function Delete(const s:string):boolean;
-         procedure Insert(const s:string);
-         procedure Concat(const s:string);
-         procedure Clear;
-       end;
-
-       { containeritem }
-       pcontaineritem = ^tcontaineritem;
-       tcontaineritem = object
-          next : pcontaineritem;
-          constructor init;
-          destructor  done;virtual;
-       end;
-
-       { container }
-       pcontainer = ^tcontainer;
-       tcontainer = object
-          root,
-          last    : pcontaineritem;
-          constructor init;
-          destructor  done;
-          { true when the container is empty }
-          function  empty:boolean;
-          { amount of strings in the container }
-          function  count:longint;
-          { inserts a string }
-          procedure insert(item:pcontaineritem);
-          { gets a string }
-          function  get:pcontaineritem;
-          { deletes all items }
-          procedure clear;
-       end;
-
-       { containeritem }
-       pstringcontaineritem = ^tstringcontaineritem;
-       tstringcontaineritem = object(tcontaineritem)
-          data : pstring;
-          file_info : tfileposinfo;
-          constructor init(const s:string);
-          constructor Init_TokenInfo(const s:string;const pos:tfileposinfo);
-          destructor  done;virtual;
-       end;
-
-       { string container }
-       pstringcontainer = ^tstringcontainer;
-       tstringcontainer = object(tcontainer)
-          doubles : boolean;  { if this is set to true, doubles are allowed }
-          constructor init;
-          constructor init_no_double;
-          procedure insert(const s : string);
-          procedure insert_with_tokeninfo(const s : string;const file_info : tfileposinfo);
-          { gets a string }
-          function get : string;
-          function get_with_tokeninfo(var file_info : tfileposinfo) : string;
-          { true if string is in the container }
-          function find(const s:string):boolean;
-       end;
-
-
        { namedindexobect for use with dictionary and indexarray }
        Pnamedindexobject=^Tnamedindexobject;
        Tnamedindexobject=object
@@ -375,585 +241,6 @@ end;
 {$endif fixLeaksOnError}
 
 
-{****************************************************************************
-                                  TStringQueue
-****************************************************************************}
-
-constructor TStringQueue.Init;
-begin
-  first:=nil;
-  last:=nil;
-end;
-
-
-function TStringQueue.Empty:boolean;
-begin
-  Empty:=(first=nil);
-end;
-
-
-function TStringQueue.Get:string;
-var
-  newnode : pstringqueueitem;
-begin
-  if first=nil then
-   begin
-     Get:='';
-     exit;
-   end;
-  Get:=first^.data^;
-  stringdispose(first^.data);
-  newnode:=first;
-  first:=first^.next;
-  dispose(newnode);
-end;
-
-
-function TStringQueue.Find(const s:string):PStringqueueItem;
-var
-  p : PStringqueueItem;
-begin
-  p:=first;
-  while assigned(p) do
-   begin
-     if p^.data^=s then
-      break;
-     p:=p^.next;
-   end;
-  Find:=p;
-end;
-
-
-function TStringQueue.Delete(const s:string):boolean;
-var
-  prev,p : PStringqueueItem;
-begin
-  Delete:=false;
-  prev:=nil;
-  p:=first;
-  while assigned(p) do
-   begin
-     if p^.data^=s then
-      begin
-        if p=last then
-          last:=prev;
-        if assigned(prev) then
-         prev^.next:=p^.next
-        else
-         first:=p^.next;
-        dispose(p^.data);
-        dispose(p);
-        Delete:=true;
-        exit;
-      end;
-     prev:=p;
-     p:=p^.next;
-   end;
-end;
-
-
-procedure TStringQueue.Insert(const s:string);
-var
-  newnode : pstringqueueitem;
-begin
-  new(newnode);
-  newnode^.next:=first;
-  newnode^.data:=stringdup(s);
-  first:=newnode;
-  if last=nil then
-   last:=newnode;
-end;
-
-
-procedure TStringQueue.Concat(const s:string);
-var
-  newnode : pstringqueueitem;
-begin
-  new(newnode);
-  newnode^.next:=nil;
-  newnode^.data:=stringdup(s);
-  if first=nil then
-   first:=newnode
-  else
-   last^.next:=newnode;
-  last:=newnode;
-end;
-
-
-procedure TStringQueue.Clear;
-var
-  newnode : pstringqueueitem;
-begin
-  while (first<>nil) do
-   begin
-     newnode:=first;
-     stringdispose(first^.data);
-     first:=first^.next;
-     dispose(newnode);
-   end;
-  last:=nil;
-end;
-
-
-destructor TStringQueue.Done;
-begin
-  Clear;
-end;
-
-
-{****************************************************************************
-                                TContainerItem
- ****************************************************************************}
-
-constructor TContainerItem.Init;
-begin
-end;
-
-
-destructor TContainerItem.Done;
-begin
-end;
-
-
-{****************************************************************************
-                             TStringContainerItem
- ****************************************************************************}
-
-constructor TStringContainerItem.Init(const s:string);
-begin
-  inherited Init;
-  data:=stringdup(s);
-  file_info.fileindex:=0;
-  file_info.line:=0;
-  file_info.column:=0;
-end;
-
-
-constructor TStringContainerItem.Init_TokenInfo(const s:string;const pos:tfileposinfo);
-begin
-  inherited Init;
-  data:=stringdup(s);
-  file_info:=pos;
-end;
-
-
-destructor TStringContainerItem.Done;
-begin
-  stringdispose(data);
-end;
-
-
-{****************************************************************************
-                                   TCONTAINER
- ****************************************************************************}
-
-    constructor tcontainer.init;
-      begin
-         root:=nil;
-         last:=nil;
-      end;
-
-
-    destructor tcontainer.done;
-      begin
-         clear;
-      end;
-
-
-    function tcontainer.empty:boolean;
-      begin
-        empty:=(root=nil);
-      end;
-
-
-    function tcontainer.count:longint;
-      var
-        i : longint;
-        p : pcontaineritem;
-      begin
-        i:=0;
-        p:=root;
-        while assigned(p) do
-         begin
-           p:=p^.next;
-           inc(i);
-         end;
-        count:=i;
-      end;
-
-
-    procedure tcontainer.insert(item:pcontaineritem);
-      begin
-         item^.next:=nil;
-         if root=nil then
-          root:=item
-         else
-          last^.next:=item;
-         last:=item;
-      end;
-
-
-    procedure tcontainer.clear;
-      var
-         newnode : pcontaineritem;
-      begin
-         newnode:=root;
-         while assigned(newnode) do
-           begin
-              root:=newnode^.next;
-              dispose(newnode,done);
-              newnode:=root;
-           end;
-         last:=nil;
-         root:=nil;
-      end;
-
-
-    function tcontainer.get:pcontaineritem;
-      begin
-         if root=nil then
-          get:=nil
-         else
-          begin
-            get:=root;
-            root:=root^.next;
-          end;
-      end;
-
-
-{****************************************************************************
-                           TSTRINGCONTAINER
- ****************************************************************************}
-
-    constructor tstringcontainer.init;
-      begin
-         inherited init;
-         doubles:=true;
-      end;
-
-
-    constructor tstringcontainer.init_no_double;
-      begin
-         inherited init;
-         doubles:=false;
-      end;
-
-
-    procedure tstringcontainer.insert(const s : string);
-      var
-        newnode : pstringcontaineritem;
-      begin
-         if (s='') or
-            ((not doubles) and find(s)) then
-          exit;
-         new(newnode,init(s));
-         inherited insert(newnode);
-      end;
-
-
-    procedure tstringcontainer.insert_with_tokeninfo(const s : string; const file_info : tfileposinfo);
-      var
-        newnode : pstringcontaineritem;
-      begin
-         if (not doubles) and find(s) then
-          exit;
-         new(newnode,init_tokeninfo(s,file_info));
-         inherited insert(newnode);
-      end;
-
-
-    function tstringcontainer.get : string;
-      var
-         p : pstringcontaineritem;
-      begin
-         p:=pstringcontaineritem(inherited get);
-         if p=nil then
-          get:=''
-         else
-          begin
-            get:=p^.data^;
-            dispose(p,done);
-          end;
-      end;
-
-
-    function tstringcontainer.get_with_tokeninfo(var file_info : tfileposinfo) : string;
-      var
-         p : pstringcontaineritem;
-      begin
-         p:=pstringcontaineritem(inherited get);
-         if p=nil then
-          begin
-            get_with_tokeninfo:='';
-            file_info.fileindex:=0;
-            file_info.line:=0;
-            file_info.column:=0;
-          end
-         else
-          begin
-            get_with_tokeninfo:=p^.data^;
-            file_info:=p^.file_info;
-            dispose(p,done);
-          end;
-      end;
-
-
-    function tstringcontainer.find(const s:string):boolean;
-      var
-        newnode : pstringcontaineritem;
-      begin
-        find:=false;
-        newnode:=pstringcontaineritem(root);
-        while assigned(newnode) do
-         begin
-           if newnode^.data^=s then
-            begin
-              find:=true;
-              exit;
-            end;
-           newnode:=pstringcontaineritem(newnode^.next);
-         end;
-      end;
-
-
-{****************************************************************************
-                            TLINKEDLIST_ITEM
- ****************************************************************************}
-
-    constructor tlinkedlist_item.init;
-      begin
-        previous:=nil;
-        next:=nil;
-      end;
-
-
-    destructor tlinkedlist_item.done;
-      begin
-      end;
-
-
-    function tlinkedlist_item.getcopy:plinkedlist_item;
-      var
-        l : longint;
-        p : plinkedlist_item;
-      begin
-        l:=sizeof(self);
-        getmem(p,l);
-        move(self,p^,l);
-        getcopy:=p;
-      end;
-
-
-{****************************************************************************
-                            TSTRING_ITEM
- ****************************************************************************}
-
-    constructor tstring_item.init(const s : string);
-      begin
-         str:=stringdup(s);
-      end;
-
-
-    destructor tstring_item.done;
-      begin
-         stringdispose(str);
-         inherited done;
-      end;
-
-
-{****************************************************************************
-                               TLINKEDLIST
- ****************************************************************************}
-
-    constructor tlinkedlist.init;
-      begin
-         first:=nil;
-         last:=nil;
-      end;
-
-
-    destructor tlinkedlist.done;
-      begin
-         clear;
-      end;
-
-
-    procedure tlinkedlist.clear;
-      var
-         newnode : plinkedlist_item;
-      begin
-         newnode:=first;
-         while assigned(newnode) do
-           begin
-              first:=newnode^.next;
-              dispose(newnode,done);
-              newnode:=first;
-           end;
-      end;
-
-
-    procedure tlinkedlist.insertlist(p : plinkedlist);
-      begin
-         { empty list ? }
-         if not(assigned(p^.first)) then
-           exit;
-
-         p^.last^.next:=first;
-
-         { we have a double linked list }
-         if assigned(first) then
-           first^.previous:=p^.last;
-
-         first:=p^.first;
-
-         if not(assigned(last)) then
-           last:=p^.last;
-
-         { p becomes empty }
-         p^.first:=nil;
-         p^.last:=nil;
-      end;
-
-
-    procedure tlinkedlist.concat(p : plinkedlist_item);
-      begin
-        if not(assigned(first)) then
-         begin
-           first:=p;
-           p^.previous:=nil;
-           p^.next:=nil;
-         end
-        else
-         begin
-           last^.next:=p;
-           p^.previous:=last;
-           p^.next:=nil;
-         end;
-        last:=p;
-      end;
-
-
-    procedure tlinkedlist.insert(p : plinkedlist_item);
-      begin
-         if not(assigned(first)) then
-          begin
-            last:=p;
-            p^.previous:=nil;
-            p^.next:=nil;
-          end
-         else
-          begin
-            first^.previous:=p;
-            p^.previous:=nil;
-            p^.next:=first;
-          end;
-         first:=p;
-      end;
-
-
-    procedure tlinkedlist.remove(p : plinkedlist_item);
-      begin
-         if not(assigned(p)) then
-           exit;
-         if (first=p) and (last=p) then
-           begin
-              first:=nil;
-              last:=nil;
-           end
-         else if first=p then
-           begin
-              first:=p^.next;
-              if assigned(first) then
-                first^.previous:=nil;
-           end
-         else if last=p then
-           begin
-              last:=last^.previous;
-              if assigned(last) then
-                last^.next:=nil;
-           end
-         else
-           begin
-              p^.previous^.next:=p^.next;
-              p^.next^.previous:=p^.previous;
-           end;
-         p^.next:=nil;
-         p^.previous:=nil;
-      end;
-
-
-    procedure tlinkedlist.concatlist(p : plinkedlist);
-     begin
-         if not(assigned(p^.first)) then
-           exit;
-
-         if not(assigned(first)) then
-           first:=p^.first
-           else
-             begin
-                last^.next:=p^.first;
-                p^.first^.previous:=last;
-             end;
-
-         last:=p^.last;
-
-         { make p empty }
-         p^.last:=nil;
-         p^.first:=nil;
-      end;
-
-
-    procedure tlinkedlist.concatlistcopy(p : plinkedlist);
-      var
-        newnode,newnode2 : plinkedlist_item;
-      begin
-         newnode:=p^.first;
-         while assigned(newnode) do
-          begin
-            newnode2:=newnode^.getcopy;
-            if assigned(newnode2) then
-             begin
-               if not(assigned(first)) then
-                begin
-                  first:=newnode2;
-                  newnode2^.previous:=nil;
-                  newnode2^.next:=nil;
-                end
-               else
-                begin
-                  last^.next:=newnode2;
-                  newnode2^.previous:=last;
-                  newnode2^.next:=nil;
-                end;
-               last:=newnode2;
-             end;
-            newnode:=newnode^.next;
-          end;
-      end;
-
-
-    function tlinkedlist.empty:boolean;
-      begin
-        empty:=(first=nil);
-      end;
-
-
-    function tlinkedlist.count:longint;
-      var
-        i : longint;
-        hp : plinkedlist_item;
-      begin
-        hp:=first;
-        i:=0;
-        while assigned(hp) do
-         begin
-           inc(i);
-           hp:=hp^.next;
-         end;
-        count:=i;
-      end;
-
-
 {****************************************************************************
                                Tnamedindexobject
  ****************************************************************************}
@@ -1616,7 +903,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.21  2000-12-24 12:25:31  peter
+  Revision 1.22  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.21  2000/12/24 12:25:31  peter
     + cstreams unit
     * dynamicarray object to class
 

compiler/comphook.pas

@@ -98,7 +98,7 @@ function  def_internalerror(i:longint):boolean;
 procedure def_initsymbolinfo;
 procedure def_donesymbolinfo;
 procedure def_extractsymbolinfo;
-function  def_openinputfile(const filename: string): pinputfile;
+function  def_openinputfile(const filename: string): tinputfile;
 Function  def_getnamedfiletime(Const F : String) : Longint;
 {$ifdef DEBUG}
 { allow easy stopping in GDB
@@ -118,7 +118,7 @@ type
   tinitsymbolinfoproc = procedure;
   tdonesymbolinfoproc = procedure;
   textractsymbolinfoproc = procedure;
-  topeninputfilefunc = function(const filename: string): pinputfile;
+  topeninputfilefunc = function(const filename: string): tinputfile;
   tgetnamedfiletimefunc = function(const filename: string): longint;
 
 const
@@ -331,9 +331,9 @@ procedure def_extractsymbolinfo;
 begin
 end;
 
-function  def_openinputfile(const filename: string): pinputfile;
+function  def_openinputfile(const filename: string): tinputfile;
 begin
-  def_openinputfile:=new(pdosinputfile, init(filename));
+  def_openinputfile:=tdosinputfile.create(filename);
 end;
 
 
@@ -366,7 +366,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.9  2000-11-13 15:26:12  marco
+  Revision 1.10  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.9  2000/11/13 15:26:12  marco
    * Renamefest
 
   Revision 1.8  2000/09/30 16:07:20  peter

compiler/compiler.pas

@@ -96,7 +96,7 @@ uses
   dos,
 {$endif Delphi}
   verbose,comphook,systems,
-  cutils,cobjects,globals,options,fmodule,parser,symtable,
+  cutils,cclasses,globals,options,fmodule,parser,symtable,
   link,import,export,tokens,
   { cpu overrides }
   cpuswtch,cpunode
@@ -224,13 +224,13 @@ function Compile(const cmd:string):longint;
 
   procedure writepathlist(w:longint;l:TSearchPathList);
   var
-    hp : pstringqueueitem;
+    hp : tstringlistitem;
   begin
-    hp:=l.first;
+    hp:=tstringlistitem(l.first);
     while assigned(hp) do
      begin
-       Message1(w,hp^.data^);
-       hp:=hp^.next;
+       Message1(w,hp.str);
+       hp:=tstringlistitem(hp.next);
      end;
   end;
 
@@ -321,7 +321,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.13  2000-12-24 12:24:38  peter
+  Revision 1.14  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.13  2000/12/24 12:24:38  peter
     * moved preprocessfile into a conditional
 
   Revision 1.11  2000/11/29 00:30:30  florian

compiler/comprsrc.pas

@@ -88,7 +88,7 @@ begin
      Message(exec_w_res_not_found);
      aktglobalswitches:=aktglobalswitches+[cs_link_extern];
    end;
-  resobj:=ForceExtension(current_module^.objfilename^,target_info.resobjext);
+  resobj:=ForceExtension(current_module.objfilename^,target_info.resobjext);
   s:=target_res.rescmd;
   Replace(s,'$OBJ',resobj);
   Replace(s,'$RES',fname);
@@ -115,7 +115,7 @@ begin
   { Update asmres when externmode is set }
   if cs_link_extern in aktglobalswitches then
     AsmRes.AddLinkCommand(resbin,s,'');
-  current_module^.linkotherofiles.insert(resobj,link_allways);
+  current_module.linkotherofiles.add(resobj,link_allways);
 end;
 
 
@@ -125,11 +125,11 @@ var
 begin
 (* OS/2 (EMX) must be processed elsewhere (in the linking/binding stage). *)
   if target_info.target <> target_i386_os2 then
-   While not Current_module^.ResourceFiles.Empty do
+   While not current_module.ResourceFiles.Empty do
     begin
       case target_info.target of
         target_i386_win32:
-          hr:=new(presourcefile,init(Current_module^.ResourceFiles.get));
+          hr:=new(presourcefile,init(current_module.ResourceFiles.getfirst));
         else
           Message(scan_e_resourcefiles_not_supported);
       end;
@@ -142,7 +142,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-09-24 15:06:14  peter
+  Revision 1.6  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/09/24 15:06:14  peter
     * use defines.inc
 
   Revision 1.4  2000/08/27 16:11:50  peter

compiler/cresstr.pas

@@ -27,36 +27,34 @@ unit cresstr;
 interface
 
 uses
-  cobjects;
+  cclasses;
 
 Type
   { These are used to form a singly-linked list, ordered by hash value }
-  PResourceStringItem = ^TResourceStringItem;
-  TResourceStringItem = object(TLinkedList_Item)
+  TResourceStringItem = class(TLinkedListItem)
     Name  : String;
     Value : Pchar;
     Len,
     hash  : longint;
-    constructor Init(const AName:string;AValue:pchar;ALen:longint);
-    destructor  Done;virtual;
+    constructor Create(const AName:string;AValue:pchar;ALen:longint);
+    destructor  Destroy;override;
     procedure CalcHash;
   end;
 
-  PResourceStrings=^TResourceStrings;
-  TResourceStrings=object
+  TResourceStrings=class
   private
     List : TLinkedList;
   public
     ResStrCount : longint;
-    constructor Init;
-    destructor  Done;
+    constructor Create;
+    destructor  Destroy;override;
     function  Register(Const name : string;p : pchar;len : longint) : longint;
     procedure CreateResourceStringList;
     Procedure WriteResourceFile(FileName : String);
   end;
 
 var
-  ResourceStrings : PResourceStrings;
+  ResourceStrings : TResourceStrings;
 
 
 implementation
@@ -73,9 +71,9 @@ uses
                           TRESOURCESTRING_ITEM
   ---------------------------------------------------------------------}
 
-constructor TResourceStringItem.Init(const AName:string;AValue:pchar;ALen:longint);
+constructor TResourceStringItem.Create(const AName:string;AValue:pchar;ALen:longint);
 begin
-  inherited Init;
+  inherited Create;
   Name:=AName;
   Len:=ALen;
   GetMem(Value,Len);
@@ -84,7 +82,7 @@ begin
 end;
 
 
-destructor TResourceStringItem.Done;
+destructor TResourceStringItem.Destroy;
 begin
   FreeMem(Value,Len);
 end;
@@ -123,16 +121,16 @@ end;
                           TRESOURCESTRINGS
   ---------------------------------------------------------------------}
 
-Constructor TResourceStrings.Init;
+Constructor TResourceStrings.Create;
 begin
-  List.Init;
+  List:=TStringList.Create;
   ResStrCount:=0;
 end;
 
 
-Destructor TResourceStrings.Done;
+Destructor TResourceStrings.Destroy;
 begin
-  List.Done;
+  List.Free;
 end;
 
 
@@ -142,63 +140,63 @@ end;
 
 procedure TResourceStrings.CreateResourceStringList;
 
-  Procedure AppendToAsmResList (P : PResourceStringItem);
+  Procedure AppendToAsmResList (P : TResourceStringItem);
   Var
     l1 : pasmlabel;
     s : pchar;
     l : longint;
   begin
-    With P^ Do
+    With P Do
      begin
        if (Value=nil) or (len=0) then
-         resourcestringlist^.concat(new(pai_const,init_32bit(0)))
+         resourcestringlist.concat(tai_const.create_32bit(0))
        else
          begin
             getdatalabel(l1);
-            resourcestringlist^.concat(new(pai_const_symbol,init(l1)));
-            consts^.concat(new(pai_const,init_32bit(len)));
-            consts^.concat(new(pai_const,init_32bit(len)));
-            consts^.concat(new(pai_const,init_32bit(-1)));
-            consts^.concat(new(pai_label,init(l1)));
+            resourcestringlist.concat(tai_const_symbol.create(l1));
+            consts.concat(tai_const.create_32bit(len));
+            consts.concat(tai_const.create_32bit(len));
+            consts.concat(tai_const.create_32bit(-1));
+            consts.concat(tai_label.create(l1));
             getmem(s,len+1);
             move(Value^,s^,len);
             s[len]:=#0;
-            consts^.concat(new(pai_string,init_length_pchar(s,len)));
-            consts^.concat(new(pai_const,init_8bit(0)));
+            consts.concat(tai_string.create_length_pchar(s,len));
+            consts.concat(tai_const.create_8bit(0));
          end;
        { append Current value (nil) and hash...}
-       resourcestringlist^.concat(new(pai_const,init_32bit(0)));
-       resourcestringlist^.concat(new(pai_const,init_32bit(hash)));
+       resourcestringlist.concat(tai_const.create_32bit(0));
+       resourcestringlist.concat(tai_const.create_32bit(hash));
        { Append the name as a ansistring. }
        getdatalabel(l1);
        L:=Length(Name);
-       resourcestringlist^.concat(new(pai_const_symbol,init(l1)));
-       consts^.concat(new(pai_const,init_32bit(l)));
-       consts^.concat(new(pai_const,init_32bit(l)));
-       consts^.concat(new(pai_const,init_32bit(-1)));
-       consts^.concat(new(pai_label,init(l1)));
+       resourcestringlist.concat(tai_const_symbol.create(l1));
+       consts.concat(tai_const.create_32bit(l));
+       consts.concat(tai_const.create_32bit(l));
+       consts.concat(tai_const.create_32bit(-1));
+       consts.concat(tai_label.create(l1));
        getmem(s,l+1);
        move(Name[1],s^,l);
        s[l]:=#0;
-       consts^.concat(new(pai_string,init_length_pchar(s,l)));
-       consts^.concat(new(pai_const,init_8bit(0)));
+       consts.concat(tai_string.create_length_pchar(s,l));
+       consts.concat(tai_const.create_8bit(0));
      end;
   end;
 
 Var
-  R : PresourceStringItem;
+  R : tresourceStringItem;
 begin
   if not(assigned(resourcestringlist)) then
-    resourcestringlist:=new(paasmoutput,init);
-  resourcestringlist^.insert(new(pai_const,init_32bit(resstrcount)));
-  resourcestringlist^.insert(new(pai_symbol,initdataname_global(current_module^.modulename^+'_'+'RESOURCESTRINGLIST',0)));
-  R:=PResourceStringItem(List.First);
+    resourcestringlist:=taasmoutput.create;
+  resourcestringlist.insert(tai_const.create_32bit(resstrcount));
+  resourcestringlist.insert(tai_symbol.createdataname_global(current_module.modulename^+'_'+'RESOURCESTRINGLIST',0));
+  R:=TResourceStringItem(List.First);
   While assigned(R) do
    begin
      AppendToAsmResList(R);
-     R:=PResourceStringItem(R^.Next);
+     R:=TResourceStringItem(R.Next);
    end;
-  resourcestringlist^.concat(new(pai_symbol_end,initname(current_module^.modulename^+'_'+'RESOURCESTRINGLIST')));
+  resourcestringlist.concat(tai_symbol_end.createname(current_module.modulename^+'_'+'RESOURCESTRINGLIST'));
 end;
 
 
@@ -208,7 +206,7 @@ end;
 
 function  TResourceStrings.Register(const name : string;p : pchar;len : longint) : longint;
 begin
-  List.Concat(new(PResourceStringItem,Init(lower(current_module^.modulename^+'.'+Name),p,len)));
+  List.Concat(tResourceStringItem.Create(lower(current_module.modulename^+'.'+Name),p,len));
   Register:=ResStrCount;
   inc(ResStrCount);
 end;
@@ -220,7 +218,7 @@ Type
 Var
   F : Text;
   Mode : TMode;
-  R : PResourceStringItem;
+  R : TResourceStringItem;
   C : char;
   Col,i : longint;
 
@@ -233,7 +231,7 @@ Var
 begin
   If List.Empty then
     exit;
-  FileName:=current_module^.outputpath^+FixFileName(ForceExtension(FileName,'.rst'));
+  FileName:=current_module.outputpath^+FixFileName(ForceExtension(FileName,'.rst'));
   message1 (general_i_writingresourcefile,filename);
   Assign(F,Filename);
   {$i-}
@@ -244,17 +242,17 @@ begin
     message(general_e_errorwritingresourcefile);
     exit;
     end;
-  R:=PResourceStringItem(List.First);
+  R:=TResourceStringItem(List.First);
   While assigned(R) do
    begin
      writeln(f);
-     Writeln(f,'# hash value = ',R^.hash);
+     Writeln(f,'# hash value = ',R.hash);
      col:=0;
-     Add(R^.Name+'=');
+     Add(R.Name+'=');
      Mode:=unquoted;
-     For I:=0 to R^.Len-1 do
+     For I:=0 to R.Len-1 do
       begin
-        C:=R^.Value[i];
+        C:=R.Value[i];
         If (ord(C)>31) and (Ord(c)<=128) and (c<>'''') then
          begin
            If mode=Quoted then
@@ -286,7 +284,7 @@ begin
      if mode=quoted then
       writeln (f,'''');
      Writeln(f);
-     R:=PResourceStringItem(R^.Next);
+     R:=TResourceStringItem(R.Next);
    end;
   close(f);
 end;
@@ -295,7 +293,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.7  2000-11-13 14:44:35  jonas
+  Revision 1.8  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.7  2000/11/13 14:44:35  jonas
     * fixes so no more range errors with improved range checking code
 
   Revision 1.6  2000/09/24 15:06:14  peter

compiler/cstreams.pas

@@ -151,6 +151,9 @@ type
 
 implementation
 
+  Type
+    PByte = ^Byte;
+
 {*****************************************************************************
                                    TCStream
 *****************************************************************************}
@@ -209,7 +212,7 @@ implementation
 
     begin
        CStreamError:=0;
-       CopyFrom:=0;
+       Result:=0;
        while Count>0 do
          begin
             if (Count>sizeof(buffer)) then
@@ -219,7 +222,7 @@ implementation
             i:=Source.Read(buffer,i);
             i:=Write(buffer,i);
             dec(count,i);
-            CopyFrom:=CopyFrom+i;
+            inc(Result,i);
             if i=0 then
               exit;
          end;
@@ -294,8 +297,6 @@ implementation
     end;
 
   Function TCStream.ReadAnsiString : AnsiString;
-  Type
-    PByte = ^Byte;
   Var
     TheSize : Longint;
     P : PByte ;
@@ -306,7 +307,7 @@ implementation
     if TheSize>0 then
      begin
        ReadBuffer (Pointer(Result)^,TheSize);
-       P:=Pointer(Result)+TheSize;
+       P:=PByte(Longint(Result)+TheSize);
        p^:=0;
      end;
    end;
@@ -450,7 +451,7 @@ begin
     begin
     Result:=FSize-FPosition;
     If Result>Count then Result:=Count;
-    Move ((FMemory+FPosition)^,Buffer,Result);
+    Move (Pointer(Longint(FMemory)+FPosition)^,Buffer,Result);
     FPosition:=Fposition+Result;
     end;
 end;
@@ -590,7 +591,10 @@ Var NewPos : Longint;
 
 begin
   If Count=0 then
-    exit(0);
+   begin
+     Result:=0;
+     exit;
+   end;
   NewPos:=FPosition+Count;
   If NewPos>Fsize then
     begin
@@ -598,7 +602,7 @@ begin
       SetCapacity (NewPos);
     FSize:=Newpos;
     end;
-  System.Move (Buffer,(FMemory+FPosition)^,Count);
+  System.Move (Buffer,Pointer(Longint(FMemory)+FPosition)^,Count);
   FPosition:=NewPos;
   Result:=Count;
 end;
@@ -606,7 +610,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2000-12-24 12:25:31  peter
+  Revision 1.2  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.1  2000/12/24 12:25:31  peter
     + cstreams unit
     * dynamicarray object to class
 

compiler/export.pas

@@ -27,7 +27,7 @@ unit export;
 interface
 
 uses
-  cutils,cobjects,
+  cutils,cclasses,
   symtype;
 
 const
@@ -37,33 +37,31 @@ const
    eo_name     = $4;
 
 type
-   pexported_item = ^texported_item;
-   texported_item = object(tlinkedlist_item)
+   texported_item = class(tlinkedlistitem)
       sym : psym;
       index : longint;
       name : pstring;
       options : word;
       is_var : boolean;
-      constructor init;
-      destructor done;virtual;
+      constructor create;
+      destructor destroy;override;
    end;
 
-   pexportlib=^texportlib;
-   texportlib=object
+   texportlib=class
    private
       notsupmsg : boolean;
       procedure NotSupported;
    public
-      constructor Init;
-      destructor Done;
+      constructor Create;
+      destructor Destroy;override;
       procedure preparelib(const s : string);virtual;
-      procedure exportprocedure(hp : pexported_item);virtual;
-      procedure exportvar(hp : pexported_item);virtual;
+      procedure exportprocedure(hp : texported_item);virtual;
+      procedure exportvar(hp : texported_item);virtual;
       procedure generatelib;virtual;
    end;
 
 var
-   exportlib : pexportlib;
+   exportlib : texportlib;
 
 procedure InitExport;
 procedure DoneExport;
@@ -113,9 +111,9 @@ uses
                            TImported_procedure
 ****************************************************************************}
 
-constructor texported_item.init;
+constructor texported_item.Create;
 begin
-  inherited init;
+  inherited Create;
   sym:=nil;
   index:=-1;
   name:=nil;
@@ -124,10 +122,10 @@ begin
 end;
 
 
-destructor texported_item.done;
+destructor texported_item.destroy;
 begin
   stringdispose(name);
-  inherited done;
+  inherited destroy;
 end;
 
 
@@ -135,13 +133,13 @@ end;
                               TImportLib
 ****************************************************************************}
 
-constructor texportlib.Init;
+constructor texportlib.Create;
 begin
   notsupmsg:=false;
 end;
 
 
-destructor texportlib.Done;
+destructor texportlib.Destroy;
 begin
 end;
 
@@ -163,13 +161,13 @@ begin
 end;
 
 
-procedure texportlib.exportprocedure(hp : pexported_item);
+procedure texportlib.exportprocedure(hp : texported_item);
 begin
   NotSupported;
 end;
 
 
-procedure texportlib.exportvar(hp : pexported_item);
+procedure texportlib.exportvar(hp : texported_item);
 begin
   NotSupported;
 end;
@@ -184,7 +182,7 @@ end;
 procedure DoneExport;
 begin
   if assigned(exportlib) then
-    dispose(exportlib,done);
+    exportlib.free;
 end;
 
 
@@ -193,32 +191,32 @@ begin
   case target_info.target of
 {$ifdef i386}
     target_i386_Linux :
-      exportlib:=new(pexportliblinux,Init);
+      exportlib:=Texportliblinux.Create;
     target_i386_freebsd:
-      exportlib:=new(pexportlibfreebsd,Init);
+      exportlib:=Texportlibfreebsd.Create;
     target_i386_Win32 :
-      exportlib:=new(pexportlibwin32,Init);
+      exportlib:=Texportlibwin32.Create;
     target_i386_Netware :
-      exportlib:=new(pexportlibnetware,Init);
+      exportlib:=Texportlibnetware.Create;
 {
     target_i386_OS2 :
-      exportlib:=new(pexportlibos2,Init);
+      exportlib:=Texportlibos2.Create;
 }
 {$endif i386}
 {$ifdef m68k}
     target_m68k_Linux :
-      exportlib:=new(pexportlib,Init);
+      exportlib:=Texportliblinux.Create;
 {$endif m68k}
 {$ifdef alpha}
     target_alpha_Linux :
-      exportlib:=new(pexportlib,Init);
+      exportlib:=Texportliblinux.Create;
 {$endif alpha}
 {$ifdef powerpc}
     target_alpha_Linux :
-      exportlib:=new(pexportlib,Init);
+      exportlib:=Texportliblinux.Create;
 {$endif powerpc}
     else
-      exportlib:=new(pexportlib,Init);
+      exportlib:=Texportlib.Create;
   end;
 end;
 
@@ -226,7 +224,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.8  2000-11-29 00:30:30  florian
+  Revision 1.9  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.8  2000/11/29 00:30:30  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/finput.pas

@@ -27,7 +27,7 @@ unit finput;
 interface
 
     uses
-      cutils,cobjects;
+      cutils,cobjects,cclasses;
 
     const
        InputFileBufSize=32*1024;
@@ -37,10 +37,9 @@ interface
        tlongintarr = array[0..1000000] of longint;
        plongintarr = ^tlongintarr;
 
-       pinputfile = ^tinputfile;
-       tinputfile = object
+       tinputfile = class
          path,name : pstring;       { path and filename }
-         next      : pinputfile;    { next file for reading }
+         next      : tinputfile;    { next file for reading }
 
          is_macro,
          endoffile,                 { still bytes left to read }
@@ -59,10 +58,10 @@ interface
          maxlinebuf : longint;
 
          ref_index  : longint;      { to handle the browser refs }
-         ref_next   : pinputfile;
+         ref_next   : tinputfile;
 
-         constructor init(const fn:string);
-         destructor done;
+         constructor create(const fn:string);
+         destructor  destroy;override;
          procedure setpos(l:longint);
          procedure seekbuf(fpos:longint);
          procedure readbuf;
@@ -73,7 +72,7 @@ interface
          procedure setmacro(p:pchar;len:longint);
          procedure setline(line,linepos:longint);
          function  getlinestr(l:longint):string;
-       {$ifdef FPC}protected{$else}public{$endif}
+       protected
          function fileopen(const filename: string): boolean; virtual;
          function fileseek(pos: longint): boolean; virtual;
          function fileread(var databuf; maxsize: longint): longint; virtual;
@@ -81,29 +80,27 @@ interface
          function fileclose: boolean; virtual;
        end;
 
-       pdosinputfile = ^tdosinputfile;
-       tdosinputfile = object(tinputfile)
-       {$ifdef FPC}protected{$else}public{$endif}
-         function fileopen(const filename: string): boolean; virtual;
-         function fileseek(pos: longint): boolean; virtual;
-         function fileread(var databuf; maxsize: longint): longint; virtual;
-         function fileeof: boolean; virtual;
-         function fileclose: boolean; virtual;
+       tdosinputfile = class(tinputfile)
+       protected
+         function fileopen(const filename: string): boolean; override;
+         function fileseek(pos: longint): boolean; override;
+         function fileread(var databuf; maxsize: longint): longint; override;
+         function fileeof: boolean; override;
+         function fileclose: boolean; override;
        private
          f            : file;       { current file handle }
        end;
 
-       pinputfilemanager = ^tinputfilemanager;
-       tinputfilemanager = object
-          files : pinputfile;
+       tinputfilemanager = class
+          files : tinputfile;
           last_ref_index : longint;
           cacheindex : longint;
-          cacheinputfile : pinputfile;
-          constructor init;
-          destructor done;
-          procedure register_file(f : pinputfile);
+          cacheinputfile : tinputfile;
+          constructor create;
+          destructor destroy;override;
+          procedure register_file(f : tinputfile);
           procedure inverse_register_indexes;
-          function  get_file(l:longint) : pinputfile;
+          function  get_file(l:longint) : tinputfile;
           function  get_file_name(l :longint):string;
           function  get_file_path(l :longint):string;
        end;
@@ -112,12 +109,11 @@ interface
                                 TModuleBase
  ****************************************************************************}
 
-       pmodulebase = ^tmodulebase;
-       tmodulebase = object(tlinkedlist_item)
+       tmodulebase = class(TLinkedListItem)
           { index }
           unit_index    : longint;  { global counter for browser }
           { sources }
-          sourcefiles   : pinputfilemanager;
+          sourcefiles   : tinputfilemanager;
           { paths and filenames }
           path,                     { path where the module is find/created }
           outputpath,               { path where the .s / .o / exe are created }
@@ -130,8 +126,8 @@ interface
           sharedlibfilename,        { fullname of the shared libraryfile }
           exefilename,              { fullname of the exefile }
           mainsource   : pstring;   { name of the main sourcefile }
-          constructor init(const s:string);
-          destructor done;virtual;
+          constructor create(const s:string);
+          destructor destroy;override;
           procedure setfilename(const fn:string;allowoutput:boolean);
        end;
 
@@ -151,7 +147,7 @@ uses
                                   TINPUTFILE
  ****************************************************************************}
 
-    constructor tinputfile.init(const fn:string);
+    constructor tinputfile.create(const fn:string);
       var
         p:dirstr;
         n:namestr;
@@ -182,7 +178,7 @@ uses
       end;
 
 
-    destructor tinputfile.done;
+    destructor tinputfile.destroy;
       begin
         if not closed then
          close;
@@ -485,7 +481,7 @@ uses
                                 Tinputfilemanager
  ****************************************************************************}
 
-    constructor tinputfilemanager.init;
+    constructor tinputfilemanager.create;
       begin
          files:=nil;
          last_ref_index:=0;
@@ -494,35 +490,35 @@ uses
       end;
 
 
-    destructor tinputfilemanager.done;
+    destructor tinputfilemanager.destroy;
       var
-         hp : pinputfile;
+         hp : tinputfile;
       begin
          hp:=files;
          while assigned(hp) do
           begin
-            files:=files^.ref_next;
-            dispose(hp,done);
+            files:=files.ref_next;
+            hp.free;
             hp:=files;
           end;
          last_ref_index:=0;
       end;
 
 
-    procedure tinputfilemanager.register_file(f : pinputfile);
+    procedure tinputfilemanager.register_file(f : tinputfile);
       begin
          { don't register macro's }
-         if f^.is_macro then
+         if f.is_macro then
           exit;
          inc(last_ref_index);
-         f^.ref_next:=files;
-         f^.ref_index:=last_ref_index;
+         f.ref_next:=files;
+         f.ref_index:=last_ref_index;
          files:=f;
          { update cache }
          cacheindex:=last_ref_index;
          cacheinputfile:=f;
 {$ifdef HEAPTRC}
-         writeln(stderr,f^.name^,' index ',current_module^.unit_index*100000+f^.ref_index);
+         writeln(stderr,f.name^,' index ',current_module.unit_index*100000+f.ref_index);
 {$endif HEAPTRC}
       end;
 
@@ -531,13 +527,13 @@ uses
      sources files from a PPU file  PM }
    procedure tinputfilemanager.inverse_register_indexes;
      var
-        f : pinputfile;
+        f : tinputfile;
      begin
         f:=files;
         while assigned(f) do
           begin
-             f^.ref_index:=last_ref_index-f^.ref_index+1;
-             f:=f^.ref_next;
+             f.ref_index:=last_ref_index-f.ref_index+1;
+             f:=f.ref_next;
           end;
         { reset cache }
         cacheindex:=0;
@@ -546,9 +542,9 @@ uses
 
 
 
-   function tinputfilemanager.get_file(l :longint) : pinputfile;
+   function tinputfilemanager.get_file(l :longint) : tinputfile;
      var
-        ff : pinputfile;
+        ff : tinputfile;
      begin
        { check cache }
        if (l=cacheindex) and assigned(cacheinputfile) then
@@ -557,19 +553,19 @@ uses
           exit;
         end;
        ff:=files;
-       while assigned(ff) and (ff^.ref_index<>l) do
-         ff:=ff^.ref_next;
+       while assigned(ff) and (ff.ref_index<>l) do
+         ff:=ff.ref_next;
        get_file:=ff;
      end;
 
 
    function tinputfilemanager.get_file_name(l :longint):string;
      var
-       hp : pinputfile;
+       hp : tinputfile;
      begin
        hp:=get_file(l);
        if assigned(hp) then
-        get_file_name:=hp^.name^
+        get_file_name:=hp.name^
        else
         get_file_name:='';
      end;
@@ -577,11 +573,11 @@ uses
 
    function tinputfilemanager.get_file_path(l :longint):string;
      var
-       hp : pinputfile;
+       hp : tinputfile;
      begin
        hp:=get_file(l);
        if assigned(hp) then
-        get_file_path:=hp^.path^
+        get_file_path:=hp.path^
        else
         get_file_path:='';
      end;
@@ -641,7 +637,7 @@ uses
       end;
 
 
-    constructor tmodulebase.init(const s:string);
+    constructor tmodulebase.create(const s:string);
       begin
         modulename:=stringdup(Upper(s));
         realmodulename:=stringdup(s);
@@ -658,14 +654,14 @@ uses
         inc(global_unit_count);
         unit_index:=global_unit_count;
         { sources }
-        new(sourcefiles,init);
+        sourcefiles:=TInputFileManager.Create;
       end;
 
 
-    destructor tmodulebase.done;
+    destructor tmodulebase.destroy;
       begin
         if assigned(sourcefiles) then
-         dispose(sourcefiles,done);
+         sourcefiles.free;
         sourcefiles:=nil;
         stringdispose(objfilename);
         stringdispose(asmfilename);
@@ -678,14 +674,18 @@ uses
         stringdispose(modulename);
         stringdispose(realmodulename);
         stringdispose(mainsource);
-        inherited done;
+        inherited destroy;
       end;
 
 end.
 {
   $Log$
-  Revision 1.5  2000-11-07 20:48:33  peter
-    * removed ref_count from pinputfile it's not used
+  Revision 1.6  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/11/07 20:48:33  peter
+    * removed ref_count from tinputfile it's not used
 
   Revision 1.4  2000/10/31 22:02:46  peter
     * symtable splitted, no real code changes
@@ -700,4 +700,4 @@ end.
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 
-}
+}

compiler/fmodule.pas

@@ -40,7 +40,7 @@ unit fmodule;
 interface
 
     uses
-       cutils,cobjects,
+       cutils,cobjects,cclasses,
        globals,ppu,finput;
 
     const
@@ -52,34 +52,30 @@ interface
          rr_asmolder,rr_crcchanged
        );
 
-       plinkcontaineritem=^tlinkcontaineritem;
-       tlinkcontaineritem=object(tcontaineritem)
-          data     : pstring;
-          needlink : longint;
-          constructor init(const s:string;m:longint);
-          destructor  done;virtual;
+       tlinkcontaineritem=class(tlinkedlistitem)
+       public
+          data : pstring;
+          needlink : cardinal;
+          constructor Create(const s:string;m:cardinal);
+          destructor Destroy;override;
        end;
 
-       plinkcontainer=^tlinkcontainer;
-       tlinkcontainer=object(tcontainer)
-          constructor Init;
-          procedure insert(const s : string;m:longint);
-          function get(var m:longint) : string;
-          function getusemask(mask:longint) : string;
+       tlinkcontainer=class(tlinkedlist)
+          procedure add(const s : string;m:cardinal);
+          function get(var m:cardinal) : string;
+          function getusemask(mask:cardinal) : string;
           function find(const s:string):boolean;
        end;
 
-       pmodule = ^tmodule;
-
 {$ifndef NEWMAP}
        tunitmap = array[0..maxunits-1] of pointer;
        punitmap = ^tunitmap;
 {$else NEWMAP}
-       tunitmap = array[0..maxunits-1] of pmodule;
+       tunitmap = array[0..maxunits-1] of tmodule;
        punitmap = ^tunitmap;
 {$endif NEWMAP}
 
-       tmodule = object(tmodulebase)
+       tmodule = class(tmodulebase)
           ppufile       : pppufile; { the PPU file }
           crc,
           interface_crc,
@@ -105,12 +101,12 @@ interface
           globalsymtable,           { pointer to the local/static symtable of this unit }
           localsymtable : pointer;  { pointer to the psymtable of this unit }
           scanner       : pointer;  { scanner object used }
-          loaded_from   : pmodule;
+          loaded_from   : tmodule;
           uses_imports  : boolean;  { Set if the module imports from DLL's.}
-          imports       : plinkedlist;
-          _exports      : plinkedlist;
+          imports       : tlinkedlist;
+          _exports      : tlinkedlist;
 
-          resourcefiles : tstringcontainer;
+          resourcefiles : tstringlist;
 
           linkunitofiles,
           linkunitstaticlibs,
@@ -134,16 +130,15 @@ interface
           crc_array2 : pointer;
           crc_size2 : longint;
 {$endif def Test_Double_checksum}
-          constructor init(const s:string;_is_unit:boolean);
-          destructor done;virtual;
+          constructor create(const s:string;_is_unit:boolean);
+          destructor destroy;override;
           procedure reset;
           procedure setfilename(const fn:string;allowoutput:boolean);
           function  openppu:boolean;
           function  search_unit(const n : string;onlysource:boolean):boolean;
        end;
 
-       pused_unit = ^tused_unit;
-       tused_unit = object(tlinkedlist_item)
+       tused_unit = class(tlinkedlistitem)
           unitid          : longint;
           name            : pstring;
           checksum,
@@ -152,28 +147,27 @@ interface
           in_uses,
           in_interface,
           is_stab_written : boolean;
-          u               : pmodule;
-          constructor init(_u : pmodule;intface:boolean);
-          constructor init_to_load(const n:string;c,intfc:longint;intface:boolean);
-          destructor done;virtual;
+          u               : tmodule;
+          constructor create(_u : tmodule;intface:boolean);
+          constructor create_to_load(const n:string;c,intfc:longint;intface:boolean);
+          destructor destroy;override;
        end;
 
-       pdependent_unit = ^tdependent_unit;
-       tdependent_unit = object(tlinkedlist_item)
-          u : pmodule;
-          constructor init(_u : pmodule);
+       tdependent_unit = class(tlinkedlistitem)
+          u : tmodule;
+          constructor create(_u : tmodule);
        end;
 
     var
-       main_module       : pmodule;     { Main module of the program }
-       current_module    : pmodule;     { Current module which is compiled or loaded }
-       compiled_module   : pmodule;     { Current module which is compiled }
+       main_module       : tmodule;     { Main module of the program }
+       current_module    : tmodule;     { Current module which is compiled or loaded }
+       compiled_module   : tmodule;     { Current module which is compiled }
        usedunits         : tlinkedlist; { Used units for this program }
        loaded_units      : tlinkedlist; { All loaded units }
-       SmartLinkOFiles   : TStringContainer; { List of .o files which are generated,
-                                               used to delete them after linking }
+       SmartLinkOFiles   : TStringList; { List of .o files which are generated,
+                                          used to delete them after linking }
 
-function get_source_file(moduleindex,fileindex : longint) : pinputfile;
+function get_source_file(moduleindex,fileindex : longint) : tinputfile;
 
 
 implementation
@@ -193,15 +187,15 @@ uses
                              Global Functions
 *****************************************************************************}
 
-    function get_source_file(moduleindex,fileindex : longint) : pinputfile;
+    function get_source_file(moduleindex,fileindex : longint) : tinputfile;
       var
-         hp : pmodule;
+         hp : tmodule;
       begin
-         hp:=pmodule(loaded_units.first);
-         while assigned(hp) and (hp^.unit_index<>moduleindex) do
-           hp:=pmodule(hp^.next);
+         hp:=tmodule(loaded_units.first);
+         while assigned(hp) and (hp.unit_index<>moduleindex) do
+           hp:=tmodule(hp.next);
          if assigned(hp) then
-          get_source_file:=hp^.sourcefiles^.get_file(fileindex)
+          get_source_file:=hp.sourcefiles.get_file(fileindex)
          else
           get_source_file:=nil;
       end;
@@ -211,92 +205,83 @@ uses
                              TLinkContainerItem
  ****************************************************************************}
 
-constructor TLinkContainerItem.Init(const s:string;m:longint);
-begin
-  inherited Init;
-  data:=stringdup(s);
-  needlink:=m;
-end;
+    constructor TLinkContainerItem.Create(const s:string;m:cardinal);
+      begin
+        inherited Create;
+        data:=stringdup(s);
+        needlink:=m;
+      end;
 
 
-destructor TLinkContainerItem.Done;
-begin
-  stringdispose(data);
-end;
+    destructor TLinkContainerItem.Destroy;
+      begin
+        stringdispose(data);
+      end;
 
 
 {****************************************************************************
                            TLinkContainer
  ****************************************************************************}
 
-    constructor TLinkContainer.Init;
-      begin
-        inherited init;
-      end;
-
-
-    procedure TLinkContainer.insert(const s : string;m:longint);
-      var
-        newnode : plinkcontaineritem;
+    procedure TLinkContainer.add(const s : string;m:cardinal);
       begin
-         {if find(s) then
-          exit; }
-         new(newnode,init(s,m));
-         inherited insert(newnode);
+        inherited concat(TLinkContainerItem.Create(s,m));
       end;
 
 
-    function TLinkContainer.get(var m:longint) : string;
+    function TLinkContainer.get(var m:cardinal) : string;
       var
-        p : plinkcontaineritem;
+        p : tlinkcontaineritem;
       begin
-        p:=plinkcontaineritem(inherited get);
+        p:=tlinkcontaineritem(inherited getfirst);
         if p=nil then
          begin
            get:='';
            m:=0;
-           exit;
+         end
+        else
+         begin
+           get:=p.data^;
+           m:=p.needlink;
+           p.free;
          end;
-        get:=p^.data^;
-        m:=p^.needlink;
-        dispose(p,done);
       end;
 
 
-    function TLinkContainer.getusemask(mask:longint) : string;
+    function TLinkContainer.getusemask(mask:cardinal) : string;
       var
-         p : plinkcontaineritem;
+         p : tlinkcontaineritem;
          found : boolean;
       begin
         found:=false;
         repeat
-          p:=plinkcontaineritem(inherited get);
+          p:=tlinkcontaineritem(inherited getfirst);
           if p=nil then
            begin
              getusemask:='';
              exit;
            end;
-          getusemask:=p^.data^;
-          found:=(p^.needlink and mask)<>0;
-          dispose(p,done);
+          getusemask:=p.data^;
+          found:=(p.needlink and mask)<>0;
+          p.free;
         until found;
       end;
 
 
     function TLinkContainer.find(const s:string):boolean;
       var
-        newnode : plinkcontaineritem;
+        newnode : tlinkcontaineritem;
       begin
         find:=false;
-        newnode:=plinkcontaineritem(root);
+        newnode:=tlinkcontaineritem(First);
         while assigned(newnode) do
          begin
-           if newnode^.data^=s then
+           if newnode.data^=s then
             begin
               find:=true;
               exit;
             end;
-           newnode:=plinkcontaineritem(newnode^.next);
+           newnode:=tlinkcontaineritem(newnode.next);
          end;
       end;
 
@@ -542,17 +527,17 @@ end;
 
          Function SearchPathList(list:TSearchPathList):boolean;
          var
-           hp : PStringQueueItem;
+           hp : TStringListItem;
            found : boolean;
          begin
            found:=false;
-           hp:=list.First;
+           hp:=TStringListItem(list.First);
            while assigned(hp) do
             begin
-              found:=SearchPath(hp^.data^);
+              found:=SearchPath(hp.Str);
               if found then
                break;
-              hp:=hp^.next;
+              hp:=TStringListItem(hp.next);
             end;
            SearchPathList:=found;
          end;
@@ -571,13 +556,13 @@ end;
          if not onlysource then
           begin
             fnd:=PPUSearchPath('.');
-            if (not fnd) and (current_module^.outputpath^<>'') then
-             fnd:=PPUSearchPath(current_module^.outputpath^);
+            if (not fnd) and (current_module.outputpath^<>'') then
+             fnd:=PPUSearchPath(current_module.outputpath^);
            end;
          if (not fnd) then
           fnd:=SourceSearchPath('.');
          if (not fnd) then
-          fnd:=SearchPathList(current_module^.LocalUnitSearchPath);
+          fnd:=SearchPathList(current_module.LocalUnitSearchPath);
          if (not fnd) then
           fnd:=SearchPathList(UnitSearchPath);
 
@@ -588,7 +573,7 @@ end;
             filename:=copy(filename,1,8);
             fnd:=SearchPath('.');
             if (not fnd) then
-             fnd:=SearchPathList(current_module^.LocalUnitSearchPath);
+             fnd:=SearchPathList(current_module.LocalUnitSearchPath);
             if not fnd then
              fnd:=SearchPathList(UnitSearchPath);
           end;
@@ -599,7 +584,7 @@ end;
 
     procedure tmodule.reset;
       var
-         pm : pdependent_unit;
+         pm : tdependent_unit;
       begin
         if assigned(scanner) then
           pscannerfile(scanner)^.invalid:=true;
@@ -623,43 +608,43 @@ end;
            dispose(ppufile,done);
            ppufile:=nil;
          end;
-        sourcefiles^.done;
-        sourcefiles^.init;
-        imports^.done;
-        imports^.init;
-        _exports^.done;
-        _exports^.init;
-        used_units.done;
-        used_units.init;
+        sourcefiles.free;
+        sourcefiles:=tinputfilemanager.create;
+        imports.free;
+        imports:=tlinkedlist.create;
+        _exports.free;
+        _exports:=tlinkedlist.create;
+        used_units.free;
+        used_units:=TLinkedList.Create;
         { all units that depend on this one must be recompiled ! }
-        pm:=pdependent_unit(dependent_units.first);
+        pm:=tdependent_unit(dependent_units.first);
         while assigned(pm) do
           begin
-            if pm^.u^.in_second_compile then
-             Comment(v_debug,'No reload already in second compile: '+pm^.u^.modulename^)
+            if pm.u.in_second_compile then
+             Comment(v_debug,'No reload already in second compile: '+pm.u.modulename^)
             else
              begin
-               pm^.u^.do_reload:=true;
-               Comment(v_debug,'Reloading '+pm^.u^.modulename^+' needed because '+modulename^+' is reloaded');
+               pm.u.do_reload:=true;
+               Comment(v_debug,'Reloading '+pm.u.modulename^+' needed because '+modulename^+' is reloaded');
              end;
-            pm:=pdependent_unit(pm^.next);
+            pm:=tdependent_unit(pm.next);
           end;
-        dependent_units.done;
-        dependent_units.init;
-        resourcefiles.done;
-        resourcefiles.init;
-        linkunitofiles.done;
-        linkunitofiles.init;
-        linkunitstaticlibs.done;
-        linkunitstaticlibs.init;
-        linkunitsharedlibs.done;
-        linkunitsharedlibs.init;
-        linkotherofiles.done;
-        linkotherofiles.init;
-        linkotherstaticlibs.done;
-        linkotherstaticlibs.init;
-        linkothersharedlibs.done;
-        linkothersharedlibs.init;
+        dependent_units.free;
+        dependent_units:=TLinkedList.Create;
+        resourcefiles.Free;
+        resourcefiles:=TStringList.Create;
+        linkunitofiles.Free;
+        linkunitofiles:=TLinkContainer.Create;
+        linkunitstaticlibs.Free;
+        linkunitstaticlibs:=TLinkContainer.Create;
+        linkunitsharedlibs.Free;
+        linkunitsharedlibs:=TLinkContainer.Create;
+        linkotherofiles.Free;
+        linkotherofiles:=TLinkContainer.Create;
+        linkotherstaticlibs.Free;
+        linkotherstaticlibs:=TLinkContainer.Create;
+        linkothersharedlibs.Free;
+        linkothersharedlibs:=TLinkContainer.Create;
         uses_imports:=false;
         do_assemble:=false;
         do_compile:=false;
@@ -678,7 +663,7 @@ end;
       end;
 
 
-    constructor tmodule.init(const s:string;_is_unit:boolean);
+    constructor tmodule.create(const s:string;_is_unit:boolean);
       var
         p : dirstr;
         n : namestr;
@@ -717,20 +702,20 @@ end;
         outputpath:=nil;
         path:=nil;
         setfilename(p+n,true);
-        localunitsearchpath.init;
-        localobjectsearchpath.init;
-        localincludesearchpath.init;
-        locallibrarysearchpath.init;
-        used_units.init;
-        dependent_units.init;
-        new(sourcefiles,init);
-        resourcefiles.init;
-        linkunitofiles.init;
-        linkunitstaticlibs.init;
-        linkunitsharedlibs.init;
-        linkotherofiles.init;
-        linkotherstaticlibs.init;
-        linkothersharedlibs.init;
+        localunitsearchpath:=TSearchPathList.Create;
+        localobjectsearchpath:=TSearchPathList.Create;
+        localincludesearchpath:=TSearchPathList.Create;
+        locallibrarysearchpath:=TSearchPathList.Create;
+        used_units:=TLinkedList.Create;
+        dependent_units:=TLinkedList.Create;
+        sourcefiles:=TInputFileManager.Create;
+        resourcefiles:=TStringList.Create;
+        linkunitofiles:=TLinkContainer.Create;
+        linkunitstaticlibs:=TLinkContainer.Create;
+        linkunitsharedlibs:=TLinkContainer.Create;
+        linkotherofiles:=TLinkContainer.Create;
+        linkotherstaticlibs:=TLinkContainer.Create;
+        linkothersharedlibs:=TLinkContainer.Create;
         ppufile:=nil;
         scanner:=nil;
         map:=nil;
@@ -758,8 +743,8 @@ end;
         is_unit:=_is_unit;
         islibrary:=false;
         uses_imports:=false;
-        imports:=new(plinkedlist,init);
-        _exports:=new(plinkedlist,init);
+        imports:=TLinkedList.Create;
+        _exports:=TLinkedList.Create;
       { search the PPU file if it is an unit }
         if is_unit then
          begin
@@ -774,7 +759,7 @@ end;
       end;
 
 
-    destructor tmodule.done;
+    destructor tmodule.Destroy;
 {$ifdef MEMDEBUG}
       var
         d : tmemdebug;
@@ -786,25 +771,25 @@ end;
          dispose(ppufile,done);
         ppufile:=nil;
         if assigned(imports) then
-         dispose(imports,done);
+         imports.free;
         imports:=nil;
         if assigned(_exports) then
-         dispose(_exports,done);
+         _exports.free;
         _exports:=nil;
         if assigned(scanner) then
           pscannerfile(scanner)^.invalid:=true;
         if assigned(sourcefiles) then
-         dispose(sourcefiles,done);
+         sourcefiles.Free;
         sourcefiles:=nil;
-        used_units.done;
-        dependent_units.done;
-        resourcefiles.done;
-        linkunitofiles.done;
-        linkunitstaticlibs.done;
-        linkunitsharedlibs.done;
-        linkotherofiles.done;
-        linkotherstaticlibs.done;
-        linkothersharedlibs.done;
+        used_units.free;
+        dependent_units.free;
+        resourcefiles.Free;
+        linkunitofiles.Free;
+        linkunitstaticlibs.Free;
+        linkunitsharedlibs.Free;
+        linkotherofiles.Free;
+        linkotherstaticlibs.Free;
+        linkothersharedlibs.Free;
         stringdispose(objfilename);
         stringdispose(asmfilename);
         stringdispose(ppufilename);
@@ -817,10 +802,10 @@ end;
         stringdispose(realmodulename);
         stringdispose(mainsource);
         stringdispose(asmprefix);
-        localunitsearchpath.done;
-        localobjectsearchpath.done;
-        localincludesearchpath.done;
-        locallibrarysearchpath.done;
+        localunitsearchpath.Free;
+        localobjectsearchpath.free;
+        localincludesearchpath.free;
+        locallibrarysearchpath.free;
 {$ifdef MEMDEBUG}
         d.init('symtable');
 {$endif}
@@ -833,7 +818,7 @@ end;
 {$ifdef MEMDEBUG}
         d.done;
 {$endif}
-        inherited done;
+        inherited Destroy;
       end;
 
 
@@ -841,21 +826,21 @@ end;
                               TUSED_UNIT
  ****************************************************************************}
 
-    constructor tused_unit.init(_u : pmodule;intface:boolean);
+    constructor tused_unit.create(_u : tmodule;intface:boolean);
       begin
         u:=_u;
         in_interface:=intface;
         in_uses:=false;
         is_stab_written:=false;
         loaded:=true;
-        name:=stringdup(_u^.modulename^);
-        checksum:=_u^.crc;
-        interface_checksum:=_u^.interface_crc;
+        name:=stringdup(_u.modulename^);
+        checksum:=_u.crc;
+        interface_checksum:=_u.interface_crc;
         unitid:=0;
       end;
 
 
-    constructor tused_unit.init_to_load(const n:string;c,intfc:longint;intface:boolean);
+    constructor tused_unit.create_to_load(const n:string;c,intfc:longint;intface:boolean);
       begin
         u:=nil;
         in_interface:=intface;
@@ -869,10 +854,10 @@ end;
       end;
 
 
-    destructor tused_unit.done;
+    destructor tused_unit.destroy;
       begin
         stringdispose(name);
-        inherited done;
+        inherited destroy;
       end;
 
 
@@ -880,7 +865,7 @@ end;
                             TDENPENDENT_UNIT
  ****************************************************************************}
 
-    constructor tdependent_unit.init(_u : pmodule);
+    constructor tdependent_unit.create(_u : tmodule);
       begin
          u:=_u;
       end;
@@ -888,7 +873,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-11-07 20:48:33  peter
+  Revision 1.6  2000-12-25 00:07:25  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/11/07 20:48:33  peter
     * removed ref_count from pinputfile it's not used
 
   Revision 1.4  2000/10/31 22:02:46  peter
@@ -904,4 +893,4 @@ end.
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 
-}
+}

compiler/gdb.pas

@@ -54,34 +54,27 @@ Const
     N_EXCL  = $C2;
 
     type
-       pai_stabs = ^tai_stabs;
-
-       tai_stabs = object(tai)
+       tai_stabs = class(tai)
           str : pchar;
-          constructor init(_str : pchar);
-          destructor done; virtual;
+          constructor Create(_str : pchar);
+          destructor Destroy;override;
        end;
 
-       pai_stabn = ^tai_stabn;
-
-       tai_stabn = object(tai)
+       tai_stabn = class(tai)
           str : pchar;
-          constructor init(_str : pchar);
-          destructor done; virtual;
+          constructor Create(_str : pchar);
+          destructor Destroy;override;
        end;
 
        { insert a cut to split into several smaller files }
-       pai_force_line = ^tai_force_line;
-       tai_force_line = object(tai)
-          constructor init;
+       tai_force_line = class(tai)
+          constructor Create;
        end;
 
-       pai_stab_function_name = ^tai_stab_function_name;
-
-       tai_stab_function_name = object(tai)
+       tai_stab_function_name = class(tai)
           str : pchar;
-          constructor init(_str : pchar);
-          destructor done; virtual;
+          constructor create(_str : pchar);
+          destructor destroy;override;
        end;
 
     const
@@ -197,10 +190,10 @@ N_BINCL to N_EINCL
      end;
 
 
-    constructor tai_stabs.init(_str : pchar);
+    constructor tai_stabs.create(_str : pchar);
 
       begin
-         inherited init;
+         inherited create;
          typ:=ait_stabs;
          str:=_str;
          if do_count_dbx then
@@ -209,54 +202,58 @@ N_BINCL to N_EINCL
            end;
       end;
 
-    destructor tai_stabs.done;
+    destructor tai_stabs.destroy;
 
       begin
          strdispose(str);
-         inherited done;
+         inherited destroy;
       end;
 
-    constructor tai_stabn.init(_str : pchar);
+    constructor tai_stabn.create(_str : pchar);
 
       begin
-         inherited init;
+         inherited create;
          typ:=ait_stabn;
          str:=_str;
       end;
 
-    destructor tai_stabn.done;
+    destructor tai_stabn.destroy;
 
       begin
          strdispose(str);
-         inherited done;
+         inherited destroy;
       end;
 
-    constructor tai_force_line.init;
+    constructor tai_force_line.create;
 
       begin
-         inherited init;
+         inherited create;
          typ:=ait_force_line;
       end;
 
-    constructor tai_stab_function_name.init(_str : pchar);
+    constructor tai_stab_function_name.create(_str : pchar);
 
       begin
-         inherited init;
+         inherited create;
          typ:=ait_stab_function_name;
          str:=_str;
       end;
 
-    destructor tai_stab_function_name.done;
+    destructor tai_stab_function_name.destroy;
 
       begin
          strdispose(str);
-         inherited done;
+         inherited destroy;
       end;
 end.
 
 {
   $Log$
-  Revision 1.4  2000-11-29 00:30:30  florian
+  Revision 1.5  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/11/29 00:30:30  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/gendef.pas

@@ -26,7 +26,7 @@ unit gendef;
 
 interface
 uses
-  cobjects;
+  cclasses;
 
 type
   pdeffile=^tdeffile;
@@ -42,7 +42,7 @@ type
     is_empty : boolean;
     WrittenOnDisk : boolean;
     exportlist,
-    importlist   : tstringcontainer;
+    importlist   : tstringlist;
   end;
 var
   deffile : tdeffile;
@@ -62,26 +62,18 @@ begin
   fname:=fn;
   WrittenOnDisk:=false;
   is_empty:=true;
-  importlist.init;
-  exportlist.init;
+  importlist:=TStringList.Create;
+  exportlist:=TStringList.Create;
 end;
 
 
 destructor tdeffile.done;
-var
-  f : file;
 begin
   if WrittenOnDisk and
      not(cs_link_extern in aktglobalswitches) then
-   begin
-     assign(f,fname);
-     {$I-}
-      erase(f);
-     {$I+}
-     if ioresult<>0 then;
-   end;
-  importlist.done;
-  exportlist.done;
+   DeleteFile(FName);
+  importlist.Free;
+  exportlist.Free;
 end;
 
 
@@ -149,7 +141,7 @@ begin
      writeln(t,'');
      writeln(t,'IMPORTS');
      while not importlist.empty do
-      writeln(t,#9+importlist.get);
+      writeln(t,#9+importlist.getfirst);
    end;
 
 {write exports}
@@ -158,7 +150,7 @@ begin
      writeln(t,'');
      writeln(t,'EXPORTS');
      while not exportlist.empty do
-      writeln(t,#9+exportlist.get);
+      writeln(t,#9+exportlist.getfirst);
    end;
 
   close(t);
@@ -168,7 +160,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-09-24 15:06:16  peter
+  Revision 1.5  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/09/24 15:06:16  peter
     * use defines.inc
 
   Revision 1.3  2000/08/27 16:11:50  peter

compiler/globals.pas

@@ -40,7 +40,8 @@ interface
       strings,
       dos,
 {$endif}
-      globtype,version,systems,cutils,cobjects;
+      cutils,cobjects,cclasses,
+      globtype,version,systems;
 
     const
 {$ifdef unix}
@@ -73,7 +74,14 @@ interface
          [m_gpc,m_all];
 
     type
-       TSearchPathList = object(TStringQueue)
+       pfileposinfo = ^tfileposinfo;
+       tfileposinfo = record
+         line      : longint;
+         column    : word;
+         fileindex : word;
+       end;
+
+       TSearchPathList = class(TStringList)
          procedure AddPath(s:string;addfirst:boolean);
          procedure AddList(list:TSearchPathList;addfirst:boolean);
          function  FindFile(const f : string;var b : boolean) : string;
@@ -134,7 +142,7 @@ interface
        inlining_procedure : boolean;     { are we inlining a procedure }
 
      { commandline values }
-       initdefines        : tlinkedlist;
+       initdefines        : tstringlist;
        initglobalswitches : tglobalswitches;
        initmoduleswitches : tmoduleswitches;
        initlocalswitches  : tlocalswitches;
@@ -661,13 +669,13 @@ implementation
        CurrentDir,
        CurrPath : string;
        dir      : searchrec;
-       hp       : PStringQueueItem;
+       hp       : TStringListItem;
 
        procedure addcurrpath;
        begin
          if addfirst then
           begin
-            Delete(currPath);
+            Remove(currPath);
             Insert(currPath);
           end
          else
@@ -753,38 +761,38 @@ implementation
      var
        s : string;
        hl : TSearchPathList;
-       hp,hp2 : PStringQueueItem;
+       hp,hp2 : TStringListItem;
      begin
        if list.empty then
         exit;
        { create temp and reverse the list }
        if addfirst then
         begin
-          hl.Init;
-          hp:=list.first;
+          hl:=TSearchPathList.Create;
+          hp:=TStringListItem(list.first);
           while assigned(hp) do
            begin
-             hl.insert(hp^.data^);
-             hp:=hp^.next;
+             hl.insert(hp.Str);
+             hp:=TStringListItem(hp.next);
            end;
           while not hl.empty do
            begin
-             s:=hl.Get;
-             Delete(s);
+             s:=hl.GetFirst;
+             Remove(s);
              Insert(s);
            end;
-          hl.done;
+          hl.Free;
         end
        else
         begin
-          hp:=list.first;
+          hp:=TStringListItem(list.first);
           while assigned(hp) do
            begin
-             hp2:=Find(hp^.data^);
+             hp2:=Find(hp.Str);
              { Check if already in path, then we don't add it }
              if not assigned(hp2) then
-              Concat(hp^.data^);
-             hp:=hp^.next;
+              Concat(hp.Str);
+             hp:=TStringListItem(hp.next);
            end;
         end;
      end;
@@ -792,20 +800,20 @@ implementation
 
    function TSearchPathList.FindFile(const f : string;var b : boolean) : string;
      Var
-       p : PStringQueueItem;
+       p : TStringListItem;
      begin
        FindFile:='';
        b:=false;
-       p:=first;
+       p:=TStringListItem(first);
        while assigned(p) do
         begin
-          If FileExists(p^.data^+f) then
+          If FileExists(p.Str+f) then
            begin
-             FindFile:=p^.data^;
+             FindFile:=p.Str;
              b:=true;
              exit;
            end;
-          p:=p^.next;
+          p:=TStringListItem(p.next);
         end;
      end;
 
@@ -1173,16 +1181,16 @@ implementation
 
    procedure DoneGlobals;
      begin
-       initdefines.done;
+       initdefines.free;
        if assigned(DLLImageBase) then
          StringDispose(DLLImageBase);
        RelocSection:=true;
        RelocSectionSetExplicitly:=false;
        UseDeffileForExport:=true;
-       librarysearchpath.Done;
-       unitsearchpath.Done;
-       objectsearchpath.Done;
-       includesearchpath.Done;
+       librarysearchpath.Free;
+       unitsearchpath.Free;
+       objectsearchpath.Free;
+       includesearchpath.Free;
      end;
 
    procedure InitGlobals;
@@ -1205,10 +1213,10 @@ implementation
         utilsdirectory:='';
 
       { Search Paths }
-        librarysearchpath.Init;
-        unitsearchpath.Init;
-        includesearchpath.Init;
-        objectsearchpath.Init;
+        librarysearchpath:=TSearchPathList.Create;
+        unitsearchpath:=TSearchPathList.Create;
+        includesearchpath:=TSearchPathList.Create;
+        objectsearchpath:=TSearchPathList.Create;
 
       { Def file }
         usewindowapi:=false;
@@ -1244,7 +1252,7 @@ implementation
   {$endif m68k}
 {$endif i386}
         initinterfacetype:=it_interfacecom;
-        initdefines.init;
+        initdefines:=TStringList.Create;
 
       { memory sizes, will be overriden by parameter or default for target
         in options or init_parser }
@@ -1270,7 +1278,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2000-11-13 15:26:12  marco
+  Revision 1.21  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.20  2000/11/13 15:26:12  marco
    * Renamefest
 
   Revision 1.19  2000/11/12 22:20:37  peter

compiler/hcgdata.pas

@@ -37,7 +37,7 @@ interface
     function genpublishedmethodstable(_class : pobjectdef) : pasmlabel;
 
     { generates a VMT for _class }
-    procedure genvmt(list : paasmoutput;_class : pobjectdef);
+    procedure genvmt(list : TAAsmoutput;_class : pobjectdef);
 
 {$ifdef WITHDMT}
     { generates a DMT for _class }
@@ -55,7 +55,7 @@ implementation
 {$else}
        strings,
 {$endif}
-       cutils,cobjects,
+       cutils,cclasses,cobjects,
        globtype,globals,verbose,
        symtable,symconst,symtype,symsym,types,
        systems
@@ -189,9 +189,9 @@ implementation
          getdatalabel(p^.nl);
          if assigned(p^.l) then
            writenames(p^.l);
-         datasegment^.concat(new(pai_label,init(p^.nl)));
-         datasegment^.concat(new(pai_const,init_8bit(strlen(p^.p^.messageinf.str))));
-         datasegment^.concat(new(pai_string,init_pchar(p^.p^.messageinf.str)));
+         dataSegment.concat(Tai_label.Create(p^.nl));
+         dataSegment.concat(Tai_const.Create_8bit(strlen(p^.p^.messageinf.str)));
+         dataSegment.concat(Tai_string.Create_pchar(p^.p^.messageinf.str));
          if assigned(p^.r) then
            writenames(p^.r);
       end;
@@ -203,8 +203,8 @@ implementation
            writestrentry(p^.l);
 
          { write name label }
-         datasegment^.concat(new(pai_const_symbol,init(p^.nl)));
-         datasegment^.concat(new(pai_const_symbol,initname(p^.p^.mangledname)));
+         dataSegment.concat(Tai_const_symbol.Create(p^.nl));
+         dataSegment.concat(Tai_const_symbol.Createname(p^.p^.mangledname));
 
          if assigned(p^.r) then
            writestrentry(p^.r);
@@ -228,9 +228,9 @@ implementation
 
          { now start writing of the message string table }
          getdatalabel(r);
-         datasegment^.concat(new(pai_label,init(r)));
+         dataSegment.concat(Tai_label.Create(r));
          genstrmsgtab:=r;
-         datasegment^.concat(new(pai_const,init_32bit(count)));
+         dataSegment.concat(Tai_const.Create_32bit(count));
          if assigned(root) then
            begin
               writestrentry(root);
@@ -246,8 +246,8 @@ implementation
            writeintentry(p^.l);
 
          { write name label }
-         datasegment^.concat(new(pai_const,init_32bit(p^.p^.messageinf.i)));
-         datasegment^.concat(new(pai_const_symbol,initname(p^.p^.mangledname)));
+         dataSegment.concat(Tai_const.Create_32bit(p^.p^.messageinf.i));
+         dataSegment.concat(Tai_const_symbol.Createname(p^.p^.mangledname));
 
          if assigned(p^.r) then
            writeintentry(p^.r);
@@ -266,9 +266,9 @@ implementation
 
          { now start writing of the message string table }
          getdatalabel(r);
-         datasegment^.concat(new(pai_label,init(r)));
+         dataSegment.concat(Tai_label.Create(r));
          genintmsgtab:=r;
-         datasegment^.concat(new(pai_const,init_32bit(count)));
+         dataSegment.concat(Tai_const.Create_32bit(count));
          if assigned(root) then
            begin
               writeintentry(root);
@@ -308,7 +308,7 @@ implementation
       begin
          if assigned(p^.l) then
            writedmtindexentry(p^.l);
-         datasegment^.concat(new(pai_const,init_32bit(p^.p^.messageinf.i)));
+         dataSegment.concat(Tai_const.Create_32bit(p^.p^.messageinf.i));
          if assigned(p^.r) then
            writedmtindexentry(p^.r);
       end;
@@ -318,7 +318,7 @@ implementation
       begin
          if assigned(p^.l) then
            writedmtaddressentry(p^.l);
-         datasegment^.concat(new(pai_const_symbol,initname(p^.p^.mangledname)));
+         dataSegment.concat(Tai_const_symbol.Createname(p^.p^.mangledname));
          if assigned(p^.r) then
            writedmtaddressentry(p^.r);
       end;
@@ -339,12 +339,12 @@ implementation
            begin
               getdatalabel(r);
               gendmt:=r;
-              datasegment^.concat(new(pai_label,init(r)));
+              dataSegment.concat(Tai_label.Create(r));
               { entries for caching }
-              datasegment^.concat(new(pai_const,init_32bit(0)));
-              datasegment^.concat(new(pai_const,init_32bit(0)));
+              dataSegment.concat(Tai_const.Create_32bit(0));
+              dataSegment.concat(Tai_const.Create_32bit(0));
 
-              datasegment^.concat(new(pai_const,init_32bit(count)));
+              dataSegment.concat(Tai_const.Create_32bit(count));
               if assigned(root) then
                 begin
                    writedmtindexentry(root);
@@ -377,12 +377,12 @@ implementation
                 internalerror(1209992);
               getdatalabel(l);
 
-              consts^.concat(new(pai_label,init(l)));
-              consts^.concat(new(pai_const,init_8bit(length(p^.name))));
-              consts^.concat(new(pai_string,init(p^.name)));
+              Consts.concat(Tai_label.Create(l));
+              Consts.concat(Tai_const.Create_8bit(length(p^.name)));
+              Consts.concat(Tai_string.Create(p^.name));
 
-              datasegment^.concat(new(pai_const_symbol,init(l)));
-              datasegment^.concat(new(pai_const_symbol,initname(hp^.mangledname)));
+              dataSegment.concat(Tai_const_symbol.Create(l));
+              dataSegment.concat(Tai_const_symbol.Createname(hp^.mangledname));
            end;
       end;
 
@@ -397,8 +397,8 @@ implementation
          if count>0 then
            begin
               getdatalabel(l);
-              datasegment^.concat(new(pai_label,init(l)));
-              datasegment^.concat(new(pai_const,init_32bit(count)));
+              dataSegment.concat(Tai_label.Create(l));
+              dataSegment.concat(Tai_const.Create_32bit(count));
               _class^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}genpubmethodtableentry);
               genpublishedmethodstable:=l;
            end
@@ -670,7 +670,7 @@ implementation
             end;
        end;
 
-    procedure genvmt(list : paasmoutput;_class : pobjectdef);
+    procedure genvmt(list : TAAsmoutput;_class : pobjectdef);
 
       procedure do_genvmt(p : pobjectdef);
 
@@ -737,12 +737,11 @@ implementation
                                   if (po_abstractmethod in procdefcoll^.data^.procoptions) then
                                     begin
                                        include(_class^.objectoptions,oo_has_abstract);
-                                       list^.concat(new(pai_const_symbol,initname('FPC_ABSTRACTERROR')));
+                                       List.concat(Tai_const_symbol.Createname('FPC_ABSTRACTERROR'));
                                     end
                                   else
                                     begin
-                                      list^.concat(new(pai_const_symbol,
-                                        initname(procdefcoll^.data^.mangledname)));
+                                      List.concat(Tai_const_symbol.createname(procdefcoll^.data^.mangledname));
                                     end;
                                end;
                           end;
@@ -760,7 +759,7 @@ implementation
           upper(_class^.implementedinterfaces^.interfaces(intfindex)^.objname^)+'_$$_VTBL';
       end;
 
-    procedure gintfcreatevtbl(_class: pobjectdef; intfindex: integer; rawdata,rawcode: paasmoutput);
+    procedure gintfcreatevtbl(_class: pobjectdef; intfindex: integer; rawdata,rawcode: TAAsmoutput);
       var
         implintf: pimplementedinterfaces;
         curintf: pobjectdef;
@@ -770,7 +769,7 @@ implementation
       begin
         implintf:=_class^.implementedinterfaces;
         curintf:=implintf^.interfaces(intfindex);
-        rawdata^.concat(new(pai_symbol,initname(gintfgetvtbllabelname(_class,intfindex),0)));
+        rawdata.concat(Tai_symbol.Createname(gintfgetvtbllabelname(_class,intfindex),0));
         count:=implintf^.implproccount(intfindex);
         for i:=1 to count do
           begin
@@ -778,11 +777,11 @@ implementation
             { create wrapper code }
             cgintfwrapper(rawcode,implintf^.implprocs(intfindex,i),tmps,implintf^.ioffsets(intfindex)^);
             { create reference }
-            rawdata^.concat(new(pai_const_symbol,initname(tmps)));
+            rawdata.concat(Tai_const_symbol.Createname(tmps));
           end;
       end;
 
-    procedure gintfgenentry(_class: pobjectdef; intfindex, contintfindex: integer; rawdata: paasmoutput);
+    procedure gintfgenentry(_class: pobjectdef; intfindex, contintfindex: integer; rawdata: TAAsmoutput);
       var
         implintf: pimplementedinterfaces;
         curintf: pobjectdef;
@@ -796,32 +795,32 @@ implementation
           begin
             { label for GUID }
             getdatalabel(tmplabel);
-            rawdata^.concat(new(pai_label,init(tmplabel)));
-            rawdata^.concat(new(pai_const,init_32bit(curintf^.iidguid.D1)));
-            rawdata^.concat(new(pai_const,init_16bit(curintf^.iidguid.D2)));
-            rawdata^.concat(new(pai_const,init_16bit(curintf^.iidguid.D3)));
+            rawdata.concat(Tai_label.Create(tmplabel));
+            rawdata.concat(Tai_const.Create_32bit(curintf^.iidguid.D1));
+            rawdata.concat(Tai_const.Create_16bit(curintf^.iidguid.D2));
+            rawdata.concat(Tai_const.Create_16bit(curintf^.iidguid.D3));
             for i:=Low(curintf^.iidguid.D4) to High(curintf^.iidguid.D4) do
-              rawdata^.concat(new(pai_const,init_8bit(curintf^.iidguid.D4[i])));
-            datasegment^.concat(new(pai_const_symbol,init(tmplabel)));
+              rawdata.concat(Tai_const.Create_8bit(curintf^.iidguid.D4[i]));
+            dataSegment.concat(Tai_const_symbol.Create(tmplabel));
           end
         else
           begin
             { nil for Corba interfaces }
-            datasegment^.concat(new(pai_const,init_32bit(0))); { nil }
+            dataSegment.concat(Tai_const.Create_32bit(0)); { nil }
           end;
         { VTable }
-        datasegment^.concat(new(pai_const_symbol,initname(gintfgetvtbllabelname(_class,contintfindex))));
+        dataSegment.concat(Tai_const_symbol.Createname(gintfgetvtbllabelname(_class,contintfindex)));
         { IOffset field }
-        datasegment^.concat(new(pai_const,init_32bit(implintf^.ioffsets(contintfindex)^)));
+        dataSegment.concat(Tai_const.Create_32bit(implintf^.ioffsets(contintfindex)^));
         { IIDStr }
         getdatalabel(tmplabel);
-        rawdata^.concat(new(pai_label,init(tmplabel)));
-        rawdata^.concat(new(pai_const,init_8bit(length(curintf^.iidstr^))));
+        rawdata.concat(Tai_label.Create(tmplabel));
+        rawdata.concat(Tai_const.Create_8bit(length(curintf^.iidstr^)));
         if curintf^.objecttype=odt_interfacecom then
-          rawdata^.concat(new(pai_string,init(upper(curintf^.iidstr^))))
+          rawdata.concat(Tai_string.Create(upper(curintf^.iidstr^)))
         else
-          rawdata^.concat(new(pai_string,init(curintf^.iidstr^)));
-        datasegment^.concat(new(pai_const_symbol,init(tmplabel)));
+          rawdata.concat(Tai_string.Create(curintf^.iidstr^));
+        dataSegment.concat(Tai_const_symbol.Create(tmplabel));
       end;
 
     procedure gintfoptimizevtbls(_class: pobjectdef; implvtbl : plongint);
@@ -915,9 +914,9 @@ implementation
 
         gintfoptimizevtbls(_class,impintfindexes);
 
-        rawdata.init;
-        rawcode.init;
-        datasegment^.concat(new(pai_const,init_16bit(max)));
+        rawdata:=TAAsmOutput.Create;
+        rawcode:=TAAsmOutput.Create;
+        dataSegment.concat(Tai_const.Create_16bit(max));
         { Two pass, one for allocation and vtbl creation }
         for i:=1 to max do
           begin
@@ -934,7 +933,7 @@ implementation
                     datasize:=datasize+target_os.size_of_pointer;
                   end;
                 { write vtbl }
-                gintfcreatevtbl(_class,i,@rawdata,@rawcode);
+                gintfcreatevtbl(_class,i,rawdata,rawcode);
               end;
           end;
         { second pass: for fill interfacetable and remained ioffsets }
@@ -942,15 +941,15 @@ implementation
           begin
             if i<>impintfindexes[i] then { why execute x:=x ? }
               with _class^.implementedinterfaces^ do
-	        ioffsets(i)^:=ioffsets(impintfindexes[i])^;
-            gintfgenentry(_class,i,impintfindexes[i],@rawdata);
+                ioffsets(i)^:=ioffsets(impintfindexes[i])^;
+            gintfgenentry(_class,i,impintfindexes[i],rawdata);
           end;
-        datasegment^.insertlist(@rawdata);
-        rawdata.done;
+        dataSegment.insertlist(rawdata);
+        rawdata.free;
         if (cs_create_smart in aktmoduleswitches) then
-          rawcode.insert(new(pai_cut,init));
-        codesegment^.insertlist(@rawcode);
-        rawcode.done;
+          rawcode.insert(Tai_cut.Create);
+        codeSegment.insertlist(rawcode);
+        rawcode.free;
         freemem(impintfindexes,(max+1)*sizeof(longint));
       end;
 
@@ -1029,7 +1028,7 @@ implementation
         { 2. step calc required fieldcount and their offsets in the object memory map
              and write data }
         getdatalabel(intftable);
-        datasegment^.concat(new(pai_label,init(intftable)));
+        dataSegment.concat(Tai_label.Create(intftable));
         gintfwritedata(_class);
         _class^.implementedinterfaces^.clearimplprocs; { release temporary information }
         genintftable:=intftable;
@@ -1053,25 +1052,29 @@ implementation
       if c^.isiidguidvalid then
         begin
           if (cs_create_smart in aktmoduleswitches) then
-            datasegment^.concat(new(pai_cut,init));
-          datasegment^.concat(new(pai_symbol,initname_global('IID$_'+s1,0)));
-          datasegment^.concat(new(pai_const,init_32bit(c^.iidguid.D1)));
-          datasegment^.concat(new(pai_const,init_16bit(c^.iidguid.D2)));
-          datasegment^.concat(new(pai_const,init_16bit(c^.iidguid.D3)));
+            dataSegment.concat(Tai_cut.Create);
+          dataSegment.concat(Tai_symbol.Createname_global('IID$_'+s1,0));
+          dataSegment.concat(Tai_const.Create_32bit(c^.iidguid.D1));
+          dataSegment.concat(Tai_const.Create_16bit(c^.iidguid.D2));
+          dataSegment.concat(Tai_const.Create_16bit(c^.iidguid.D3));
           for i:=Low(c^.iidguid.D4) to High(c^.iidguid.D4) do
-            datasegment^.concat(new(pai_const,init_8bit(c^.iidguid.D4[i])));
+            dataSegment.concat(Tai_const.Create_8bit(c^.iidguid.D4[i]));
         end;
       if (cs_create_smart in aktmoduleswitches) then
-        datasegment^.concat(new(pai_cut,init));
-      datasegment^.concat(new(pai_symbol,initname_global('IIDSTR$_'+s1,0)));
-      datasegment^.concat(new(pai_const,init_8bit(length(c^.iidstr^))));
-      datasegment^.concat(new(pai_string,init(c^.iidstr^)));
+        dataSegment.concat(Tai_cut.Create);
+      dataSegment.concat(Tai_symbol.Createname_global('IIDSTR$_'+s1,0));
+      dataSegment.concat(Tai_const.Create_8bit(length(c^.iidstr^)));
+      dataSegment.concat(Tai_string.Create(c^.iidstr^));
     end;
 
 end.
 {
   $Log$
-  Revision 1.16  2000-11-29 00:30:30  florian
+  Revision 1.17  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.16  2000/11/29 00:30:30  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/hcodegen.pas

@@ -27,9 +27,10 @@ unit hcodegen;
   interface
 
     uses
+      { common }
       cobjects,
       { global }
-      verbose,
+      globals,verbose,
       { symtable }
       symconst,symtype,symdef,symsym,
       { aasm }
@@ -94,23 +95,13 @@ unit hcodegen;
 
           { code for the current procedure }
           aktproccode,aktentrycode,
-          aktexitcode,aktlocaldata : paasmoutput;
+          aktexitcode,aktlocaldata : taasmoutput;
           { local data is used for smartlink }
 
           constructor init;
           destructor done;
        end;
 
-       { some kind of temp. types needs to be destructed }
-       { for example ansistring, this is done using this }
-       { list                                       }
-       ptemptodestroy = ^ttemptodestroy;
-       ttemptodestroy = object(tlinkedlist_item)
-          typ : pdef;
-          address : treference;
-          constructor init(const a : treference;p : pdef);
-       end;
-
        pregvarinfo = ^tregvarinfo;
        tregvarinfo = record
           regvars : array[1..maxvarregs] of pvarsym;
@@ -173,7 +164,8 @@ unit hcodegen;
 implementation
 
      uses
-        systems,globals,cresstr
+        systems,
+        cresstr
 {$ifdef fixLeaksOnError}
         ,comphook
 {$endif fixLeaksOnError}
@@ -312,19 +304,19 @@ implementation
         exported:=false;
         no_fast_exit:=false;
 
-        aktentrycode:=new(paasmoutput,init);
-        aktexitcode:=new(paasmoutput,init);
-        aktproccode:=new(paasmoutput,init);
-        aktlocaldata:=new(paasmoutput,init);
+        aktentrycode:=Taasmoutput.Create;
+        aktexitcode:=Taasmoutput.Create;
+        aktproccode:=Taasmoutput.Create;
+        aktlocaldata:=Taasmoutput.Create;
       end;
 
 
     destructor tprocinfo.done;
       begin
-         dispose(aktentrycode,done);
-         dispose(aktexitcode,done);
-         dispose(aktproccode,done);
-         dispose(aktlocaldata,done);
+         aktentrycode.free;
+         aktexitcode.free;
+         aktproccode.free;
+         aktlocaldata.free;
       end;
 
 
@@ -361,14 +353,14 @@ implementation
 
     procedure codegen_newmodule;
       begin
-         exprasmlist:=new(paasmoutput,init);
-         datasegment:=new(paasmoutput,init);
-         codesegment:=new(paasmoutput,init);
-         bsssegment:=new(paasmoutput,init);
-         debuglist:=new(paasmoutput,init);
-         withdebuglist:=new(paasmoutput,init);
-         consts:=new(paasmoutput,init);
-         rttilist:=new(paasmoutput,init);
+         exprasmlist:=taasmoutput.create;
+         datasegment:=taasmoutput.create;
+         codesegment:=taasmoutput.create;
+         bsssegment:=taasmoutput.create;
+         debuglist:=taasmoutput.create;
+         withdebuglist:=taasmoutput.create;
+         consts:=taasmoutput.create;
+         rttilist:=taasmoutput.create;
          ResourceStringList:=Nil;
          importssection:=nil;
          exportssection:=nil;
@@ -377,7 +369,7 @@ implementation
          asmsymbollist:=new(pdictionary,init);
          asmsymbollist^.usehash;
          { resourcestrings }
-         new(ResourceStrings,Init);
+         ResourceStrings:=TResourceStrings.Create;
       end;
 
 
@@ -391,22 +383,22 @@ implementation
 {$ifdef MEMDEBUG}
          d.init('asmlist');
 {$endif}
-         dispose(exprasmlist,done);
-         dispose(codesegment,done);
-         dispose(bsssegment,done);
-         dispose(datasegment,done);
-         dispose(debuglist,done);
-         dispose(withdebuglist,done);
-         dispose(consts,done);
-         dispose(rttilist,done);
+         exprasmlist.free;
+         codesegment.free;
+         bsssegment.free;
+         datasegment.free;
+         debuglist.free;
+         withdebuglist.free;
+         consts.free;
+         rttilist.free;
          if assigned(ResourceStringList) then
-          dispose(ResourceStringList,done);
+          ResourceStringList.free;
          if assigned(importssection) then
-          dispose(importssection,done);
+          importssection.free;
          if assigned(exportssection) then
-          dispose(exportssection,done);
+          exportssection.free;
          if assigned(resourcesection) then
-          dispose(resourcesection,done);
+          resourcesection.free;
 {$ifdef MEMDEBUG}
          d.done;
 {$endif}
@@ -419,19 +411,7 @@ implementation
          d.done;
 {$endif}
          { resource strings }
-         dispose(ResourceStrings,done);
-      end;
-
-
-{*****************************************************************************
-                              TTempToDestroy
-*****************************************************************************}
-
-    constructor ttemptodestroy.init(const a : treference;p : pdef);
-      begin
-         inherited init;
-         address:=a;
-         typ:=p;
+         ResourceStrings.free;
       end;
 
 {$ifdef fixLeaksOnError}
@@ -457,7 +437,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2000-11-30 22:16:49  florian
+  Revision 1.9  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.8  2000/11/30 22:16:49  florian
     * moved to i386
 
   Revision 1.7  2000/10/31 22:02:47  peter

compiler/i386/ag386att.pas

@@ -26,12 +26,15 @@ unit ag386att;
 
 interface
 
-    uses cobjects,aasm,assemble;
+    uses
+      cobjects,
+      globals,
+      aasm,assemble;
 
     type
       pi386attasmlist=^ti386attasmlist;
       ti386attasmlist=object(tasmlist)
-        procedure WriteTree(p:paasmoutput);virtual;
+        procedure WriteTree(p:TAAsmoutput);virtual;
         procedure WriteAsmList;virtual;
 {$ifdef GDB}
         procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
@@ -49,7 +52,7 @@ interface
       strings,
       dos,
 {$endif Delphi}
-      cutils,globtype,globals,systems,
+      cutils,globtype,systems,
       fmodule,finput,verbose,cpubase,cpuasm
 {$ifdef GDB}
       ,gdb
@@ -70,7 +73,7 @@ interface
       lastsec      : tsection; { last section type written }
       lastfileinfo : tfileposinfo;
       infile,
-      lastinfile   : pinputfile;
+      lastinfile   : tinputfile;
       symendcount  : longint;
 
    function fixline(s:string):string;
@@ -299,19 +302,19 @@ interface
           if (fileinfo.fileindex<>0) and
              (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
            begin
-             infile:=current_module^.sourcefiles^.get_file(fileinfo.fileindex);
+             infile:=current_module.sourcefiles.get_file(fileinfo.fileindex);
              if assigned(infile) then
               begin
                 if includecount=0 then
                  curr_n:=n_sourcefile
                 else
                  curr_n:=n_includefile;
-                if (infile^.path^<>'') then
+                if (infile.path^<>'') then
                  begin
-                   AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+
+                   AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+
                      tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
                  end;
-                AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
+                AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile.name^))+'",'+
                   tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
                 AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
                 inc(includecount);
@@ -351,7 +354,7 @@ interface
 {$endif GDB}
 
 
-    procedure ti386attasmlist.WriteTree(p:paasmoutput);
+    procedure ti386attasmlist.WriteTree(p:TAAsmoutput);
     const
       allocstr : array[boolean] of string[10]=(' released',' allocated');
       nolinetai =[ait_label,
@@ -364,7 +367,7 @@ interface
       t32bitarray = array[0..3] of byte;
     var
       ch       : char;
-      hp       : pai;
+      hp       : tai;
       consttyp : tait;
       s        : string;
       found    : boolean;
@@ -386,34 +389,34 @@ interface
       do_line:=(cs_asm_source in aktglobalswitches) or
                ((cs_lineinfo in aktmoduleswitches)
                  and (p=codesegment));
-      hp:=pai(p^.first);
+      hp:=tai(p.first);
       while assigned(hp) do
        begin
-         aktfilepos:=hp^.fileinfo;
+         aktfilepos:=hp.fileinfo;
 
-         if not(hp^.typ in nolinetai) then
+         if not(hp.typ in nolinetai) then
           begin
 {$ifdef GDB}
              { write stabs }
              if (cs_debuginfo in aktmoduleswitches) or
                 (cs_gdb_lineinfo in aktglobalswitches) then
-               WriteFileLineInfo(hp^.fileinfo);
+               WriteFileLineInfo(hp.fileinfo);
 {$endif GDB}
 
              if do_line then
               begin
               { load infile }
-                if lastfileinfo.fileindex<>hp^.fileinfo.fileindex then
+                if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
                  begin
-                   infile:=current_module^.sourcefiles^.get_file(hp^.fileinfo.fileindex);
+                   infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
                    if assigned(infile) then
                     begin
                       { open only if needed !! }
                       if (cs_asm_source in aktglobalswitches) then
-                       infile^.open;
+                       infile.open;
                     end;
                    { avoid unnecessary reopens of the same file !! }
-                   lastfileinfo.fileindex:=hp^.fileinfo.fileindex;
+                   lastfileinfo.fileindex:=hp.fileinfo.fileindex;
                    { be sure to change line !! }
                    lastfileinfo.line:=-1;
                  end;
@@ -423,65 +426,65 @@ interface
                  begin
                    if (infile<>lastinfile) then
                      begin
-                       AsmWriteLn(target_asm.comment+'['+infile^.name^+']');
+                       AsmWriteLn(target_asm.comment+'['+infile.name^+']');
                        if assigned(lastinfile) then
-                         lastinfile^.close;
+                         lastinfile.close;
                      end;
-                   if (hp^.fileinfo.line<>lastfileinfo.line) and
-                      ((hp^.fileinfo.line<infile^.maxlinebuf) or (InlineLevel>0)) then
+                   if (hp.fileinfo.line<>lastfileinfo.line) and
+                      ((hp.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
                      begin
-                       if (hp^.fileinfo.line<>0) and
-                          ((infile^.linebuf^[hp^.fileinfo.line]>=0) or (InlineLevel>0)) then
-                         AsmWriteLn(target_asm.comment+'['+tostr(hp^.fileinfo.line)+'] '+
-                           fixline(infile^.GetLineStr(hp^.fileinfo.line)));
+                       if (hp.fileinfo.line<>0) and
+                          ((infile.linebuf^[hp.fileinfo.line]>=0) or (InlineLevel>0)) then
+                         AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
+                           fixline(infile.GetLineStr(hp.fileinfo.line)));
                        { set it to a negative value !
                        to make that is has been read already !! PM }
-                       if (infile^.linebuf^[hp^.fileinfo.line]>=0) then
-                         infile^.linebuf^[hp^.fileinfo.line]:=-infile^.linebuf^[hp^.fileinfo.line]-1;
+                       if (infile.linebuf^[hp.fileinfo.line]>=0) then
+                         infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
                      end;
                  end;
-                lastfileinfo:=hp^.fileinfo;
+                lastfileinfo:=hp.fileinfo;
                 lastinfile:=infile;
               end;
           end;
 
-         case hp^.typ of
+         case hp.typ of
 
            ait_comment :
              Begin
                AsmWrite(target_asm.comment);
-               AsmWritePChar(pai_asm_comment(hp)^.str);
+               AsmWritePChar(tai_asm_comment(hp).str);
                AsmLn;
              End;
 
            ait_regalloc :
              begin
                if (cs_asm_regalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+
-                   allocstr[pairegalloc(hp)^.allocation]);
+                 AsmWriteLn(target_asm.comment+'Register '+att_reg2str[tairegalloc(hp).reg]+
+                   allocstr[tairegalloc(hp).allocation]);
              end;
 
            ait_tempalloc :
              begin
                if (cs_asm_tempalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Temp '+tostr(paitempalloc(hp)^.temppos)+','+
-                   tostr(paitempalloc(hp)^.tempsize)+allocstr[paitempalloc(hp)^.allocation]);
+                 AsmWriteLn(target_asm.comment+'Temp '+tostr(taitempalloc(hp).temppos)+','+
+                   tostr(taitempalloc(hp).tempsize)+allocstr[taitempalloc(hp).allocation]);
              end;
 
            ait_align :
              begin
-               AsmWrite(#9'.balign '+tostr(pai_align(hp)^.aligntype));
-               if pai_align(hp)^.use_op then
-                AsmWrite(','+tostr(pai_align(hp)^.fillop));
+               AsmWrite(#9'.balign '+tostr(tai_align(hp).aligntype));
+               if tai_align(hp).use_op then
+                AsmWrite(','+tostr(tai_align(hp).fillop));
                AsmLn;
              end;
 
            ait_section :
              begin
-               if pai_section(hp)^.sec<>sec_none then
+               if tai_section(hp).sec<>sec_none then
                 begin
                   AsmLn;
-                  AsmWriteLn(ait_section2str(pai_section(hp)^.sec));
+                  AsmWriteLn(ait_section2str(tai_section(hp).sec));
 {$ifdef GDB}
                   lastfileinfo.line:=-1;
 {$endif GDB}
@@ -490,27 +493,27 @@ interface
 
            ait_datablock :
              begin
-               if pai_datablock(hp)^.is_global then
+               if tai_datablock(hp).is_global then
                 AsmWrite(#9'.comm'#9)
                else
                 AsmWrite(#9'.lcomm'#9);
-               AsmWrite(pai_datablock(hp)^.sym^.name);
-               AsmWriteLn(','+tostr(pai_datablock(hp)^.size));
+               AsmWrite(tai_datablock(hp).sym^.name);
+               AsmWriteLn(','+tostr(tai_datablock(hp).size));
              end;
 
            ait_const_32bit,
            ait_const_16bit,
            ait_const_8bit :
              begin
-               AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
-               consttyp:=hp^.typ;
+               AsmWrite(ait_const2str[hp.typ]+tostr(tai_const(hp).value));
+               consttyp:=hp.typ;
                l:=0;
                repeat
-                 found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
+                 found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
                  if found then
                   begin
-                    hp:=Pai(hp^.next);
-                    s:=','+tostr(pai_const(hp)^.value);
+                    hp:=tai(hp.next);
+                    s:=','+tostr(tai_const(hp).value);
                     AsmWrite(s);
                     inc(l,length(s));
                   end;
@@ -520,24 +523,24 @@ interface
 
            ait_const_symbol :
              begin
-               AsmWrite(#9'.long'#9+pai_const_symbol(hp)^.sym^.name);
-               if pai_const_symbol(hp)^.offset>0 then
-                 AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
-               else if pai_const_symbol(hp)^.offset<0 then
-                 AsmWrite(tostr(pai_const_symbol(hp)^.offset));
+               AsmWrite(#9'.long'#9+tai_const_symbol(hp).sym^.name);
+               if tai_const_symbol(hp).offset>0 then
+                 AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
+               else if tai_const_symbol(hp).offset<0 then
+                 AsmWrite(tostr(tai_const_symbol(hp).offset));
                AsmLn;
              end;
 
            ait_const_rva :
-             AsmWriteLn(#9'.rva'#9+pai_const_symbol(hp)^.sym^.name);
+             AsmWriteLn(#9'.rva'#9+tai_const_symbol(hp).sym^.name);
 
            ait_real_80bit :
              begin
                if do_line then
-                AsmWriteLn(target_asm.comment+extended2str(pai_real_80bit(hp)^.value));
+                AsmWriteLn(target_asm.comment+extended2str(tai_real_80bit(hp).value));
              { Make sure e is a extended type, bestreal could be
                a different type (bestreal) !! (PFV) }
-               e:=pai_real_80bit(hp)^.value;
+               e:=tai_real_80bit(hp).value;
                AsmWrite(#9'.byte'#9);
                for i:=0 to 9 do
                 begin
@@ -551,8 +554,8 @@ interface
            ait_real_64bit :
              begin
                if do_line then
-                AsmWriteLn(target_asm.comment+double2str(pai_real_64bit(hp)^.value));
-               d:=pai_real_64bit(hp)^.value;
+                AsmWriteLn(target_asm.comment+double2str(tai_real_64bit(hp).value));
+               d:=tai_real_64bit(hp).value;
                AsmWrite(#9'.byte'#9);
                for i:=0 to 7 do
                 begin
@@ -566,8 +569,8 @@ interface
            ait_real_32bit :
              begin
                if do_line then
-                AsmWriteLn(target_asm.comment+single2str(pai_real_32bit(hp)^.value));
-               sin:=pai_real_32bit(hp)^.value;
+                AsmWriteLn(target_asm.comment+single2str(tai_real_32bit(hp).value));
+               sin:=tai_real_32bit(hp).value;
                AsmWrite(#9'.byte'#9);
                for i:=0 to 3 do
                 begin
@@ -581,12 +584,12 @@ interface
            ait_comp_64bit :
              begin
                if do_line then
-                AsmWriteLn(target_asm.comment+comp2str(pai_comp_64bit(hp)^.value));
+                AsmWriteLn(target_asm.comment+comp2str(tai_comp_64bit(hp).value));
                AsmWrite(#9'.byte'#9);
 {$ifdef FPC}
-               co:=comp(pai_comp_64bit(hp)^.value);
+               co:=comp(tai_comp_64bit(hp).value);
 {$else}
-               co:=pai_comp_64bit(hp)^.value;
+               co:=tai_comp_64bit(hp).value;
 {$endif}
                for i:=0 to 7 do
                 begin
@@ -599,14 +602,14 @@ interface
 
            ait_direct :
              begin
-               AsmWritePChar(pai_direct(hp)^.str);
+               AsmWritePChar(tai_direct(hp).str);
                AsmLn;
 {$IfDef GDB}
-               if strpos(pai_direct(hp)^.str,'.data')<>nil then
+               if strpos(tai_direct(hp).str,'.data')<>nil then
                  n_line:=n_dataline
-               else if strpos(pai_direct(hp)^.str,'.text')<>nil then
+               else if strpos(tai_direct(hp).str,'.text')<>nil then
                  n_line:=n_textline
-               else if strpos(pai_direct(hp)^.str,'.bss')<>nil then
+               else if strpos(tai_direct(hp).str,'.bss')<>nil then
                  n_line:=n_bssline;
 {$endif GDB}
              end;
@@ -614,14 +617,14 @@ interface
            ait_string :
              begin
                pos:=0;
-               for i:=1 to pai_string(hp)^.len do
+               for i:=1 to tai_string(hp).len do
                 begin
                   if pos=0 then
                    begin
                      AsmWrite(#9'.ascii'#9'"');
                      pos:=20;
                    end;
-                  ch:=pai_string(hp)^.str[i-1];
+                  ch:=tai_string(hp).str[i-1];
                   case ch of
                      #0, {This can't be done by range, because a bug in FPC}
                 #1..#31,
@@ -633,7 +636,7 @@ interface
                   end;
                   AsmWrite(s);
                   inc(pos,length(s));
-                  if (pos>line_length) or (i=pai_string(hp)^.len) then
+                  if (pos>line_length) or (i=tai_string(hp).len) then
                    begin
                      AsmWriteLn('"');
                      pos:=0;
@@ -643,45 +646,45 @@ interface
 
            ait_label :
              begin
-               if (pai_label(hp)^.l^.is_used) then
+               if (tai_label(hp).l^.is_used) then
                 begin
-                  if pai_label(hp)^.l^.defbind=AB_GLOBAL then
+                  if tai_label(hp).l^.defbind=AB_GLOBAL then
                    begin
                      AsmWrite('.globl'#9);
-                     AsmWriteLn(pai_label(hp)^.l^.name);
+                     AsmWriteLn(tai_label(hp).l^.name);
                    end;
-                  AsmWrite(pai_label(hp)^.l^.name);
+                  AsmWrite(tai_label(hp).l^.name);
                   AsmWriteLn(':');
                 end;
              end;
 
            ait_symbol :
              begin
-               if pai_symbol(hp)^.is_global then
+               if tai_symbol(hp).is_global then
                 begin
                   AsmWrite('.globl'#9);
-                  AsmWriteLn(pai_symbol(hp)^.sym^.name);
+                  AsmWriteLn(tai_symbol(hp).sym^.name);
                 end;
                if target_info.target=target_i386_linux then
                 begin
                    AsmWrite(#9'.type'#9);
-                   AsmWrite(pai_symbol(hp)^.sym^.name);
-                   if assigned(pai(hp^.next)) and
-                      (pai(hp^.next)^.typ in [ait_const_symbol,ait_const_rva,
+                   AsmWrite(tai_symbol(hp).sym^.name);
+                   if assigned(tai(hp.next)) and
+                      (tai(hp.next).typ in [ait_const_symbol,ait_const_rva,
                          ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock,
                          ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]) then
                     AsmWriteLn(',@object')
                    else
                     AsmWriteLn(',@function');
-                   if pai_symbol(hp)^.sym^.size>0 then
+                   if tai_symbol(hp).sym^.size>0 then
                     begin
                       AsmWrite(#9'.size'#9);
-                      AsmWrite(pai_symbol(hp)^.sym^.name);
+                      AsmWrite(tai_symbol(hp).sym^.name);
                       AsmWrite(', ');
-                      AsmWriteLn(tostr(pai_symbol(hp)^.sym^.size));
+                      AsmWriteLn(tostr(tai_symbol(hp).sym^.size));
                     end;
                 end;
-               AsmWrite(pai_symbol(hp)^.sym^.name);
+               AsmWrite(tai_symbol(hp).sym^.name);
                AsmWriteLn(':');
              end;
 
@@ -693,18 +696,18 @@ interface
                   inc(symendcount);
                   AsmWriteLn(s+':');
                   AsmWrite(#9'.size'#9);
-                  AsmWrite(pai_symbol(hp)^.sym^.name);
+                  AsmWrite(tai_symbol(hp).sym^.name);
                   AsmWrite(', '+s+' - ');
-                  AsmWriteLn(pai_symbol(hp)^.sym^.name);
+                  AsmWriteLn(tai_symbol(hp).sym^.name);
                 end;
              end;
 
            ait_instruction :
              begin
-               op:=paicpu(hp)^.opcode;
+               op:=taicpu(hp).opcode;
                calljmp:=is_calljmp(op);
              { call maybe not translated to call }
-               s:=#9+att_op2str[op]+cond2str[paicpu(hp)^.condition];
+               s:=#9+att_op2str[op]+cond2str[taicpu(hp).condition];
                { suffix needed ?  fnstsw,fldcw don't support suffixes
                  with binutils 2.9.5 under linux }
                if (not calljmp) and
@@ -713,12 +716,12 @@ interface
                   (op<>A_FNSTCW) and (op<>A_FSTCW) and
                   (op<>A_FLDCW) and
                   not(
-                   (paicpu(hp)^.oper[0].typ=top_reg) and
-                   (paicpu(hp)^.oper[0].reg in [R_ST..R_ST7])
+                   (taicpu(hp).oper[0].typ=top_reg) and
+                   (taicpu(hp).oper[0].reg in [R_ST..R_ST7])
                   ) then
-                  s:=s+att_opsize2str[paicpu(hp)^.opsize];
+                  s:=s+att_opsize2str[taicpu(hp).opsize];
              { process operands }
-               if paicpu(hp)^.ops<>0 then
+               if taicpu(hp).ops<>0 then
                 begin
                 { call and jmp need an extra handling                          }
                 { this code is only called if jmp isn't a labeled instruction  }
@@ -726,17 +729,17 @@ interface
                   if calljmp then
                     begin
                        AsmWrite(s+#9);
-                       s:=getopstr_jmp(paicpu(hp)^.oper[0]);
+                       s:=getopstr_jmp(taicpu(hp).oper[0]);
                     end
                   else
                    begin
-                     for i:=0 to paicpu(hp)^.ops-1 do
+                     for i:=0 to taicpu(hp).ops-1 do
                       begin
                         if i=0 then
                          sep:=#9
                         else
                          sep:=',';
-                        s:=s+sep+getopstr(paicpu(hp)^.oper[i])
+                        s:=s+sep+getopstr(taicpu(hp).oper[i])
                       end;
                    end;
                 end;
@@ -747,14 +750,14 @@ interface
            ait_stabs :
              begin
                AsmWrite(#9'.stabs ');
-               AsmWritePChar(pai_stabs(hp)^.str);
+               AsmWritePChar(tai_stabs(hp).str);
                AsmLn;
              end;
 
            ait_stabn :
              begin
                AsmWrite(#9'.stabn ');
-               AsmWritePChar(pai_stabn(hp)^.str);
+               AsmWritePChar(tai_stabn(hp).str);
                AsmLn;
              end;
 
@@ -762,7 +765,7 @@ interface
              stabslastfileinfo.line:=0;
 
            ait_stab_function_name:
-             funcname:=pai_stab_function_name(hp)^.str;
+             funcname:=tai_stab_function_name(hp).str;
 {$endif GDB}
 
            ait_cut :
@@ -776,21 +779,21 @@ interface
                    begin
                      AsmClose;
                      DoAssemble;
-                     AsmCreate(pai_cut(hp)^.place);
+                     AsmCreate(tai_cut(hp).place);
                    end;
                 { avoid empty files }
-                  while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
+                  while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
                    begin
-                     if pai(hp^.next)^.typ=ait_section then
-                       lastsec:=pai_section(hp^.next)^.sec;
-                     hp:=pai(hp^.next);
+                     if tai(hp.next).typ=ait_section then
+                       lastsec:=tai_section(hp.next).sec;
+                     hp:=tai(hp.next);
                    end;
 {$ifdef GDB}
                   { force write of filename }
                   FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
                   includecount:=0;
                   funcname:=nil;
-                  WriteFileLineInfo(hp^.fileinfo);
+                  WriteFileLineInfo(hp.fileinfo);
 {$endif GDB}
                   if lastsec<>sec_none then
                     AsmWriteLn(ait_section2str(lastsec));
@@ -799,15 +802,15 @@ interface
              end;
 
            ait_marker :
-             if pai_marker(hp)^.kind=InlineStart then
+             if tai_marker(hp).kind=InlineStart then
                inc(InlineLevel)
-             else if pai_marker(hp)^.kind=InlineEnd then
+             else if tai_marker(hp).kind=InlineEnd then
                dec(InlineLevel);
 
            else
              internalerror(10000);
          end;
-         hp:=pai(hp^.next);
+         hp:=tai(hp.next);
        end;
     end;
 
@@ -823,8 +826,8 @@ interface
 
     begin
 {$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       Comment(v_info,'Start writing att-styled assembler output for '+current_module^.mainsource^);
+      if assigned(current_module.mainsource) then
+       Comment(v_info,'Start writing att-styled assembler output for '+current_module.mainsource^);
 {$endif}
 
       LastSec:=sec_none;
@@ -834,8 +837,8 @@ interface
       FillChar(lastfileinfo,sizeof(lastfileinfo),0);
       LastInfile:=nil;
 
-      if assigned(current_module^.mainsource) then
-       fsplit(current_module^.mainsource^,p,n,e)
+      if assigned(current_module.mainsource) then
+       fsplit(current_module.mainsource^,p,n,e)
       else
        begin
          p:=inputdir;
@@ -880,8 +883,8 @@ interface
 
       AsmLn;
 {$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Done writing att-styled assembler output for '+current_module^.mainsource^);
+      if assigned(current_module.mainsource) then
+       comment(v_info,'Done writing att-styled assembler output for '+current_module.mainsource^);
 {$endif EXTDEBUG}
     end;
 
@@ -889,7 +892,11 @@ interface
 end.
 {
   $Log$
-  Revision 1.1  2000-11-30 22:18:48  florian
+  Revision 1.2  2000-12-25 00:07:31  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.1  2000/11/30 22:18:48  florian
     * moved to i386
 
   Revision 1.6  2000/09/24 15:06:10  peter

compiler/i386/ag386bin.pas

@@ -30,6 +30,7 @@ interface
 
     uses
       cobjects,
+      globals,
       cpubase,aasm,
       fmodule,finput,
       ogbase,assemble;
@@ -46,10 +47,10 @@ interface
       private
         { the aasmoutput lists that need to be processed }
         lists        : byte;
-        list         : array[1..maxoutputlists] of paasmoutput;
+        list         : array[1..maxoutputlists] of TAAsmoutput;
         { current processing }
         currlistidx  : byte;
-        currlist     : paasmoutput;
+        currlist     : TAAsmoutput;
         currpass     : byte;
 {$ifdef GDB}
         n_line       : byte;     { different types of source lines }
@@ -64,10 +65,10 @@ interface
         procedure StartFileLineInfo;
         procedure EndFileLineInfo;
 {$endif}
-        function  MaybeNextList(var hp:pai):boolean;
-        function  TreePass0(hp:pai):pai;
-        function  TreePass1(hp:pai):pai;
-        function  TreePass2(hp:pai):pai;
+        function  MaybeNextList(var hp:Tai):boolean;
+        function  TreePass0(hp:Tai):Tai;
+        function  TreePass1(hp:Tai):Tai;
+        function  TreePass2(hp:Tai):Tai;
         procedure writetree;
         procedure writetreesmart;
       end;
@@ -80,7 +81,7 @@ interface
 {$else}
        strings,
 {$endif}
-       cutils,globtype,globals,systems,verbose,
+       cutils,globtype,systems,verbose,
        cpuasm,
 {$ifdef GDB}
        gdb,
@@ -274,7 +275,7 @@ interface
       var
         curr_n : byte;
         hp : pasmsymbol;
-        infile : pinputfile;
+        infile : tinputfile;
       begin
         if not ((cs_debuginfo in aktmoduleswitches) or
            (cs_gdb_lineinfo in aktglobalswitches)) then
@@ -283,7 +284,7 @@ interface
         if (fileinfo.fileindex<>0) and
            (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
          begin
-           infile:=current_module^.sourcefiles^.get_file(fileinfo.fileindex);
+           infile:=current_module.sourcefiles.get_file(fileinfo.fileindex);
            if includecount=0 then
             curr_n:=n_sourcefile
            else
@@ -298,10 +299,10 @@ interface
            else
              objectdata.writesymbol(hp);
            { emit stabs }
-           if (infile^.path^<>'') then
-             EmitStabs('"'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+tostr(curr_n)+
+           if (infile.path^<>'') then
+             EmitStabs('"'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+tostr(curr_n)+
                ',0,0,Ltext'+ToStr(IncludeCount));
-           EmitStabs('"'+lower(FixFileName(infile^.name^))+'",'+tostr(curr_n)+
+           EmitStabs('"'+lower(FixFileName(infile.name^))+'",'+tostr(curr_n)+
              ',0,0,Ltext'+ToStr(IncludeCount));
            inc(includecount);
          end;
@@ -351,7 +352,7 @@ interface
 {$endif GDB}
 
 
-    function ti386binasmlist.MaybeNextList(var hp:pai):boolean;
+    function ti386binasmlist.MaybeNextList(var hp:Tai):boolean;
       begin
         { maybe end of list }
         while not assigned(hp) do
@@ -360,7 +361,7 @@ interface
             begin
               inc(currlistidx);
               currlist:=list[currlistidx];
-              hp:=pai(currlist^.first);
+              hp:=Tai(currList.first);
             end
            else
             begin
@@ -372,42 +373,42 @@ interface
       end;
 
 
-    function ti386binasmlist.TreePass0(hp:pai):pai;
+    function ti386binasmlist.TreePass0(hp:Tai):Tai;
       var
         l : longint;
       begin
         while assigned(hp) do
          begin
-           case hp^.typ of
+           case hp.typ of
              ait_align :
                begin
                  { always use the maximum fillsize in this pass to avoid possible
                    short jumps to become out of range }
-                 pai_align(hp)^.fillsize:=pai_align(hp)^.aligntype;
-                 objectalloc.sectionalloc(pai_align(hp)^.fillsize);
+                 Tai_align(hp).fillsize:=Tai_align(hp).aligntype;
+                 objectalloc.sectionalloc(Tai_align(hp).fillsize);
                end;
              ait_datablock :
                begin
                  if not SmartAsm then
                   begin
-                    if not pai_datablock(hp)^.is_global then
+                    if not Tai_datablock(hp).is_global then
                      begin
-                        l:=pai_datablock(hp)^.size;
+                        l:=Tai_datablock(hp).size;
                         if l>2 then
                           objectalloc.sectionalign(4)
                         else if l>1 then
                           objectalloc.sectionalign(2);
-                        objectalloc.sectionalloc(pai_datablock(hp)^.size);
+                        objectalloc.sectionalloc(Tai_datablock(hp).size);
                      end;
                   end
                  else
                   begin
-                    l:=pai_datablock(hp)^.size;
+                    l:=Tai_datablock(hp).size;
                     if l>2 then
                       objectalloc.sectionalign(4)
                     else if l>1 then
                       objectalloc.sectionalign(2);
-                    objectalloc.sectionalloc(pai_datablock(hp)^.size);
+                    objectalloc.sectionalloc(Tai_datablock(hp).size);
                   end;
                end;
              ait_const_32bit :
@@ -428,30 +429,30 @@ interface
              ait_const_symbol :
                objectalloc.sectionalloc(4);
              ait_section:
-               objectalloc.setsection(pai_section(hp)^.sec);
+               objectalloc.setsection(Tai_section(hp).sec);
              ait_symbol :
-               pai_symbol(hp)^.sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+               Tai_symbol(hp).sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
              ait_label :
-               pai_label(hp)^.l^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+               Tai_label(hp).l^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
              ait_string :
-               objectalloc.sectionalloc(pai_string(hp)^.len);
+               objectalloc.sectionalloc(Tai_string(hp).len);
              ait_instruction :
                begin
                  { reset instructions which could change in pass 2 }
-                 paicpu(hp)^.resetpass2;
-                 objectalloc.sectionalloc(paicpu(hp)^.Pass1(objectalloc.sectionsize));
+                 Taicpu(hp).resetpass2;
+                 objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
                end;
              ait_cut :
                if SmartAsm then
                 break;
            end;
-           hp:=pai(hp^.next);
+           hp:=Tai(hp.next);
          end;
         TreePass0:=hp;
       end;
 
 
-    function ti386binasmlist.TreePass1(hp:pai):pai;
+    function ti386binasmlist.TreePass1(hp:Tai):Tai;
       var
         i,l : longint;
       begin
@@ -463,21 +464,21 @@ interface
              (cs_gdb_lineinfo in aktglobalswitches)) then
             begin
               if (objectalloc.currsec<>sec_none) and
-                 not(hp^.typ in  [
+                 not(hp.typ in  [
                      ait_label,
                      ait_regalloc,ait_tempalloc,
                      ait_stabn,ait_stabs,ait_section,
                      ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
-               WriteFileLineInfo(hp^.fileinfo);
+               WriteFileLineInfo(hp.fileinfo);
             end;
 {$endif GDB}
-           case hp^.typ of
+           case hp.typ of
              ait_align :
                begin
                  { here we must determine the fillsize which is used in pass2 }
-                 pai_align(hp)^.fillsize:=align(objectalloc.sectionsize,pai_align(hp)^.aligntype)-
+                 Tai_align(hp).fillsize:=align(objectalloc.sectionsize,Tai_align(hp).aligntype)-
                    objectalloc.sectionsize;
-                 objectalloc.sectionalloc(pai_align(hp)^.fillsize);
+                 objectalloc.sectionalloc(Tai_align(hp).fillsize);
                end;
              ait_datablock :
                begin
@@ -485,36 +486,36 @@ interface
                   Message(asmw_e_alloc_data_only_in_bss);
                  if not SmartAsm then
                   begin
-                    if pai_datablock(hp)^.is_global then
+                    if Tai_datablock(hp).is_global then
                      begin
-                       pai_datablock(hp)^.sym^.setaddress(sec_none,pai_datablock(hp)^.size,pai_datablock(hp)^.size);
+                       Tai_datablock(hp).sym^.setaddress(sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size);
                        { force to be common/external, must be after setaddress as that would
                          set it to AS_GLOBAL }
-                       pai_datablock(hp)^.sym^.bind:=AB_COMMON;
+                       Tai_datablock(hp).sym^.bind:=AB_COMMON;
                      end
                     else
                      begin
-                       l:=pai_datablock(hp)^.size;
+                       l:=Tai_datablock(hp).size;
                        if l>2 then
                          objectalloc.sectionalign(4)
                        else if l>1 then
                          objectalloc.sectionalign(2);
-                       pai_datablock(hp)^.sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,
-                         pai_datablock(hp)^.size);
-                       objectalloc.sectionalloc(pai_datablock(hp)^.size);
+                       Tai_datablock(hp).sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,
+                         Tai_datablock(hp).size);
+                       objectalloc.sectionalloc(Tai_datablock(hp).size);
                      end;
                    end
                   else
                    begin
-                     l:=pai_datablock(hp)^.size;
+                     l:=Tai_datablock(hp).size;
                      if l>2 then
                        objectalloc.sectionalign(4)
                      else if l>1 then
                        objectalloc.sectionalign(2);
-                     pai_datablock(hp)^.sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,pai_datablock(hp)^.size);
-                     objectalloc.sectionalloc(pai_datablock(hp)^.size);
+                     Tai_datablock(hp).sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size);
+                     objectalloc.sectionalloc(Tai_datablock(hp).size);
                    end;
-                 UsedAsmSymbolListInsert(pai_datablock(hp)^.sym);
+                 UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
                end;
              ait_const_32bit :
                objectalloc.sectionalloc(4);
@@ -534,13 +535,13 @@ interface
              ait_const_symbol :
                begin
                  objectalloc.sectionalloc(4);
-                 UsedAsmSymbolListInsert(pai_const_symbol(hp)^.sym);
+                 UsedAsmSymbolListInsert(Tai_const_symbol(hp).sym);
                end;
              ait_section:
                begin
-                 objectalloc.setsection(pai_section(hp)^.sec);
+                 objectalloc.setsection(Tai_section(hp).sec);
 {$ifdef GDB}
-                 case pai_section(hp)^.sec of
+                 case Tai_section(hp).sec of
                   sec_code : n_line:=n_textline;
                   sec_data : n_line:=n_dataline;
                    sec_bss : n_line:=n_bssline;
@@ -552,14 +553,14 @@ interface
                end;
 {$ifdef GDB}
              ait_stabn :
-               convertstabs(pai_stabn(hp)^.str);
+               convertstabs(Tai_stabn(hp).str);
              ait_stabs :
-               convertstabs(pai_stabs(hp)^.str);
+               convertstabs(Tai_stabs(hp).str);
              ait_stab_function_name :
                begin
-                 if assigned(pai_stab_function_name(hp)^.str) then
+                 if assigned(Tai_stab_function_name(hp).str) then
                   begin
-                    funcname:=getasmsymbol(strpas(pai_stab_function_name(hp)^.str));
+                    funcname:=getasmsymbol(strpas(Tai_stab_function_name(hp).str));
                     UsedAsmSymbolListInsert(funcname);
                   end
                  else
@@ -570,31 +571,31 @@ interface
 {$endif}
              ait_symbol :
                begin
-                 pai_symbol(hp)^.sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
-                 UsedAsmSymbolListInsert(pai_symbol(hp)^.sym);
+                 Tai_symbol(hp).sym^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+                 UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
                end;
              ait_symbol_end :
                begin
                  if target_info.target=target_i386_linux then
                   begin
-                    pai_symbol(hp)^.sym^.size:=objectalloc.sectionsize-pai_symbol(hp)^.sym^.address;
-                    UsedAsmSymbolListInsert(pai_symbol(hp)^.sym);
+                    Tai_symbol(hp).sym^.size:=objectalloc.sectionsize-Tai_symbol(hp).sym^.address;
+                    UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
                   end;
                 end;
              ait_label :
                begin
-                 pai_label(hp)^.l^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
-                 UsedAsmSymbolListInsert(pai_label(hp)^.l);
+                 Tai_label(hp).l^.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+                 UsedAsmSymbolListInsert(Tai_label(hp).l);
                end;
              ait_string :
-               objectalloc.sectionalloc(pai_string(hp)^.len);
+               objectalloc.sectionalloc(Tai_string(hp).len);
              ait_instruction :
                begin
-                 objectalloc.sectionalloc(paicpu(hp)^.Pass1(objectalloc.sectionsize));
+                 objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
                  { fixup the references }
-                 for i:=1 to paicpu(hp)^.ops do
+                 for i:=1 to Taicpu(hp).ops do
                   begin
-                    with paicpu(hp)^.oper[i-1] do
+                    with Taicpu(hp).oper[i-1] do
                      begin
                        case typ of
                          top_ref :
@@ -616,13 +617,13 @@ interface
                if SmartAsm then
                 break;
            end;
-           hp:=pai(hp^.next);
+           hp:=Tai(hp.next);
          end;
         TreePass1:=hp;
       end;
 
 
-    function ti386binasmlist.TreePass2(hp:pai):pai;
+    function ti386binasmlist.TreePass2(hp:Tai):Tai;
       var
         l  : longint;
 {$ifdef I386}
@@ -638,22 +639,22 @@ interface
              (cs_gdb_lineinfo in aktglobalswitches)) then
             begin
               if (objectdata.currsec<>sec_none) and
-                 not(hp^.typ in [
+                 not(hp.typ in [
                      ait_label,
                      ait_regalloc,ait_tempalloc,
                      ait_stabn,ait_stabs,ait_section,
                      ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
-               WriteFileLineInfo(hp^.fileinfo);
+               WriteFileLineInfo(hp.fileinfo);
             end;
 {$endif GDB}
-           case hp^.typ of
+           case hp.typ of
              ait_align :
-               objectdata.writebytes(pai_align(hp)^.getfillbuf^,pai_align(hp)^.fillsize);
+               objectdata.writebytes(Tai_align(hp).getfillbuf^,Tai_align(hp).fillsize);
              ait_section :
                begin
-                 objectdata.defaultsection(pai_section(hp)^.sec);
+                 objectdata.defaultsection(Tai_section(hp).sec);
 {$ifdef GDB}
-                 case pai_section(hp)^.sec of
+                 case Tai_section(hp).sec of
                   sec_code : n_line:=n_textline;
                   sec_data : n_line:=n_dataline;
                    sec_bss : n_line:=n_bssline;
@@ -665,69 +666,69 @@ interface
                end;
              ait_symbol :
                begin
-                 objectdata.writesymbol(pai_symbol(hp)^.sym);
-                 objectoutput.exportsymbol(pai_symbol(hp)^.sym);
+                 objectdata.writesymbol(Tai_symbol(hp).sym);
+                 objectoutput.exportsymbol(Tai_symbol(hp).sym);
                end;
              ait_datablock :
                begin
-                 objectdata.writesymbol(pai_datablock(hp)^.sym);
-                 objectoutput.exportsymbol(pai_datablock(hp)^.sym);
-                 if SmartAsm or (not pai_datablock(hp)^.is_global) then
+                 objectdata.writesymbol(Tai_datablock(hp).sym);
+                 objectoutput.exportsymbol(Tai_datablock(hp).sym);
+                 if SmartAsm or (not Tai_datablock(hp).is_global) then
                    begin
-                     l:=pai_datablock(hp)^.size;
+                     l:=Tai_datablock(hp).size;
                      if l>2 then
                        objectdata.allocalign(4)
                      else if l>1 then
                        objectdata.allocalign(2);
-                     objectdata.alloc(pai_datablock(hp)^.size);
+                     objectdata.alloc(Tai_datablock(hp).size);
                    end;
                end;
              ait_const_32bit :
-               objectdata.writebytes(pai_const(hp)^.value,4);
+               objectdata.writebytes(Tai_const(hp).value,4);
              ait_const_16bit :
-               objectdata.writebytes(pai_const(hp)^.value,2);
+               objectdata.writebytes(Tai_const(hp).value,2);
              ait_const_8bit :
-               objectdata.writebytes(pai_const(hp)^.value,1);
+               objectdata.writebytes(Tai_const(hp).value,1);
              ait_real_80bit :
-               objectdata.writebytes(pai_real_80bit(hp)^.value,10);
+               objectdata.writebytes(Tai_real_80bit(hp).value,10);
              ait_real_64bit :
-               objectdata.writebytes(pai_real_64bit(hp)^.value,8);
+               objectdata.writebytes(Tai_real_64bit(hp).value,8);
              ait_real_32bit :
-               objectdata.writebytes(pai_real_32bit(hp)^.value,4);
+               objectdata.writebytes(Tai_real_32bit(hp).value,4);
              ait_comp_64bit :
                begin
 {$ifdef FPC}
-                 co:=comp(pai_comp_64bit(hp)^.value);
+                 co:=comp(Tai_comp_64bit(hp).value);
 {$else}
-                 co:=pai_comp_64bit(hp)^.value;
+                 co:=Tai_comp_64bit(hp).value;
 {$endif}
                  objectdata.writebytes(co,8);
                end;
              ait_string :
-               objectdata.writebytes(pai_string(hp)^.str^,pai_string(hp)^.len);
+               objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
              ait_const_rva :
-               objectdata.writereloc(pai_const_symbol(hp)^.offset,4,
-                 pai_const_symbol(hp)^.sym,relative_rva);
+               objectdata.writereloc(Tai_const_symbol(hp).offset,4,
+                 Tai_const_symbol(hp).sym,relative_rva);
              ait_const_symbol :
-               objectdata.writereloc(pai_const_symbol(hp)^.offset,4,
-                 pai_const_symbol(hp)^.sym,relative_false);
+               objectdata.writereloc(Tai_const_symbol(hp).offset,4,
+                 Tai_const_symbol(hp).sym,relative_false);
              ait_label :
                begin
-                 objectdata.writesymbol(pai_label(hp)^.l);
+                 objectdata.writesymbol(Tai_label(hp).l);
                  { exporting shouldn't be necessary as labels are local,
                    but it's better to be on the safe side (PFV) }
-                 objectoutput.exportsymbol(pai_label(hp)^.l);
+                 objectoutput.exportsymbol(Tai_label(hp).l);
                end;
              ait_instruction :
-               paicpu(hp)^.Pass2;
+               Taicpu(hp).Pass2;
 {$ifdef GDB}
              ait_stabn :
-               convertstabs(pai_stabn(hp)^.str);
+               convertstabs(Tai_stabn(hp).str);
              ait_stabs :
-               convertstabs(pai_stabs(hp)^.str);
+               convertstabs(Tai_stabs(hp).str);
              ait_stab_function_name :
-               if assigned(pai_stab_function_name(hp)^.str) then
-                 funcname:=getasmsymbol(strpas(pai_stab_function_name(hp)^.str))
+               if assigned(Tai_stab_function_name(hp).str) then
+                 funcname:=getasmsymbol(strpas(Tai_stab_function_name(hp).str))
                else
                  funcname:=nil;
              ait_force_line :
@@ -737,7 +738,7 @@ interface
                if SmartAsm then
                 break;
            end;
-           hp:=pai(hp^.next);
+           hp:=Tai(hp.next);
          end;
         TreePass2:=hp;
       end;
@@ -745,7 +746,7 @@ interface
 
     procedure ti386binasmlist.writetree;
       var
-        hp : pai;
+        hp : Tai;
       label
         doexit;
       begin
@@ -755,7 +756,7 @@ interface
         objectdata:=objectoutput.initwriting(cut_normal);
         objectdata.defaultsection(sec_code);
       { reset the asmsymbol list }
-        InitUsedAsmsymbolList;
+        CreateUsedAsmsymbolList;
 
 {$ifdef MULTIPASS}
       { Pass 0 }
@@ -764,7 +765,7 @@ interface
         { start with list 1 }
         currlistidx:=1;
         currlist:=list[currlistidx];
-        hp:=pai(currlist^.first);
+        hp:=Tai(currList.first);
         while assigned(hp) do
          begin
            hp:=TreePass0(hp);
@@ -785,7 +786,7 @@ interface
         { start with list 1 }
         currlistidx:=1;
         currlist:=list[currlistidx];
-        hp:=pai(currlist^.first);
+        hp:=Tai(currList.first);
         while assigned(hp) do
          begin
            hp:=TreePass1(hp);
@@ -811,7 +812,7 @@ interface
         { start with list 1 }
         currlistidx:=1;
         currlist:=list[currlistidx];
-        hp:=pai(currlist^.first);
+        hp:=Tai(currList.first);
         while assigned(hp) do
          begin
            hp:=TreePass2(hp);
@@ -833,13 +834,13 @@ interface
         { reset the used symbols back, must be after the .o has been
           written }
         UsedAsmsymbolListReset;
-        DoneUsedAsmsymbolList;
+        DestroyUsedAsmsymbolList;
       end;
 
 
     procedure ti386binasmlist.writetreesmart;
       var
-        hp : pai;
+        hp : Tai;
         startsec : tsection;
         place: tcutplace;
       begin
@@ -853,11 +854,11 @@ interface
         { start with list 1 }
         currlistidx:=1;
         currlist:=list[currlistidx];
-        hp:=pai(currlist^.first);
+        hp:=Tai(currList.first);
         while assigned(hp) do
          begin
          { reset the asmsymbol list }
-           InitUsedAsmSymbolList;
+           CreateUsedAsmSymbolList;
 
 {$ifdef MULTIPASS}
          { Pass 0 }
@@ -911,7 +912,7 @@ interface
            { reset the used symbols back, must be after the .o has been
              written }
            UsedAsmsymbolListReset;
-           DoneUsedAsmsymbolList;
+           DestroyUsedAsmsymbolList;
 
            { end of lists? }
            if not MaybeNextList(hp) then
@@ -923,25 +924,25 @@ interface
            { we will start a new objectfile so reset everything }
            { The place can still change in the next while loop, so don't init }
            { the writer yet (JM)                                              }
-           if (hp^.typ=ait_cut) then
-            place := pai_cut(hp)^.place
+           if (hp.typ=ait_cut) then
+            place := Tai_cut(hp).place
            else
             place := cut_normal;
 
            { avoid empty files }
-           while assigned(hp^.next) and
-                 (pai(hp^.next)^.typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
+           while assigned(hp.next) and
+                 (Tai(hp.next).typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
             begin
-              if pai(hp^.next)^.typ=ait_section then
-               startsec:=pai_section(hp^.next)^.sec
-              else if (pai(hp^.next)^.typ=ait_cut) then
-               place := pai_cut(hp)^.place;
-              hp:=pai(hp^.next);
+              if Tai(hp.next).typ=ait_section then
+               startsec:=Tai_section(hp.next).sec
+              else if (Tai(hp.next).typ=ait_cut) then
+               place := Tai_cut(hp).place;
+              hp:=Tai(hp.next);
             end;
 
            objectdata:=objectoutput.initwriting(place);
 
-           hp:=pai(hp^.next);
+           hp:=Tai(hp.next);
 
            { there is a problem if startsec is sec_none !! PM }
            if startsec=sec_none then
@@ -955,7 +956,7 @@ interface
 
     procedure ti386binasmlist.writebin;
 
-        procedure addlist(p:paasmoutput);
+        procedure addlist(p:TAAsmoutput);
         begin
           inc(lists);
           list[lists]:=p;
@@ -1025,7 +1026,11 @@ interface
 end.
 {
   $Log$
-  Revision 1.3  2000-12-23 19:59:35  peter
+  Revision 1.4  2000-12-25 00:07:31  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.3  2000/12/23 19:59:35  peter
     * object to class for ow/og objects
     * split objectdata from objectoutput
 

compiler/i386/ag386int.pas

@@ -31,7 +31,7 @@ interface
     type
       pi386intasmlist=^ti386intasmlist;
       ti386intasmlist = object(tasmlist)
-        procedure WriteTree(p:paasmoutput);virtual;
+        procedure WriteTree(p:TAAsmoutput);virtual;
         procedure WriteAsmList;virtual;
         procedure WriteExternals;
       end;
@@ -290,14 +290,14 @@ interface
        PadTabs:=s+#9;
     end;
 
-    procedure ti386intasmlist.WriteTree(p:paasmoutput);
+    procedure ti386intasmlist.WriteTree(p:TAAsmoutput);
     const
       allocstr : array[boolean] of string[10]=(' released',' allocated');
     var
       s,
       prefix,
       suffix   : string;
-      hp       : pai;
+      hp       : tai;
       counter,
       lines,
       i,j,l    : longint;
@@ -308,13 +308,13 @@ interface
     begin
       if not assigned(p) then
        exit;
-      hp:=pai(p^.first);
+      hp:=tai(p.first);
       while assigned(hp) do
        begin
-         case hp^.typ of
+         case hp.typ of
        ait_comment : Begin
                        AsmWrite(target_asm.comment);
-                       AsmWritePChar(pai_asm_comment(hp)^.str);
+                       AsmWritePChar(tai_asm_comment(hp).str);
                        AsmLn;
                      End;
        ait_regalloc,
@@ -322,38 +322,38 @@ interface
        ait_section : begin
                        if LastSec<>sec_none then
                         AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
-                       if pai_section(hp)^.sec<>sec_none then
+                       if tai_section(hp).sec<>sec_none then
                         begin
                           AsmLn;
-                          AsmWriteLn('_'+target_asm.secnames[pai_section(hp)^.sec]+#9#9+
+                          AsmWriteLn('_'+target_asm.secnames[tai_section(hp).sec]+#9#9+
                                      'SEGMENT'#9'PARA PUBLIC USE32 '''+
-                                     target_asm.secnames[pai_section(hp)^.sec]+'''');
+                                     target_asm.secnames[tai_section(hp).sec]+'''');
                         end;
-                       LastSec:=pai_section(hp)^.sec;
+                       LastSec:=tai_section(hp).sec;
                      end;
          ait_align : begin
                      { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION   }
                      { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
                      { HERE UNDER TASM!                              }
-                       AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
+                       AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype));
                      end;
      ait_datablock : begin
-                       if pai_datablock(hp)^.is_global then
-                         AsmWriteLn(#9'PUBLIC'#9+pai_datablock(hp)^.sym^.name);
-                       AsmWriteLn(PadTabs(pai_datablock(hp)^.sym^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
+                       if tai_datablock(hp).is_global then
+                         AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym^.name);
+                       AsmWriteLn(PadTabs(tai_datablock(hp).sym^.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)');
                      end;
    ait_const_32bit,
     ait_const_8bit,
    ait_const_16bit : begin
-                       AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
-                       consttyp:=hp^.typ;
+                       AsmWrite(ait_const2str[hp.typ]+tostr(tai_const(hp).value));
+                       consttyp:=hp.typ;
                        l:=0;
                        repeat
-                         found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
+                         found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
                          if found then
                           begin
-                            hp:=Pai(hp^.next);
-                            s:=','+tostr(pai_const(hp)^.value);
+                            hp:=tai(hp.next);
+                            s:=','+tostr(tai_const(hp).value);
                             AsmWrite(s);
                             inc(l,length(s));
                           end;
@@ -361,25 +361,25 @@ interface
                        AsmLn;
                      end;
   ait_const_symbol : begin
-                       AsmWriteLn(#9#9'DD'#9'offset '+pai_const_symbol(hp)^.sym^.name);
-                       if pai_const_symbol(hp)^.offset>0 then
-                         AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
-                       else if pai_const_symbol(hp)^.offset<0 then
-                         AsmWrite(tostr(pai_const_symbol(hp)^.offset));
+                       AsmWriteLn(#9#9'DD'#9'offset '+tai_const_symbol(hp).sym^.name);
+                       if tai_const_symbol(hp).offset>0 then
+                         AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
+                       else if tai_const_symbol(hp).offset<0 then
+                         AsmWrite(tostr(tai_const_symbol(hp).offset));
                        AsmLn;
                      end;
      ait_const_rva : begin
-                       AsmWriteLn(#9#9'RVA'#9+pai_const_symbol(hp)^.sym^.name);
+                       AsmWriteLn(#9#9'RVA'#9+tai_const_symbol(hp).sym^.name);
                      end;
-        ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(pai_real_32bit(hp)^.value));
-        ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_real_64bit(hp)^.value));
-      ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_real_80bit(hp)^.value));
-          ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_real_80bit(hp)^.value));
+        ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value));
+        ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value));
+      ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value));
+          ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(tai_real_80bit(hp).value));
         ait_string : begin
                        counter := 0;
-                       lines := pai_string(hp)^.len div line_length;
+                       lines := tai_string(hp).len div line_length;
                      { separate lines in different parts }
-                       if pai_string(hp)^.len > 0 then
+                       if tai_string(hp).len > 0 then
                         Begin
                           for j := 0 to lines-1 do
                            begin
@@ -388,9 +388,9 @@ interface
                              for i:=counter to counter+line_length do
                                 begin
                                   { it is an ascii character. }
-                                  if (ord(pai_string(hp)^.str[i])>31) and
-                                     (ord(pai_string(hp)^.str[i])<128) and
-                                     (pai_string(hp)^.str[i]<>'"') then
+                                  if (ord(tai_string(hp).str[i])>31) and
+                                     (ord(tai_string(hp).str[i])<128) and
+                                     (tai_string(hp).str[i]<>'"') then
                                       begin
                                         if not(quoted) then
                                             begin
@@ -398,7 +398,7 @@ interface
                                                 AsmWrite(',');
                                               AsmWrite('"');
                                             end;
-                                        AsmWrite(pai_string(hp)^.str[i]);
+                                        AsmWrite(tai_string(hp).str[i]);
                                         quoted:=true;
                                       end { if > 31 and < 128 and ord('"') }
                                   else
@@ -408,7 +408,7 @@ interface
                                           if i>counter then
                                               AsmWrite(',');
                                           quoted:=false;
-                                          AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                                          AsmWrite(tostr(ord(tai_string(hp).str[i])));
                                       end;
                                end; { end for i:=0 to... }
                              if quoted then AsmWrite('"');
@@ -418,12 +418,12 @@ interface
                         { do last line of lines }
                         AsmWrite(#9#9'DB'#9);
                         quoted:=false;
-                        for i:=counter to pai_string(hp)^.len-1 do
+                        for i:=counter to tai_string(hp).len-1 do
                           begin
                             { it is an ascii character. }
-                            if (ord(pai_string(hp)^.str[i])>31) and
-                               (ord(pai_string(hp)^.str[i])<128) and
-                               (pai_string(hp)^.str[i]<>'"') then
+                            if (ord(tai_string(hp).str[i])>31) and
+                               (ord(tai_string(hp).str[i])<128) and
+                               (tai_string(hp).str[i]<>'"') then
                                 begin
                                   if not(quoted) then
                                       begin
@@ -431,7 +431,7 @@ interface
                                           AsmWrite(',');
                                         AsmWrite('"');
                                       end;
-                                  AsmWrite(pai_string(hp)^.str[i]);
+                                  AsmWrite(tai_string(hp).str[i]);
                                   quoted:=true;
                                 end { if > 31 and < 128 and " }
                             else
@@ -441,7 +441,7 @@ interface
                                   if i>counter then
                                       AsmWrite(',');
                                   quoted:=false;
-                                  AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                                  AsmWrite(tostr(ord(tai_string(hp).str[i])));
                                 end;
                           end; { end for i:=0 to... }
                         if quoted then
@@ -450,10 +450,10 @@ interface
                        AsmLn;
                      end;
          ait_label : begin
-                       if pai_label(hp)^.l^.is_used then
+                       if tai_label(hp).l^.is_used then
                         begin
-                          AsmWrite(pai_label(hp)^.l^.name);
-                          if assigned(hp^.next) and not(pai(hp^.next)^.typ in
+                          AsmWrite(tai_label(hp).l^.name);
+                          if assigned(hp.next) and not(tai(hp.next).typ in
                              [ait_const_32bit,ait_const_16bit,ait_const_8bit,
                               ait_const_symbol,ait_const_rva,
                               ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
@@ -461,14 +461,14 @@ interface
                         end;
                      end;
         ait_direct : begin
-                       AsmWritePChar(pai_direct(hp)^.str);
+                       AsmWritePChar(tai_direct(hp).str);
                        AsmLn;
                      end;
         ait_symbol : begin
-                       if pai_symbol(hp)^.is_global then
-                         AsmWriteLn(#9'PUBLIC'#9+pai_symbol(hp)^.sym^.name);
-                       AsmWrite(pai_symbol(hp)^.sym^.name);
-                       if assigned(hp^.next) and not(pai(hp^.next)^.typ in
+                       if tai_symbol(hp).is_global then
+                         AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym^.name);
+                       AsmWrite(tai_symbol(hp).sym^.name);
+                       if assigned(hp.next) and not(tai(hp.next).typ in
                           [ait_const_32bit,ait_const_16bit,ait_const_8bit,
                            ait_const_symbol,ait_const_rva,
                            ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
@@ -478,9 +478,9 @@ interface
                      end;
    ait_instruction : begin
                      { Must be done with args in ATT order }
-                       paicpu(hp)^.CheckNonCommutativeOpcodes;
+                       taicpu(hp).CheckNonCommutativeOpcodes;
                      { We need intel order, no At&t }
-                       paicpu(hp)^.SwapOperands;
+                       taicpu(hp).SwapOperands;
                      { Reset }
                        suffix:='';
                        prefix:= '';
@@ -488,24 +488,24 @@ interface
                       { We need to explicitely set
                         word prefix to get selectors
                         to be pushed in 2 bytes  PM }
-                      if (paicpu(hp)^.opsize=S_W) and
-                         ((paicpu(hp)^.opcode=A_PUSH) or
-                          (paicpu(hp)^.opcode=A_POP)) and
-                          (paicpu(hp)^.oper[0].typ=top_reg) and
-                          ((paicpu(hp)^.oper[0].reg>=firstsreg) and
-                           (paicpu(hp)^.oper[0].reg<=lastsreg)) then
+                      if (taicpu(hp).opsize=S_W) and
+                         ((taicpu(hp).opcode=A_PUSH) or
+                          (taicpu(hp).opcode=A_POP)) and
+                          (taicpu(hp).oper[0].typ=top_reg) and
+                          ((taicpu(hp).oper[0].reg>=firstsreg) and
+                           (taicpu(hp).oper[0].reg<=lastsreg)) then
                         AsmWriteln(#9#9'DB'#9'066h');
                      { added prefix instructions, must be on same line as opcode }
-                       if (paicpu(hp)^.ops = 0) and
-                          ((paicpu(hp)^.opcode = A_REP) or
-                           (paicpu(hp)^.opcode = A_LOCK) or
-                           (paicpu(hp)^.opcode =  A_REPE) or
-                           (paicpu(hp)^.opcode =  A_REPNZ) or
-                           (paicpu(hp)^.opcode =  A_REPZ) or
-                           (paicpu(hp)^.opcode = A_REPNE)) then
+                       if (taicpu(hp).ops = 0) and
+                          ((taicpu(hp).opcode = A_REP) or
+                           (taicpu(hp).opcode = A_LOCK) or
+                           (taicpu(hp).opcode =  A_REPE) or
+                           (taicpu(hp).opcode =  A_REPNZ) or
+                           (taicpu(hp).opcode =  A_REPZ) or
+                           (taicpu(hp).opcode = A_REPNE)) then
                         Begin
-                          prefix:=int_op2str[paicpu(hp)^.opcode]+#9;
-                          hp:=Pai(hp^.next);
+                          prefix:=int_op2str[taicpu(hp).opcode]+#9;
+                          hp:=tai(hp.next);
                         { this is theorically impossible... }
                           if hp=nil then
                            begin
@@ -519,23 +519,23 @@ interface
                         end
                        else
                         prefix:= '';
-                       if paicpu(hp)^.ops<>0 then
+                       if taicpu(hp).ops<>0 then
                         begin
-                          if is_calljmp(paicpu(hp)^.opcode) then
-                           s:=#9+getopstr_jmp(paicpu(hp)^.oper[0])
+                          if is_calljmp(taicpu(hp).opcode) then
+                           s:=#9+getopstr_jmp(taicpu(hp).oper[0])
                           else
                            begin
-                             for i:=0to paicpu(hp)^.ops-1 do
+                             for i:=0to taicpu(hp).ops-1 do
                               begin
                                 if i=0 then
                                  sep:=#9
                                 else
                                  sep:=',';
-                                s:=s+sep+getopstr(paicpu(hp)^.oper[i],paicpu(hp)^.opsize,paicpu(hp)^.opcode,(i=2));
+                                s:=s+sep+getopstr(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
                               end;
                            end;
                         end;
-                       AsmWriteLn(#9#9+prefix+int_op2str[paicpu(hp)^.opcode]+cond2str[paicpu(hp)^.condition]+suffix+s);
+                       AsmWriteLn(#9#9+prefix+int_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix+s);
                      end;
 {$ifdef GDB}
              ait_stabn,
@@ -555,16 +555,16 @@ ait_stab_function_name : ;
                           AsmWriteLn(#9'END');
                           AsmClose;
                           DoAssemble;
-                          AsmCreate(pai_cut(hp)^.place);
+                          AsmCreate(tai_cut(hp).place);
                         end;
                      { avoid empty files }
-                       while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
+                       while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
                         begin
-                          if pai(hp^.next)^.typ=ait_section then
+                          if tai(hp.next).typ=ait_section then
                            begin
-                             lastsec:=pai_section(hp^.next)^.sec;
+                             lastsec:=tai_section(hp.next).sec;
                            end;
-                          hp:=pai(hp^.next);
+                          hp:=tai(hp.next);
                         end;
                        AsmWriteLn(#9'.386p');
                        { I was told that this isn't necesarry because }
@@ -580,7 +580,7 @@ ait_stab_function_name : ;
          else
           internalerror(10000);
          end;
-         hp:=pai(hp^.next);
+         hp:=tai(hp.next);
        end;
     end;
 
@@ -590,7 +590,7 @@ ait_stab_function_name : ;
     procedure writeexternal(p:pnamedindexobject);
       begin
         if pasmsymbol(p)^.defbind=AB_EXTERNAL then
-         currentasmlist^.AsmWriteln(#9'EXTRN'#9+p^.name);
+         currentasmList^.AsmWriteln(#9'EXTRN'#9+p^.name);
       end;
 
     procedure ti386intasmlist.WriteExternals;
@@ -603,8 +603,8 @@ ait_stab_function_name : ;
     procedure ti386intasmlist.WriteAsmList;
     begin
 {$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Start writing intel-styled assembler output for '+current_module^.mainsource^);
+      if assigned(current_module.mainsource) then
+       comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^);
 {$endif}
       LastSec:=sec_none;
       AsmWriteLn(#9'.386p');
@@ -632,15 +632,19 @@ ait_stab_function_name : ;
       AsmLn;
 
 {$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Done writing intel-styled assembler output for '+current_module^.mainsource^);
+      if assigned(current_module.mainsource) then
+       comment(v_info,'Done writing intel-styled assembler output for '+current_module.mainsource^);
 {$endif EXTDEBUG}
    end;
 
 end.
 {
   $Log$
-  Revision 1.3  2000-12-18 21:56:52  peter
+  Revision 1.4  2000-12-25 00:07:31  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.3  2000/12/18 21:56:52  peter
     * extdebug fixes
 
   Revision 1.2  2000/11/29 00:30:43  florian

compiler/i386/ag386nsm.pas

@@ -32,7 +32,7 @@ interface
     type
       pi386nasmasmlist=^ti386nasmasmlist;
       ti386nasmasmlist = object(tasmlist)
-        procedure WriteTree(p:paasmoutput);virtual;
+        procedure WriteTree(p:taasmoutput);virtual;
         procedure WriteAsmList;virtual;
         procedure WriteExternals;
       end;
@@ -53,7 +53,7 @@ interface
     var
       lastfileinfo : tfileposinfo;
       infile,
-      lastinfile   : pinputfile;
+      lastinfile   : tinputfile;
 
    function fixline(s:string):string;
    {
@@ -335,7 +335,7 @@ interface
     end;
 
 
-    procedure ti386nasmasmlist.WriteTree(p:paasmoutput);
+    procedure ti386nasmasmlist.WriteTree(p:taasmoutput);
     const
       allocstr : array[boolean] of string[10]=(' released',' allocated');
       nolinetai =[ait_label,
@@ -346,7 +346,7 @@ interface
       s : string;
       {prefix,
       suffix   : string; no need here }
-      hp       : pai;
+      hp       : tai;
       counter,
       lines,
       i,j,l    : longint;
@@ -364,27 +364,27 @@ interface
       do_line:=(cs_asm_source in aktglobalswitches) or
                ((cs_lineinfo in aktmoduleswitches)
                  and (p=codesegment));
-      hp:=pai(p^.first);
+      hp:=tai(p.first);
       while assigned(hp) do
        begin
-         aktfilepos:=hp^.fileinfo;
+         aktfilepos:=hp.fileinfo;
 
-         if not(hp^.typ in nolinetai) then
+         if not(hp.typ in nolinetai) then
            begin
              if do_line then
               begin
               { load infile }
-                if lastfileinfo.fileindex<>hp^.fileinfo.fileindex then
+                if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
                  begin
-                   infile:=current_module^.sourcefiles^.get_file(hp^.fileinfo.fileindex);
+                   infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
                    if assigned(infile) then
                     begin
                       { open only if needed !! }
                       if (cs_asm_source in aktglobalswitches) then
-                       infile^.open;
+                       infile.open;
                     end;
                    { avoid unnecessary reopens of the same file !! }
-                   lastfileinfo.fileindex:=hp^.fileinfo.fileindex;
+                   lastfileinfo.fileindex:=hp.fileinfo.fileindex;
                    { be sure to change line !! }
                    lastfileinfo.line:=-1;
                  end;
@@ -394,86 +394,86 @@ interface
                  begin
                    if (infile<>lastinfile) then
                      begin
-                       AsmWriteLn(target_asm.comment+'['+infile^.name^+']');
+                       AsmWriteLn(target_asm.comment+'['+infile.name^+']');
                        if assigned(lastinfile) then
-                         lastinfile^.close;
+                         lastinfile.close;
                      end;
-                   if (hp^.fileinfo.line<>lastfileinfo.line) and
-                      ((hp^.fileinfo.line<infile^.maxlinebuf) or (InlineLevel>0)) then
+                   if (hp.fileinfo.line<>lastfileinfo.line) and
+                      ((hp.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
                      begin
-                       if (hp^.fileinfo.line<>0) and
-                          ((infile^.linebuf^[hp^.fileinfo.line]>=0) or (InlineLevel>0)) then
-                         AsmWriteLn(target_asm.comment+'['+tostr(hp^.fileinfo.line)+'] '+
-                           fixline(infile^.GetLineStr(hp^.fileinfo.line)));
+                       if (hp.fileinfo.line<>0) and
+                          ((infile.linebuf^[hp.fileinfo.line]>=0) or (InlineLevel>0)) then
+                         AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
+                           fixline(infile.GetLineStr(hp.fileinfo.line)));
                        { set it to a negative value !
                        to make that is has been read already !! PM }
-                       if (infile^.linebuf^[hp^.fileinfo.line]>=0) then
-                         infile^.linebuf^[hp^.fileinfo.line]:=-infile^.linebuf^[hp^.fileinfo.line]-1;
+                       if (infile.linebuf^[hp.fileinfo.line]>=0) then
+                         infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
                      end;
                  end;
-                lastfileinfo:=hp^.fileinfo;
+                lastfileinfo:=hp.fileinfo;
                 lastinfile:=infile;
               end;
            end;
-         case hp^.typ of
+         case hp.typ of
            ait_comment :
              Begin
                AsmWrite(target_asm.comment);
-               AsmWritePChar(pai_asm_comment(hp)^.str);
+               AsmWritePChar(tai_asm_comment(hp).str);
                AsmLn;
              End;
 
            ait_regalloc :
              begin
                if (cs_asm_regalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+
-                   allocstr[pairegalloc(hp)^.allocation]);
+                 AsmWriteLn(target_asm.comment+'Register '+att_reg2str[tairegalloc(hp).reg]+
+                   allocstr[tairegalloc(hp).allocation]);
              end;
 
            ait_tempalloc :
              begin
                if (cs_asm_tempalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Temp '+tostr(paitempalloc(hp)^.temppos)+','+
-                   tostr(paitempalloc(hp)^.tempsize)+allocstr[paitempalloc(hp)^.allocation]);
+                 AsmWriteLn(target_asm.comment+'Temp '+tostr(taitempalloc(hp).temppos)+','+
+                   tostr(taitempalloc(hp).tempsize)+allocstr[taitempalloc(hp).allocation]);
              end;
 
            ait_section :
              begin
-               if pai_section(hp)^.sec<>sec_none then
+               if tai_section(hp).sec<>sec_none then
                 begin
                   AsmLn;
-                  AsmWriteLn('SECTION '+target_asm.secnames[pai_section(hp)^.sec]);
+                  AsmWriteLn('SECTION '+target_asm.secnames[tai_section(hp).sec]);
                 end;
-               LastSec:=pai_section(hp)^.sec;
+               LastSec:=tai_section(hp).sec;
              end;
 
            ait_align :
-             AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
+             AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype));
 
            ait_datablock :
              begin
-               if pai_datablock(hp)^.is_global then
+               if tai_datablock(hp).is_global then
                 begin
                   AsmWrite(#9'GLOBAL ');
-                  AsmWriteLn(pai_datablock(hp)^.sym^.name);
+                  AsmWriteLn(tai_datablock(hp).sym^.name);
                 end;
-               AsmWrite(PadTabs(pai_datablock(hp)^.sym^.name,':'));
-               AsmWriteLn('RESB'#9+tostr(pai_datablock(hp)^.size));
+               AsmWrite(PadTabs(tai_datablock(hp).sym^.name,':'));
+               AsmWriteLn('RESB'#9+tostr(tai_datablock(hp).size));
              end;
 
            ait_const_32bit,
            ait_const_16bit,
            ait_const_8bit :
              begin
-               AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
-               consttyp:=hp^.typ;
+               AsmWrite(ait_const2str[hp.typ]+tostr(tai_const(hp).value));
+               consttyp:=hp.typ;
                l:=0;
                repeat
-                 found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
+                 found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
                  if found then
                   begin
-                    hp:=Pai(hp^.next);
-                    s:=','+tostr(pai_const(hp)^.value);
+                    hp:=tai(hp.next);
+                    s:=','+tostr(tai_const(hp).value);
                     AsmWrite(s);
                     inc(l,length(s));
                   end;
@@ -484,38 +484,38 @@ interface
            ait_const_symbol :
              begin
                AsmWrite(#9#9'DD'#9);
-               AsmWrite(pai_const_symbol(hp)^.sym^.name);
-               if pai_const_symbol(hp)^.offset>0 then
-                 AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
-               else if pai_const_symbol(hp)^.offset<0 then
-                 AsmWrite(tostr(pai_const_symbol(hp)^.offset));
+               AsmWrite(tai_const_symbol(hp).sym^.name);
+               if tai_const_symbol(hp).offset>0 then
+                 AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
+               else if tai_const_symbol(hp).offset<0 then
+                 AsmWrite(tostr(tai_const_symbol(hp).offset));
                AsmLn;
              end;
 
            ait_const_rva :
              begin
                AsmWrite(#9#9'RVA'#9);
-               AsmWriteLn(pai_const_symbol(hp)^.sym^.name);
+               AsmWriteLn(tai_const_symbol(hp).sym^.name);
              end;
 
            ait_real_32bit :
-             AsmWriteLn(#9#9'DD'#9+single2str(pai_real_32bit(hp)^.value));
+             AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value));
 
            ait_real_64bit :
-             AsmWriteLn(#9#9'DQ'#9+double2str(pai_real_64bit(hp)^.value));
+             AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value));
 
            ait_real_80bit :
-             AsmWriteLn(#9#9'DT'#9+extended2str(pai_real_80bit(hp)^.value));
+             AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value));
 
            ait_comp_64bit :
-             AsmWriteLn(#9#9'DQ'#9+comp2str(pai_real_80bit(hp)^.value));
+             AsmWriteLn(#9#9'DQ'#9+comp2str(tai_real_80bit(hp).value));
 
            ait_string :
              begin
                counter := 0;
-               lines := pai_string(hp)^.len div line_length;
+               lines := tai_string(hp).len div line_length;
              { separate lines in different parts }
-               if pai_string(hp)^.len > 0 then
+               if tai_string(hp).len > 0 then
                 Begin
                   for j := 0 to lines-1 do
                    begin
@@ -524,9 +524,9 @@ interface
                      for i:=counter to counter+line_length-1 do
                         begin
                           { it is an ascii character. }
-                          if (ord(pai_string(hp)^.str[i])>31) and
-                             (ord(pai_string(hp)^.str[i])<128) and
-                             (pai_string(hp)^.str[i]<>'"') then
+                          if (ord(tai_string(hp).str[i])>31) and
+                             (ord(tai_string(hp).str[i])<128) and
+                             (tai_string(hp).str[i]<>'"') then
                               begin
                                 if not(quoted) then
                                     begin
@@ -534,7 +534,7 @@ interface
                                         AsmWrite(',');
                                       AsmWrite('"');
                                     end;
-                                AsmWrite(pai_string(hp)^.str[i]);
+                                AsmWrite(tai_string(hp).str[i]);
                                 quoted:=true;
                               end { if > 31 and < 128 and ord('"') }
                           else
@@ -544,7 +544,7 @@ interface
                                   if i>counter then
                                       AsmWrite(',');
                                   quoted:=false;
-                                  AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                                  AsmWrite(tostr(ord(tai_string(hp).str[i])));
                               end;
                        end; { end for i:=0 to... }
                      if quoted then AsmWrite('"');
@@ -552,15 +552,15 @@ interface
                      inc(counter,line_length);
                   end; { end for j:=0 ... }
                 { do last line of lines }
-                if counter<pai_string(hp)^.len then
+                if counter<tai_string(hp).len then
                   AsmWrite(#9#9'DB'#9);
                 quoted:=false;
-                for i:=counter to pai_string(hp)^.len-1 do
+                for i:=counter to tai_string(hp).len-1 do
                   begin
                     { it is an ascii character. }
-                    if (ord(pai_string(hp)^.str[i])>31) and
-                       (ord(pai_string(hp)^.str[i])<128) and
-                       (pai_string(hp)^.str[i]<>'"') then
+                    if (ord(tai_string(hp).str[i])>31) and
+                       (ord(tai_string(hp).str[i])<128) and
+                       (tai_string(hp).str[i]<>'"') then
                         begin
                           if not(quoted) then
                               begin
@@ -568,7 +568,7 @@ interface
                                   AsmWrite(',');
                                 AsmWrite('"');
                               end;
-                          AsmWrite(pai_string(hp)^.str[i]);
+                          AsmWrite(tai_string(hp).str[i]);
                           quoted:=true;
                         end { if > 31 and < 128 and " }
                     else
@@ -578,7 +578,7 @@ interface
                           if i>counter then
                               AsmWrite(',');
                           quoted:=false;
-                          AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                          AsmWrite(tostr(ord(tai_string(hp).str[i])));
                         end;
                   end; { end for i:=0 to... }
                 if quoted then
@@ -589,25 +589,25 @@ interface
 
            ait_label :
              begin
-               if pai_label(hp)^.l^.is_used then
-                AsmWriteLn(pai_label(hp)^.l^.name+':');
+               if tai_label(hp).l^.is_used then
+                AsmWriteLn(tai_label(hp).l^.name+':');
              end;
 
            ait_direct :
              begin
-               AsmWritePChar(pai_direct(hp)^.str);
+               AsmWritePChar(tai_direct(hp).str);
                AsmLn;
              end;
 
            ait_symbol :
              begin
-               if pai_symbol(hp)^.is_global then
+               if tai_symbol(hp).is_global then
                 begin
                   AsmWrite(#9'GLOBAL ');
-                  AsmWriteLn(pai_symbol(hp)^.sym^.name);
+                  AsmWriteLn(tai_symbol(hp).sym^.name);
                 end;
-               AsmWrite(pai_symbol(hp)^.sym^.name);
-               if assigned(hp^.next) and not(pai(hp^.next)^.typ in
+               AsmWrite(tai_symbol(hp).sym^.name);
+               if assigned(hp.next) and not(tai(hp.next).typ in
                   [ait_const_32bit,ait_const_16bit,ait_const_8bit,
                    ait_const_symbol,ait_const_rva,
                    ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
@@ -621,53 +621,53 @@ interface
            ait_instruction :
              begin
              { Must be done with args in ATT order }
-               paicpu(hp)^.CheckNonCommutativeOpcodes;
+               taicpu(hp).CheckNonCommutativeOpcodes;
              { We need intel order, no At&t }
-               paicpu(hp)^.SwapOperands;
+               taicpu(hp).SwapOperands;
              { Reset
                suffix:='';
                prefix:='';}
                s:='';
-               if (paicpu(hp)^.opcode=A_FADDP) and (paicpu(hp)^.ops=0) then
+               if (taicpu(hp).opcode=A_FADDP) and (taicpu(hp).ops=0) then
                  begin
-                   paicpu(hp)^.ops:=2;
-                   paicpu(hp)^.oper[0].typ:=top_reg;
-                   paicpu(hp)^.oper[0].reg:=R_ST1;
-                   paicpu(hp)^.oper[1].typ:=top_reg;
-                   paicpu(hp)^.oper[1].reg:=R_ST;
+                   taicpu(hp).ops:=2;
+                   taicpu(hp).oper[0].typ:=top_reg;
+                   taicpu(hp).oper[0].reg:=R_ST1;
+                   taicpu(hp).oper[1].typ:=top_reg;
+                   taicpu(hp).oper[1].reg:=R_ST;
                  end;
-               if paicpu(hp)^.ops<>0 then
+               if taicpu(hp).ops<>0 then
                 begin
-                  if is_calljmp(paicpu(hp)^.opcode) then
-                   s:=#9+getopstr_jmp(paicpu(hp)^.oper[0],paicpu(hp)^.opcode)
+                  if is_calljmp(taicpu(hp).opcode) then
+                   s:=#9+getopstr_jmp(taicpu(hp).oper[0],taicpu(hp).opcode)
                   else
                    begin
                       { We need to explicitely set
                         word prefix to get selectors
                         to be pushed in 2 bytes  PM }
-                      if (paicpu(hp)^.opsize=S_W) and
-                         ((paicpu(hp)^.opcode=A_PUSH) or
-                          (paicpu(hp)^.opcode=A_POP)) and
-                          (paicpu(hp)^.oper[0].typ=top_reg) and
-                          ((paicpu(hp)^.oper[0].reg>=firstsreg) and
-                           (paicpu(hp)^.oper[0].reg<=lastsreg)) then
+                      if (taicpu(hp).opsize=S_W) and
+                         ((taicpu(hp).opcode=A_PUSH) or
+                          (taicpu(hp).opcode=A_POP)) and
+                          (taicpu(hp).oper[0].typ=top_reg) and
+                          ((taicpu(hp).oper[0].reg>=firstsreg) and
+                           (taicpu(hp).oper[0].reg<=lastsreg)) then
                         AsmWriteln(#9#9'DB'#9'066h');
-                     for i:=0 to paicpu(hp)^.ops-1 do
+                     for i:=0 to taicpu(hp).ops-1 do
                       begin
                         if i=0 then
                          sep:=#9
                         else
                          sep:=',';
-                        s:=s+sep+getopstr(paicpu(hp)^.oper[i],paicpu(hp)^.opsize,paicpu(hp)^.opcode,
-                          paicpu(hp)^.ops,(i=2));
+                        s:=s+sep+getopstr(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,
+                          taicpu(hp).ops,(i=2));
                       end;
                    end;
                 end;
-               if paicpu(hp)^.opcode=A_FWAIT then
+               if taicpu(hp).opcode=A_FWAIT then
                 AsmWriteln(#9#9'DB'#9'09bh')
                else
-                AsmWriteLn(#9#9+{prefix+}int_op2str[paicpu(hp)^.opcode]+
-                  cond2str[paicpu(hp)^.condition]+{suffix+}s);
+                AsmWriteLn(#9#9+{prefix+}int_op2str[taicpu(hp).opcode]+
+                  cond2str[taicpu(hp).condition]+{suffix+}s);
              end;
 {$ifdef GDB}
            ait_stabn,
@@ -685,14 +685,14 @@ interface
                 begin
                   AsmClose;
                   DoAssemble;
-                  AsmCreate(pai_cut(hp)^.place);
+                  AsmCreate(tai_cut(hp).place);
                 end;
              { avoid empty files }
-               while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
+               while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
                 begin
-                  if pai(hp^.next)^.typ=ait_section then
-                    lastsec:=pai_section(hp^.next)^.sec;
-                  hp:=pai(hp^.next);
+                  if tai(hp.next).typ=ait_section then
+                    lastsec:=tai_section(hp.next).sec;
+                  hp:=tai(hp.next);
                 end;
                if lastsec<>sec_none then
                  AsmWriteLn('SECTION '+target_asm.secnames[lastsec]);
@@ -700,15 +700,15 @@ interface
              end;
 
            ait_marker :
-             if pai_marker(hp)^.kind=InlineStart then
+             if tai_marker(hp).kind=InlineStart then
                inc(InlineLevel)
-             else if pai_marker(hp)^.kind=InlineEnd then
+             else if tai_marker(hp).kind=InlineEnd then
                dec(InlineLevel);
 
            else
              internalerror(10000);
          end;
-         hp:=pai(hp^.next);
+         hp:=tai(hp.next);
        end;
     end;
 
@@ -732,8 +732,8 @@ interface
     procedure ti386nasmasmlist.WriteAsmList;
     begin
 {$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Start writing nasm-styled assembler output for '+current_module^.mainsource^);
+      if assigned(current_module.mainsource) then
+       comment(v_info,'Start writing nasm-styled assembler output for '+current_module.mainsource^);
 {$endif}
       LastSec:=sec_none;
       AsmWriteLn('BITS 32');
@@ -759,15 +759,19 @@ interface
 
       AsmLn;
 {$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Done writing nasm-styled assembler output for '+current_module^.mainsource^);
+      if assigned(current_module.mainsource) then
+       comment(v_info,'Done writing nasm-styled assembler output for '+current_module.mainsource^);
 {$endif EXTDEBUG}
    end;
 
 end.
 {
   $Log$
-  Revision 1.2  2000-11-29 00:30:43  florian
+  Revision 1.3  2000-12-25 00:07:31  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.2  2000/11/29 00:30:43  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/i386/aopt386.pas

@@ -30,7 +30,7 @@ Interface
 Uses
   aasm;
 
-Procedure Optimize(AsmL: PAasmOutput);
+Procedure Optimize(AsmL: TAasmOutput);
 
 
 Implementation
@@ -41,9 +41,9 @@ Uses
   DAOpt386,POpt386,CSOpt386;
 
 
-Procedure Optimize(AsmL: PAasmOutput);
+Procedure Optimize(AsmL: TAAsmOutput);
 Var
-  BlockStart, BlockEnd, HP: Pai;
+  BlockStart, BlockEnd, HP: Tai;
   pass: longint;
   slowopt, changed, lastLoop: boolean;
 Begin
@@ -58,7 +58,7 @@ Begin
        (pass = 4);
      changed := false;
    { Setup labeltable, always necessary }
-     BlockStart := Pai(AsmL^.First);
+     BlockStart := Tai(AsmL.First);
      BlockEnd := DFAPass1(AsmL, BlockStart);
    { Blockend now either contains an ait_marker with Kind = AsmBlockStart, }
    { or nil                                                                }
@@ -92,18 +92,18 @@ Begin
         { assembler block or nil                                         }
          BlockStart := BlockEnd;
          While Assigned(BlockStart) And
-               (BlockStart^.typ = ait_Marker) And
-               (Pai_Marker(BlockStart)^.Kind = AsmBlockStart) Do
+               (BlockStart.typ = ait_Marker) And
+               (Tai_Marker(BlockStart).Kind = AsmBlockStart) Do
            Begin
            { We stopped at an assembler block, so skip it }
             Repeat
-              BlockStart := Pai(BlockStart^.Next);
-            Until (BlockStart^.Typ = Ait_Marker) And
-                  (Pai_Marker(Blockstart)^.Kind = AsmBlockEnd);
-           { Blockstart now contains a pai_marker(asmblockend) }
+              BlockStart := Tai(BlockStart.Next);
+            Until (BlockStart.Typ = Ait_Marker) And
+                  (Tai_Marker(Blockstart).Kind = AsmBlockEnd);
+           { Blockstart now contains a Tai_marker(asmblockend) }
              If GetNextInstruction(BlockStart, HP) And
-                ((HP^.typ <> ait_Marker) Or
-                 (Pai_Marker(HP)^.Kind <> AsmBlockStart)) Then
+                ((HP.typ <> ait_Marker) Or
+                 (Tai_Marker(HP).Kind <> AsmBlockStart)) Then
              { There is no assembler block anymore after the current one, so }
              { optimize the next block of "normal" instructions              }
                BlockEnd := DFAPass1(AsmL, BlockStart)
@@ -118,7 +118,11 @@ End;
 End.
 {
   $Log$
-  Revision 1.2  2000-10-24 10:40:53  jonas
+  Revision 1.3  2000-12-25 00:07:31  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.2  2000/10/24 10:40:53  jonas
     + register renaming ("fixes" bug1088)
     * changed command line options meanings for optimizer:
         O2 now means peepholopts, CSE and register renaming in 1 pass

compiler/i386/cpuasm.pas

@@ -40,7 +40,7 @@ unit cpuasm;
 interface
 
 uses
-  cobjects,
+  cobjects,cclasses,
   aasm,globals,verbose,
   cpubase;
 
@@ -48,8 +48,7 @@ const
   MaxPrefixes=4;
 
 type
-  pairegalloc = ^tairegalloc;
-  tairegalloc = object(tai)
+  tairegalloc = class(tai)
      allocation : boolean;
      reg        : tregister;
      constructor alloc(r : tregister);
@@ -57,16 +56,14 @@ type
   end;
 
   { alignment for operator }
-  pai_align = ^tai_align;
-  tai_align = object(tai_align_abstract)
+  tai_align = class(tai_align_abstract)
      reg       : tregister;
-     constructor init(b:byte);
-     constructor init_op(b: byte; _op: byte);
+     constructor create(b:byte);
+     constructor create_op(b: byte; _op: byte);
      function getfillbuf:pchar;
   end;
 
-  paicpu = ^taicpu;
-  taicpu = object(tai)
+  taicpu = class(tai)
      is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
      opcode    : tasmop;
      opsize    : topsize;
@@ -113,8 +110,8 @@ type
      procedure changeopsize(siz:topsize);
      procedure SetCondition(c:TAsmCond);
 
-     destructor done;virtual;
-     function  getcopy:plinkedlist_item;virtual;
+     destructor destroy;override;
+     function  getcopy:tlinkedlistitem;override;
      function  GetString:string;
      procedure SwapOperands;
      procedure CheckNonCommutativeOpcodes;
@@ -155,7 +152,7 @@ uses
 
     constructor tairegalloc.alloc(r : tregister);
       begin
-        inherited init;
+        inherited create;
         typ:=ait_regalloc;
         allocation:=true;
         reg:=r;
@@ -164,7 +161,7 @@ uses
 
     constructor tairegalloc.dealloc(r : tregister);
       begin
-        inherited init;
+        inherited create;
         typ:=ait_regalloc;
         allocation:=false;
         reg:=r;
@@ -175,16 +172,16 @@ uses
                               TAI_ALIGN
  ****************************************************************************}
 
-    constructor tai_align.init(b: byte);
+    constructor tai_align.create(b: byte);
       begin
-        inherited init(b);
+        inherited create(b);
         reg := R_ECX;
       end;
 
 
-    constructor tai_align.init_op(b: byte; _op: byte);
+    constructor tai_align.create_op(b: byte; _op: byte);
       begin
-        inherited init_op(b,_op);
+        inherited create_op(b,_op);
         reg := R_NO;
       end;
 
@@ -340,14 +337,14 @@ uses
 
     constructor taicpu.op_none(op : tasmop;_size : topsize);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
       end;
 
 
     constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=1;
          loadreg(0,_op1);
@@ -356,7 +353,7 @@ uses
 
     constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : longint);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=1;
          loadconst(0,_op1);
@@ -365,7 +362,7 @@ uses
 
     constructor taicpu.op_ref(op : tasmop;_size : topsize;_op1 : preference);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=1;
          loadref(0,_op1);
@@ -374,7 +371,7 @@ uses
 
     constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadreg(0,_op1);
@@ -384,7 +381,7 @@ uses
 
     constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: longint);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadreg(0,_op1);
@@ -394,7 +391,7 @@ uses
 
     constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : preference);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadreg(0,_op1);
@@ -404,7 +401,7 @@ uses
 
     constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadconst(0,_op1);
@@ -414,7 +411,7 @@ uses
 
     constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadconst(0,_op1);
@@ -424,7 +421,7 @@ uses
 
     constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadconst(0,_op1);
@@ -434,7 +431,7 @@ uses
 
     constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : preference;_op2 : tregister);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadref(0,_op1);
@@ -444,7 +441,7 @@ uses
 
     constructor taicpu.op_ref_ref(op : tasmop;_size : topsize;_op1,_op2 : preference);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadref(0,_op1);
@@ -454,7 +451,7 @@ uses
 
     constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=3;
          loadreg(0,_op1);
@@ -464,7 +461,7 @@ uses
 
     constructor taicpu.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=3;
          loadconst(0,_op1);
@@ -474,7 +471,7 @@ uses
 
     constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;_op3 : preference);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=3;
          loadreg(0,_op1);
@@ -485,7 +482,7 @@ uses
 
     constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference;_op3 : tregister);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=3;
          loadconst(0,_op1);
@@ -496,7 +493,7 @@ uses
 
     constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : preference);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=3;
          loadconst(0,_op1);
@@ -507,7 +504,7 @@ uses
 
     constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : pasmsymbol);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          condition:=cond;
          ops:=1;
@@ -517,7 +514,7 @@ uses
 
     constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : pasmsymbol);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=1;
          loadsymbol(0,_op1,0);
@@ -526,7 +523,7 @@ uses
 
     constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=1;
          loadsymbol(0,_op1,_op1ofs);
@@ -535,7 +532,7 @@ uses
 
     constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadsymbol(0,_op1,_op1ofs);
@@ -545,7 +542,7 @@ uses
 
     constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
       begin
-         inherited init;
+         inherited create;
          init(op,_size);
          ops:=2;
          loadsymbol(0,_op1,_op1ofs);
@@ -553,7 +550,7 @@ uses
       end;
 
 
-    destructor taicpu.done;
+    destructor taicpu.destroy;
       var
         i : longint;
       begin
@@ -563,22 +560,22 @@ uses
           for i:=1 to ops do
             if (oper[i-1].typ=top_ref) then
               dispose(oper[i-1].ref);
-        inherited done;
+        inherited destroy;
       end;
 
 
-    function taicpu.getcopy:plinkedlist_item;
+    function taicpu.getcopy:tlinkedlistitem;
       var
         i : longint;
-        p : plinkedlist_item;
+        p : taicpu;
       begin
-        p:=inherited getcopy;
+        p:=taicpu(inherited getcopy);
         { make a copy of the references }
         for i:=1 to ops do
-         if (paicpu(p)^.oper[i-1].typ=top_ref) then
+         if (p.oper[i-1].typ=top_ref) then
           begin
-            new(paicpu(p)^.oper[i-1].ref);
-            paicpu(p)^.oper[i-1].ref^:=oper[i-1].ref^;
+            new(p.oper[i-1].ref);
+            p.oper[i-1].ref^:=oper[i-1].ref^;
           end;
         getcopy:=p;
       end;
@@ -1670,7 +1667,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-12-23 19:59:35  peter
+  Revision 1.6  2000-12-25 00:07:31  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/12/23 19:59:35  peter
     * object to class for ow/og objects
     * split objectdata from objectoutput
 

compiler/i386/n386add.pas

@@ -1179,23 +1179,23 @@ interface
                          release_loc(left.location);
                          { allocate EAX }
                          if R_EAX in unused then
-                           exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+                           exprasmList.concat(Tairegalloc.Alloc(R_EAX));
                          { load he right value }
                          emitloadord2reg(right.location,u32bitdef,R_EAX,true);
                          release_loc(right.location);
                          { allocate EAX if it isn't yet allocated (JM) }
                          if (R_EAX in unused) then
-                           exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+                           exprasmList.concat(Tairegalloc.Alloc(R_EAX));
                          { also allocate EDX, since it is also modified by }
                          { a mul (JM)                                      }
                          if R_EDX in unused then
-                           exprasmlist^.concat(new(pairegalloc,alloc(R_EDX)));
+                           exprasmList.concat(Tairegalloc.Alloc(R_EDX));
                          emit_reg(A_MUL,S_L,R_EDI);
                          ungetregister32(R_EDI);
                          if R_EDX in unused then
-                           exprasmlist^.concat(new(pairegalloc,dealloc(R_EDX)));
+                           exprasmList.concat(Tairegalloc.DeAlloc(R_EDX));
                          if R_EAX in unused then
-                           exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+                           exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
                          location.register := getregister32;
                          emit_reg_reg(A_MOV,S_L,R_EAX,location.register);
                          if popedx then
@@ -2289,7 +2289,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2000-12-16 15:56:18  jonas
+  Revision 1.8  2000-12-25 00:07:32  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.7  2000/12/16 15:56:18  jonas
     - removed all ifdef cardinalmulfix code
 
   Revision 1.6  2000/12/05 11:44:32  jonas

compiler/i386/n386bas.pas

@@ -67,39 +67,39 @@ unit n386bas;
         end;
 
       var
-        hp,hp2 : pai;
+        hp,hp2 : tai;
         localfixup,parafixup,
         i : longint;
         skipnode : boolean;
       begin
          if inlining_procedure then
            begin
-             InitUsedAsmSymbolList;
+             CreateUsedAsmSymbolList;
              localfixup:=aktprocsym^.definition^.localst^.address_fixup;
              parafixup:=aktprocsym^.definition^.parast^.address_fixup;
-             hp:=pai(p_asm^.first);
+             hp:=tai(p_asm.first);
              while assigned(hp) do
               begin
-                hp2:=pai(hp^.getcopy);
+                hp2:=tai(hp.getcopy);
                 skipnode:=false;
-                case hp2^.typ of
+                case hp2.typ of
                   ait_label :
                      begin
                        { regenerate the labels by setting altsymbol }
-                       ReLabel(pasmsymbol(pai_label(hp2)^.l));
+                       ReLabel(pasmsymbol(tai_label(hp2).l));
                      end;
                   ait_const_rva,
                   ait_const_symbol :
                      begin
-                       ReLabel(pai_const_symbol(hp2)^.sym);
+                       ReLabel(tai_const_symbol(hp2).sym);
                      end;
                   ait_instruction :
                      begin
 {$ifdef i386}
                        { fixup the references }
-                       for i:=1 to paicpu(hp2)^.ops do
+                       for i:=1 to taicpu(hp2).ops do
                         begin
-                          with paicpu(hp2)^.oper[i-1] do
+                          with taicpu(hp2).oper[i-1] do
                            begin
                              case typ of
                                top_ref :
@@ -125,29 +125,29 @@ unit n386bas;
                    ait_marker :
                      begin
                      { it's not an assembler block anymore }
-                       if (pai_marker(hp2)^.kind in [AsmBlockStart, AsmBlockEnd]) then
+                       if (tai_marker(hp2).kind in [AsmBlockStart, AsmBlockEnd]) then
                         skipnode:=true;
                      end;
                    else
                 end;
                 if not skipnode then
-                 exprasmlist^.concat(hp2)
+                 exprasmList.concat(hp2)
                 else
-                 dispose(hp2,done);
-                hp:=pai(hp^.next);
+                 hp2.free;
+                hp:=tai(hp.next);
               end;
              { restore used symbols }
              UsedAsmSymbolListResetAltSym;
-             DoneUsedAsmSymbolList;
+             DestroyUsedAsmSymbolList;
            end
          else
            begin
              { if the routine is an inline routine, then we must hold a copy
                because it can be necessary for inlining later }
              if (pocall_inline in aktprocsym^.definition^.proccalloptions) then
-               exprasmlist^.concatlistcopy(p_asm)
+               exprasmList.concatlistcopy(p_asm)
              else
-               exprasmlist^.concatlist(p_asm);
+               exprasmList.concatlist(p_asm);
            end;
          if not (nf_object_preserved in flags) then
           begin
@@ -174,7 +174,7 @@ unit n386bas;
                cleartempgen;
                {!!!!!!
                oldrl:=temptoremove;
-               temptoremove:=new(plinkedlist,init);
+               temptoremove:=new(TLinkedList,init);
                }
                secondpass(tstatementnode(hp).right);
                { !!!!!!!
@@ -204,7 +204,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-11-29 00:30:46  florian
+  Revision 1.5  2000-12-25 00:07:32  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/11/29 00:30:46  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/i386/n386cal.pas

@@ -33,7 +33,7 @@ interface
 
     type
        ti386callparanode = class(tcallparanode)
-          procedure secondcallparan(defcoll : pparaitem;
+          procedure secondcallparan(defcoll : TParaItem;
                    push_from_left_to_right,inlined,is_cdecl : boolean;
                    para_alignment,para_offset : longint);override;
        end;
@@ -69,15 +69,15 @@ implementation
                              TI386CALLPARANODE
 *****************************************************************************}
 
-    procedure ti386callparanode.secondcallparan(defcoll : pparaitem;
+    procedure ti386callparanode.secondcallparan(defcoll : TParaItem;
                 push_from_left_to_right,inlined,is_cdecl : boolean;para_alignment,para_offset : longint);
 
       procedure maybe_push_high;
         begin
            { open array ? }
-           { defcoll^.data can be nil for read/write }
-           if assigned(defcoll^.paratype.def) and
-              push_high_param(defcoll^.paratype.def) then
+           { defcoll.data can be nil for read/write }
+           if assigned(defcoll.paratype.def) and
+              push_high_param(defcoll.paratype.def) then
              begin
                if assigned(hightree) then
                 begin
@@ -103,7 +103,7 @@ implementation
 
          { push from left to right if specified }
          if push_from_left_to_right and assigned(right) then
-           tcallparanode(right).secondcallparan(pparaitem(defcoll^.next),push_from_left_to_right,
+           tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
              inlined,is_cdecl,para_alignment,para_offset);
          otlabel:=truelabel;
          oflabel:=falselabel;
@@ -115,9 +115,9 @@ implementation
            begin
              { nothing, everything is already pushed }
            end
-         { in codegen.handleread.. defcoll^.data is set to nil }
-         else if assigned(defcoll^.paratype.def) and
-           (defcoll^.paratype.def^.deftype=formaldef) then
+         { in codegen.handleread.. defcoll.data is set to nil }
+         else if assigned(defcoll.paratype.def) and
+           (defcoll.paratype.def^.deftype=formaldef) then
            begin
               { allow @var }
               inc(pushedparasize,4);
@@ -157,16 +157,16 @@ implementation
                 end;
            end
          { handle call by reference parameter }
-         else if (defcoll^.paratyp in [vs_var,vs_out]) then
+         else if (defcoll.paratyp in [vs_var,vs_out]) then
            begin
               if (left.location.loc<>LOC_REFERENCE) then
                 CGMessage(cg_e_var_must_be_reference);
               maybe_push_high;
-              if (defcoll^.paratyp=vs_out) and
-                 assigned(defcoll^.paratype.def) and
-                 not is_class(defcoll^.paratype.def) and
-                 defcoll^.paratype.def^.needs_inittable then
-                finalize(defcoll^.paratype.def,left.location.reference,false);
+              if (defcoll.paratyp=vs_out) and
+                 assigned(defcoll.paratype.def) and
+                 not is_class(defcoll.paratype.def) and
+                 defcoll.paratype.def^.needs_inittable then
+                finalize(defcoll.paratype.def,left.location.reference,false);
               inc(pushedparasize,4);
               if inlined then
                 begin
@@ -189,9 +189,9 @@ implementation
               { open array must always push the address, this is needed to
                 also push addr of small open arrays and with cdecl functions (PFV) }
               if (
-                  assigned(defcoll^.paratype.def) and
-                  (is_open_array(defcoll^.paratype.def) or
-                   is_array_of_const(defcoll^.paratype.def))
+                  assigned(defcoll.paratype.def) and
+                  (is_open_array(defcoll.paratype.def) or
+                   is_array_of_const(defcoll.paratype.def))
                  ) or
                  (
                   push_addr_param(resulttype) and
@@ -223,7 +223,7 @@ implementation
          falselabel:=oflabel;
          { push from right to left }
          if not push_from_left_to_right and assigned(right) then
-           tcallparanode(right).secondcallparan(pparaitem(defcoll^.next),push_from_left_to_right,
+           tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
              inlined,is_cdecl,para_alignment,para_offset);
       end;
 
@@ -313,9 +313,9 @@ implementation
              Comment(V_debug,
                'inlined parasymtable is at offset '
                +tostr(pprocdef(procdefinition)^.parast^.address_fixup));
-             exprasmlist^.concat(new(pai_asm_comment,init(
+             exprasmList.concat(Tai_asm_comment.Create(
                strpnew('inlined parasymtable is at offset '
-               +tostr(pprocdef(procdefinition)^.parast^.address_fixup)))));
+               +tostr(pprocdef(procdefinition)^.parast^.address_fixup))));
 {$endif extdebug}
               { disable further inlining of the same proc
                 in the args }
@@ -390,8 +390,8 @@ implementation
                emit_const_reg(A_SUB,S_L,pop_size,R_ESP);
 {$ifdef GDB}
                if (cs_debuginfo in aktmoduleswitches) and
-                  (exprasmlist^.first=exprasmlist^.last) then
-                 exprasmlist^.concat(new(pai_force_line,init));
+                  (exprasmList.first=exprasmList.last) then
+                 exprasmList.concat(Tai_force_line.Create);
 {$endif GDB}
              end;
           end;
@@ -450,12 +450,12 @@ implementation
                 para_offset:=0;
               if not(inlined) and
                  assigned(right) then
-                tcallparanode(params).secondcallparan(pparaitem(pabstractprocdef(right.resulttype)^.para^.first),
+                tcallparanode(params).secondcallparan(TParaItem(pabstractprocdef(right.resulttype)^.Para.first),
                   (pocall_leftright in procdefinition^.proccalloptions),inlined,
                   (([pocall_cdecl,pocall_cppdecl]*procdefinition^.proccalloptions)<>[]),
                   para_alignment,para_offset)
               else
-                tcallparanode(params).secondcallparan(pparaitem(procdefinition^.para^.first),
+                tcallparanode(params).secondcallparan(TParaItem(procdefinition^.Para.first),
                   (pocall_leftright in procdefinition^.proccalloptions),inlined,
                   (([pocall_cdecl,pocall_cppdecl]*procdefinition^.proccalloptions)<>[]),
                   para_alignment,para_offset);
@@ -1083,9 +1083,9 @@ implementation
                        getexplicitregister32(R_EDI);
                        emit_reg(A_POP,S_L,R_EDI);
                        ungetregister32(R_EDI);
-                       exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
+                       exprasmList.concat(Tairegalloc.Alloc(R_ESI));
                        emit_reg(A_POP,S_L,R_ESI);
-                       exprasmlist^.concat(new(pairegalloc,alloc(R_ESI)));
+                       exprasmList.concat(Tairegalloc.Alloc(R_ESI));
                     end
                 else if pushedparasize<>0 then
                   emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
@@ -1136,7 +1136,7 @@ implementation
               r^.base:=R_EDI;
               emit_ref(A_CALL,S_NO,r);
               ungetregister32(R_EDI);
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
               emitlab(constructorfailed);
               emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
            end;
@@ -1397,8 +1397,7 @@ implementation
            oldprocinfo : pprocinfo;
            oldinlining_procedure,
            nostackframe,make_global : boolean;
-           proc_names : tstringcontainer;
-           inlineentrycode,inlineexitcode : paasmoutput;
+           inlineentrycode,inlineexitcode : TAAsmoutput;
            oldexitlabel,oldexit2label,oldquickexitlabel:Pasmlabel;
            oldunused,oldusableregs : tregisterset;
            oldc_usableregs : longint;
@@ -1478,13 +1477,13 @@ implementation
               st^.address_fixup:=gettempofsizepersistant(st^.datasize)+st^.datasize;
 {$ifdef extdebug}
               Comment(V_debug,'local symtable is at offset '+tostr(st^.address_fixup));
-              exprasmlist^.concat(new(pai_asm_comment,init(strpnew(
-                'local symtable is at offset '+tostr(st^.address_fixup)))));
+              exprasmList.concat(Tai_asm_comment.Create(strpnew(
+                'local symtable is at offset '+tostr(st^.address_fixup))));
 {$endif extdebug}
             end;
-          exprasmlist^.concat(new(Pai_Marker, Init(InlineStart)));
+          exprasmList.concat(Tai_Marker.Create(InlineStart));
 {$ifdef extdebug}
-          exprasmlist^.concat(new(pai_asm_comment,init(strpnew('Start of inlined proc'))));
+          exprasmList.concat(Tai_asm_comment.Create(strpnew('Start of inlined proc')));
 {$endif extdebug}
 {$ifdef GDB}
           if (cs_debuginfo in aktmoduleswitches) then
@@ -1510,31 +1509,30 @@ implementation
                   strpcopy(strend(pp),'-');
                   strpcopy(strend(pp),oldprocsym^.definition^.mangledname);
                 end;
-              withdebuglist^.concat(new(pai_stabn,init(strnew(pp))));
+              withdebugList.concat(Tai_stabn.Create(strnew(pp)));
             end;
 {$endif GDB}
           { takes care of local data initialization }
-          inlineentrycode:=new(paasmoutput,init);
-          inlineexitcode:=new(paasmoutput,init);
-          proc_names.init;
+          inlineentrycode:=TAAsmoutput.Create;
+          inlineexitcode:=TAAsmoutput.Create;
           ps:=para_size;
           make_global:=false; { to avoid warning }
-          genentrycode(inlineentrycode,proc_names,make_global,0,ps,nostackframe,true);
+          genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
           if po_assembler in aktprocsym^.definition^.procoptions then
-            inlineentrycode^.insert(new(pai_marker,init(asmblockstart)));
-          exprasmlist^.concatlist(inlineentrycode);
+            inlineentrycode.insert(Tai_marker.Create(asmblockstart));
+          exprasmList.concatlist(inlineentrycode);
           secondpass(inlinetree);
           genexitcode(inlineexitcode,0,false,true);
           if po_assembler in aktprocsym^.definition^.procoptions then
-            inlineexitcode^.concat(new(pai_marker,init(asmblockend)));
-          exprasmlist^.concatlist(inlineexitcode);
+            inlineexitcode.concat(Tai_marker.Create(asmblockend));
+          exprasmList.concatlist(inlineexitcode);
 
-          dispose(inlineentrycode,done);
-          dispose(inlineexitcode,done);
+          inlineentrycode.free;
+          inlineexitcode.free;
 {$ifdef extdebug}
-          exprasmlist^.concat(new(pai_asm_comment,init(strpnew('End of inlined proc'))));
+          exprasmList.concat(Tai_asm_comment.Create(strpnew('End of inlined proc')));
 {$endif extdebug}
-          exprasmlist^.concat(new(Pai_Marker, Init(InlineEnd)));
+          exprasmList.concat(Tai_Marker.Create(InlineEnd));
 
           {we can free the local data now, reset also the fixup address }
           if st^.datasize>0 then
@@ -1555,7 +1553,7 @@ implementation
                  strpcopy(strend(pp),'-');
                  strpcopy(strend(pp),oldprocsym^.definition^.mangledname);
                end;
-              withdebuglist^.concat(new(pai_stabn,init(strnew(pp))));
+              withdebugList.concat(Tai_stabn.Create(strnew(pp)));
               freemem(pp,mangled_length+50);
             end;
 {$endif GDB}
@@ -1592,7 +1590,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2000-12-09 10:45:40  florian
+  Revision 1.16  2000-12-25 00:07:32  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.15  2000/12/09 10:45:40  florian
     * AfterConstructor isn't called anymore when a constructor failed
 
   Revision 1.14  2000/12/07 17:19:46  jonas

compiler/i386/n386cnv.pas

@@ -690,10 +690,10 @@ implementation
                 getdatalabel(l1);
                 getlabel(l2);
                 emitjmp(C_Z,l2);
-                consts^.concat(new(pai_label,init(l1)));
+                Consts.concat(Tai_label.Create(l1));
                 { I got this constant from a test progtram (FK) }
-                consts^.concat(new(pai_const,init_32bit(0)));
-                consts^.concat(new(pai_const,init_32bit(1138753536)));
+                Consts.concat(Tai_const.Create_32bit(0));
+                Consts.concat(Tai_const.Create_32bit(1138753536));
                 r:=new_reference(R_NO,0);
                 r^.symbol:=l1;
                 emit_ref(A_FADD,S_FL,r);
@@ -1227,14 +1227,14 @@ implementation
               begin
                  del_reference(left.location.reference);
                  hreg:=getregister32;
-                 exprasmlist^.concat(new(paicpu,op_ref_reg(
-                   A_MOV,S_L,newreference(left.location.reference),hreg)));
+                 exprasmList.concat(Taicpu.Op_ref_reg(
+                   A_MOV,S_L,newreference(left.location.reference),hreg));
               end;
             LOC_CREGISTER:
               begin
                  hreg:=getregister32;
-                 exprasmlist^.concat(new(paicpu,op_reg_reg(
-                   A_MOV,S_L,left.location.register,hreg)));
+                 exprasmList.concat(Taicpu.Op_reg_reg(
+                   A_MOV,S_L,left.location.register,hreg));
               end;
             LOC_REGISTER:
               hreg:=left.location.register;
@@ -1493,7 +1493,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2000-12-07 17:19:46  jonas
+  Revision 1.11  2000-12-25 00:07:32  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.10  2000/12/07 17:19:46  jonas
     * new constant handling: from now on, hex constants >$7fffffff are
       parsed as unsigned constants (otherwise, $80000000 got sign extended
       and became $ffffffff80000000), all constants in the longint range

compiler/i386/n386con.pas

@@ -79,7 +79,7 @@ implementation
           (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_none,ait_none);
 
       var
-         hp1 : pai;
+         hp1 : tai;
          lastlabel : pasmlabel;
          realait : tait;
 
@@ -104,20 +104,20 @@ implementation
               if not assigned(lab_real) then
                 begin
                    { tries to find an old entry }
-                   hp1:=pai(consts^.first);
+                   hp1:=tai(Consts.first);
                    while assigned(hp1) do
                      begin
-                        if hp1^.typ=ait_label then
-                          lastlabel:=pai_label(hp1)^.l
+                        if hp1.typ=ait_label then
+                          lastlabel:=tai_label(hp1).l
                         else
                           begin
-                             if (hp1^.typ=realait) and (lastlabel<>nil) then
+                             if (hp1.typ=realait) and (lastlabel<>nil) then
                                begin
                                   if(
-                                     ((realait=ait_real_32bit) and (pai_real_32bit(hp1)^.value=value_real)) or
-                                     ((realait=ait_real_64bit) and (pai_real_64bit(hp1)^.value=value_real)) or
-                                     ((realait=ait_real_80bit) and (pai_real_80bit(hp1)^.value=value_real)) or
-                                     ((realait=ait_comp_64bit) and (pai_comp_64bit(hp1)^.value=value_real))
+                                     ((realait=ait_real_32bit) and (tai_real_32bit(hp1).value=value_real)) or
+                                     ((realait=ait_real_64bit) and (tai_real_64bit(hp1).value=value_real)) or
+                                     ((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real)) or
+                                     ((realait=ait_comp_64bit) and (tai_comp_64bit(hp1).value=value_real))
                                     ) then
                                     begin
                                        { found! }
@@ -127,7 +127,7 @@ implementation
                                end;
                              lastlabel:=nil;
                           end;
-                        hp1:=pai(hp1^.next);
+                        hp1:=tai(hp1.next);
                      end;
                    { :-(, we must generate a new entry }
                    if not assigned(lab_real) then
@@ -135,17 +135,17 @@ implementation
                         getdatalabel(lastlabel);
                         lab_real:=lastlabel;
                         if (cs_create_smart in aktmoduleswitches) then
-                         consts^.concat(new(pai_cut,init));
-                        consts^.concat(new(pai_label,init(lastlabel)));
+                         Consts.concat(Tai_cut.Create);
+                        Consts.concat(Tai_label.Create(lastlabel));
                         case realait of
                           ait_real_32bit :
-                            consts^.concat(new(pai_real_32bit,init(value_real)));
+                            Consts.concat(Tai_real_32bit.Create(value_real));
                           ait_real_64bit :
-                            consts^.concat(new(pai_real_64bit,init(value_real)));
+                            Consts.concat(Tai_real_64bit.Create(value_real));
                           ait_real_80bit :
-                            consts^.concat(new(pai_real_80bit,init(value_real)));
+                            Consts.concat(Tai_real_80bit.Create(value_real));
                           ait_comp_64bit :
-                            consts^.concat(new(pai_comp_64bit,init(value_real)));
+                            Consts.concat(Tai_comp_64bit.Create(value_real));
                         else
                           internalerror(10120);
                         end;
@@ -185,10 +185,10 @@ implementation
            begin
               getdatalabel(l);
               if (cs_create_smart in aktmoduleswitches) then
-                consts^.concat(new(pai_cut,init));
-              consts^.concat(new(pai_label,init(l)));
-              consts^.concat(new(pai_const,init_32bit(longint(lo(value)))));
-              consts^.concat(new(pai_const,init_32bit(longint(hi(value)))));
+                Consts.concat(Tai_cut.Create);
+              Consts.concat(Tai_label.Create(l));
+              Consts.concat(Tai_const.Create_32bit(longint(lo(value))));
+              Consts.concat(Tai_const.Create_32bit(longint(hi(value))));
               reset_reference(location.reference);
               location.reference.symbol:=l;
            end
@@ -220,7 +220,7 @@ implementation
 
     procedure ti386stringconstnode.pass_2;
       var
-         hp1 : pai;
+         hp1 : tai;
          l1,l2,
          lastlabel   : pasmlabel;
          pc       : pchar;
@@ -249,11 +249,11 @@ implementation
               if not(is_widestring(resulttype)) then
                 begin
                   { tries to found an old entry }
-                  hp1:=pai(consts^.first);
+                  hp1:=tai(Consts.first);
                   while assigned(hp1) do
                     begin
-                       if hp1^.typ=ait_label then
-                         lastlabel:=pai_label(hp1)^.l
+                       if hp1.typ=ait_label then
+                         lastlabel:=tai_label(hp1).l
                        else
                          begin
                             { when changing that code, be careful that }
@@ -262,15 +262,15 @@ implementation
                             { currently, this is no problem, because   }
                             { typed consts have no leading length or   }
                             { they have no trailing zero           }
-                            if (hp1^.typ=ait_string) and (lastlabel<>nil) and
-                               (pai_string(hp1)^.len=mylength) then
+                            if (hp1.typ=ait_string) and (lastlabel<>nil) and
+                               (tai_string(hp1).len=mylength) then
                               begin
                                  same_string:=true;
                                  { if shortstring then check the length byte first and
                                    set the start index to 1 }
                                  if is_shortstring(resulttype) then
                                   begin
-                                    if len<>ord(pai_string(hp1)^.str[0]) then
+                                    if len<>ord(tai_string(hp1).str[0]) then
                                      same_string:=false;
                                     j:=1;
                                   end
@@ -281,7 +281,7 @@ implementation
                                   begin
                                     for i:=0 to len do
                                      begin
-                                       if pai_string(hp1)^.str[j]<>value_str[i] then
+                                       if tai_string(hp1).str[j]<>value_str[i] then
                                         begin
                                           same_string:=false;
                                           break;
@@ -297,8 +297,8 @@ implementation
                                     if (stringtype in [st_ansistring,st_widestring]) then
                                      begin
                                        getdatalabel(l2);
-                                       consts^.concat(new(pai_label,init(l2)));
-                                       consts^.concat(new(pai_const_symbol,init(lab_str)));
+                                       Consts.concat(Tai_label.Create(l2));
+                                       Consts.concat(Tai_const_symbol.Create(lab_str));
                                        { return the offset of the real string }
                                        lab_str:=l2;
                                      end;
@@ -307,7 +307,7 @@ implementation
                               end;
                             lastlabel:=nil;
                          end;
-                       hp1:=pai(hp1^.next);
+                       hp1:=tai(hp1.next);
                     end;
                 end;
               { :-(, we must generate a new entry }
@@ -316,31 +316,31 @@ implementation
                    getdatalabel(lastlabel);
                    lab_str:=lastlabel;
                    if (cs_create_smart in aktmoduleswitches) then
-                    consts^.concat(new(pai_cut,init));
-                   consts^.concat(new(pai_label,init(lastlabel)));
+                    Consts.concat(Tai_cut.Create);
+                   Consts.concat(Tai_label.Create(lastlabel));
                    { generate an ansi string ? }
                    case stringtype of
                       st_ansistring:
                         begin
                            { an empty ansi string is nil! }
                            if len=0 then
-                             consts^.concat(new(pai_const,init_32bit(0)))
+                             Consts.concat(Tai_const.Create_32bit(0))
                            else
                              begin
                                 getdatalabel(l1);
                                 getdatalabel(l2);
-                                consts^.concat(new(pai_label,init(l2)));
-                                consts^.concat(new(pai_const_symbol,init(l1)));
-                                consts^.concat(new(pai_const,init_32bit(len)));
-                                consts^.concat(new(pai_const,init_32bit(len)));
-                                consts^.concat(new(pai_const,init_32bit(-1)));
-                                consts^.concat(new(pai_label,init(l1)));
+                                Consts.concat(Tai_label.Create(l2));
+                                Consts.concat(Tai_const_symbol.Create(l1));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(-1));
+                                Consts.concat(Tai_label.Create(l1));
                                 getmem(pc,len+2);
                                 move(value_str^,pc^,len);
                                 pc[len]:=#0;
                                 { to overcome this problem we set the length explicitly }
                                 { with the ending null char }
-                                consts^.concat(new(pai_string,init_length_pchar(pc,len+1)));
+                                Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
                                 { return the offset of the real string }
                                 lab_str:=l2;
                              end;
@@ -349,24 +349,24 @@ implementation
                         begin
                            { an empty wide string is nil! }
                            if len=0 then
-                             consts^.concat(new(pai_const,init_32bit(0)))
+                             Consts.concat(Tai_const.Create_32bit(0))
                            else
                              begin
                                 getdatalabel(l1);
                                 getdatalabel(l2);
-                                consts^.concat(new(pai_label,init(l2)));
-                                consts^.concat(new(pai_const_symbol,init(l1)));
+                                Consts.concat(Tai_label.Create(l2));
+                                Consts.concat(Tai_const_symbol.Create(l1));
 
                                 { we use always UTF-16 coding for constants }
                                 { at least for now                          }
-                                consts^.concat(new(pai_const,init_8bit(2)));
-                                consts^.concat(new(pai_const,init_32bit(len)));
-                                consts^.concat(new(pai_const,init_32bit(len)));
-                                consts^.concat(new(pai_const,init_32bit(-1)));
-                                consts^.concat(new(pai_label,init(l1)));
+                                Consts.concat(Tai_const.Create_8bit(2));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(-1));
+                                Consts.concat(Tai_label.Create(l1));
                                 for i:=0 to len-1 do
-                                  consts^.concat(new(pai_const,init_16bit(
-                                    pcompilerwidestring(value_str)^.data[i])));
+                                  Consts.concat(Tai_const.Create_16bit(
+                                    pcompilerwidestring(value_str)^.data[i]));
                                 { return the offset of the real string }
                                 lab_str:=l2;
                              end;
@@ -385,7 +385,7 @@ implementation
                           { to overcome this problem we set the length explicitly }
                           { with the ending null char }
                           pc[l+1]:=#0;
-                          consts^.concat(new(pai_string,init_length_pchar(pc,l+2)));
+                          Consts.concat(Tai_string.Create_length_pchar(pc,l+2));
                         end;
                    end;
                 end;
@@ -402,7 +402,7 @@ implementation
 
     procedure ti386setconstnode.pass_2;
       var
-         hp1     : pai;
+         hp1     : tai;
          lastlabel   : pasmlabel;
          i         : longint;
          neededtyp   : tait;
@@ -424,25 +424,25 @@ implementation
         if not assigned(lab_set) then
           begin
              { tries to found an old entry }
-             hp1:=pai(consts^.first);
+             hp1:=tai(Consts.first);
              while assigned(hp1) do
                begin
-                  if hp1^.typ=ait_label then
-                    lastlabel:=pai_label(hp1)^.l
+                  if hp1.typ=ait_label then
+                    lastlabel:=tai_label(hp1).l
                   else
                     begin
-                      if (lastlabel<>nil) and (hp1^.typ=neededtyp) then
+                      if (lastlabel<>nil) and (hp1.typ=neededtyp) then
                         begin
-                          if (hp1^.typ=ait_const_8bit) then
+                          if (hp1.typ=ait_const_8bit) then
                            begin
                              { compare normal set }
                              i:=0;
                              while assigned(hp1) and (i<32) do
                               begin
-                                if pai_const(hp1)^.value<>value_set^[i] then
+                                if tai_const(hp1).value<>value_set^[i] then
                                  break;
                                 inc(i);
-                                hp1:=pai(hp1^.next);
+                                hp1:=tai(hp1.next);
                               end;
                              if i=32 then
                               begin
@@ -451,14 +451,14 @@ implementation
                                 break;
                               end;
                              { leave when the end of consts is reached, so no
-                               hp1^.next is done }
+                               hp1.next is done }
                              if not assigned(hp1) then
                               break;
                            end
                           else
                            begin
                              { compare small set }
-                             if plongint(value_set)^=pai_const(hp1)^.value then
+                             if plongint(value_set)^=tai_const(hp1).value then
                               begin
                                 { found! }
                                 lab_set:=lastlabel;
@@ -468,7 +468,7 @@ implementation
                         end;
                       lastlabel:=nil;
                     end;
-                  hp1:=pai(hp1^.next);
+                  hp1:=tai(hp1.next);
                end;
              { :-(, we must generate a new entry }
              if not assigned(lab_set) then
@@ -476,17 +476,17 @@ implementation
                  getdatalabel(lastlabel);
                  lab_set:=lastlabel;
                  if (cs_create_smart in aktmoduleswitches) then
-                  consts^.concat(new(pai_cut,init));
-                 consts^.concat(new(pai_label,init(lastlabel)));
+                  Consts.concat(Tai_cut.Create);
+                 Consts.concat(Tai_label.Create(lastlabel));
                  if psetdef(resulttype)^.settype=smallset then
                   begin
                     move(value_set^,i,sizeof(longint));
-                    consts^.concat(new(pai_const,init_32bit(i)));
+                    Consts.concat(Tai_const.Create_32bit(i));
                   end
                  else
                   begin
                     for i:=0 to 31 do
-                      consts^.concat(new(pai_const,init_8bit(value_set^[i])));
+                      Consts.concat(Tai_const.Create_8bit(value_set^[i]));
                   end;
                end;
           end;
@@ -518,7 +518,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-11-29 00:30:47  florian
+  Revision 1.6  2000-12-25 00:07:32  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/11/29 00:30:47  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/i386/n386flw.pas

@@ -102,8 +102,8 @@ implementation
          oldclabel,oldblabel : pasmlabel;
          otlabel,oflabel : pasmlabel;
 
-         start_regvars_loaded,
-         then_regvars_loaded: regvar_booleanarray;
+         //start_regvars_loaded,
+         //then_regvars_loaded: regvar_booleanarray;
 
       begin
          getlabel(lloop);
@@ -126,9 +126,9 @@ implementation
          cleartempgen;
          if assigned(right) then
            secondpass(right);
-         
+
          load_all_regvars(exprasmlist);
-         
+
          emitlab(lcont);
          otlabel:=truelabel;
          oflabel:=falselabel;
@@ -145,7 +145,7 @@ implementation
           end;
          cleartempgen;
          secondpass(left);
-         
+
          load_all_regvars(exprasmlist);
 
          maketojumpbool(left);
@@ -193,7 +193,7 @@ implementation
                 begin
                    getlabel(hl);
                    { do go back to if line !! }
-                   aktfilepos:=exprasmlist^.getlasttaifilepos^;
+                   aktfilepos:=exprasmList.getlasttaifilepos^;
                    emitjmp(C_None,hl);
                 end;
               emitlab(falselabel);
@@ -346,7 +346,7 @@ implementation
 
          { align loop target }
          if not(cs_littlesize in aktglobalswitches) then
-           exprasmlist^.concat(new(pai_align,init_op(4,$90)));
+           exprasmList.concat(Tai_align.Create_op(4,$90));
 
          emitlab(l3);
 
@@ -696,10 +696,10 @@ do_jmp:
 
       begin
          emitcall('FPC_POPOBJECTSTACK');
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
          emitcall('FPC_DESTROYEXCEPTION');
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
          maybe_loadesi;
       end;
 
@@ -710,10 +710,10 @@ do_jmp:
       begin
          emitcall('FPC_POPADDRSTACK');
          { allocate eax }
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_POP,S_L,R_EAX);
          { deallocate eax }
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
       end;
 
     procedure ti386tryexceptnode.pass_2;
@@ -776,13 +776,13 @@ do_jmp:
          push_int (1); { push type of exceptionframe }
          emitcall('FPC_PUSHEXCEPTADDR');
          { allocate eax }
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
          emitcall('FPC_SETJMP');
          emit_reg(A_PUSH,S_L,R_EAX);
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
          { deallocate eax }
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
          emitjmp(C_NE,exceptlabel);
 
          { try block }
@@ -807,10 +807,10 @@ do_jmp:
          emitlab(exceptlabel);
          emitcall('FPC_POPADDRSTACK');
 
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_POP,S_L,R_EAX);
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
 
          emitjmp(C_E,endexceptlabel);
          emitlab(doexceptlabel);
@@ -850,19 +850,16 @@ do_jmp:
               { guarded by an exception frame                        }
               getlabel(doobjectdestroy);
               getlabel(doobjectdestroyandreraise);
-              exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,1)));
+              exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,1));
               emitcall('FPC_PUSHEXCEPTADDR');
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
-              exprasmlist^.concat(new(paicpu,
-                op_reg(A_PUSH,S_L,R_EAX)));
-              exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
+              exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
               emitcall('FPC_SETJMP');
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
-              exprasmlist^.concat(new(paicpu,
-                op_reg(A_PUSH,S_L,R_EAX)));
-              exprasmlist^.concat(new(paicpu,
-                op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
-              exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
+              exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
+              exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
               emitjmp(C_NE,doobjectdestroyandreraise);
 
               oldexceptblock:=aktexceptblock;
@@ -875,18 +872,16 @@ do_jmp:
 
               emitlab(doobjectdestroyandreraise);
               emitcall('FPC_POPADDRSTACK');
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
-              exprasmlist^.concat(new(paicpu,
-                op_reg(A_POP,S_L,R_EAX)));
-              exprasmlist^.concat(new(paicpu,
-                op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
-              exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX));
+              exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
+              exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
               emitjmp(C_E,doobjectdestroy);
               emitcall('FPC_POPSECONDOBJECTSTACK');
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
               emit_reg(A_PUSH,S_L,R_EAX);
               emitcall('FPC_DESTROYEXCEPTION');
-              exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
               { we don't need to restore esi here because reraise never }
               { returns                                                 }
               emitcall('FPC_RERAISE');
@@ -1000,7 +995,7 @@ do_jmp:
            newasmsymbol(excepttype^.vmt_mangledname));
          emitcall('FPC_CATCHES');
          { allocate eax }
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
          emitjmp(C_E,nextonlabel);
          ref.symbol:=nil;
@@ -1013,24 +1008,21 @@ do_jmp:
          emit_reg_ref(A_MOV,S_L,
            R_EAX,newreference(ref));
          { deallocate eax }
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
 
          { in the case that another exception is risen }
          { we've to destroy the old one                }
          getlabel(doobjectdestroyandreraise);
-         exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,1)));
+         exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,1));
          emitcall('FPC_PUSHEXCEPTADDR');
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
-         exprasmlist^.concat(new(paicpu,
-           op_reg(A_PUSH,S_L,R_EAX)));
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
          emitcall('FPC_SETJMP');
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
-         exprasmlist^.concat(new(paicpu,
-           op_reg(A_PUSH,S_L,R_EAX)));
-         exprasmlist^.concat(new(paicpu,
-           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
+         exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
          emitjmp(C_NE,doobjectdestroyandreraise);
 
          if assigned(right) then
@@ -1060,18 +1052,16 @@ do_jmp:
          getlabel(doobjectdestroy);
          emitlab(doobjectdestroyandreraise);
          emitcall('FPC_POPADDRSTACK');
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
-         exprasmlist^.concat(new(paicpu,
-           op_reg(A_POP,S_L,R_EAX)));
-         exprasmlist^.concat(new(paicpu,
-           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX));
+         exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
          emitjmp(C_E,doobjectdestroy);
          emitcall('FPC_POPSECONDOBJECTSTACK');
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
          emitcall('FPC_DESTROYEXCEPTION');
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
          { we don't need to restore esi here because reraise never }
          { returns                                                 }
          emitcall('FPC_RERAISE');
@@ -1175,13 +1165,13 @@ do_jmp:
          push_int(1); { Type of stack-frame must be pushed}
          emitcall('FPC_PUSHEXCEPTADDR');
          { allocate eax }
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
          emitcall('FPC_SETJMP');
          emit_reg(A_PUSH,S_L,R_EAX);
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
          { deallocate eax }
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
          emitjmp(C_NE,finallylabel);
 
          { try code }
@@ -1209,7 +1199,7 @@ do_jmp:
          if codegenerror then
            exit;
          { allocate eax }
-         exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
          emit_reg(A_POP,S_L,R_EAX);
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
          emitjmp(C_E,endfinallylabel);
@@ -1237,7 +1227,7 @@ do_jmp:
               emitjmp(C_Z,oldaktcontinuelabel);
            end;
          { deallocate eax }
-         exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
          emitlab(reraiselabel);
          emitcall('FPC_RERAISE');
          { do some magic for exit,break,continue in the try block }
@@ -1245,9 +1235,9 @@ do_jmp:
            begin
               emitlab(exitfinallylabel);
               { allocate eax }
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
               emit_reg(A_POP,S_L,R_EAX);
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
               emit_const(A_PUSH,S_L,2);
               emitjmp(C_NONE,finallylabel);
            end;
@@ -1255,19 +1245,19 @@ do_jmp:
           begin
              emitlab(breakfinallylabel);
              { allocate eax }
-             exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+             exprasmList.concat(Tairegalloc.Alloc(R_EAX));
              emit_reg(A_POP,S_L,R_EAX);
              { deallocate eax }
-             exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
+             exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
              emit_const(A_PUSH,S_L,3);
              emitjmp(C_NONE,finallylabel);
            end;
          if fc_continue in tryflowcontrol then
            begin
               emitlab(continuefinallylabel);
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
               emit_reg(A_POP,S_L,R_EAX);
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
               emit_const(A_PUSH,S_L,4);
               emitjmp(C_NONE,finallylabel);
            end;
@@ -1312,7 +1302,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2000-12-05 11:44:33  jonas
+  Revision 1.5  2000-12-25 00:07:32  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/12/05 11:44:33  jonas
     + new integer regvar handling, should be much more efficient
 
   Revision 1.3  2000/11/29 00:30:47  florian

compiler/i386/n386ic.pas

@@ -28,7 +28,7 @@ uses
   aasm,
   symbase,symtype,symtable,symdef,symsym;
 
-procedure cgintfwrapper(asmlist: paasmoutput; procdef: pprocdef; const labelname: string; ioffset: longint);
+procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: pprocdef; const labelname: string; ioffset: longint);
 
 implementation
 
@@ -94,7 +94,7 @@ begin
 end;
 
 
-procedure cgintfwrapper(asmlist: paasmoutput; procdef: pprocdef; const labelname: string; ioffset: longint);
+procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: pprocdef; const labelname: string; ioffset: longint);
   procedure checkvirtual;
   begin
     if (procdef^.extnumber=-1) then
@@ -133,7 +133,7 @@ procedure cgintfwrapper(asmlist: paasmoutput; procdef: pprocdef; const labelname
   end;
 
 var
-  oldexprasmlist: paasmoutput;
+  oldexprasmlist: TAAsmoutput;
   lab : pasmsymbol;
 
 begin
@@ -147,7 +147,7 @@ begin
   oldexprasmlist:=exprasmlist;
   exprasmlist:=asmlist;
 
-  exprasmlist^.concat(new(pai_symbol,initname(labelname,0)));
+  exprasmList.concat(Tai_symbol.Createname(labelname,0));
 
   { set param1 interface to self  }
   adjustselfvalue(ioffset);
@@ -202,7 +202,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-11-29 00:30:47  florian
+  Revision 1.4  2000-12-25 00:07:33  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.3  2000/11/29 00:30:47  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/i386/n386inl.pas

@@ -229,7 +229,7 @@ implementation
 
         begin
            { here we don't use register calling conventions }
-           dummycoll.init;
+           dummycoll:=TParaItem.Create;
            dummycoll.register:=R_NO;
            { I/O check }
            if (cs_check_io in aktlocalswitches) and
@@ -356,7 +356,7 @@ implementation
                         else
                           if (is_chararray(tcallparanode(hp).resulttype)) then
                             dummycoll.paratype.setdef(openchararraydef);
-                        tcallparanode(hp).secondcallparan(@dummycoll,false,false,false,0,0);
+                        tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                         if ft=ft_typed then
                           never_copy_const_param:=false;
                       end;
@@ -401,7 +401,7 @@ implementation
                                    tcallparanode(hp).right:=nil;
                                    dummycoll.paratype.setdef(hp.resulttype);
                                    dummycoll.paratyp:=vs_value;
-                                   tcallparanode(hp).secondcallparan(@dummycoll,false,false,false,0,0);
+                                   tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                                    tcallparanode(hp).right:=node;
                                    if codegenerror then
                                      exit;
@@ -419,7 +419,7 @@ implementation
                                    tcallparanode(hp).right:=nil;
                                    dummycoll.paratype.setdef(hp.resulttype);
                                    dummycoll.paratyp:=vs_value;
-                                   tcallparanode(hp).secondcallparan(@dummycoll,false,false,false,0,0);
+                                   tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                                    tcallparanode(hp).right:=node;
                                    if pararesult^.deftype<>floatdef then
                                      CGMessage(parser_e_illegal_colon_qualifier);
@@ -558,7 +558,7 @@ implementation
            procedureprefix : string;
 
           begin
-           dummycoll.init;
+           dummycoll:=TParaItem.Create;
            dummycoll.register:=R_NO;
            pushusedregisters(pushed,$ff);
            node:=tcallparanode(left);
@@ -585,7 +585,7 @@ implementation
            else
              dummycoll.paratype.setdef(hp.resulttype);
            procedureprefix:='FPC_'+pstringdef(hp.resulttype)^.stringtypname+'_';
-           tcallparanode(hp).secondcallparan(@dummycoll,false,false,false,0,0);
+           tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
            if codegenerror then
              exit;
 
@@ -607,7 +607,7 @@ implementation
              begin
                 dummycoll.paratype.setdef(hp.resulttype);
                 dummycoll.paratyp:=vs_value;
-                tcallparanode(hp).secondcallparan(@dummycoll,false,false,false,0,0);
+                tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                 if codegenerror then
                   exit;
                 hp.free;
@@ -624,7 +624,7 @@ implementation
              begin
                 dummycoll.paratype.setdef(hp.resulttype);
                 dummycoll.paratyp:=vs_value;
-                tcallparanode(hp).secondcallparan(@dummycoll,false,false,false,0,0);
+                tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                 if codegenerror then
                   exit;
                 hp.free;
@@ -648,7 +648,7 @@ implementation
            { last arg longint or real }
            dummycoll.paratype.setdef(hp.resulttype);
            dummycoll.paratyp:=vs_value;
-           tcallparanode(hp).secondcallparan(@dummycoll,false,false,false,0,0);
+           tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
            if codegenerror then
              exit;
 
@@ -688,7 +688,7 @@ implementation
            r : preference;
 
           begin
-           dummycoll.init;
+           dummycoll:=TParaItem.Create;
            dummycoll.register:=R_NO;
            node:=tcallparanode(left);
            hp:=node;
@@ -720,7 +720,7 @@ implementation
           {load and push the address of the destination}
            dummycoll.paratyp:=vs_var;
            dummycoll.paratype.setdef(dest_para.resulttype);
-           dest_para.secondcallparan(@dummycoll,false,false,false,0,0);
+           dest_para.secondcallparan(dummycoll,false,false,false,0,0);
            if codegenerror then
              exit;
 
@@ -734,7 +734,7 @@ implementation
              Begin
                dummycoll.paratyp:=vs_var;
                dummycoll.paratype.setdef(code_para.resulttype);
-               code_para.secondcallparan(@dummycoll,false,false,false,0,0);
+               code_para.secondcallparan(dummycoll,false,false,false,0,0);
                if codegenerror then
                  exit;
                code_para.free;
@@ -749,7 +749,7 @@ implementation
           {node = first parameter = string}
            dummycoll.paratyp:=vs_const;
            dummycoll.paratype.setdef(node.resulttype);
-           node.secondcallparan(@dummycoll,false,false,false,0,0);
+           node.secondcallparan(dummycoll,false,false,false,0,0);
            if codegenerror then
              exit;
 
@@ -940,7 +940,7 @@ implementation
                  { lineno }
                  emit_const(A_PUSH,S_L,aktfilepos.line);
                  { filename string }
-                 hp2:=genstringconstnode(current_module^.sourcefiles^.get_file_name(aktfilepos.fileindex),st_shortstring);
+                 hp2:=genstringconstnode(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
                  secondpass(hp2);
                  if codegenerror then
                   exit;
@@ -1428,10 +1428,10 @@ implementation
                   if not(is_dynamic_array(def)) and
                      (pstringdef(def)^.string_typ = st_shortstring) then
                     begin
-                      dummycoll.init;
+                      dummycoll:=TParaItem.Create;
                       dummycoll.paratyp:=vs_var;
                       dummycoll.paratype.setdef(openshortstringdef);
-                      tcallparanode(hp).secondcallparan(@dummycoll,false,false,false,0,0);
+                      tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
                       if codegenerror then
                         exit;
                     end
@@ -1682,7 +1682,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2000-12-09 22:51:37  florian
+  Revision 1.11  2000-12-25 00:07:33  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.10  2000/12/09 22:51:37  florian
     * helper name of val for qword fixed
 
   Revision 1.9  2000/12/07 17:19:46  jonas

compiler/i386/n386ld.pas

@@ -69,8 +69,8 @@ implementation
          hp : preference;
          s : pasmsymbol;
          popeax : boolean;
-         pushed : tpushed;
-         hr : treference;
+         //pushed : tpushed;
+         //hr : treference;
 
       begin
          simple_loadn:=true;
@@ -403,7 +403,7 @@ implementation
          fputyp : tfloattype;
          loc : tloc;
          r : preference;
-         ai : paicpu;
+         ai : taicpu;
          op : tasmop;
          pushed : boolean;
          regspushed : tpushed;
@@ -492,7 +492,7 @@ implementation
                   case right.location.loc of
                      LOC_REGISTER,LOC_CREGISTER:
                        begin
-                          exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,right.location.register)));
+                          exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,right.location.register));
                           ungetregister32(right.location.register);
                        end;
                      LOC_REFERENCE,LOC_MEM:
@@ -803,9 +803,9 @@ implementation
                                 emit_flag2reg(right.location.resflags,left.location.register)
                               else
                                 begin
-                                  ai:=new(paicpu,op_ref(A_Setcc,S_B,newreference(left.location.reference)));
-                                  ai^.SetCondition(flag_2_cond[right.location.resflags]);
-                                  exprasmlist^.concat(ai);
+                                  ai:=Taicpu.Op_ref(A_Setcc,S_B,newreference(left.location.reference));
+                                  ai.SetCondition(flag_2_cond[right.location.resflags]);
+                                  exprasmList.concat(ai);
                                 end;
 {$IfDef regallocfix}
                               del_reference(left.location.reference);
@@ -1061,7 +1061,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2000-12-05 11:44:33  jonas
+  Revision 1.11  2000-12-25 00:07:33  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.10  2000/12/05 11:44:33  jonas
     + new integer regvar handling, should be much more efficient
 
   Revision 1.9  2000/11/29 00:30:48  florian

compiler/i386/n386mem.pas

@@ -214,7 +214,7 @@ implementation
 
          pushusedregisters(pushed,$ff);
          saveregvars($ff);
-         
+
          { call the mem handling procedures }
          case nodetype of
            simpledisposen:
@@ -461,7 +461,7 @@ implementation
          t   : tnode;
          hp  : preference;
          href : treference;
-         tai : Paicpu;
+         tai : Taicpu;
          pushed : tpushed;
          hightree : tnode;
          hl,otl,ofl : pasmlabel;
@@ -811,11 +811,11 @@ implementation
                       { Booleans are stored in an 8 bit memory location, so
                         the use of MOVL is not correct }
                       case right.resulttype^.size of
-                       1 : tai:=new(paicpu,op_ref_reg(A_MOVZX,S_BL,newreference(right.location.reference),ind));
-                       2 : tai:=new(Paicpu,op_ref_reg(A_MOVZX,S_WL,newreference(right.location.reference),ind));
-                       4 : tai:=new(Paicpu,op_ref_reg(A_MOV,S_L,newreference(right.location.reference),ind));
+                       1 : tai:=Taicpu.Op_ref_reg(A_MOVZX,S_BL,newreference(right.location.reference),ind);
+                       2 : tai:=Taicpu.Op_ref_reg(A_MOVZX,S_WL,newreference(right.location.reference),ind);
+                       4 : tai:=Taicpu.Op_ref_reg(A_MOV,S_L,newreference(right.location.reference),ind);
                       end;
-                      exprasmlist^.concat(tai);
+                      exprasmList.concat(tai);
                    end;
                  else
                    internalerror(5913428);
@@ -995,10 +995,10 @@ implementation
                       getaddrlabel(withstartlabel);
                       getaddrlabel(withendlabel);
                       emitlab(withstartlabel);
-                      withdebuglist^.concat(new(pai_stabs,init(strpnew(
+                      withdebugList.concat(Tai_stabs.Create(strpnew(
                          '"with'+tostr(withlevel)+':'+tostr(symtablestack^.getnewtypecount)+
                          '=*'+pstoreddef(left.resulttype)^.numberstring+'",'+
-                         tostr(N_LSYM)+',0,0,'+tostr(withreference^.offset)))));
+                         tostr(N_LSYM)+',0,0,'+tostr(withreference^.offset))));
                       mangled_length:=length(aktprocsym^.definition^.mangledname);
                       getmem(pp,mangled_length+50);
                       strpcopy(pp,'192,0,0,'+withstartlabel^.name);
@@ -1007,7 +1007,7 @@ implementation
                           strpcopy(strend(pp),'-');
                           strpcopy(strend(pp),aktprocsym^.definition^.mangledname);
                         end;
-                      withdebuglist^.concat(new(pai_stabn,init(strnew(pp))));
+                      withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                     end;
 {$endif GDB}
                 end;
@@ -1029,7 +1029,7 @@ implementation
                           strpcopy(strend(pp),'-');
                           strpcopy(strend(pp),aktprocsym^.definition^.mangledname);
                         end;
-                       withdebuglist^.concat(new(pai_stabn,init(strnew(pp))));
+                       withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                        freemem(pp,mangled_length+50);
                        dec(withlevel);
                      end;
@@ -1060,7 +1060,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2000-12-05 11:44:33  jonas
+  Revision 1.8  2000-12-25 00:07:33  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.7  2000/12/05 11:44:33  jonas
     + new integer regvar handling, should be much more efficient
 
   Revision 1.6  2000/11/29 00:30:48  florian

compiler/i386/n386set.pas

@@ -540,7 +540,7 @@ implementation
          { true, if we can omit the range check of the jump table }
          jumptable_no_range : boolean;
          { where to put the jump table }
-         jumpsegment : paasmoutput;
+         jumpsegment : TAAsmoutput;
          min_label : TConstExprInt;
 
       procedure gentreejmp(p : pcaserecord);
@@ -771,9 +771,9 @@ implementation
                genitem(t^.less);
              { fill possible hole }
              for i:=last+1 to t^._low-1 do
-               jumpsegment^.concat(new(pai_const_symbol,init(elselabel)));
+               jumpSegment.concat(Tai_const_symbol.Create(elselabel));
              for i:=t^._low to t^._high do
-               jumpsegment^.concat(new(pai_const_symbol,init(t^.statement)));
+               jumpSegment.concat(Tai_const_symbol.Create(t^.statement));
               last:=t^._high;
              if assigned(t^.greater) then
                genitem(t^.greater);
@@ -819,9 +819,9 @@ implementation
            emit_ref(A_JMP,S_NO,hr);
            { !!!!! generate tables
              if not(cs_littlesize in aktlocalswitches) then
-             jumpsegment^.concat(new(paicpu,op_const(A_ALIGN,S_NO,4)));
+             jumpSegment.concat(Taicpu.Op_const(A_ALIGN,S_NO,4));
            }
-           jumpsegment^.concat(new(pai_label,init(table)));
+           jumpSegment.concat(Tai_label.Create(table));
              last:=min_;
            genitem(hp);
              { !!!!!!!
@@ -1045,7 +1045,7 @@ implementation
               cleartempgen;
               secondpass(tbinarynode(hp).right);
               { don't come back to case line }
-              aktfilepos:=exprasmlist^.getlasttaifilepos^;
+              aktfilepos:=exprasmList.getlasttaifilepos^;
               load_all_regvars(exprasmlist);
               emitjmp(C_None,endlabel);
               hp:=tbinarynode(hp).left;
@@ -1069,7 +1069,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2000-12-18 17:45:32  jonas
+  Revision 1.10  2000-12-25 00:07:33  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.9  2000/12/18 17:45:32  jonas
     * int64 case fixes
     * explicit longint type casts for constants used in assembler code
       generation s,ice they can be cardinals too (or even int64's in case of

compiler/i386/n386util.pas

@@ -94,10 +94,10 @@ implementation
                         gettempofsizereference(href,8);
                         p.temp_offset:=href.offset;
                         href.offset:=href.offset+4;
-                        exprasmlist^.concat(new(paicpu,op_reg(A_MOV,S_L,p.location.registerhigh,href)));
+                        exprasmList.concat(Taicpu.Op_reg(A_MOV,S_L,p.location.registerhigh,href));
                         href.offset:=href.offset-4;
 {$else TEMPS_NOT_PUSH}
-                        exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p.location.registerhigh)));
+                        exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.registerhigh));
 {$endif TEMPS_NOT_PUSH}
                         ungetregister32(p.location.registerhigh);
                      end
@@ -111,9 +111,9 @@ implementation
                      ;
                    pushed:=true;
 {$ifdef TEMPS_NOT_PUSH}
-                   exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,p.location.register,href)));
+                   exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,p.location.register,href));
 {$else TEMPS_NOT_PUSH}
-                   exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p.location.register)));
+                   exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.register));
 {$endif TEMPS_NOT_PUSH}
                    ungetregister32(p.location.register);
                 end
@@ -127,10 +127,10 @@ implementation
                      emit_ref_reg(A_LEA,S_L,newreference(p.location.reference),R_EDI);
 {$ifdef TEMPS_NOT_PUSH}
                      gettempofsizereference(href,4);
-                     exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,href)));
+                     exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,href));
                      p.temp_offset:=href.offset;
 {$else TEMPS_NOT_PUSH}
-                     exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_EDI)));
+                     exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI));
 {$endif TEMPS_NOT_PUSH}
                      ungetregister32(R_EDI);
                      pushed:=true;
@@ -158,7 +158,7 @@ implementation
                         gettempofsizereference(href,8);
                         p^.temp_offset:=href.offset;
                         href.offset:=href.offset+4;
-                        exprasmlist^.concat(new(paicpu,op_reg(A_MOV,S_L,p^.location.registerhigh,href)));
+                        exprasmList.concat(Taicpu.Op_reg(A_MOV,S_L,p^.location.registerhigh,href));
                         href.offset:=href.offset-4;
                         ungetregister32(p^.location.registerhigh);
                      end
@@ -168,7 +168,7 @@ implementation
                         p^.temp_offset:=href.offset;
                      end;
                    pushed:=true;
-                   exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,p^.location.register,href)));
+                   exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,p^.location.register,href));
                    ungetregister32(p^.location.register);
                 end
               else if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
@@ -181,7 +181,7 @@ implementation
                      emit_ref_reg(A_LEA,S_L,newreference(p^.location.reference),
                        R_EDI);
                      gettempofsizereference(href,4);
-                     exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,href)));
+                     exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,href));
                      ungetregister32(R_EDI);
                      p^.temp_offset:=href.offset;
                      pushed:=true;
@@ -213,7 +213,7 @@ implementation
          href.offset:=p.temp_offset;
          emit_ref_reg(A_MOV,S_L,href,hregister);
 {$else  TEMPS_NOT_PUSH}
-         exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,hregister)));
+         exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,hregister));
 {$endif TEMPS_NOT_PUSH}
          if (p.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
            begin
@@ -227,7 +227,7 @@ implementation
                    { set correctly for release ! }
                    href.offset:=p.temp_offset;
 {$else  TEMPS_NOT_PUSH}
-                   exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,p.location.registerhigh)));
+                   exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,p.location.registerhigh));
 {$endif TEMPS_NOT_PUSH}
                 end;
            end
@@ -292,9 +292,9 @@ implementation
         if p.nodetype=ordconstn then
          begin
            if target_os.stackalignment=4 then
-             exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_L,tordconstnode(p).value)))
+             exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,tordconstnode(p).value))
            else
-             exprasmlist^.concat(new(paicpu,op_const(A_PUSH,S_W,tordconstnode(p).value)));
+             exprasmList.concat(Taicpu.Op_const(A_PUSH,S_W,tordconstnode(p).value));
          end
         else
          begin
@@ -321,9 +321,9 @@ implementation
                      end;
                  end;
                  if target_os.stackalignment=4 then
-                   exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,hr32)))
+                   exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,hr32))
                  else
-                   exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_W,hr16)));
+                   exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,hr16));
                  ungetregister32(hr32);
                end;
            else
@@ -363,16 +363,16 @@ implementation
                              if inlined then
                                begin
                                   r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                  exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
-                                    p.location.registerlow,r)));
+                                  exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,
+                                    p.location.registerlow,r));
                                   r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
-                                  exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
-                                    p.location.registerhigh,r)));
+                                  exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,
+                                    p.location.registerhigh,r));
                                end
                              else
-                               exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p.location.registerhigh)));
+                               exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.registerhigh));
                              ungetregister32(p.location.registerhigh);
-                               exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p.location.registerlow)));
+                               exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.registerlow));
                              ungetregister32(p.location.registerlow);
                           end
                         else
@@ -381,11 +381,11 @@ implementation
                              if inlined then
                                begin
                                   r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                  exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
-                                    p.location.register,r)));
+                                  exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,
+                                    p.location.register,r));
                                end
                              else
-                               exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p.location.register)));
+                               exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.location.register));
                              ungetregister32(p.location.register);
                           end;
                       end;
@@ -406,10 +406,10 @@ implementation
                         if inlined then
                           begin
                             r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                            exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
+                            exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
                           end
                         else
-                          exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,opsize,hreg)));
+                          exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
                         ungetregister32(reg16toreg32(p.location.register));
                       end;
                    R_AL,R_BL,R_CL,R_DL:
@@ -430,10 +430,10 @@ implementation
                         if inlined then
                           begin
                             r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                            exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
+                            exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
                           end
                         else
-                          exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,opsize,hreg)));
+                          exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
                         ungetregister32(reg8toreg32(p.location.register));
                       end;
                    else internalerror(1899);
@@ -447,8 +447,8 @@ implementation
                  emit_const_reg(A_SUB,S_L,size,R_ESP);
 {$ifdef GDB}
                 if (cs_debuginfo in aktmoduleswitches) and
-                   (exprasmlist^.first=exprasmlist^.last) then
-                  exprasmlist^.concat(new(pai_force_line,init));
+                   (exprasmList.first=exprasmList.last) then
+                  exprasmList.concat(Tai_force_line.Create);
 {$endif GDB}
                 r:=new_reference(R_ESP,0);
                 floatstoreops(pfloatdef(p.resulttype)^.typ,op,opsize);
@@ -458,21 +458,21 @@ implementation
                      r^.base:=procinfo^.framepointer;
                      r^.offset:=para_offset-pushedparasize;
                   end;
-                exprasmlist^.concat(new(paicpu,op_ref(op,opsize,r)));
+                exprasmList.concat(Taicpu.Op_ref(op,opsize,r));
                 dec(fpuvaroffset);
              end;
            LOC_CFPUREGISTER:
              begin
-                exprasmlist^.concat(new(paicpu,op_reg(A_FLD,S_NO,
-                  correct_fpuregister(p.location.register,fpuvaroffset))));
+                exprasmList.concat(Taicpu.Op_reg(A_FLD,S_NO,
+                  correct_fpuregister(p.location.register,fpuvaroffset)));
                 size:=align(pfloatdef(p.resulttype)^.size,alignment);
                 inc(pushedparasize,size);
                 if not inlined then
                  emit_const_reg(A_SUB,S_L,size,R_ESP);
 {$ifdef GDB}
                 if (cs_debuginfo in aktmoduleswitches) and
-                   (exprasmlist^.first=exprasmlist^.last) then
-                  exprasmlist^.concat(new(pai_force_line,init));
+                   (exprasmList.first=exprasmList.last) then
+                  exprasmList.concat(Tai_force_line.Create);
 {$endif GDB}
                 r:=new_reference(R_ESP,0);
                 floatstoreops(pfloatdef(p.resulttype)^.typ,op,opsize);
@@ -482,7 +482,7 @@ implementation
                      r^.base:=procinfo^.framepointer;
                      r^.offset:=para_offset-pushedparasize;
                   end;
-                exprasmlist^.concat(new(paicpu,op_ref(op,opsize,r)));
+                exprasmList.concat(Taicpu.Op_ref(op,opsize,r));
              end;
            LOC_REFERENCE,LOC_MEM:
              begin
@@ -501,14 +501,14 @@ implementation
                                  emit_ref_reg(A_MOV,S_L,
                                    newreference(tempreference),R_EDI);
                                  r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
                                  ungetregister32(R_EDI);
                                  getexplicitregister32(R_EDI);
                                  inc(tempreference.offset,4);
                                  emit_ref_reg(A_MOV,S_L,
                                    newreference(tempreference),R_EDI);
                                  r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
-                                 exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
                                  ungetregister32(R_EDI);
                                end
                              else
@@ -527,7 +527,7 @@ implementation
                                  emit_ref_reg(A_MOV,S_L,
                                    newreference(tempreference),R_EDI);
                                  r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
                                  ungetregister32(R_EDI);
                                end
                              else
@@ -552,7 +552,7 @@ implementation
                                 emit_ref_reg(A_MOV,opsize,
                                   newreference(tempreference),hreg);
                                 r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
+                                exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
                                 ungetregister32(R_EDI);
                               end
                              else
@@ -575,7 +575,7 @@ implementation
                                   emit_ref_reg(A_MOV,S_L,
                                     newreference(tempreference),R_EDI);
                                   r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                  exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                                  exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
                                   ungetregister32(R_EDI);
                                end
                              else
@@ -592,7 +592,7 @@ implementation
                                  emit_ref_reg(A_MOV,S_L,
                                    newreference(tempreference),R_EDI);
                                  r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
                                  ungetregister32(R_EDI);
                               end
                             else
@@ -605,7 +605,7 @@ implementation
                                  emit_ref_reg(A_MOV,S_L,
                                    newreference(tempreference),R_EDI);
                                  r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
                                  ungetregister32(R_EDI);
                               end
                             else
@@ -624,7 +624,7 @@ implementation
                                  emit_ref_reg(A_MOV,S_L,
                                    newreference(tempreference),R_EDI);
                                  r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
                                  ungetregister32(R_EDI);
                               end
                             else
@@ -637,7 +637,7 @@ implementation
                                  emit_ref_reg(A_MOV,S_L,
                                    newreference(tempreference),R_EDI);
                                  r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
                                  ungetregister32(R_EDI);
                               end
                             else
@@ -662,12 +662,12 @@ implementation
                                  emit_ref_reg(A_MOV,opsize,
                                    newreference(tempreference),hreg);
                                  r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                                 exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
+                                 exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
                                  ungetregister32(R_EDI);
                               end
                             else
-                              exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,opsize,
-                                newreference(tempreference))));
+                              exprasmList.concat(Taicpu.Op_ref(A_PUSH,opsize,
+                                newreference(tempreference)));
                         end;
                       end;
                     end;
@@ -682,7 +682,7 @@ implementation
                             emit_ref_reg(A_MOV,S_L,
                               newreference(tempreference),R_EDI);
                             r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                            exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                            exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_EDI,r));
                             ungetregister32(R_EDI);
                          end
                        else
@@ -733,7 +733,7 @@ implementation
                                         concatcopy(tempreference,r^,2,false,false);
                                       end
                                     else
-                                      exprasmlist^.concat(new(paicpu,op_ref(A_PUSH,S_W,newreference(tempreference))));
+                                      exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_W,newreference(tempreference)));
                                   end;
                               end;
                          end
@@ -774,7 +774,7 @@ implementation
                      emit_const_ref(A_MOV,opsize,1,r);
                   end
                 else
-                  exprasmlist^.concat(new(paicpu,op_const(A_PUSH,opsize,1)));
+                  exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,1));
                 emitjmp(C_None,hlabel);
                 emitlab(falselabel);
                 if inlined then
@@ -783,7 +783,7 @@ implementation
                      emit_const_ref(A_MOV,opsize,0,r);
                   end
                 else
-                  exprasmlist^.concat(new(paicpu,op_const(A_PUSH,opsize,0)));
+                  exprasmList.concat(Taicpu.Op_const(A_PUSH,opsize,0));
                 emitlab(hlabel);
              end;
            LOC_FLAGS:
@@ -810,10 +810,10 @@ implementation
                 if inlined then
                   begin
                      r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                     exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
+                     exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,opsize,hreg,r));
                   end
                 else
-                  exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,opsize,hreg)));
+                  exprasmList.concat(Taicpu.Op_reg(A_PUSH,opsize,hreg));
                 if not(R_EAX in unused) then
                   begin
                     emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
@@ -829,20 +829,20 @@ implementation
                   A_SUB,S_L,8,R_ESP);
 {$ifdef GDB}
                 if (cs_debuginfo in aktmoduleswitches) and
-                   (exprasmlist^.first=exprasmlist^.last) then
-                  exprasmlist^.concat(new(pai_force_line,init));
+                   (exprasmList.first=exprasmList.last) then
+                  exprasmList.concat(Tai_force_line.Create);
 {$endif GDB}
                 if inlined then
                   begin
                      r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
-                     exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVQ,S_NO,
-                       p.location.register,r)));
+                     exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,
+                       p.location.register,r));
                   end
                 else
                    begin
                       r:=new_reference(R_ESP,0);
-                      exprasmlist^.concat(new(paicpu,op_reg_ref(
-                        A_MOVQ,S_NO,p.location.register,r)));
+                      exprasmList.concat(Taicpu.Op_reg_ref(
+                        A_MOVQ,S_NO,p.location.register,r));
                    end;
              end;
 {$endif SUPPORT_MMX}
@@ -938,7 +938,7 @@ implementation
         hdef   :  porddef;
         fromdef : pdef;
         opcode : tasmop;
-        opsize   : topsize;  
+        opsize   : topsize;
         oldregisterdef: boolean;
         from_signed,to_signed: boolean;
 
@@ -946,12 +946,12 @@ implementation
          fromdef:=p.resulttype;
          from_signed := is_signed(fromdef);
          to_signed := is_signed(todef);
-         
+
          if not is_64bitint(todef) then
            begin
              oldregisterdef := registerdef;
              registerdef := false;
-             
+
              { get the high dword in a register }
              if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
                hreg := p.location.registerhigh
@@ -1181,10 +1181,10 @@ implementation
             begin
               if not(R_ECX in unused) then
                begin
-                 exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_ECX)));
+                 exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_ECX));
                  popecx:=true;
                end
-                 else exprasmlist^.concat(new(pairegalloc,alloc(R_ECX)));
+                 else exprasmList.concat(Tairegalloc.Alloc(R_ECX));
               if is_reg then
                emit_reg_reg(op,opsize,p.location.register,R_ECX)
               else
@@ -1199,7 +1199,7 @@ implementation
             end;
            { insert bound instruction only }
            getexplicitregister32(R_EDI);
-           exprasmlist^.concat(new(paicpu,op_sym_ofs_reg(A_MOV,S_L,newasmsymbol(rstr),0,R_EDI)));
+           exprasmList.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,newasmsymbol(rstr),0,R_EDI));
            emitcall('FPC_BOUNDCHECK');
            ungetregister32(R_EDI);
            { u32bit needs 2 checks }
@@ -1220,15 +1220,15 @@ implementation
               else
                 begin
                   getexplicitregister32(R_EDI);
-                  exprasmlist^.concat(new(paicpu,op_sym_ofs_reg(A_MOV,S_L,newasmsymbol(rstr),8,R_EDI)));
+                  exprasmList.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,newasmsymbol(rstr),8,R_EDI));
                   emitcall('FPC_BOUNDCHECK');
                   ungetregister32(R_EDI);
                 end;
               emitlab(poslabel);
             end;
            if popecx then
-            exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)))
-           else exprasmlist^.concat(new(pairegalloc,dealloc(R_ECX)));
+            exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,R_ECX))
+           else exprasmList.concat(Tairegalloc.DeAlloc(R_ECX));
          end
         else
          begin
@@ -1261,14 +1261,14 @@ implementation
               emitjmp(C_L,neglabel);
             end;
            { insert bound instruction only }
-           exprasmlist^.concat(new(paicpu,op_reg_ref(A_BOUND,S_L,hreg,newreference(href))));
+           exprasmList.concat(Taicpu.Op_reg_ref(A_BOUND,S_L,hreg,newreference(href)));
            { u32bit needs 2 checks }
            if doublebound then
             begin
               href.offset:=8;
               emitjmp(C_None,poslabel);
               emitlab(neglabel);
-              exprasmlist^.concat(new(paicpu,op_reg_ref(A_BOUND,S_L,hreg,newreference(href))));
+              exprasmList.concat(Taicpu.Op_reg_ref(A_BOUND,S_L,hreg,newreference(href)));
               emitlab(poslabel);
             end;
            if hreg = R_EDI then
@@ -1515,7 +1515,7 @@ implementation
             LOC_REGISTER,LOC_CREGISTER:
               begin
                  pushusedregisters(pushed, $ff xor ($80 shr byte(p.right.location.register)));
-                 exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,p.right.location.register)));
+                 exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,p.right.location.register));
                  ungetregister32(p.right.location.register);
               end;
             LOC_REFERENCE,LOC_MEM:
@@ -1543,7 +1543,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2000-12-11 19:10:19  jonas
+  Revision 1.9  2000-12-25 00:07:33  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.8  2000/12/11 19:10:19  jonas
     * fixed web bug 1144
     + implemented range checking for 64bit types
 

compiler/i386/ra386.pas

@@ -51,7 +51,7 @@ type
     procedure CheckOperandSizes;
     procedure CheckNonCommutativeOpcodes;
     { opcode adding }
-    procedure ConcatInstruction(p : paasmoutput);virtual;
+    procedure ConcatInstruction(p : taasmoutput);virtual;
   end;
 
 
@@ -443,11 +443,11 @@ end;
                               opcode Adding
 *****************************************************************************}
 
-procedure T386Instruction.ConcatInstruction(p : paasmoutput);
+procedure T386Instruction.ConcatInstruction(p : taasmoutput);
 var
   siz  : topsize;
   i    : longint;
-  ai   : paicpu;
+  ai   : taicpu;
 begin
 { Get Opsize }
   if (opsize<>S_NO) or (Ops=0) then
@@ -484,29 +484,29 @@ begin
        message(asmr_w_enter_not_supported_by_linux);
      end;
 
-  ai:=new(paicpu,op_none(opcode,siz));
-  ai^.Ops:=Ops;
+  ai:=taicpu.op_none(opcode,siz);
+  ai.Ops:=Ops;
   for i:=1to Ops do
    begin
      case operands[i]^.opr.typ of
        OPR_CONSTANT :
-         ai^.loadconst(i-1,operands[i]^.opr.val);
+         ai.loadconst(i-1,operands[i]^.opr.val);
        OPR_REGISTER:
-         ai^.loadreg(i-1,operands[i]^.opr.reg);
+         ai.loadreg(i-1,operands[i]^.opr.reg);
        OPR_SYMBOL:
-         ai^.loadsymbol(i-1,operands[i]^.opr.symbol,operands[i]^.opr.symofs);
+         ai.loadsymbol(i-1,operands[i]^.opr.symbol,operands[i]^.opr.symofs);
        OPR_REFERENCE:
-         ai^.loadref(i-1,newreference(operands[i]^.opr.ref));
+         ai.loadref(i-1,newreference(operands[i]^.opr.ref));
      end;
    end;
 
  { Condition ? }
   if condition<>C_None then
-   ai^.SetCondition(condition);
+   ai.SetCondition(condition);
 
  { Concat the opcode or give an error }
   if assigned(ai) then
-   p^.concat(ai)
+   p.concat(ai)
   else
    Message(asmr_e_invalid_opcode_and_operand);
 end;
@@ -514,7 +514,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-11-29 00:30:50  florian
+  Revision 1.4  2000-12-25 00:07:34  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.3  2000/11/29 00:30:50  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/i386/ra386att.pas

@@ -99,7 +99,7 @@ const
   firsttoken : boolean = TRUE;
 var
   _asmsorted     : boolean;
-  curlist        : paasmoutput;
+  curlist        : TAAsmoutput;
   c              : char;
   actasmtoken    : tasmtoken;
   prevasmtoken   : tasmtoken;
@@ -1883,7 +1883,7 @@ Begin
      SetupTables;
      _asmsorted:=TRUE;
    end;
-  curlist:=new(paasmoutput,init);
+  curlist:=TAAsmoutput.Create;
   lastsec:=sec_code;
   { setup label linked list }
   new(LocalLabelList,Init);
@@ -1917,14 +1917,14 @@ Begin
 
       AS_DATA:
         Begin
-          curlist^.Concat(new(pai_section,init(sec_data)));
+          curList.Concat(Tai_section.Create(sec_data));
           lastsec:=sec_data;
           Consume(AS_DATA);
         end;
 
       AS_TEXT:
         Begin
-          curlist^.Concat(new(pai_section,init(sec_code)));
+          curList.Concat(Tai_section.Create(sec_code));
           lastsec:=sec_code;
           Consume(AS_TEXT);
         end;
@@ -2089,7 +2089,7 @@ Begin
   if lastsec<>sec_code then
    begin
      Message(asmr_w_assembler_code_not_returned_to_text);
-     curlist^.Concat(new(pai_section,init(sec_code)));
+     curList.Concat(Tai_section.Create(sec_code));
    end;
   { Return the list in an asmnode }
   assemble:=casmnode.create(curlist);
@@ -2120,7 +2120,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-12-07 17:19:46  jonas
+  Revision 1.6  2000-12-25 00:07:34  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/12/07 17:19:46  jonas
     * new constant handling: from now on, hex constants >$7fffffff are
       parsed as unsigned constants (otherwise, $80000000 got sign extended
       and became $ffffffff80000000), all constants in the longint range

compiler/i386/ra386dir.pas

@@ -63,7 +63,7 @@ interface
          c : char;
          ende : boolean;
          sym : psym;
-         code : paasmoutput;
+         code : TAAsmoutput;
          i,l : longint;
 
        procedure writeasmline;
@@ -75,7 +75,7 @@ interface
             dec(i);
            s[0]:=chr(i);
            if s<>'' then
-            code^.concat(new(pai_direct,init(strpnew(s))));
+            code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
            if assigned(procinfo^.returntype.def) and
               (pos(retstr,upper(s))>0) then
@@ -95,7 +95,7 @@ interface
        else
          retstr:='';
          c:=current_scanner^.asmgetchar;
-         code:=new(paasmoutput,init);
+         code:=TAAsmoutput.Create;
          while not(ende) do
            begin
               { wrong placement
@@ -288,7 +288,11 @@ interface
 end.
 {
   $Log$
-  Revision 1.3  2000-11-29 00:30:50  florian
+  Revision 1.4  2000-12-25 00:07:34  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.3  2000/11/29 00:30:50  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/i386/ra386int.pas

@@ -114,7 +114,7 @@ const
 var
   _asmsorted     : boolean;
   inexpression   : boolean;
-  curlist        : paasmoutput;
+  curlist        : TAAsmoutput;
   c              : char;
   prevasmtoken   : tasmtoken;
   actasmtoken    : tasmtoken;
@@ -1809,7 +1809,7 @@ Begin
      SetupTables;
      _asmsorted:=TRUE;
    end;
-  curlist:=new(paasmoutput,init);
+  curlist:=TAAsmoutput.Create;
   { setup label linked list }
   new(LocalLabelList,Init);
   { start tokenizer }
@@ -1920,7 +1920,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-12-07 17:19:46  jonas
+  Revision 1.6  2000-12-25 00:07:34  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/12/07 17:19:46  jonas
     * new constant handling: from now on, hex constants >$7fffffff are
       parsed as unsigned constants (otherwise, $80000000 got sign extended
       and became $ffffffff80000000), all constants in the longint range

compiler/i386/rropt386.pas

@@ -29,7 +29,7 @@ Interface
 
 Uses aasm;
 
-procedure doRenaming(asml: paasmoutput; first, last: pai);
+procedure doRenaming(asml: TAAsmoutput; first, last: Tai);
 
 Implementation
 
@@ -37,36 +37,36 @@ Uses
   {$ifdef replaceregdebug}cutils,{$endif}
   verbose,globals,cpubase,cpuasm,daopt386,csopt386,tgcpu;
 
-function canBeFirstSwitch(p: paicpu; reg: tregister): boolean;
+function canBeFirstSwitch(p: Taicpu; reg: tregister): boolean;
 { checks whether an operation on reg can be switched to another reg without an }
 { additional mov, e.g. "addl $4,%reg1" can be changed to "leal 4(%reg1),%reg2" }
 begin
   canBeFirstSwitch := false;
-  case p^.opcode of
+  case p.opcode of
     A_MOV,A_MOVZX,A_MOVSX,A_LEA:
       canBeFirstSwitch :=
-        (p^.oper[1].typ = top_reg) and
-        (reg32(p^.oper[1].reg) = reg);
+        (p.oper[1].typ = top_reg) and
+        (reg32(p.oper[1].reg) = reg);
     A_IMUL:
       canBeFirstSwitch :=
-        (p^.ops >= 2) and
-        (reg32(p^.oper[p^.ops-1].reg) = reg) and
-        (p^.oper[0].typ <> top_ref);
+        (p.ops >= 2) and
+        (reg32(p.oper[p.ops-1].reg) = reg) and
+        (p.oper[0].typ <> top_ref);
     A_INC,A_DEC,A_SUB,A_ADD:
       canBeFirstSwitch :=
-        (p^.oper[1].typ = top_reg) and
-        (p^.opsize = S_L) and
-        (reg32(p^.oper[1].reg) = reg) and
-        (p^.oper[0].typ <> top_ref) and
-        ((p^.opcode <> A_SUB) or
-         (p^.oper[0].typ = top_const));
+        (p.oper[1].typ = top_reg) and
+        (p.opsize = S_L) and
+        (reg32(p.oper[1].reg) = reg) and
+        (p.oper[0].typ <> top_ref) and
+        ((p.opcode <> A_SUB) or
+         (p.oper[0].typ = top_const));
     A_SHL:
       canBeFirstSwitch :=
-        (p^.opsize = S_L) and
-        (p^.oper[1].typ = top_reg) and
-        (p^.oper[1].reg = reg) and
-        (p^.oper[0].typ = top_const) and
-        (p^.oper[0].val in [1,2,3]);
+        (p.opsize = S_L) and
+        (p.oper[1].typ = top_reg) and
+        (p.oper[1].reg = reg) and
+        (p.oper[0].typ = top_const) and
+        (p.oper[0].val in [1,2,3]);
   end;
 end;
 
@@ -100,88 +100,88 @@ begin
   end;
 end;
 
-procedure doSwitchReg(hp: paicpu; reg1,reg2: tregister);
+procedure doSwitchReg(hp: Taicpu; reg1,reg2: tregister);
 var
   opCount: longint;
 begin
-  for opCount := 0 to hp^.ops-1 do
-    switchOp(hp^.oper[opCount],reg1,reg2);
+  for opCount := 0 to hp.ops-1 do
+    switchOp(hp.oper[opCount],reg1,reg2);
 end;
 
 
-procedure doFirstSwitch(p: paicpu; reg1, reg2: tregister);
+procedure doFirstSwitch(p: Taicpu; reg1, reg2: tregister);
 var
   tmpRef: treference;
 begin
-  case p^.opcode of
+  case p.opcode of
     A_MOV,A_MOVZX,A_MOVSX,A_LEA:
        begin
-         changeOp(p^.oper[1],reg1,reg2);
-         changeOp(p^.oper[0],reg2,reg1);
+         changeOp(p.oper[1],reg1,reg2);
+         changeOp(p.oper[0],reg2,reg1);
        end;
     A_IMUL:
       begin
-        p^.ops := 3;
-        p^.loadreg(2,p^.oper[1].reg);
-        changeOp(p^.oper[2],reg1,reg2);
+        p.ops := 3;
+        p.loadreg(2,p.oper[1].reg);
+        changeOp(p.oper[2],reg1,reg2);
       end;
     A_INC,A_DEC:
       begin
         reset_reference(tmpref);
         tmpref.base := reg1;
-        case p^.opcode of
+        case p.opcode of
           A_INC:
             tmpref.offset := 1;
           A_DEC:
             tmpref.offset := -1;
         end;
-        p^.ops := 2;
-        p^.opcode := A_LEA;
-        p^.loadreg(1,reg2);
-        p^.loadref(0,newreference(tmpref));
+        p.ops := 2;
+        p.opcode := A_LEA;
+        p.loadreg(1,reg2);
+        p.loadref(0,newreference(tmpref));
       end;
     A_SUB,A_ADD:
       begin
         reset_reference(tmpref);
         tmpref.base := reg1;
-        case p^.oper[0].typ of
+        case p.oper[0].typ of
           top_const:
             begin
-              tmpref.offset := p^.oper[0].val;
-              if p^.opcode = A_SUB then
+              tmpref.offset := p.oper[0].val;
+              if p.opcode = A_SUB then
                 tmpref.offset := - tmpRef.offset;
             end;
           top_symbol:
-            tmpref.symbol := p^.oper[0].sym;
+            tmpref.symbol := p.oper[0].sym;
           top_reg:
             begin
-              tmpref.index := p^.oper[0].reg;
+              tmpref.index := p.oper[0].reg;
               tmpref.scalefactor := 1;
             end;
           else internalerror(200010031);
         end;
-        p^.opcode := A_LEA;
-        p^.loadref(0,newreference(tmpref));
-        p^.loadreg(1,reg2);
+        p.opcode := A_LEA;
+        p.loadref(0,newreference(tmpref));
+        p.loadreg(1,reg2);
       end;
     A_SHL:
       begin
         reset_reference(tmpref);
         tmpref.index := reg1;
-        tmpref.scalefactor := 1 shl p^.oper[0].val;
-        p^.opcode := A_LEA;
-        p^.loadref(0,newreference(tmpref));
-        p^.loadreg(1,reg2);
+        tmpref.scalefactor := 1 shl p.oper[0].val;
+        p.opcode := A_LEA;
+        p.loadref(0,newreference(tmpref));
+        p.loadreg(1,reg2);
       end;
     else internalerror(200010032);
   end;
 end;
 
 
-function switchRegs(asml: paasmoutput; reg1, reg2: tregister; start: pai): Boolean;
+function switchRegs(asml: TAAsmoutput; reg1, reg2: tregister; start: Tai): Boolean;
 { change movl  %reg1,%reg2 ... bla ... to ... bla with reg1 and reg2 switched }
 var
-  endP, hp: pai;
+  endP, hp: Tai;
   switchDone, switchLast, tmpResult, sequenceEnd, reg1Modified, reg2Modified: boolean;
   reg1StillUsed, reg2StillUsed, isInstruction: boolean;
 begin
@@ -196,15 +196,15 @@ begin
       tmpResult :=
         getNextInstruction(endP,endP);
       If tmpResult and
-         not ppaiprop(endP^.optinfo)^.canBeRemoved then
+         not pTaiprop(endp.optinfo)^.canBeRemoved then
         begin
           { if the newReg gets stored back to the oldReg, we can change }
           { "mov %oldReg,%newReg; <operations on %newReg>; mov %newReg, }
           { %oldReg" to "<operations on %oldReg>"                       }
           switchLast := storeBack(endP,reg1,reg2);
-          reg1StillUsed := reg1 in ppaiprop(endP^.optinfo)^.usedregs;
-          reg2StillUsed := reg2 in ppaiprop(endP^.optinfo)^.usedregs;
-          isInstruction := endP^.typ = ait_instruction;
+          reg1StillUsed := reg1 in pTaiprop(endp.optinfo)^.usedregs;
+          reg2StillUsed := reg2 in pTaiprop(endp.optinfo)^.usedregs;
+          isInstruction := endp.typ = ait_instruction;
           sequenceEnd :=
             switchLast or
             { if both registers are released right before an instruction }
@@ -212,13 +212,13 @@ begin
             (not reg1StillUsed and not reg2StillUsed) or
             { no support for (i)div, mul and imul with hardcoded operands }
             (((not isInstruction) or
-              noHardCodedRegs(paicpu(endP),reg1,reg2)) and
+              noHardCodedRegs(Taicpu(endP),reg1,reg2)) and
              (not reg1StillUsed or
               (isInstruction and findRegDealloc(reg1,endP) and
-               regLoadedWithNewValue(reg1,false,paicpu(endP)))) and
+               regLoadedWithNewValue(reg1,false,Taicpu(endP)))) and
              (not reg2StillUsed or
               (isInstruction and findRegDealloc(reg2,endP) and
-               regLoadedWithNewValue(reg2,false,paicpu(endP)))));
+               regLoadedWithNewValue(reg2,false,Taicpu(endP)))));
 
           { we can't switch reg1 and reg2 in something like }
           {   movl  %reg1,%reg2                             }
@@ -234,7 +234,7 @@ begin
           if not reg1Modified then
             begin
               reg1Modified := regModifiedByInstruction(reg1,endP);
-              if reg1Modified and not canBeFirstSwitch(paicpu(endP),reg1) then
+              if reg1Modified and not canBeFirstSwitch(Taicpu(endP),reg1) then
                 begin
                   tmpResult := false;
                   break;
@@ -247,10 +247,10 @@ begin
             break;
 
           tmpResult :=
-            (endP^.typ <> ait_label) and
+            (endp.typ <> ait_label) and
             ((not isInstruction) or
-             (NoHardCodedRegs(paicpu(endP),reg1,reg2) and
-               RegSizesOk(reg1,reg2,paicpu(endP))));
+             (NoHardCodedRegs(Taicpu(endP),reg1,reg2) and
+               RegSizesOk(reg1,reg2,Taicpu(endP))));
         end;
     end;
 
@@ -262,8 +262,8 @@ begin
       getNextInstruction(start,hp);
       while hp <> endP do
         begin
-          if (not ppaiprop(hp^.optinfo)^.canberemoved) and
-             (hp^.typ = ait_instruction) then
+          if (not pTaiprop(hp.optinfo)^.canberemoved) and
+             (hp.typ = ait_instruction) then
             begin
               switchDone := false;
               if not reg1Modified then
@@ -271,55 +271,55 @@ begin
                   reg1Modified := regModifiedByInstruction(reg1,hp);
                   if reg1Modified then
                     begin
-                      doFirstSwitch(paicpu(hp),reg1,reg2);
+                      doFirstSwitch(Taicpu(hp),reg1,reg2);
                       switchDone := true;
                     end;
                 end;
               if not switchDone then
                 if reg1Modified then
-                  doSwitchReg(paicpu(hp),reg1,reg2)
+                  doSwitchReg(Taicpu(hp),reg1,reg2)
                 else
-                  doReplaceReg(paicpu(hp),reg2,reg1);
+                  doReplaceReg(Taicpu(hp),reg2,reg1);
             end;
           getNextInstruction(hp,hp);
         end;
       if switchLast then
-        doSwitchReg(paicpu(hp),reg1,reg2)
+        doSwitchReg(Taicpu(hp),reg1,reg2)
       else getLastInstruction(hp,hp);
       allocRegBetween(asmL,reg1,start,hp);
       allocRegBetween(asmL,reg2,start,hp);
     end;
 end;
 
-procedure doRenaming(asml: paasmoutput; first, last: pai);
+procedure doRenaming(asml: TAAsmoutput; first, last: Tai);
 var
-  p: pai;
+  p: Tai;
 begin
   p := First;
   SkipHead(p);
   while p <> last do
     begin
-      case p^.typ of
+      case p.typ of
         ait_instruction:
           begin
-            case paicpu(p)^.opcode of
+            case Taicpu(p).opcode of
               A_MOV:
                 begin
-                  if not(ppaiprop(p^.optinfo)^.canBeRemoved) and
-                     (paicpu(p)^.oper[0].typ = top_reg) and
-                     (paicpu(p)^.oper[1].typ = top_reg) and
-                     (paicpu(p)^.opsize = S_L) and
-                     (paicpu(p)^.oper[0].reg in (usableregs+[R_EDI])) and
-                     (paicpu(p)^.oper[1].reg in (usableregs+[R_EDI])) then
-                    if switchRegs(asml,paicpu(p)^.oper[0].reg,
-                         paicpu(p)^.oper[1].reg,p) then
+                  if not(pTaiprop(p.optinfo)^.canBeRemoved) and
+                     (Taicpu(p).oper[0].typ = top_reg) and
+                     (Taicpu(p).oper[1].typ = top_reg) and
+                     (Taicpu(p).opsize = S_L) and
+                     (Taicpu(p).oper[0].reg in (usableregs+[R_EDI])) and
+                     (Taicpu(p).oper[1].reg in (usableregs+[R_EDI])) then
+                    if switchRegs(asml,Taicpu(p).oper[0].reg,
+                         Taicpu(p).oper[1].reg,p) then
                       begin
 {                        getnextinstruction(p,hp);
                         asmL^.remove(p);
                         dispose(p,done);
                         p := hp;
                         continue }
-                        ppaiprop(p^.optinfo)^.canBeRemoved := true;
+                        pTaiprop(p.optinfo)^.canBeRemoved := true;
                       end;
                 end;
             end;
@@ -334,7 +334,11 @@ End.
 
 {
   $Log$
-  Revision 1.4  2000-12-05 09:32:47  jonas
+  Revision 1.5  2000-12-25 00:07:34  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/12/05 09:32:47  jonas
     * fixed bug where "shl $1,%reg" was changed to "leal (%reg),%reg2"
       instread of to "leal (,%reg,2),%reg2"
 

compiler/i386/tgcpu.pas

@@ -161,7 +161,7 @@ implementation
                     if not(r in unused) then
                      begin
                         { then save it }
-                        exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,r)));
+                        exprasmlist.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
 
                         { here was a big problem  !!!!!}
                         { you cannot do that for a register that is
@@ -187,13 +187,11 @@ implementation
               { if the mmx register is in use, save it }
               if not(r in unused) then
                 begin
-                   exprasmlist^.concat(new(paicpu,op_const_reg(
-                     A_SUB,S_L,8,R_ESP)));
+                   exprasmList.concat(Taicpu.Op_const_reg(A_SUB,S_L,8,R_ESP));
                    new(hr);
                    reset_reference(hr^);
                    hr^.base:=R_ESP;
-                   exprasmlist^.concat(new(paicpu,op_reg_ref(
-                     A_MOVQ,S_NO,r,hr)));
+                   exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,r,hr));
                    if not(is_reg_var[r]) then
                      begin
                        unused:=unused+[r];
@@ -210,9 +208,9 @@ implementation
 {$endif TEMPREGDEBUG}
       end;
 
-    
+
     procedure saveregvars(b: byte);
-    
+
       var
          r : tregister;
 
@@ -246,7 +244,7 @@ implementation
                         { then save it }
                         gettempofsizereference(4,hr);
                         saved[r]:=hr.offset;
-                        exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,r,newreference(hr))));
+                        exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,r,newreference(hr)));
                         { here was a big problem  !!!!!}
                         { you cannot do that for a register that is
                         globally assigned to a var
@@ -271,8 +269,7 @@ implementation
               if not(r in unused) then
                 begin
                    gettempofsizereference(8,hr);
-                   exprasmlist^.concat(new(paicpu,op_reg_ref(
-                     A_MOVQ,S_NO,r,newreference(hr))));
+                   exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,r,newreference(hr)));
                    if not(is_reg_var[r]) then
                      begin
                        unused:=unused+[r];
@@ -306,10 +303,10 @@ implementation
                    new(hr);
                    reset_reference(hr^);
                    hr^.base:=R_ESP;
-                   exprasmlist^.concat(new(paicpu,op_ref_reg(
-                     A_MOVQ,S_NO,hr,r)));
-                   exprasmlist^.concat(new(paicpu,op_const_reg(
-                     A_ADD,S_L,8,R_ESP)));
+                   exprasmList.concat(Taicpu.Op_ref_reg(
+                     A_MOVQ,S_NO,hr,r));
+                   exprasmList.concat(Taicpu.Op_const_reg(
+                     A_ADD,S_L,8,R_ESP));
                    unused:=unused-[r];
 {$ifdef TEMPREGDEBUG}
                    dec(usableregmmx);
@@ -320,7 +317,7 @@ implementation
          for r:=R_EBX downto R_EAX do
            if pushed[r] then
              begin
-                exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,r)));
+                exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,r));
 {$ifdef TEMPREGDEBUG}
                 if not (r in unused) then
                   { internalerror(10)
@@ -352,8 +349,8 @@ implementation
                    reset_reference(hr);
                    hr.base:=frame_pointer;
                    hr.offset:=saved[r];
-                   exprasmlist^.concat(new(paicpu,op_ref_reg(
-                     A_MOVQ,S_NO,newreference(hr),r)));
+                   exprasmList.concat(Taicpu.Op_ref_reg(
+                     A_MOVQ,S_NO,newreference(hr),r));
                    unused:=unused-[r];
 {$ifdef TEMPREGDEBUG}
                    dec(usableregmmx);
@@ -368,7 +365,7 @@ implementation
                 reset_reference(hr);
                 hr.base:=frame_pointer;
                 hr.offset:=saved[r];
-                exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,S_L,newreference(hr),r)));
+                exprasmList.concat(Taicpu.Op_ref_reg(A_MOV,S_L,newreference(hr),r));
 {$ifdef TEMPREGDEBUG}
                 if not (r in unused) then
                   internalerror(10)
@@ -405,7 +402,7 @@ implementation
          if (r = R_EDI) or
             ((not assigned(procinfo^._class)) and (r = R_ESI)) then
            begin
-             exprasmlist^.concat(new(pairegalloc,dealloc(r)));
+             exprasmList.concat(Tairegalloc.DeAlloc(r));
              exit;
            end;
          if cs_regalloc in aktglobalswitches then
@@ -439,7 +436,7 @@ implementation
               reg_releaser[r]:=curptree^;
 {$endif TEMPREGDEBUG}
            end;
-         exprasmlist^.concat(new(pairegalloc,dealloc(r)));
+         exprasmList.concat(Tairegalloc.DeAlloc(r));
 {$ifdef TEMPREGDEBUG}
         testregisters32;
 {$endif TEMPREGDEBUG}
@@ -554,7 +551,7 @@ implementation
 {$ifdef TEMPREGDEBUG}
               reg_user[R_EAX]:=curptree^;
 {$endif TEMPREGDEBUG}
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
            end
          else if R_EDX in unused then
            begin
@@ -564,7 +561,7 @@ implementation
 {$ifdef TEMPREGDEBUG}
               reg_user[R_EDX]:=curptree^;
 {$endif TEMPREGDEBUG}
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EDX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EDX));
            end
          else if R_EBX in unused then
            begin
@@ -574,7 +571,7 @@ implementation
 {$ifdef TEMPREGDEBUG}
               reg_user[R_EBX]:=curptree^;
 {$endif TEMPREGDEBUG}
-              exprasmlist^.concat(new(pairegalloc,alloc(R_EBX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_EBX));
            end
          else if R_ECX in unused then
            begin
@@ -584,7 +581,7 @@ implementation
 {$ifdef TEMPREGDEBUG}
               reg_user[R_ECX]:=curptree^;
 {$endif TEMPREGDEBUG}
-              exprasmlist^.concat(new(pairegalloc,alloc(R_ECX)));
+              exprasmList.concat(Tairegalloc.Alloc(R_ECX));
            end
          else internalerror(10);
 {$ifdef TEMPREGDEBUG}
@@ -597,7 +594,7 @@ implementation
       begin
          if r in [R_ESI,R_EDI] then
            begin
-             exprasmlist^.concat(new(pairegalloc,alloc(r)));
+             exprasmList.concat(Tairegalloc.Alloc(r));
              getexplicitregister32 := r;
              exit;
            end;
@@ -611,7 +608,7 @@ implementation
 {$endif TEMPREGDEBUG}
               unused:=unused-[r];
               usedinproc:=usedinproc or ($80 shr byte(r));
-              exprasmlist^.concat(new(pairegalloc,alloc(r)));
+              exprasmList.concat(Tairegalloc.Alloc(r));
               getexplicitregister32:=r;
 {$ifdef TEMPREGDEBUG}
          testregisters32;
@@ -677,7 +674,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2000-12-05 11:44:34  jonas
+  Revision 1.3  2000-12-25 00:07:34  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.2  2000/12/05 11:44:34  jonas
     + new integer regvar handling, should be much more efficient
 
   Revision 1.1  2000/11/29 00:30:51  florian

compiler/import.pas

@@ -26,37 +26,34 @@ unit import;
 interface
 
 uses
-  cutils,cobjects;
+  cutils,cclasses;
 
 type
-   pimported_item = ^timported_item;
-   timported_item = object(tlinkedlist_item)
+   timported_item = class(tlinkedlistitem)
       ordnr  : word;
       name,
       func   : pstring;
       lab    : pointer; { should be plabel, but this gaves problems with circular units }
       is_var : boolean;
-      constructor init(const n,s : string;o : word);
-      constructor init_var(const n,s : string);
-      destructor done;virtual;
+      constructor Create(const n,s : string;o : word);
+      constructor Create_var(const n,s : string);
+      destructor Destroy;override;
    end;
 
-   pimportlist = ^timportlist;
-   timportlist = object(tlinkedlist_item)
+   timportlist = class(tlinkedlistitem)
       dllname : pstring;
-      imported_items : plinkedlist;
-      constructor init(const n : string);
-      destructor done;virtual;
+      imported_items : tlinkedlist;
+      constructor Create(const n : string);
+      destructor Destroy;Override;
    end;
 
-   pimportlib=^timportlib;
-   timportlib=object
+   timportlib=class
    private
       notsupmsg : boolean;
       procedure NotSupported;
    public
-      constructor Init;
-      destructor Done;
+      constructor Create;
+      destructor Destroy;override;
       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;
@@ -65,7 +62,7 @@ type
    end;
 
 var
-  importlib : pimportlib;
+  importlib : timportlib;
 
 procedure InitImport;
 procedure DoneImport;
@@ -115,9 +112,9 @@ uses
                            Timported_item
 ****************************************************************************}
 
-constructor timported_item.init(const n,s : string;o : word);
+constructor timported_item.Create(const n,s : string;o : word);
 begin
-  inherited init;
+  inherited Create;
   func:=stringdup(n);
   name:=stringdup(s);
   ordnr:=o;
@@ -126,9 +123,9 @@ begin
 end;
 
 
-constructor timported_item.init_var(const n,s : string);
+constructor timported_item.create_var(const n,s : string);
 begin
-  inherited init;
+  inherited Create;
   func:=stringdup(n);
   name:=stringdup(s);
   ordnr:=0;
@@ -137,11 +134,11 @@ begin
 end;
 
 
-destructor timported_item.done;
+destructor timported_item.destroy;
 begin
   stringdispose(name);
   stringdispose(func);
-  inherited done;
+  inherited destroy;
 end;
 
 
@@ -149,17 +146,17 @@ end;
                               TImportlist
 ****************************************************************************}
 
-constructor timportlist.init(const n : string);
+constructor timportlist.Create(const n : string);
 begin
-  inherited init;
+  inherited Create;
   dllname:=stringdup(n);
-  imported_items:=new(plinkedlist,init);
+  imported_items:=Tlinkedlist.Create;
 end;
 
 
-destructor timportlist.done;
+destructor timportlist.destroy;
 begin
-  dispose(imported_items,done);
+  imported_items.free;
   stringdispose(dllname);
 end;
 
@@ -168,13 +165,13 @@ end;
                               TImportLib
 ****************************************************************************}
 
-constructor timportlib.Init;
+constructor timportlib.Create;
 begin
   notsupmsg:=false;
 end;
 
 
-destructor timportlib.Done;
+destructor timportlib.Destroy;
 begin
 end;
 
@@ -223,7 +220,7 @@ end;
 procedure DoneImport;
 begin
   if assigned(importlib) then
-    dispose(importlib,done);
+    importlib.free;
 end;
 
 
@@ -232,30 +229,30 @@ begin
   case target_info.target of
 {$ifdef i386}
     target_i386_Linux :
-      importlib:=new(pimportliblinux,Init);
+      importlib:=Timportliblinux.Create;
     target_i386_freebsd:
-      importlib:=new(pimportlibfreebsd,Init);
+      importlib:=Timportlibfreebsd.Create;
          target_i386_Win32 :
-      importlib:=new(pimportlibwin32,Init);
+      importlib:=Timportlibwin32.Create;
     target_i386_OS2 :
-      importlib:=new(pimportlibos2,Init);
+      importlib:=Timportlibos2.Create;
     target_i386_Netware :
-      importlib:=new(pimportlibnetware,Init);
+      importlib:=Timportlibnetware.Create;
 {$endif i386}
 {$ifdef m68k}
     target_m68k_Linux :
-      importlib:=new(pimportliblinux,Init);
+      importlib:=Timportliblinux.Create;
 {$endif m68k}
 {$ifdef alpha}
     target_alpha_Linux :
-      importlib:=new(pimportliblinux,Init);
+      importlib:=Timportliblinux.Create;
 {$endif alpha}
 {$ifdef powerpc}
     target_alpha_Linux :
-      importlib:=new(pimportliblinux,Init);
+      importlib:=Timportliblinux.Create;
 {$endif powerpc}
     else
-      importlib:=new(pimportlib,Init);
+      importlib:=Timportlib.Create;
   end;
 end;
 
@@ -263,7 +260,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  2000-09-24 15:06:18  peter
+  Revision 1.7  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.6  2000/09/24 15:06:18  peter
     * use defines.inc
 
   Revision 1.5  2000/09/16 12:22:52  peter

compiler/link.pas

@@ -32,7 +32,8 @@ unit link;
 
 interface
 uses
-  cobjects,fmodule;
+  cobjects,cclasses,
+  fmodule;
 
 Type
     TLinkerInfo=record
@@ -43,17 +44,16 @@ Type
       DynamicLinker : string[100];
     end;
 
-    PLinker=^TLinker;
-    TLinker = Object
+    TLinker = class
     public
        Info            : TLinkerInfo;
        ObjectFiles,
        SharedLibFiles,
-       StaticLibFiles  : TStringContainer;
+       StaticLibFiles  : TStringList;
      { Methods }
-       Constructor Init;
-       Destructor Done;
-       procedure AddModuleFiles(hp:pmodule);
+       Constructor Create;
+       Destructor Destroy;override;
+       procedure AddModuleFiles(hp:tmodule);
        function  FindObjectFile(s : string;const unitpath:string) : string;
        function  FindLibraryFile(s:string;const ext:string;var found : boolean) : string;
        Procedure AddObject(const S,unitpath : String);
@@ -69,7 +69,7 @@ Type
      end;
 
 Var
-  Linker : PLinker;
+  Linker : TLinker;
 
 procedure InitLinker;
 procedure DoneLinker;
@@ -129,11 +129,11 @@ uses
                                    TLINKER
 *****************************************************************************}
 
-Constructor TLinker.Init;
+Constructor TLinker.Create;
 begin
-  ObjectFiles.Init_no_double;
-  SharedLibFiles.Init_no_double;
-  StaticLibFiles.Init_no_double;
+  ObjectFiles:=TStringList.Create_no_double;
+  SharedLibFiles:=TStringList.Create_no_double;
+  StaticLibFiles:=TStringList.Create_no_double;
 { set generic defaults }
   FillChar(Info,sizeof(Info),0);
   Info.ResName:='link.res';
@@ -150,11 +150,11 @@ begin
 end;
 
 
-Destructor TLinker.Done;
+Destructor TLinker.Destroy;
 begin
-  ObjectFiles.Done;
-  SharedLibFiles.Done;
-  StaticLibFiles.Done;
+  ObjectFiles.Free;
+  SharedLibFiles.Free;
+  StaticLibFiles.Free;
 end;
 
 
@@ -163,11 +163,11 @@ begin
 end;
 
 
-procedure TLinker.AddModuleFiles(hp:pmodule);
+procedure TLinker.AddModuleFiles(hp:tmodule);
 var
   mask : longint;
 begin
-  with hp^ do
+  with hp do
    begin
    { link unit files }
      if (flags and uf_no_link)=0 then
@@ -297,7 +297,7 @@ begin
   if (not found) then
    findobjectfile:=UnitSearchPath.FindFile(s,found)+s;
   if (not found) then
-   findobjectfile:=current_module^.localobjectsearchpath.FindFile(s,found)+s;
+   findobjectfile:=current_module.localobjectsearchpath.FindFile(s,found)+s;
   if (not found) then
    findobjectfile:=objectsearchpath.FindFile(s,found)+s;
   if (not found) then
@@ -330,7 +330,7 @@ begin
   found:=false;
   findlibraryfile:=FindFile(s,'.'+DirSep,found)+s;
   if (not found) then
-   findlibraryfile:=current_module^.locallibrarysearchpath.FindFile(s,found)+s;
+   findlibraryfile:=current_module.locallibrarysearchpath.FindFile(s,found)+s;
   if (not found) then
    findlibraryfile:=librarysearchpath.FindFile(s,found)+s;
   if (not found) then
@@ -408,9 +408,9 @@ begin
      if showinfo then
        begin
          if DLLsource then
-           AsmRes.AddLinkCommand(Command,Para,current_module^.sharedlibfilename^)
+           AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename^)
          else
-           AsmRes.AddLinkCommand(Command,Para,current_module^.exefilename^);
+           AsmRes.AddLinkCommand(Command,Para,current_module.exefilename^);
        end
      else
       AsmRes.AddLinkCommand(Command,Para,'');
@@ -441,24 +441,24 @@ var
 begin
   MakeStaticLibrary:=false;
 { remove the library, to be sure that it is rewritten }
-  RemoveFile(current_module^.staticlibfilename^);
+  RemoveFile(current_module.staticlibfilename^);
 { Call AR }
-  smartpath:=current_module^.outputpath^+FixPath(FixFileName(current_module^.modulename^)+target_info.smartext,false);
+  smartpath:=current_module.outputpath^+FixPath(FixFileName(current_module.modulename^)+target_info.smartext,false);
   SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
-  Replace(cmdstr,'$LIB',current_module^.staticlibfilename^);
-  Replace(cmdstr,'$FILES',FixFileName(smartpath+current_module^.asmprefix^+'*'+target_info.objext));
+  Replace(cmdstr,'$LIB',current_module.staticlibfilename^);
+  Replace(cmdstr,'$FILES',FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext));
   success:=DoExec(FindUtil(binstr),cmdstr,false,true);
 { Clean up }
   if not(cs_asm_leave in aktglobalswitches) then
    if not(cs_link_extern in aktglobalswitches) then
     begin
       while not SmartLinkOFiles.Empty do
-       RemoveFile(SmartLinkOFiles.Get);
+       RemoveFile(SmartLinkOFiles.GetFirst);
       RemoveDir(smartpath);
     end
    else
     begin
-      AsmRes.AddDeleteCommand(FixFileName(smartpath+current_module^.asmprefix^+'*'+target_info.objext));
+      AsmRes.AddDeleteCommand(FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext));
       AsmRes.Add('rmdir '+smartpath);
     end;
   MakeStaticLibrary:=success;
@@ -475,57 +475,57 @@ begin
 {$ifdef i386}
   {$ifndef NOTARGETLINUX}
     target_i386_linux :
-      linker:=new(plinkerlinux,Init);
+      linker:=Tlinkerlinux.Create;
   {$endif}
   {$ifndef NOTARGETFreeBSD}
     target_i386_FreeBSD :
-      linker:=new(plinkerFreeBSD,Init);
+      linker:=TlinkerFreeBSD.Create;
   {$endif}
   {$ifndef NOTARGETWIN32}
     target_i386_Win32 :
-      linker:=new(plinkerwin32,Init);
+      linker:=Tlinkerwin32.Create;
   {$endif}
   {$ifndef NOTARGETNETWARE}
     target_i386_Netware :
-      linker:=new(plinkernetware,Init);
+      linker:=Tlinkernetware.Create;
   {$endif}
   {$ifndef NOTARGETGO32V1}
     target_i386_Go32v1 :
-      linker:=new(plinkergo32v1,Init);
+      linker:=TLinkergo32v1.Create;
   {$endif}
   {$ifndef NOTARGETGO32V2}
     target_i386_Go32v2 :
-      linker:=new(plinkergo32v2,Init);
+      linker:=TLinkergo32v2.Create;
   {$endif}
   {$ifndef NOTARGETOS2}
     target_i386_os2 :
-      linker:=new(plinkeros2,Init);
+      linker:=TLinkeros2.Create;
   {$endif}
 {$endif i386}
 {$ifdef m68k}
   {$ifndef NOTARGETPALMOS}
     target_m68k_palmos:
-      linker:=new(plinker,Init);
+      linker:=Tlinker.Create;
   {$endif}
   {$ifndef NOTARGETLINUX}
     target_m68k_linux :
-      linker:=new(plinkerlinux,Init);
+      linker:=Tlinkerlinux.Create;
   {$endif}
 {$endif m68k}
 {$ifdef alpha}
   {$ifndef NOTARGETLINUX}
     target_alpha_linux :
-      linker:=new(plinkerlinux,Init);
+      linker:=Tlinkerlinux.Create;
   {$endif}
 {$endif alpha}
 {$ifdef powerpc}
   {$ifndef NOTARGETLINUX}
     target_powerpc_linux :
-      linker:=new(plinkerlinux,Init);
+      linker:=Tlinkerlinux.Create;
   {$endif}
 {$endif powerpc}
     else
-      linker:=new(plinker,Init);
+      linker:=Tlinker.Create;
   end;
 end;
 
@@ -533,14 +533,18 @@ end;
 procedure DoneLinker;
 begin
   if assigned(linker) then
-   dispose(linker,done);
+   Linker.Free;
 end;
 
 
 end.
 {
   $Log$
-  Revision 1.10  2000-11-29 00:30:31  florian
+  Revision 1.11  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.10  2000/11/29 00:30:31  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/nbas.pas

@@ -42,8 +42,8 @@ interface
        end;
 
        tasmnode = class(tnode)
-          p_asm : paasmoutput;
-          constructor create(p : paasmoutput);virtual;
+          p_asm : taasmoutput;
+          constructor create(p : taasmoutput);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -72,8 +72,8 @@ interface
 implementation
 
     uses
-      globtype,systems,
-      cutils,verbose,globals,
+      cutils,cclasses,
+      verbose,globals,globtype,systems,
       symtype,symdef,types,
       pass_1,
       nflw,tgcpu,hcodegen
@@ -295,7 +295,7 @@ implementation
                              TASMNODE
 *****************************************************************************}
 
-    constructor tasmnode.create(p : paasmoutput);
+    constructor tasmnode.create(p : taasmoutput);
 
       begin
          inherited create(asmn);
@@ -305,7 +305,7 @@ implementation
     destructor tasmnode.destroy;
       begin
         if assigned(p_asm) then
-         dispose(p_asm,done);
+         p_asm.free;
         inherited destroy;
       end;
 
@@ -316,8 +316,8 @@ implementation
         n := tasmnode(inherited getcopy);
         if assigned(p_asm) then
           begin
-            new(n.p_asm,init);
-            n.p_asm^.concatlistcopy(p_asm);
+            n.p_asm:=taasmoutput.create;
+            n.p_asm.concatlistcopy(p_asm);
           end
         else n.p_asm := nil;
         getcopy := n;
@@ -338,7 +338,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-11-29 00:30:31  florian
+  Revision 1.6  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/11/29 00:30:31  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/ncal.pas

@@ -70,8 +70,8 @@ interface
           procedure gen_high_tree(openstring:boolean);
           { tcallparanode doesn't use pass_1 }
           { tcallnode takes care of this     }
-          procedure firstcallparan(defcoll : pparaitem;do_count : boolean);virtual;
-          procedure secondcallparan(defcoll : pparaitem;
+          procedure firstcallparan(defcoll : tparaitem;do_count : boolean);virtual;
+          procedure secondcallparan(defcoll : tparaitem;
                    push_from_left_to_right,inlined,is_cdecl : boolean;
                    para_alignment,para_offset : longint);virtual;abstract;
        end;
@@ -174,7 +174,7 @@ interface
       begin
       end;
 
-    procedure tcallparanode.firstcallparan(defcoll : pparaitem;do_count : boolean);
+    procedure tcallparanode.firstcallparan(defcoll : tparaitem;do_count : boolean);
       var
         old_get_para_resulttype : boolean;
         old_array_constructor : boolean;
@@ -197,7 +197,7 @@ interface
               if defcoll=nil then
                 tcallparanode(right).firstcallparan(nil,do_count)
               else
-                tcallparanode(right).firstcallparan(pparaitem(defcoll^.next),do_count);
+                tcallparanode(right).firstcallparan(tparaitem(defcoll.next),do_count);
               registers32:=right.registers32;
               registersfpu:=right.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -228,13 +228,13 @@ interface
                 it here before the arrayconstructor node breaks the tree
                 with its conversions of enum->ord }
               if (left.nodetype=arrayconstructorn) and
-                 (defcoll^.paratype.def^.deftype=setdef) then
-                left:=gentypeconvnode(left,defcoll^.paratype.def);
+                 (defcoll.paratype.def^.deftype=setdef) then
+                left:=gentypeconvnode(left,defcoll.paratype.def);
 
               { set some settings needed for arrayconstructor }
               if is_array_constructor(left.resulttype) then
                begin
-                 if is_array_of_const(defcoll^.paratype.def) then
+                 if is_array_of_const(defcoll.paratype.def) then
                   begin
                     if assigned(aktcallprocsym) and
                        (([pocall_cppdecl,pocall_cdecl]*aktcallprocsym^.definition^.proccalloptions)<>[]) and
@@ -246,21 +246,21 @@ interface
                  else
                   begin
                     include(left.flags,nf_novariaallowed);
-                    tarrayconstructornode(left).constructordef:=parraydef(defcoll^.paratype.def)^.elementtype.def;
+                    tarrayconstructornode(left).constructordef:=parraydef(defcoll.paratype.def)^.elementtype.def;
                   end;
                end;
 
               if do_count then
                begin
                  { not completly proper, but avoids some warnings }
-                 if (defcoll^.paratyp in [vs_var,vs_out]) then
+                 if (defcoll.paratyp in [vs_var,vs_out]) then
                    set_funcret_is_valid(left);
 
                  { protected has nothing to do with read/write
-                 if (defcoll^.paratyp in [vs_var,vs_out]) then
+                 if (defcoll.paratyp in [vs_var,vs_out]) then
                    test_protected(left);
                  }
-                 { set_varstate(left,defcoll^.paratyp<>vs_var);
+                 { set_varstate(left,defcoll.paratyp<>vs_var);
                    must only be done after typeconv PM }
                  { only process typeconvn and arrayconstructn, else it will
                    break other trees }
@@ -278,67 +278,67 @@ interface
                end;
               { check if local proc/func is assigned to procvar }
               if left.resulttype^.deftype=procvardef then
-                test_local_to_procvar(pprocvardef(left.resulttype),defcoll^.paratype.def);
+                test_local_to_procvar(pprocvardef(left.resulttype),defcoll.paratype.def);
               { property is not allowed as var parameter }
-              if (defcoll^.paratyp in [vs_out,vs_var]) and
+              if (defcoll.paratyp in [vs_out,vs_var]) and
                  (nf_isproperty in left.flags) then
                 CGMessagePos(left.fileinfo,type_e_argument_cant_be_assigned);
               { generate the high() value tree }
-              if push_high_param(defcoll^.paratype.def) then
-                gen_high_tree(is_open_string(defcoll^.paratype.def));
+              if push_high_param(defcoll.paratype.def) then
+                gen_high_tree(is_open_string(defcoll.paratype.def));
               if not(is_shortstring(left.resulttype) and
-                     is_shortstring(defcoll^.paratype.def)) and
-                     (defcoll^.paratype.def^.deftype<>formaldef) then
+                     is_shortstring(defcoll.paratype.def)) and
+                     (defcoll.paratype.def^.deftype<>formaldef) then
                 begin
-                   if (defcoll^.paratyp in [vs_var,vs_out]) and
+                   if (defcoll.paratyp in [vs_var,vs_out]) and
                    { allows conversion from word to integer and
                      byte to shortint }
                      (not(
                         (left.resulttype^.deftype=orddef) and
-                        (defcoll^.paratype.def^.deftype=orddef) and
-                        (left.resulttype^.size=defcoll^.paratype.def^.size)
+                        (defcoll.paratype.def^.deftype=orddef) and
+                        (left.resulttype^.size=defcoll.paratype.def^.size)
                          ) and
                    { an implicit pointer conversion is allowed }
                      not(
                         (left.resulttype^.deftype=pointerdef) and
-                        (defcoll^.paratype.def^.deftype=pointerdef)
+                        (defcoll.paratype.def^.deftype=pointerdef)
                          ) and
                    { child classes can be also passed }
                      not(
                         (left.resulttype^.deftype=objectdef) and
-                        (defcoll^.paratype.def^.deftype=objectdef) and
-                        pobjectdef(left.resulttype)^.is_related(pobjectdef(defcoll^.paratype.def))
+                        (defcoll.paratype.def^.deftype=objectdef) and
+                        pobjectdef(left.resulttype)^.is_related(pobjectdef(defcoll.paratype.def))
                         ) and
                    { passing a single element to a openarray of the same type }
                      not(
-                        (is_open_array(defcoll^.paratype.def) and
-                        is_equal(parraydef(defcoll^.paratype.def)^.elementtype.def,left.resulttype))
+                        (is_open_array(defcoll.paratype.def) and
+                        is_equal(parraydef(defcoll.paratype.def)^.elementtype.def,left.resulttype))
                         ) and
                    { an implicit file conversion is also allowed }
                    { from a typed file to an untyped one           }
                      not(
                         (left.resulttype^.deftype=filedef) and
-                        (defcoll^.paratype.def^.deftype=filedef) and
-                        (pfiledef(defcoll^.paratype.def)^.filetyp = ft_untyped) and
+                        (defcoll.paratype.def^.deftype=filedef) and
+                        (pfiledef(defcoll.paratype.def)^.filetyp = ft_untyped) and
                         (pfiledef(left.resulttype)^.filetyp = ft_typed)
                          ) and
-                     not(is_equal(left.resulttype,defcoll^.paratype.def))) then
+                     not(is_equal(left.resulttype,defcoll.paratype.def))) then
                        begin
                           CGMessagePos2(left.fileinfo,parser_e_call_by_ref_without_typeconv,
-                            left.resulttype^.typename,defcoll^.paratype.def^.typename);
+                            left.resulttype^.typename,defcoll.paratype.def^.typename);
                        end;
                    { Process open parameters }
-                   if push_high_param(defcoll^.paratype.def) then
+                   if push_high_param(defcoll.paratype.def) then
                     begin
                       { insert type conv but hold the ranges of the array }
                       oldtype:=left.resulttype;
-                      left:=gentypeconvnode(left,defcoll^.paratype.def);
+                      left:=gentypeconvnode(left,defcoll.paratype.def);
                       firstpass(left);
                       left.resulttype:=oldtype;
                     end
                    else
                     begin
-                      left:=gentypeconvnode(left,defcoll^.paratype.def);
+                      left:=gentypeconvnode(left,defcoll.paratype.def);
                       firstpass(left);
                     end;
                    if codegenerror then
@@ -350,10 +350,10 @@ interface
               { check var strings }
               if (cs_strict_var_strings in aktlocalswitches) and
                  is_shortstring(left.resulttype) and
-                 is_shortstring(defcoll^.paratype.def) and
-                 (defcoll^.paratyp in [vs_out,vs_var]) and
-                 not(is_open_string(defcoll^.paratype.def)) and
-                 not(is_equal(left.resulttype,defcoll^.paratype.def)) then
+                 is_shortstring(defcoll.paratype.def) and
+                 (defcoll.paratyp in [vs_out,vs_var]) and
+                 not(is_open_string(defcoll.paratype.def)) and
+                 not(is_equal(left.resulttype,defcoll.paratype.def)) then
                  begin
                     aktfilepos:=left.fileinfo;
                     CGMessage(type_e_strict_var_string_violation);
@@ -363,9 +363,9 @@ interface
               { into a register }
               { is this usefull here ? }
               { this was missing in formal parameter list   }
-              if (defcoll^.paratype.def=pdef(cformaldef)) then
+              if (defcoll.paratype.def=pdef(cformaldef)) then
                 begin
-                  if defcoll^.paratyp in [vs_var,vs_out] then
+                  if defcoll.paratyp in [vs_var,vs_out] then
                     begin
                       if not valid_for_formal_var(left) then
                         begin
@@ -373,7 +373,7 @@ interface
                            CGMessage(parser_e_illegal_parameter_list);
                         end;
                     end;
-                  if defcoll^.paratyp=vs_const then
+                  if defcoll.paratyp=vs_const then
                     begin
                       if not valid_for_formal_const(left) then
                         begin
@@ -383,24 +383,24 @@ interface
                     end;
                 end;
 
-              if defcoll^.paratyp in [vs_var,vs_const] then
+              if defcoll.paratyp in [vs_var,vs_const] then
                 begin
                    { Causes problems with const ansistrings if also }
                    { done for vs_const (JM)                         }
-                   if defcoll^.paratyp = vs_var then
+                   if defcoll.paratyp = vs_var then
                      set_unique(left);
                    make_not_regable(left);
                 end;
 
               { ansistrings out paramaters doesn't need to be  }
               { unique, they are finalized                     }
-              if defcoll^.paratyp=vs_out then
+              if defcoll.paratyp=vs_out then
                 make_not_regable(left);
 
               if do_count then
-                set_varstate(left,not(defcoll^.paratyp in [vs_var,vs_out]));
+                set_varstate(left,not(defcoll.paratyp in [vs_var,vs_out]));
               { must only be done after typeconv PM }
-              resulttype:=defcoll^.paratype.def;
+              resulttype:=defcoll.paratype.def;
            end;
          if left.registers32>registers32 then
            registers32:=left.registers32;
@@ -532,8 +532,8 @@ interface
          pprocdefcoll = ^tprocdefcoll;
          tprocdefcoll = record
             data      : pprocdef;
-            nextpara  : pparaitem;
-            firstpara : pparaitem;
+            nextpara  : tparaitem;
+            firstpara : tparaitem;
             next      : pprocdefcoll;
          end;
       var
@@ -546,7 +546,7 @@ interface
          exactmatch,inlined : boolean;
          paralength,lastpara : longint;
          lastparatype : pdef;
-         pdc : pparaitem;
+         pdc : tparaitem;
 {$ifdef TEST_PROCSYMS}
          nextprocsym : pprocsym;
          symt : psymtable;
@@ -687,12 +687,12 @@ interface
               set_varstate(right,true);
 
               { check the parameters }
-              pdc:=pparaitem(pprocvardef(right.resulttype)^.para^.first);
+              pdc:=tparaitem(pprocvardef(right.resulttype)^.Para.first);
               pt:=tcallparanode(left);
               while assigned(pdc) and assigned(pt) do
                 begin
                    pt:=tcallparanode(pt.right);
-                   pdc:=pparaitem(pdc^.next);
+                   pdc:=tparaitem(pdc.next);
                 end;
               if assigned(pt) or assigned(pdc) then
                 begin
@@ -703,7 +703,7 @@ interface
               { insert type conversions }
               if assigned(left) then
                 begin
-                   tcallparanode(left).firstcallparan(pparaitem(pprocvardef(right.resulttype)^.para^.first),true);
+                   tcallparanode(left).firstcallparan(tparaitem(pprocvardef(right.resulttype)^.Para.first),true);
                    if codegenerror then
                      goto errorexit;
                 end;
@@ -773,11 +773,11 @@ interface
                              new(hp);
                              hp^.data:=pd;
                              hp^.next:=procs;
-                             hp^.firstpara:=pparaitem(pd^.para^.first);
+                             hp^.firstpara:=tparaitem(pd^.Para.first);
                              { if not all parameters are given, then skip the
                                default parameters }
                              for i:=1 to pd^.maxparacount-paralength do
-                              hp^.firstpara:=pparaitem(hp^.firstpara^.next);
+                              hp^.firstpara:=tparaitem(hp^.firstPara.next);
                              hp^.nextpara:=hp^.firstpara;
                              procs:=hp;
                           end;
@@ -825,7 +825,7 @@ interface
                            1. pt.exact_match_found if one parameter has an exact match
                            2. exactmatch if an equal or exact match is found
 
-                           3. para^.argconvtyp to exact,equal or convertable
+                           3. Para.argconvtyp to exact,equal or convertable
                                 (when convertable then also convertlevel is set)
                            4. pt.convlevel1found if there is a convertlevel=1
                            5. pt.convlevel2found if there is a convertlevel=2
@@ -834,23 +834,23 @@ interface
                         hp:=procs;
                         while assigned(hp) do
                           begin
-                             if is_equal(pt,hp^.nextpara^.paratype.def) then
+                             if is_equal(pt,hp^.nextPara.paratype.def) then
                                begin
-                                  if hp^.nextpara^.paratype.def=pt.resulttype then
+                                  if hp^.nextPara.paratype.def=pt.resulttype then
                                     begin
                                        include(pt.callparaflags,cpf_exact_match_found);
-                                       hp^.nextpara^.argconvtyp:=act_exact;
+                                       hp^.nextPara.argconvtyp:=act_exact;
                                     end
                                   else
-                                    hp^.nextpara^.argconvtyp:=act_equal;
+                                    hp^.nextPara.argconvtyp:=act_equal;
                                   exactmatch:=true;
                                end
                              else
                                begin
-                                 hp^.nextpara^.argconvtyp:=act_convertable;
-                                 hp^.nextpara^.convertlevel:=isconvertable(pt.resulttype,hp^.nextpara^.paratype.def,
+                                 hp^.nextPara.argconvtyp:=act_convertable;
+                                 hp^.nextPara.convertlevel:=isconvertable(pt.resulttype,hp^.nextPara.paratype.def,
                                      hcvt,pt.left,pt.left.nodetype,false);
-                                 case hp^.nextpara^.convertlevel of
+                                 case hp^.nextPara.convertlevel of
                                   1 : include(pt.callparaflags,cpf_convlevel1found);
                                   2 : include(pt.callparaflags,cpf_convlevel2found);
                                  end;
@@ -868,7 +868,7 @@ interface
                               begin
                                  hp2:=hp^.next;
                                  { keep if not convertable }
-                                 if (hp^.nextpara^.argconvtyp<>act_convertable) then
+                                 if (hp^.nextPara.argconvtyp<>act_convertable) then
                                   begin
                                     hp^.next:=procs;
                                     procs:=hp;
@@ -888,7 +888,7 @@ interface
                               begin
                                  hp2:=hp^.next;
                                  { keep if not convertable }
-                                 if (hp^.nextpara^.convertlevel<>0) then
+                                 if (hp^.nextPara.convertlevel<>0) then
                                   begin
                                     hp^.next:=procs;
                                     procs:=hp;
@@ -896,7 +896,7 @@ interface
                                  else
                                   begin
                                     { save the type for nice error message }
-                                    lastparatype:=hp^.nextpara^.paratype.def;
+                                    lastparatype:=hp^.nextPara.paratype.def;
                                     dispose(hp);
                                   end;
                                  hp:=hp2;
@@ -906,7 +906,7 @@ interface
                         hp:=procs;
                         while assigned(hp) do
                           begin
-                             hp^.nextpara:=pparaitem(hp^.nextpara^.next);
+                             hp^.nextpara:=tparaitem(hp^.nextPara.next);
                              hp:=hp^.next;
                           end;
                         { load next parameter or quit loop if no procs left }
@@ -961,12 +961,12 @@ interface
                              hp:=procs;
                              while assigned(hp) do
                                begin
-                                  if not is_equal(pt,hp^.nextpara^.paratype.def) then
+                                  if not is_equal(pt,hp^.nextPara.paratype.def) then
                                     begin
-                                       def_to:=hp^.nextpara^.paratype.def;
+                                       def_to:=hp^.nextPara.paratype.def;
                                        if ((def_from^.deftype=orddef) and (def_to^.deftype=orddef)) and
                                          (is_in_limit(def_from,def_to) or
-                                         ((hp^.nextpara^.paratyp in [vs_var,vs_out]) and
+                                         ((hp^.nextPara.paratyp in [vs_var,vs_out]) and
                                          (def_from^.size=def_to^.size))) then
                                          begin
                                             exactmatch:=true;
@@ -980,7 +980,7 @@ interface
                              if exactmatch then
                                begin
                                   { the first .... }
-                                  while (assigned(procs)) and not(is_in_limit(def_from,procs^.nextpara^.paratype.def)) do
+                                  while (assigned(procs)) and not(is_in_limit(def_from,procs^.nextPara.paratype.def)) do
                                     begin
                                        hp:=procs^.next;
                                        dispose(procs);
@@ -990,7 +990,7 @@ interface
                                   hp:=procs;
                                   while (assigned(hp)) and assigned(hp^.next) do
                                     begin
-                                       if not(is_in_limit(def_from,hp^.next^.nextpara^.paratype.def)) then
+                                       if not(is_in_limit(def_from,hp^.next^.nextPara.paratype.def)) then
                                          begin
                                             hp2:=hp^.next^.next;
                                             dispose(hp^.next);
@@ -998,7 +998,7 @@ interface
                                          end
                                        else
                                          begin
-                                           def_to:=hp^.next^.nextpara^.paratype.def;
+                                           def_to:=hp^.next^.nextPara.paratype.def;
                                            if (conv_to^.size>def_to^.size) or
                                               ((porddef(conv_to)^.low<porddef(def_to)^.low) and
                                               (porddef(conv_to)^.high>porddef(def_to)^.high)) then
@@ -1017,7 +1017,7 @@ interface
                              hp:=procs;
                              while assigned(hp) do
                                begin
-                                  hp^.nextpara:=pparaitem(hp^.nextpara^.next);
+                                  hp^.nextpara:=tparaitem(hp^.nextPara.next);
                                   hp:=hp^.next;
                                end;
                              pt:=tcallparanode(pt.right);
@@ -1047,7 +1047,7 @@ interface
                                    begin
                                       hp2:=hp^.next;
                                       { keep the exact matches, dispose the others }
-                                      if (hp^.nextpara^.argconvtyp=act_exact) then
+                                      if (hp^.nextPara.argconvtyp=act_exact) then
                                        begin
                                          hp^.next:=procs;
                                          procs:=hp;
@@ -1061,7 +1061,7 @@ interface
                              hp:=procs;
                              while assigned(hp) do
                                begin
-                                  hp^.nextpara:=pparaitem(hp^.nextpara^.next);
+                                  hp^.nextpara:=tparaitem(hp^.nextPara.next);
                                   hp:=hp^.next;
                                end;
                              pt:=tcallparanode(pt.right);
@@ -1092,7 +1092,7 @@ interface
                                hp:=procs;
                                while assigned(hp) do
                                 begin
-                                  def_to:=hp^.nextpara^.paratype.def;
+                                  def_to:=hp^.nextPara.paratype.def;
                                   { to be sure, it couldn't be something else,
                                     also the defs here are all in the range
                                     so now find the closest range }
@@ -1115,7 +1115,7 @@ interface
                                 begin
                                   hp2:=hp^.next;
                                   { keep matching bestord, dispose the others }
-                                  if (porddef(hp^.nextpara^.paratype.def)=bestord) then
+                                  if (porddef(hp^.nextPara.paratype.def)=bestord) then
                                    begin
                                      hp^.next:=procs;
                                      procs:=hp;
@@ -1130,7 +1130,7 @@ interface
                             hp:=procs;
                             while assigned(hp) do
                              begin
-                               hp^.nextpara:=pparaitem(hp^.nextpara^.next);
+                               hp^.nextpara:=tparaitem(hp^.nextPara.next);
                                hp:=hp^.next;
                              end;
                             pt:=tcallparanode(pt.right);
@@ -1164,8 +1164,8 @@ interface
                                    begin
                                       hp2:=hp^.next;
                                       { keep all not act_convertable and all convertlevels=1 }
-                                      if (hp^.nextpara^.argconvtyp<>act_convertable) or
-                                         (hp^.nextpara^.convertlevel=1) then
+                                      if (hp^.nextPara.argconvtyp<>act_convertable) or
+                                         (hp^.nextPara.convertlevel=1) then
                                        begin
                                          hp^.next:=procs;
                                          procs:=hp;
@@ -1179,7 +1179,7 @@ interface
                              hp:=procs;
                              while assigned(hp) do
                                begin
-                                  hp^.nextpara:=pparaitem(hp^.nextpara^.next);
+                                  hp^.nextpara:=tparaitem(hp^.nextPara.next);
                                   hp:=hp^.next;
                                end;
                              pt:=tcallparanode(pt.right);
@@ -1293,25 +1293,25 @@ interface
                  (paralength<procdefinition^.maxparacount) then
                begin
                  { add default parameters, just read back the skipped
-                   paras starting from firstpara^.previous, when not available
+                   paras starting from firstPara.previous, when not available
                    (all parameters are default) then start with the last
                    parameter and read backward (PFV) }
                  if not assigned(procs^.firstpara) then
-                  pdc:=pparaitem(procs^.data^.para^.last)
+                  pdc:=tparaitem(procs^.data^.Para.last)
                  else
-                  pdc:=pparaitem(procs^.firstpara^.previous);
+                  pdc:=tparaitem(procs^.firstPara.previous);
                  while assigned(pdc) do
                   begin
-                    if not assigned(pdc^.defaultvalue) then
+                    if not assigned(pdc.defaultvalue) then
                      internalerror(751349858);
-                    left:=gencallparanode(genconstsymtree(pconstsym(pdc^.defaultvalue)),left);
-                    pdc:=pparaitem(pdc^.previous);
+                    left:=gencallparanode(genconstsymtree(pconstsym(pdc.defaultvalue)),left);
+                    pdc:=tparaitem(pdc.previous);
                   end;
                end;
 
               { work trough all parameters to insert the type conversions }
               if assigned(left) then
-                tcallparanode(left).firstcallparan(pparaitem(procdefinition^.para^.first),true);
+                tcallparanode(left).firstcallparan(tparaitem(procdefinition^.Para.first),true);
 {$ifndef newcg}
 {$ifdef i386}
               incrementregisterpushed(pprocdef(procdefinition)^.usedregisters);
@@ -1535,7 +1535,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2000-12-17 14:35:12  peter
+  Revision 1.20  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.19  2000/12/17 14:35:12  peter
     * fixed crash with procvar load in tp mode
 
   Revision 1.18  2000/11/29 00:30:32  florian

compiler/ninl.pas

@@ -692,10 +692,10 @@ implementation
                           (pstringdef(ppn.left.resulttype)^.string_typ =
                             st_shortstring) then
                          begin
-                           dummycoll.init;
+                           dummycoll:=tparaitem.create;
                            dummycoll.paratyp:=vs_var;
                            dummycoll.paratype.setdef(openshortstringdef);
-                           tcallparanode(ppn).firstcallparan(@dummycoll,false);
+                           tcallparanode(ppn).firstcallparan(dummycoll,false);
                            if codegenerror then
                              exit;
                          end;
@@ -1491,7 +1491,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2000-12-17 14:35:41  peter
+  Revision 1.21  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.20  2000/12/17 14:35:41  peter
     * fixed crash with val()
 
   Revision 1.19  2000/11/29 00:30:33  florian

compiler/nmat.pas

@@ -384,8 +384,8 @@ implementation
                 minusdef:=nil;
               while assigned(minusdef) do
                 begin
-                   if is_equal(pparaitem(minusdef^.para^.first)^.paratype.def,left.resulttype) and
-                      (pparaitem(minusdef^.para^.first)^.next=nil) then
+                   if is_equal(tparaitem(minusdef^.para.first).paratype.def,left.resulttype) and
+                      (tparaitem(minusdef^.para.first).next=nil) then
                      begin
                         t:=gencallnode(overloaded_operators[_minus],nil);
                         tcallnode(t).left:=gencallparanode(left,nil);
@@ -502,8 +502,8 @@ implementation
                 notdef:=nil;
               while assigned(notdef) do
                 begin
-                   if is_equal(pparaitem(notdef^.para^.first)^.paratype.def,left.resulttype) and
-                      (pparaitem(notdef^.para^.first)^.next=nil) then
+                   if is_equal(tparaitem(notdef^.para.first).paratype.def,left.resulttype) and
+                      (tparaitem(notdef^.para.first).next=nil) then
                      begin
                         t:=gencallnode(overloaded_operators[_op_not],nil);
                         tcallnode(t).left:=gencallparanode(left,nil);
@@ -529,7 +529,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2000-12-16 15:54:01  jonas
+  Revision 1.11  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.10  2000/12/16 15:54:01  jonas
     * 'resulttype of cardinal shl/shr x' is cardinal instead of longint
 
   Revision 1.9  2000/11/29 00:30:34  florian

compiler/nmem.pas

@@ -306,7 +306,7 @@ implementation
     function taddrnode.pass_1 : tnode;
       var
          hp  : tnode;
-         hp2 : pparaitem;
+         hp2 : TParaItem;
          hp3 : pabstractprocdef;
       begin
          pass_1:=nil;
@@ -411,11 +411,11 @@ implementation
                          include(pprocvardef(resulttype)^.procoptions,po_methodpointer);
                        { we need to process the parameters reverse so they are inserted
                          in the correct right2left order (PFV) }
-                       hp2:=pparaitem(hp3^.para^.last);
+                       hp2:=TParaItem(hp3^.Para.last);
                        while assigned(hp2) do
                          begin
-                            pprocvardef(resulttype)^.concatpara(hp2^.paratype,hp2^.paratyp,hp2^.defaultvalue);
-                            hp2:=pparaitem(hp2^.previous);
+                            pprocvardef(resulttype)^.concatpara(hp2.paratype,hp2.paratyp,hp2.defaultvalue);
+                            hp2:=TParaItem(hp2.previous);
                          end;
                     end
                   else
@@ -873,7 +873,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2000-12-05 15:19:50  jonas
+  Revision 1.13  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.12  2000/12/05 15:19:50  jonas
     * fixed webbug 1268 ("merged")
 
   Revision 1.11  2000/11/29 00:30:34  florian

compiler/node.pas

@@ -27,26 +27,804 @@ unit node;
 interface
 
     uses
-       cobjects,
-       globtype,
+       cobjects,cclasses,
+       globtype,globals,
        cpubase,
        aasm,
        symtype;
 
-    {$I nodeh.inc}
+    type
+       pconstset = ^tconstset;
+       tconstset = array[0..31] of byte;
+
+       tnodetype = (
+          addn,     {Represents the + operator.}
+          muln,     {Represents the * operator.}
+          subn,     {Represents the - operator.}
+          divn,     {Represents the div operator.}
+          symdifn,       {Represents the >< operator.}
+          modn,     {Represents the mod operator.}
+          assignn,       {Represents an assignment.}
+          loadn,           {Represents the use of a variabele.}
+          rangen,         {Represents a range (i.e. 0..9).}
+          ltn,       {Represents the < operator.}
+          lten,     {Represents the <= operator.}
+          gtn,       {Represents the > operator.}
+          gten,     {Represents the >= operator.}
+          equaln,         {Represents the = operator.}
+          unequaln,     {Represents the <> operator.}
+          inn,       {Represents the in operator.}
+          orn,       {Represents the or operator.}
+          xorn,     {Represents the xor operator.}
+          shrn,     {Represents the shr operator.}
+          shln,     {Represents the shl operator.}
+          slashn,         {Represents the / operator.}
+          andn,     {Represents the and operator.}
+          subscriptn,      {??? Field in a record/object?}
+          derefn,         {Dereferences a pointer.}
+          addrn,           {Represents the @ operator.}
+          doubleaddrn,     {Represents the @@ operator.}
+          ordconstn,       {Represents an ordinal value.}
+          typeconvn,       {Represents type-conversion/typecast.}
+          calln,           {Represents a call node.}
+          callparan,       {Represents a parameter.}
+          realconstn,      {Represents a real value.}
+          fixconstn,       {Represents a fixed value.}
+          unaryminusn,     {Represents a sign change (i.e. -2).}
+          asmn,     {Represents an assembler node }
+          vecn,     {Represents array indexing.}
+          pointerconstn,
+          stringconstn,    {Represents a string constant.}
+          funcretn,     {Represents the function result var.}
+          selfn,           {Represents the self parameter.}
+          notn,     {Represents the not operator.}
+          inlinen,       {Internal procedures (i.e. writeln).}
+          niln,     {Represents the nil pointer.}
+          errorn,         {This part of the tree could not be
+                            parsed because of a compiler error.}
+          typen,           {A type name. Used for i.e. typeof(obj).}
+          hnewn,           {The new operation, constructor call.}
+          hdisposen,       {The dispose operation with destructor call.}
+          newn,     {The new operation, constructor call.}
+          simpledisposen,  {The dispose operation.}
+          setelementn,     {A set element(s) (i.e. [a,b] and also [a..b]).}
+          setconstn,       {A set constant (i.e. [1,2]).}
+          blockn,         {A block of statements.}
+          statementn,      {One statement in a block of nodes.}
+          loopn,           { used in genloopnode, must be converted }
+          ifn,       {An if statement.}
+          breakn,         {A break statement.}
+          continuen,       {A continue statement.}
+          repeatn,       {A repeat until block.}
+          whilen,         {A while do statement.}
+          forn,     {A for loop.}
+          exitn,           {An exit statement.}
+          withn,           {A with statement.}
+          casen,           {A case statement.}
+          labeln,         {A label.}
+          goton,           {A goto statement.}
+          simplenewn,      {The new operation.}
+          tryexceptn,      {A try except block.}
+          raisen,         {A raise statement.}
+          switchesn,       {??? Currently unused...}
+          tryfinallyn,     {A try finally statement.}
+          onn,       { for an on statement in exception code }
+          isn,       {Represents the is operator.}
+          asn,       {Represents the as typecast.}
+          caretn,         {Represents the ^ operator.}
+          failn,           {Represents the fail statement.}
+          starstarn,       {Represents the ** operator exponentiation }
+          procinlinen,     {Procedures that can be inlined }
+          arrayconstructorn, {Construction node for [...] parsing}
+          arrayconstructorrangen, {Range element to allow sets in array construction tree}
+          { added for optimizations where we cannot suppress }
+          nothingn,
+          loadvmtn
+       );
+
+       { all boolean field of ttree are now collected in flags }
+       tnodeflags = (
+         nf_needs_truefalselabel,
+         nf_swapable,    { tbinop operands can be swaped }
+         nf_swaped,      { tbinop operands are swaped    }
+         nf_error,
+
+         { flags used by tcallnode }
+         nf_no_check,
+         nf_unit_specific,
+         nf_return_value_used,
+         nf_static_call,
+
+         { flags used by loop nodes }
+         nf_backward,  { set if it is a for ... downto ... do loop }
+         nf_varstate,  { do we need to parse childs to set var state }
+
+         { taddrnode }
+         nf_procvarload,
+
+         { tvecnode }
+         nf_memindex,
+         nf_memseg,
+         nf_callunique,
+
+         { twithnode }
+         nf_islocal,
+
+         { tloadnode }
+         nf_absolute,
+         nf_first,
+
+         { tassignmentnode }
+         nf_concat_string,
+
+         { tfuncretnode }
+         nf_is_first_funcret, { 20th }
+
+         { tarrayconstructnode }
+         nf_cargs,
+         nf_cargswap,
+         nf_forcevaria,
+         nf_novariaallowed,
+
+         { ttypeconvnode }
+         nf_explizit,
+
+         { tinlinenode }
+         nf_inlineconst,
+
+         { general }
+         nf_isproperty,
+         nf_varstateset,
+
+         { tasmnode }
+         nf_object_preserved,
+
+         { taddnode }
+         nf_use_strconcat
+       );
+
+       tnodeflagset = set of tnodeflags;
+
+    const
+       { contains the flags which must be equal for the equality }
+       { of nodes                                                }
+       flagsequal : tnodeflagset = [nf_error,nf_static_call,nf_backward];
+
+    type
+       tnodelist = class
+       end;
+
+       { later (for the newcg) tnode will inherit from tlinkedlist_item }
+       tnode = class
+          nodetype : tnodetype;
+          { the location of the result of this node }
+          location : tlocation;
+          { the parent node of this is node    }
+          { this field is set by concattolist  }
+          parent : tnode;
+          { there are some properties about the node stored }
+          flags : tnodeflagset;
+          { the number of registers needed to evalute the node }
+          registers32,registersfpu : longint;  { must be longint !!!! }
+{$ifdef SUPPORT_MMX}
+          registersmmx,registerskni : longint;
+{$endif SUPPORT_MMX}
+          resulttype : pdef;
+          fileinfo : tfileposinfo;
+          localswitches : tlocalswitches;
+{$ifdef extdebug}
+          maxfirstpasscount,
+          firstpasscount : longint;
+{$endif extdebug}
+          list : taasmoutput;
+          constructor create(tt : tnodetype);
+          { this constructor is only for creating copies of class }
+          { the fields are copied by getcopy                      }
+          constructor createforcopy;
+          destructor destroy;override;
+
+          { toggles the flag }
+          procedure toggleflag(f : tnodeflags);
+
+          { the 1.1 code generator may override pass_1 }
+          { and it need not to implement det_* then    }
+          { 1.1: pass_1 returns a value<>0 if the node has been transformed }
+          { 2.0: runs det_resulttype and det_temp                           }
+          function pass_1 : tnode;virtual;
+          { dermines the resulttype of the node }
+          procedure det_resulttype;virtual;abstract;
+          { dermines the number of necessary temp. locations to evaluate
+            the node }
+          procedure det_temp;virtual;abstract;
+
+          procedure pass_2;virtual;abstract;
+
+          { comparing of nodes }
+          function isequal(p : tnode) : boolean;
+          { to implement comparisation, override this method }
+          function docompare(p : tnode) : boolean;virtual;
+          { gets a copy of the node }
+          function getcopy : tnode;virtual;
+
+          procedure insertintolist(l : tnodelist);virtual;
+{$ifdef EXTDEBUG}
+          { writes a node for debugging purpose, shouldn't be called }
+          { direct, because there is no test for nil, use writenode  }
+          { to write a complete tree                                 }
+          procedure dowrite;virtual;
+          procedure dowritenodetype;virtual;
+{$endif EXTDEBUG}
+          procedure concattolist(l : tlinkedlist);virtual;
+          function ischild(p : tnode) : boolean;virtual;
+          procedure set_file_line(from : tnode);
+          procedure set_tree_filepos(const filepos : tfileposinfo);
+       end;
+
+       { this node is the anchestor for all nodes with at least   }
+       { one child, you have to use it if you want to use         }
+       { true- and falselabel                                     }
+       tparentnode = class(tnode)
+{$ifdef newcg}
+          falselabel,truelabel : pasmlabel;
+{$endif newcg}
+       end;
+
+       tnodeclass = class of tnode;
+
+       punarynode = ^tunarynode;
+       tunarynode = class(tparentnode)
+          left : tnode;
+          constructor create(tt : tnodetype;l : tnode);
+          destructor destroy;override;
+          procedure concattolist(l : tlinkedlist);override;
+          function ischild(p : tnode) : boolean;override;
+          procedure det_resulttype;override;
+          procedure det_temp;override;
+          function docompare(p : tnode) : boolean;override;
+          function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
+          procedure left_max;
+{$ifdef extdebug}
+          procedure dowrite;override;
+{$endif extdebug}
+       end;
+
+       pbinarynode = ^tbinarynode;
+       tbinarynode = class(tunarynode)
+          right : tnode;
+          constructor create(tt : tnodetype;l,r : tnode);
+          destructor destroy;override;
+          procedure concattolist(l : tlinkedlist);override;
+          function ischild(p : tnode) : boolean;override;
+          procedure det_resulttype;override;
+          procedure det_temp;override;
+          function docompare(p : tnode) : boolean;override;
+          procedure swapleftright;
+          function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
+          procedure left_right_max;
+{$ifdef extdebug}
+          procedure dowrite;override;
+{$endif extdebug}
+       end;
+
+       pbinopnode = ^tbinopnode;
+       tbinopnode = class(tbinarynode)
+          constructor create(tt : tnodetype;l,r : tnode);virtual;
+          function docompare(p : tnode) : boolean;override;
+       end;
+
+{$ifdef EXTDEBUG}
+     var
+       writenodeindention : string;
+
+     procedure writenode(t:tnode);
+{$endif EXTDEBUG}
+
 
 implementation
 
     uses
-       cutils,
-       globals;
+       cutils;
+
+{****************************************************************************
+                                 TNODE
+ ****************************************************************************}
+
+    constructor tnode.create(tt : tnodetype);
+
+      begin
+         inherited create;
+         nodetype:=tt;
+         { this allows easier error tracing }
+         location.loc:=LOC_INVALID;
+         { save local info }
+         fileinfo:=aktfilepos;
+         localswitches:=aktlocalswitches;
+         resulttype:=nil;
+         registers32:=0;
+         registersfpu:=0;
+{$ifdef SUPPORT_MMX}
+         registersmmx:=0;
+{$endif SUPPORT_MMX}
+         flags:=[];
+      end;
+
+    constructor tnode.createforcopy;
+
+      begin
+      end;
+
+    procedure tnode.toggleflag(f : tnodeflags);
+
+      begin
+         if f in flags then
+           exclude(flags,f)
+         else
+           include(flags,f);
+      end;
+
+    destructor tnode.destroy;
+
+      begin
+         { reference info }
+         {if (location.loc in [LOC_MEM,LOC_REFERENCE]) and
+            assigned(location.reference.symbol) then
+           dispose(location.reference.symbol,done);}
+
+{$ifdef EXTDEBUG}
+         if firstpasscount>maxfirstpasscount then
+            maxfirstpasscount:=firstpasscount;
+{$endif EXTDEBUG}
+      end;
+
+    function tnode.pass_1 : tnode;
+
+      begin
+         pass_1:=nil;
+
+         if not(assigned(resulttype)) then
+           det_resulttype;
+
+         det_temp;
+      end;
+
+    procedure tnode.concattolist(l : tlinkedlist);
+
+      begin
+{$ifdef newcg}
+         //!!!!!!! l^.concat(self);
+         {$warning fixme}
+{$endif newcg}
+      end;
+
+    function tnode.ischild(p : tnode) : boolean;
+
+      begin
+         ischild:=false;
+      end;
+
+{$ifdef EXTDEBUG}
+    procedure tnode.dowrite;
+      begin
+        dowritenodetype;
+      end;
+
+    procedure tnode.dowritenodetype;
+      const nodetype2str : array[tnodetype] of string[20] = (
+          'addn',
+          'muln',
+          'subn',
+          'divn',
+          'symdifn',
+          'modn',
+          'assignn',
+          'loadn',
+          'rangen',
+          'ltn',
+          'lten',
+          'gtn',
+          'gten',
+          'equaln',
+          'unequaln',
+          'inn',
+          'orn',
+          'xorn',
+          'shrn',
+          'shln',
+          'slashn',
+          'andn',
+          'subscriptn',
+          'derefn',
+          'addrn',
+          'doubleaddrn',
+          'ordconstn',
+          'typeconvn',
+          'calln',
+          'callparan',
+          'realconstn',
+          'fixconstn',
+          'umminusn',
+          'asmn',
+          'vecn',
+          'pointerconstn',
+          'stringconstn',
+          'funcretn',
+          'selfn',
+          'notn',
+          'inlinen',
+          'niln',
+          'errorn',
+          'typen',
+          'hnewn',
+          'hdisposen',
+          'newn',
+          'simpledisposen',
+          'setelementn',
+          'setconstn',
+          'blockn',
+          'statementn',
+          'loopn',
+          'ifn',
+          'breakn',
+          'continuen',
+          'repeatn',
+          'whilen',
+          'forn',
+          'exitn',
+          'withn',
+          'casen',
+          'labeln',
+          'goton',
+          'simplenewn',
+          'tryexceptn',
+          'raisen',
+          'switchesn',
+          'tryfinallyn',
+          'onn',
+          'isn',
+          'asn',
+          'caretn',
+          'failn',
+          'starstarn',
+          'procinlinen',
+          'arrayconstructn',
+          'arrayconstructrangen',
+          'nothingn',
+          'loadvmtn');
+
+      begin
+         write(writenodeindention,'(',nodetype2str[nodetype]);
+      end;
+{$endif EXTDEBUG}
+
+    function tnode.isequal(p : tnode) : boolean;
+
+      begin
+         isequal:=assigned(p) and (p.nodetype=nodetype) and
+           (flags*flagsequal=p.flags*flagsequal) and
+           docompare(p);
+      end;
+
+    function tnode.docompare(p : tnode) : boolean;
+
+      begin
+         docompare:=true;
+      end;
+
+
+    function tnode.getcopy : tnode;
+
+      var
+         p : tnode;
+
+      begin
+         { this is quite tricky because we need a node of the current }
+         { node type and not one of tnode!                            }
+         p:=tnodeclass(classtype).createforcopy;
+         p.nodetype:=nodetype;
+         p.location:=location;
+         p.parent:=parent;
+         p.flags:=flags;
+         p.registers32:=registers32;
+         p.registersfpu:=registersfpu;
+{$ifdef SUPPORT_MMX}
+         p.registersmmx:=registersmmx;
+         p.registerskni:=registerskni;
+{$endif SUPPORT_MMX}
+         p.resulttype:=resulttype;
+         p.fileinfo:=fileinfo;
+         p.localswitches:=localswitches;
+{$ifdef extdebug}
+         p.firstpasscount:=firstpasscount;
+{$endif extdebug}
+         p.list:=list;
+         getcopy:=p;
+      end;
+
+    procedure tnode.insertintolist(l : tnodelist);
+
+      begin
+      end;
+
+    procedure tnode.set_file_line(from : tnode);
+
+      begin
+         if assigned(from) then
+           fileinfo:=from.fileinfo;
+      end;
+
+    procedure tnode.set_tree_filepos(const filepos : tfileposinfo);
+
+      begin
+         fileinfo:=filepos;
+      end;
+
+
+{****************************************************************************
+                                 TUNARYNODE
+ ****************************************************************************}
+
+    constructor tunarynode.create(tt : tnodetype;l : tnode);
+
+      begin
+         inherited create(tt);
+         left:=l;
+      end;
+
+    destructor tunarynode.destroy;
+      begin
+        left.free;
+        inherited destroy;
+      end;
+
+    function tunarynode.docompare(p : tnode) : boolean;
+
+      begin
+         docompare:=(inherited docompare(p)) and
+           left.isequal(tunarynode(p).left);
+      end;
+
+    function tunarynode.getcopy : tnode;
+
+      var
+         p : tunarynode;
+
+      begin
+         p:=tunarynode(inherited getcopy);
+         if assigned(left) then
+           p.left:=left.getcopy
+         else
+           p.left:=nil;
+         getcopy:=p;
+      end;
+
+    procedure tunarynode.insertintolist(l : tnodelist);
+
+      begin
+      end;
+
+{$ifdef extdebug}
+    procedure tunarynode.dowrite;
+
+      begin
+         inherited dowrite;
+         writeln(',');
+         writenodeindention:=writenodeindention+'    ';
+         writenode(left);
+         write(')');
+         delete(writenodeindention,1,4);
+      end;
+{$endif}
+
+    procedure tunarynode.left_max;
+
+      begin
+         registers32:=left.registers32;
+         registersfpu:=left.registersfpu;
+{$ifdef SUPPORT_MMX}
+         registersmmx:=left.registersmmx;
+{$endif SUPPORT_MMX}
+      end;
+
+    procedure tunarynode.concattolist(l : tlinkedlist);
+
+      begin
+         left.parent:=self;
+         left.concattolist(l);
+         inherited concattolist(l);
+      end;
+
+    function tunarynode.ischild(p : tnode) : boolean;
+
+      begin
+         ischild:=p=left;
+      end;
+
+    procedure tunarynode.det_resulttype;
+
+      begin
+         left.det_resulttype;
+      end;
+
+    procedure tunarynode.det_temp;
+
+      begin
+         left.det_temp;
+      end;
+
+{****************************************************************************
+                            TBINARYNODE
+ ****************************************************************************}
+
+    constructor tbinarynode.create(tt : tnodetype;l,r : tnode);
+
+      begin
+         inherited create(tt,l);
+         right:=r
+      end;
+
+    destructor tbinarynode.destroy;
+      begin
+        right.free;
+        inherited destroy;
+      end;
+
+    procedure tbinarynode.concattolist(l : tlinkedlist);
+
+      begin
+         { we could change that depending on the number of }
+         { required registers                              }
+         left.parent:=self;
+         left.concattolist(l);
+         left.parent:=self;
+         left.concattolist(l);
+         inherited concattolist(l);
+      end;
+
+    function tbinarynode.ischild(p : tnode) : boolean;
+
+      begin
+         ischild:=(p=right) or (p=right);
+      end;
+
+    procedure tbinarynode.det_resulttype;
+
+      begin
+         left.det_resulttype;
+         right.det_resulttype;
+      end;
+
+    procedure tbinarynode.det_temp;
+
+      begin
+         left.det_temp;
+         right.det_temp;
+      end;
+
+    function tbinarynode.docompare(p : tnode) : boolean;
+
+      begin
+         docompare:=left.isequal(tbinarynode(p).left) and
+           right.isequal(tbinarynode(p).right);
+      end;
+
+    function tbinarynode.getcopy : tnode;
+
+      var
+         p : tbinarynode;
+
+      begin
+         p:=tbinarynode(inherited getcopy);
+         if assigned(right) then
+           p.right:=right.getcopy
+         else
+           p.right:=nil;
+         getcopy:=p;
+      end;
+
+    procedure tbinarynode.insertintolist(l : tnodelist);
+
+      begin
+      end;
+
+    procedure tbinarynode.swapleftright;
+
+      var
+         swapp : tnode;
+
+      begin
+         swapp:=right;
+         right:=left;
+         left:=
+         swapp;
+         if nf_swaped in flags then
+           exclude(flags,nf_swaped)
+         else
+           include(flags,nf_swaped);
+      end;
+
+    procedure tbinarynode.left_right_max;
+      begin
+        if assigned(left) then
+         begin
+           if assigned(right) then
+            begin
+              registers32:=max(left.registers32,right.registers32);
+              registersfpu:=max(left.registersfpu,right.registersfpu);
+{$ifdef SUPPORT_MMX}
+              registersmmx:=max(left.registersmmx,right.registersmmx);
+{$endif SUPPORT_MMX}
+            end
+           else
+            begin
+              registers32:=left.registers32;
+              registersfpu:=left.registersfpu;
+{$ifdef SUPPORT_MMX}
+              registersmmx:=left.registersmmx;
+{$endif SUPPORT_MMX}
+            end;
+         end;
+      end;
+
+{$ifdef extdebug}
+    procedure tbinarynode.dowrite;
+
+      begin
+         inherited dowrite;
+         writeln(',');
+         writenodeindention:=writenodeindention+'    ';
+         writenode(right);
+         write(')');
+         delete(writenodeindention,1,4);
+      end;
+{$endif}
+
+{****************************************************************************
+                            TBINOPYNODE
+ ****************************************************************************}
+
+    constructor tbinopnode.create(tt : tnodetype;l,r : tnode);
+
+      begin
+         inherited create(tt,l,r);
+      end;
+
+    function tbinopnode.docompare(p : tnode) : boolean;
+
+      begin
+         docompare:=(inherited docompare(p)) or
+           ((nf_swapable in flags) and
+            left.isequal(tbinopnode(p).right) and
+            right.isequal(tbinopnode(p).left));
+      end;
+
+
+{****************************************************************************
+                                 WRITENODE
+ ****************************************************************************}
+
+{$ifdef EXTDEBUG}
+     procedure writenode(t:tnode);
+     begin
+       if assigned(t) then
+        t.dowrite
+       else
+        write(writenodeindention,'nil');
+       if writenodeindention='' then
+        writeln;
+     end;
+{$endif EXTDEBUG}
 
-    {$I node.inc}
 
 end.
 {
   $Log$
-  Revision 1.10  2000-11-29 00:30:34  florian
+  Revision 1.11  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.10  2000/11/29 00:30:34  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/ogbase.pas

@@ -432,12 +432,12 @@ implementation
         SmartFilesCount:=0;
         SmartHeaderCount:=0;
         objsmart:=smart;
-        objfile:=current_module^.objfilename^;
+        objfile:=current_module.objfilename^;
       { Which path will be used ? }
         if objsmart and
            (cs_asm_leave in aktglobalswitches) then
          begin
-           path:=current_module^.path^+FixFileName(current_module^.modulename^)+target_info.smartext;
+           path:=current_module.path^+FixFileName(current_module.modulename^)+target_info.smartext;
            {$I-}
             mkdir(path);
            {$I+}
@@ -445,11 +445,11 @@ implementation
            path:=FixPath(path,false);
          end
         else
-         path:=current_module^.path^;
+         path:=current_module.path^;
       { init writer }
         if objsmart and
            not(cs_asm_leave in aktglobalswitches) then
-          writer:=tarobjectwriter.create(current_module^.staticlibfilename^)
+          writer:=tarobjectwriter.create(current_module.staticlibfilename^)
         else
           writer:=tobjectwriter.create;
       end;
@@ -469,9 +469,9 @@ implementation
         if SmartFilesCount>999999 then
          Message(asmw_f_too_many_asm_files);
         if (cs_asm_leave in aktglobalswitches) then
-         s:=current_module^.asmprefix^
+         s:=current_module.asmprefix^
         else
-         s:=current_module^.modulename^;
+         s:=current_module.modulename^;
         case place of
           cut_begin :
             begin
@@ -529,7 +529,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-12-24 12:25:31  peter
+  Revision 1.5  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/12/24 12:25:31  peter
     + cstreams unit
     * dynamicarray object to class
 

compiler/ogcoff.pas

@@ -204,7 +204,7 @@ implementation
            createsection(sec_stabstr);
            writestabs(sec_none,0,nil,0,0,0,false);
            { write zero pchar and name together (PM) }
-           s:=#0+SplitFileName(current_module^.mainsource^)+#0;
+           s:=#0+SplitFileName(current_module.mainsource^)+#0;
            sects[sec_stabstr].write(s[1],length(s));
          end;
       end;
@@ -483,7 +483,7 @@ implementation
         if (cs_debuginfo in aktmoduleswitches) then
          begin
            inc(s[sec_stab],sizeof(coffstab));
-           inc(s[sec_stabstr],length(SplitFileName(current_module^.mainsource^))+2);
+           inc(s[sec_stabstr],length(SplitFileName(current_module.mainsource^))+2);
          end;
         { calc mempos }
         mempos:=0;
@@ -609,7 +609,7 @@ implementation
            { The `.file' record, and the file name auxiliary record }
            write_symbol ('.file', -1, 0, -2, $67, 1);
            fillchar(filename,sizeof(filename),0);
-           filename:=SplitFileName(current_module^.mainsource^);
+           filename:=SplitFileName(current_module.mainsource^);
            writer.write(filename[1],sizeof(filename)-1);
            { The section records, with their auxiliaries, also store the
              symbol index }
@@ -778,7 +778,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2000-12-24 12:25:31  peter
+  Revision 1.8  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.7  2000/12/24 12:25:31  peter
     + cstreams unit
     * dynamicarray object to class
 

compiler/ogelf.pas

@@ -291,7 +291,7 @@ implementation
         shstrtabsect:=telf32section.createname('.shstrtab',3,0,0,0,1,0);
         { insert the empty and filename as first in strtab }
         strtabsect.writestr(#0);
-        strtabsect.writestr(SplitFileName(current_module^.mainsource^)+#0);
+        strtabsect.writestr(SplitFileName(current_module.mainsource^)+#0);
         { we need at least the following sections }
         createsection(sec_code);
         createsection(sec_data);
@@ -303,7 +303,7 @@ implementation
            createsection(sec_stabstr);
            writestabs(sec_none,0,nil,0,0,0,false);
            { write zero pchar and name together (PM) }
-           s:=#0+SplitFileName(current_module^.mainsource^)+#0;
+           s:=#0+SplitFileName(current_module.mainsource^)+#0;
            sects[sec_stabstr].write(s[1],length(s));
          end;
       end;
@@ -844,7 +844,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-12-24 12:25:32  peter
+  Revision 1.5  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/12/24 12:25:32  peter
     + cstreams unit
     * dynamicarray object to class
 

compiler/options.pas

@@ -99,50 +99,21 @@ procedure def_symbol(const s : string);
 begin
   if s='' then
    exit;
-  initdefines.concat(new(pstring_item,init(upper(s))));
+  initdefines.insert(upper(s));
 end;
 
 
 procedure undef_symbol(const s : string);
-var
-  item,next : pstring_item;
 begin
   if s='' then
    exit;
-  item:=pstring_item(initdefines.first);
-  while assigned(item) do
-   begin
-     if (item^.str^=s) then
-      begin
-        next:=pstring_item(item^.next);
-        initdefines.remove(item);
-        dispose(item,done);
-        item:=next;
-      end
-     else
-      if item<>pstring_item(item^.next) then
-       item:=pstring_item(item^.next)
-      else
-       break;
-   end;
+  InitDefines.Remove(s);
 end;
 
 
 function check_symbol(const s:string):boolean;
-var
-  hp : pstring_item;
 begin
-  hp:=pstring_item(initdefines.first);
-  while assigned(hp) do
-   begin
-     if (hp^.str^=s) then
-      begin
-        check_symbol:=true;
-        exit;
-      end;
-     hp:=pstring_item(hp^.next);
-   end;
-  check_symbol:=false;
+  check_symbol:=(initdefines.find(s)<>nil);
 end;
 
 
@@ -394,7 +365,7 @@ begin
                           end
                         else if More<>'+' then
 {$ifdef BrowserLog}
-                          browserlog.elements_to_list^.insert(more);
+                          browserlog.elements_to_list.insert(more);
 {$else}
                           IllegalPara(opt);
 {$endif}
@@ -1211,19 +1182,19 @@ begin
   FirstPass:=false;
   FileLevel:=0;
   Quickinfo:='';
-  ParaIncludePath.Init;
-  ParaObjectPath.Init;
-  ParaUnitPath.Init;
-  ParaLibraryPath.Init;
+  ParaIncludePath:=TSearchPathList.Create;
+  ParaObjectPath:=TSearchPathList.Create;
+  ParaUnitPath:=TSearchPathList.Create;
+  ParaLibraryPath:=TSearchPathList.Create;
 end;
 
 
 destructor TOption.destroy;
 begin
-  ParaIncludePath.Done;
-  ParaObjectPath.Done;
-  ParaUnitPath.Done;
-  ParaLibraryPath.Done;
+  ParaIncludePath.Free;
+  ParaObjectPath.Free;
+  ParaUnitPath.Free;
+  ParaLibraryPath.Free;
 end;
 
 
@@ -1538,7 +1509,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.23  2000-12-24 12:21:41  peter
+  Revision 1.24  2000-12-25 00:07:26  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.23  2000/12/24 12:21:41  peter
     * use system.paramstr()
 
   Revision 1.22  2000/12/23 19:46:49  peter

compiler/parser.pas

@@ -36,8 +36,8 @@ interface
 implementation
 
     uses
-      globtype,version,tokens,systems,
-      cutils,cobjects,globals,verbose,
+      cutils,cobjects,cclasses,
+      globtype,version,tokens,systems,globals,verbose,
       symbase,symtable,symsym,fmodule,aasm,
       hcodegen,
       script,gendef,
@@ -70,9 +70,9 @@ implementation
          compiled_module:=nil;
          procinfo:=nil;
 
-         loaded_units.init;
+         loaded_units:=TLinkedList.Create;
 
-         usedunits.init;
+         usedunits:=TLinkedList.Create;
 
          { global switches }
          aktglobalswitches:=initglobalswitches;
@@ -98,35 +98,35 @@ implementation
          DefFile.Init(outputexedir+inputfile+target_os.defext);
 
          { list of generated .o files, so the linker can remove them }
-         SmartLinkOFiles.init;
+         SmartLinkOFiles:=TStringList.Create;
       end;
 
 
     procedure doneparser;
       begin
          { unload units }
-         loaded_units.done;
-         usedunits.done;
+         loaded_units.free;
+         usedunits.free;
 
          { close ppas,deffile }
          asmres.done;
          deffile.done;
 
          { free list of .o files }
-         SmartLinkOFiles.done;
+         SmartLinkOFiles.Free;
       end;
 
 
     procedure default_macros;
       var
-        hp : pstring_item;
+        hp : tstringlistitem;
       begin
       { commandline }
-        hp:=pstring_item(initdefines.first);
+        hp:=tstringlistitem(initdefines.first);
         while assigned(hp) do
          begin
-           current_scanner^.def_macro(hp^.str^);
-           hp:=pstring_item(hp^.next);
+           current_scanner^.def_macro(hp.str);
+           hp:=tstringlistitem(hp.next);
          end;
       { set macros for version checking }
         current_scanner^.set_macro('FPC_VERSION',version_nr);
@@ -149,7 +149,7 @@ implementation
          main_module:=current_module;
        { startup scanner, and save in current_module }
          current_scanner:=new(pscannerfile,Init(filename));
-         current_module^.scanner:=current_scanner;
+         current_module.scanner:=current_scanner;
        { loop until EOF is found }
          repeat
            current_scanner^.readtoken;
@@ -240,10 +240,10 @@ implementation
          oldexprasmlist,
          olddebuglist,
          oldwithdebuglist,
-         oldconsts     : paasmoutput;
+         oldconsts     : taasmoutput;
          oldasmsymbollist : pdictionary;
        { resourcestrings }
-         OldResourceStrings : PResourceStrings;
+         OldResourceStrings : tResourceStrings;
        { akt.. things }
          oldaktlocalswitches  : tlocalswitches;
          oldaktmoduleswitches : tmoduleswitches;
@@ -256,7 +256,7 @@ implementation
          oldaktasmmode      : tasmmode;
          oldaktinterfacetype: tinterfacetypes;
          oldaktmodeswitches : tmodeswitches;
-         old_compiled_module : pmodule;
+         old_compiled_module : tmodule;
          prev_name          : pstring;
 {$ifdef USEEXCEPT}
 {$ifndef Delphi}
@@ -352,14 +352,14 @@ implementation
        { reset the unit or create a new program }
          if assigned(current_module) then
            begin
-              {current_module^.reset this is wrong !! }
-               scanner:=current_module^.scanner;
-               current_module^.reset;
-               current_module^.scanner:=scanner;
+              {current_module.reset this is wrong !! }
+               scanner:=current_module.scanner;
+               current_module.reset;
+               current_module.scanner:=scanner;
            end
          else
           begin
-            current_module:=new(pmodule,init(filename,false));
+            current_module:=tmodule.create(filename,false);
             main_module:=current_module;
           end;
 
@@ -367,7 +367,7 @@ implementation
          SetCompileModule(current_module);
 
          compiled_module:=current_module;
-         current_module^.in_compile:=true;
+         current_module.in_compile:=true;
        { Load current state from the init values }
          aktlocalswitches:=initlocalswitches;
          aktmoduleswitches:=initmoduleswitches;
@@ -392,8 +392,8 @@ implementation
          default_macros;
        { read the first token }
          current_scanner^.readtoken;
-         prev_scanner:=current_module^.scanner;
-         current_module^.scanner:=current_scanner;
+         prev_scanner:=current_module.scanner;
+         current_module.scanner:=current_scanner;
 
        { init code generator for a new module }
          codegen_newmodule;
@@ -420,7 +420,7 @@ implementation
 
             if (token=_UNIT) or (compile_level>1) then
               begin
-                current_module^.is_unit:=true;
+                current_module.is_unit:=true;
                 proc_unit;
               end
             else
@@ -454,15 +454,15 @@ implementation
 {$endif newcg}
 
        { free ppu }
-         if assigned(current_module^.ppufile) then
+         if assigned(current_module.ppufile) then
           begin
-            dispose(current_module^.ppufile,done);
-            current_module^.ppufile:=nil;
+            dispose(current_module.ppufile,done);
+            current_module.ppufile:=nil;
           end;
        { free scanner }
          dispose(current_scanner,done);
        { restore previous scanner !! }
-         current_module^.scanner:=prev_scanner;
+         current_module.scanner:=prev_scanner;
          if assigned(prev_scanner) then
            prev_scanner^.invalid:=true;
 
@@ -542,7 +542,7 @@ implementation
               if (cs_browser_log in aktglobalswitches) and
                  (cs_browser in aktmoduleswitches) then
                  begin
-                 if browserlog.elements_to_list^.empty then
+                 if browserlog.elements_to_list.empty then
                    begin
                    Message1(parser_i_writing_browser_log,browserlog.Fname);
                    WriteBrowserLog;
@@ -556,13 +556,13 @@ implementation
                  do_extractsymbolinfo{$ifdef FPC}(){$endif};
               end;
 
-         if current_module^.in_second_compile then
+         if current_module.in_second_compile then
            begin
-             current_module^.in_second_compile:=false;
-             current_module^.in_compile:=true;
+             current_module.in_second_compile:=false;
+             current_module.in_compile:=true;
            end
          else
-           current_module^.in_compile:=false;
+           current_module.in_compile:=false;
 
           (* Obsolete code aktprocsym
              is disposed by the localsymtable disposal (PM)
@@ -570,7 +570,7 @@ implementation
             if assigned(aktprocsym) and (aktprocsym^.owner=nil) then
              begin
                { init parts are not needed in units !! }
-               if current_module^.is_unit then
+               if current_module.is_unit then
                  aktprocsym^.definition^.forwarddef:=false;
                dispose(aktprocsym,done);
              end; *)
@@ -589,7 +589,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2000-12-24 12:24:38  peter
+  Revision 1.13  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.12  2000/12/24 12:24:38  peter
     * moved preprocessfile into a conditional
 
   Revision 1.11  2000/11/29 00:30:34  florian

compiler/pass_2.pas

@@ -294,14 +294,18 @@ implementation
                 procinfo^.def^.fpu_used:=p.registersfpu;
 
            end;
-         procinfo^.aktproccode^.concatlist(exprasmlist);
+         procinfo^.aktproccode.concatlist(exprasmlist);
          make_const_global:=false;
       end;
 
 end.
 {
   $Log$
-  Revision 1.11  2000-11-29 00:30:35  florian
+  Revision 1.12  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.11  2000/11/29 00:30:35  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/pbase.pas

@@ -27,7 +27,8 @@ unit pbase;
 interface
 
     uses
-       cobjects,tokens,globals,
+       cutils,cobjects,cclasses,
+       tokens,globals,
        symbase,symdef,symsym
 {$ifdef fixLeaksOnError}
        ,comphook
@@ -42,6 +43,20 @@ interface
        getprocvar : boolean = false;
        getprocvardef : pprocvardef = nil;
 
+    type
+       { listitem }
+       tidstringlistitem = class(tlinkedlistitem)
+          data : pstring;
+          file_info : tfileposinfo;
+          constructor Create(const s:string;const pos:tfileposinfo);
+          destructor  Destroy;override;
+       end;
+
+       tidstringlist=class(tlinkedlist)
+          procedure add(const s : string;const file_info : tfileposinfo);
+          function  get(var file_info : tfileposinfo) : string;
+          function  find(const s:string):boolean;
+       end;
 
     var
        { size of data segment, set by proc_unit or proc_program }
@@ -83,19 +98,90 @@ interface
     { consumes tokens while they are semicolons }
     procedure emptystats;
 
-    { reads a list of identifiers into a string container }
-    function idlist : pstringcontainer;
+    { reads a list of identifiers into a string list }
+    function idlist : tidstringlist;
 
     { just for an accurate position of the end of a procedure (PM) }
     var
        last_endtoken_filepos: tfileposinfo;
 
 
-  implementation
+implementation
 
     uses
        scanner,systems,verbose;
 
+{****************************************************************************
+                           TIdStringlistItem
+****************************************************************************}
+
+    constructor TIDStringlistItem.Create(const s:string;const pos:tfileposinfo);
+      begin
+        data:=stringdup(s);
+        file_info:=pos;
+      end;
+
+
+    destructor  TIDStringlistItem.Destroy;
+      begin
+        stringdispose(data);
+      end;
+
+
+{****************************************************************************
+                             TIdStringlist
+****************************************************************************}
+
+    procedure tidstringlist.add(const s : string; const file_info : tfileposinfo);
+      begin
+         if find(s) then
+          exit;
+         inherited concat(tidstringlistitem.create(s,file_info));
+      end;
+
+
+    function tidstringlist.get(var file_info : tfileposinfo) : string;
+      var
+         p : tidstringlistitem;
+      begin
+         p:=tidstringlistitem(inherited getfirst);
+         if p=nil then
+          begin
+            get:='';
+            file_info.fileindex:=0;
+            file_info.line:=0;
+            file_info.column:=0;
+          end
+         else
+          begin
+            get:=p.data^;
+            file_info:=p.file_info;
+            p.free;
+          end;
+      end;
+
+    function tidstringlist.find(const s:string):boolean;
+      var
+        newnode : tidstringlistitem;
+      begin
+        find:=false;
+        newnode:=tidstringlistitem(First);
+        while assigned(newnode) do
+         begin
+           if newnode.data^=s then
+            begin
+              find:=true;
+              exit;
+            end;
+           newnode:=tidstringlistitem(newnode.next);
+         end;
+      end;
+
+
+{****************************************************************************
+                               Token Parsing
+****************************************************************************}
+
     function tokenstring(i : ttoken):string;
       begin
         tokenstring:=tokeninfo^[i].str;
@@ -153,14 +239,14 @@ interface
       end;
 
 
-    { reads a list of identifiers into a string container }
-    function idlist : pstringcontainer;
+    { reads a list of identifiers into a string list }
+    function idlist : tidstringlist;
       var
-        sc : pstringcontainer;
+        sc : tIdstringlist;
       begin
-         sc:=new(pstringcontainer,init);
+         sc:=TIdStringlist.Create;
          repeat
-           sc^.insert_with_tokeninfo(orgpattern,akttokenpos);
+           sc.add(orgpattern,akttokenpos);
            consume(_ID);
          until not try_to_consume(_COMMA);
          idlist:=sc;
@@ -168,13 +254,13 @@ interface
 
 {$ifdef fixLeaksOnError}
 procedure pbase_do_stop;
-var names: PStringContainer;
+var names: PStringlist;
 begin
-  names := PStringContainer(strContStack.pop);
+  names := PStringlist(strContStack.pop);
   while names <> nil do
     begin
       dispose(names,done);
-      names := PStringContainer(strContStack.pop);
+      names := PStringlist(strContStack.pop);
     end;
   strContStack.done;
   do_stop := pbase_old_do_stop;
@@ -190,7 +276,11 @@ end.
 
 {
   $Log$
-  Revision 1.6  2000-10-31 22:02:49  peter
+  Revision 1.7  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.6  2000/10/31 22:02:49  peter
     * symtable splitted, no real code changes
 
   Revision 1.5  2000/09/24 15:06:21  peter
@@ -207,4 +297,4 @@ end.
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
 
-}
+}

compiler/pdecl.pas

@@ -25,8 +25,16 @@ unit pdecl;
 {$i defines.inc}
 
 interface
+
     uses
-      cobjects,symsym,node;
+      { common }
+      cobjects,
+      { global }
+      globals,
+      { symtable }
+      symsym,
+      { pass_1 }
+      node;
 
     function  readconstant(const name:string;const filepos:tfileposinfo):pconstsym;
 
@@ -43,7 +51,7 @@ implementation
        { common }
        cutils,
        { global }
-       globtype,globals,tokens,verbose,
+       globtype,tokens,verbose,
        systems,
        { aasm }
        aasm,
@@ -536,7 +544,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2000-12-07 17:19:42  jonas
+  Revision 1.24  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.23  2000/12/07 17:19:42  jonas
     * new constant handling: from now on, hex constants >$7fffffff are
       parsed as unsigned constants (otherwise, $80000000 got sign extended
       and became $ffffffff80000000), all constants in the longint range

compiler/pdecobj.pas

@@ -35,7 +35,7 @@ interface
 implementation
 
     uses
-      cutils,cobjects,
+      cutils,cobjects,cclasses,
       globals,verbose,systems,tokens,
       aasm,symconst,symbase,symsym,symtable,types,
 {$ifdef GDB}
@@ -88,7 +88,7 @@ implementation
 
         var
            sym : psym;
-           propertyparas : plinkedlist;
+           propertyparas : tlinkedlist;
 
         { returns the matching procedure to access a property }
         function get_procdef : pprocdef;
@@ -109,12 +109,12 @@ implementation
           end;
 
         var
-           hp2,datacoll : pparaitem;
+           hp2,datacoll : tparaitem;
            p : ppropertysym;
            overriden : psym;
            hs : string;
            varspez : tvarspez;
-           sc : pstringcontainer;
+           sc : tidstringlist;
            s : string;
            tt : ttype;
            declarepos : tfileposinfo;
@@ -127,7 +127,7 @@ implementation
            if not(is_class_or_interface(aktclass)) then
             Message(parser_e_syntax_error);
            consume(_PROPERTY);
-           new(propertyparas,init);
+           propertyparas:=TParaLinkedList.Create;
            datacoll:=nil;
            if token=_ID then
              begin
@@ -190,26 +190,26 @@ implementation
                        else
                          tt.setdef(cformaldef);
                        repeat
-                         s:=sc^.get_with_tokeninfo(declarepos);
+                         s:=sc.get(declarepos);
                          if s='' then
                           break;
-                         new(hp2,init);
-                         hp2^.paratyp:=varspez;
-                         hp2^.paratype:=tt;
-                         propertyparas^.insert(hp2);
+                         hp2:=TParaItem.create;
+                         hp2.paratyp:=varspez;
+                         hp2.paratype:=tt;
+                         propertyparas.insert(hp2);
                        until false;
 {$ifdef fixLeaksOnError}
                        if strContStack.pop <> sc then
                          writeln('problem with strContStack in ptype');
 {$endif fixLeaksOnError}
-                       dispose(sc,done);
+                       sc.free;
                      until not try_to_consume(_SEMICOLON);
                      dec(testcurobject);
                      consume(_RECKKLAMMER);
                   end;
                 { overriden property ?                                 }
                 { force property interface, if there is a property parameter }
-                if (token=_COLON) or not(propertyparas^.empty) then
+                if (token=_COLON) or not(propertyparas.empty) then
                   begin
                      consume(_COLON);
                      single_type(p^.proptype,hs,false);
@@ -229,14 +229,14 @@ implementation
                           p^.indextype.setdef(pt.resulttype);
                           include(p^.propoptions,ppo_indexed);
                           { concat a longint to the para template }
-                          new(hp2,init);
-                          hp2^.paratyp:=vs_value;
-                          hp2^.paratype:=p^.indextype;
-                          propertyparas^.insert(hp2);
+                          hp2:=TParaItem.Create;
+                          hp2.paratyp:=vs_value;
+                          hp2.paratype:=p^.indextype;
+                          propertyparas.insert(hp2);
                           pt.free;
                        end;
                      { the parser need to know if a property has parameters }
-                     if not(propertyparas^.empty) then
+                     if not(propertyparas.empty) then
                        include(p^.propoptions,ppo_hasparameters);
                   end
                 else
@@ -258,9 +258,9 @@ implementation
                   Message(parser_e_cant_publish_that_property);
 
                 { create data defcoll to allow correct parameter checks }
-                new(datacoll,init);
-                datacoll^.paratyp:=vs_value;
-                datacoll^.paratype:=p^.proptype;
+                datacoll:=TParaItem.Create;
+                datacoll.paratyp:=vs_value;
+                datacoll.paratype:=p^.proptype;
 
                 if (idtoken=_READ) then
                   begin
@@ -303,7 +303,7 @@ implementation
                               end;
                             varsym :
                               begin
-                                if not(propertyparas^.empty) or
+                                if not(propertyparas.empty) or
                                    not(is_equal(pvarsym(sym)^.vartype.def,p^.proptype.def)) then
                                   Message(parser_e_ill_property_access_sym);
                               end;
@@ -347,17 +347,17 @@ implementation
                             procsym :
                               begin
                                  { insert data entry to check access method }
-                                 propertyparas^.insert(datacoll);
+                                 propertyparas.insert(datacoll);
                                  pp:=get_procdef;
                                  { ... and remove it }
-                                 propertyparas^.remove(datacoll);
+                                 propertyparas.remove(datacoll);
                                  if not(assigned(pp)) then
                                    Message(parser_e_ill_property_access_sym);
                                  p^.writeaccess^.setdef(pp);
                               end;
                             varsym :
                               begin
-                                 if not(propertyparas^.empty) or
+                                 if not(propertyparas.empty) or
                                     not(is_equal(pvarsym(sym)^.vartype.def,p^.proptype.def)) then
                                    Message(parser_e_ill_property_access_sym);
                               end
@@ -413,7 +413,7 @@ implementation
                                            while assigned(pp) do
                                              begin
                                                 { the stored function shouldn't have any parameters }
-                                                if pp^.para^.empty then
+                                                if pp^.Para.empty then
                                                   break;
                                                  pp:=pp^.nextoverloaded;
                                              end;
@@ -425,7 +425,7 @@ implementation
                                          end;
                                        varsym :
                                          begin
-                                           if not(propertyparas^.empty) or
+                                           if not(propertyparas.empty) or
                                               not(is_equal(pvarsym(sym)^.vartype.def,booldef)) then
                                              Message(parser_e_stored_property_must_be_boolean);
                                          end;
@@ -451,7 +451,7 @@ implementation
                             is_64bitint(p^.proptype.def) or
                             ((p^.proptype.def^.deftype=setdef) and
                              (psetdef(p^.proptype.def)^.settype=smallset))) or
-                        not(propertyparas^.empty) then
+                        not(propertyparas.empty) then
                        Message(parser_e_property_cant_have_a_default_value);
                      { Get the result of the default, the firstpass is
                        needed to support values like -1 }
@@ -494,21 +494,21 @@ implementation
                      }
                        begin
                           include(p^.propoptions,ppo_defaultproperty);
-                          if propertyparas^.empty then
+                          if propertyparas.empty then
                             message(parser_e_property_need_paras);
                        end;
                      consume(_SEMICOLON);
                   end;
                 { clean up }
                 if assigned(datacoll) then
-                  dispose(datacoll,done);
+                  datacoll.free;
              end
            else
              begin
                 consume(_ID);
                 consume(_SEMICOLON);
              end;
-           dispose(propertyparas,done);
+           propertyparas.free;
         end;
 
 
@@ -522,7 +522,7 @@ implementation
             Message(parser_e_destructorname_must_be_done);
            include(aktclass^.objectoptions,oo_has_destructor);
            consume(_SEMICOLON);
-           if not(aktprocsym^.definition^.para^.empty) then
+           if not(aktprocsym^.definition^.Para.empty) then
              if not (m_tp in aktmodeswitches) then
                Message(parser_e_no_paras_for_destructor);
            { no return value }
@@ -602,8 +602,8 @@ implementation
            dmtlabel:=gendmt(aktclass);
 {$endif WITHDMT}
            { this generates the entries }
-           vmtlist.init;
-           genvmt(@vmtlist,aktclass);
+           vmtlist:=TAasmoutput.Create;
+           genvmt(vmtlist,aktclass);
 
            { write tables for classes, this must be done before the actual
              class is written, because we need the labels defined }
@@ -616,16 +616,16 @@ implementation
                aktclass^.generate_rtti;
               { write class name }
               getdatalabel(classnamelabel);
-              datasegment^.concat(new(pai_label,init(classnamelabel)));
-              datasegment^.concat(new(pai_const,init_8bit(length(aktclass^.objname^))));
-              datasegment^.concat(new(pai_string,init(aktclass^.objname^)));
+              dataSegment.concat(Tai_label.Create(classnamelabel));
+              dataSegment.concat(Tai_const.Create_8bit(length(aktclass^.objname^)));
+              dataSegment.concat(Tai_string.Create(aktclass^.objname^));
               { generate message and dynamic tables }
               if (oo_has_msgstr in aktclass^.objectoptions) then
                 strmessagetable:=genstrmsgtab(aktclass);
               if (oo_has_msgint in aktclass^.objectoptions) then
                 intmessagetable:=genintmsgtab(aktclass)
               else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
+                dataSegment.concat(Tai_const.Create_32bit(0));
               if aktclass^.implementedinterfaces^.count>0 then
                 interfacetable:=genintftable(aktclass);
             end;
@@ -636,23 +636,23 @@ implementation
            begin
              do_count_dbx:=true;
              if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
-               datasegment^.concat(new(pai_stabs,init(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+
-                 typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
+               dataSegment.concat(Tai_stabs.Create(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+
+                 typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname)));
            end;
 {$endif GDB}
-           datasegment^.concat(new(pai_symbol,initdataname_global(aktclass^.vmt_mangledname,0)));
+           dataSegment.concat(Tai_symbol.Createdataname_global(aktclass^.vmt_mangledname,0));
 
            { determine the size with symtable^.datasize, because }
            { size gives back 4 for classes                    }
-           datasegment^.concat(new(pai_const,init_32bit(aktclass^.symtable^.datasize)));
-           datasegment^.concat(new(pai_const,init_32bit(-aktclass^.symtable^.datasize)));
+           dataSegment.concat(Tai_const.Create_32bit(aktclass^.symtable^.datasize));
+           dataSegment.concat(Tai_const.Create_32bit(-aktclass^.symtable^.datasize));
 {$ifdef WITHDMT}
            if classtype=ct_object then
              begin
                 if assigned(dmtlabel) then
-                  datasegment^.concat(new(pai_const_symbol,init(dmtlabel)))
+                  dataSegment.concat(Tai_const_symbol.Create(dmtlabel)))
                 else
-                  datasegment^.concat(new(pai_const,init_32bit(0)));
+                  dataSegment.concat(Tai_const.Create_32bit(0));
              end;
 {$endif WITHDMT}
            { write pointer to parent VMT, this isn't implemented in TP }
@@ -661,60 +661,60 @@ implementation
            { it is not written for parents that don't have any vmt !! }
            if assigned(aktclass^.childof) and
               (oo_has_vmt in aktclass^.childof^.objectoptions) then
-             datasegment^.concat(new(pai_const_symbol,initname(aktclass^.childof^.vmt_mangledname)))
+             dataSegment.concat(Tai_const_symbol.Createname(aktclass^.childof^.vmt_mangledname))
            else
-             datasegment^.concat(new(pai_const,init_32bit(0)));
+             dataSegment.concat(Tai_const.Create_32bit(0));
 
            { write extended info for classes, for the order see rtl/inc/objpash.inc }
            if classtype=odt_class then
             begin
               { pointer to class name string }
-              datasegment^.concat(new(pai_const_symbol,init(classnamelabel)));
+              dataSegment.concat(Tai_const_symbol.Create(classnamelabel));
               { pointer to dynamic table }
               if (oo_has_msgint in aktclass^.objectoptions) then
-                datasegment^.concat(new(pai_const_symbol,init(intmessagetable)))
+                dataSegment.concat(Tai_const_symbol.Create(intmessagetable))
               else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
+                dataSegment.concat(Tai_const.Create_32bit(0));
               { pointer to method table }
               if assigned(methodnametable) then
-                datasegment^.concat(new(pai_const_symbol,init(methodnametable)))
+                dataSegment.concat(Tai_const_symbol.Create(methodnametable))
               else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
+                dataSegment.concat(Tai_const.Create_32bit(0));
               { pointer to field table }
-              datasegment^.concat(new(pai_const_symbol,init(fieldtablelabel)));
+              dataSegment.concat(Tai_const_symbol.Create(fieldtablelabel));
               { pointer to type info of published section }
               if (oo_can_have_published in aktclass^.objectoptions) then
-                datasegment^.concat(new(pai_const_symbol,initname(aktclass^.rtti_name)))
+                dataSegment.concat(Tai_const_symbol.Createname(aktclass^.rtti_name))
               else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
+                dataSegment.concat(Tai_const.Create_32bit(0));
               { inittable for con-/destruction }
               {
               if aktclass^.needs_inittable then
               }
               { we generate the init table for classes always, because needs_inittable }
               { for classes is always false, it applies only for objects               }
-              datasegment^.concat(new(pai_const_symbol,init(aktclass^.get_inittable_label)));
+              dataSegment.concat(Tai_const_symbol.Create(aktclass^.get_inittable_label));
               {
               else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
+                dataSegment.concat(Tai_const.Create_32bit(0));
               }
               { auto table }
-              datasegment^.concat(new(pai_const,init_32bit(0)));
+              dataSegment.concat(Tai_const.Create_32bit(0));
               { interface table }
               if aktclass^.implementedinterfaces^.count>0 then
-                datasegment^.concat(new(pai_const_symbol,init(interfacetable)))
+                dataSegment.concat(Tai_const_symbol.Create(interfacetable))
               else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
+                dataSegment.concat(Tai_const.Create_32bit(0));
               { table for string messages }
               if (oo_has_msgstr in aktclass^.objectoptions) then
-                datasegment^.concat(new(pai_const_symbol,init(strmessagetable)))
+                dataSegment.concat(Tai_const_symbol.Create(strmessagetable))
               else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
+                dataSegment.concat(Tai_const.Create_32bit(0));
             end;
-           datasegment^.concatlist(@vmtlist);
-           vmtlist.done;
+           dataSegment.concatlist(vmtlist);
+           vmtlist.free;
            { write the size of the VMT }
-           datasegment^.concat(new(pai_symbol_end,initname(aktclass^.vmt_mangledname)));
+           dataSegment.concat(Tai_symbol_end.Createname(aktclass^.vmt_mangledname));
         end;
 
       procedure setinterfacemethodoptions;
@@ -856,9 +856,7 @@ implementation
 
       procedure readinterfaceiid;
         var
-          tt: ttype;
           p : tnode;
-
         begin
           p:=comp_expr(true);
           do_firstpass(p);
@@ -877,8 +875,8 @@ implementation
             end;
         end;
 
-      procedure readparentclasses;
 
+      procedure readparentclasses;
         begin
            { reads the parent class }
            if token=_LKLAMMER then
@@ -1144,7 +1142,7 @@ implementation
             ) then
            aktclass^.insertvmt;
          if (cs_create_smart in aktmoduleswitches) then
-           datasegment^.concat(new(pai_cut,init));
+           dataSegment.concat(Tai_cut.Create);
 
          if is_interface(aktclass) then
            writeinterfaceids(aktclass);
@@ -1170,7 +1168,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2000-11-29 00:30:35  florian
+  Revision 1.15  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.14  2000/11/29 00:30:35  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/pdecsub.pas

@@ -44,7 +44,7 @@ interface
 
     procedure parameter_dec(aktprocdef:pabstractprocdef);
 
-    procedure parse_proc_directives(Anames:Pstringcontainer;var pdflags:word);
+    procedure parse_proc_directives(var pdflags:word);
 
     procedure parse_proc_head(options:tproctypeoption);
     procedure parse_proc_dec;
@@ -92,7 +92,7 @@ implementation
       }
       var
         is_procvar : boolean;
-        sc      : Pstringcontainer;
+        sc      : tidstringlist;
         s       : string;
         hpos,
         storetokenpos : tfileposinfo;
@@ -217,10 +217,10 @@ implementation
                       begin
                         if try_to_consume(_EQUAL) then
                          begin
-                           s:=sc^.get_with_tokeninfo(hpos);
-                           if not sc^.empty then
+                           s:=sc.get(hpos);
+                           if not sc.empty then
                             Comment(V_Error,'default value only allowed for one parameter');
-                           sc^.insert_with_tokeninfo(s,hpos);
+                           sc.add(s,hpos);
                            { prefix 'def' to the parameter name }
                            pdefaultvalue:=ReadConstant('$def'+Upper(s),hpos);
                            if assigned(pdefaultvalue) then
@@ -247,9 +247,9 @@ implementation
                if not is_procvar then
                 hs2:=pprocdef(aktprocdef)^.mangledname;
                storetokenpos:=akttokenpos;
-               while not sc^.empty do
+               while not sc.empty do
                 begin
-                  s:=sc^.get_with_tokeninfo(akttokenpos);
+                  s:=sc.get(akttokenpos);
                   aktprocdef^.concatpara(tt,varspez,pdefaultvalue);
                   { For proc vars we only need the definitions }
                   if not is_procvar then
@@ -293,7 +293,7 @@ implementation
                if PStringContainer(strContStack.pop) <> sc then
                   writeln('problem with strContStack in pdecl (1)');
 {$endif fixLeaksOnError}
-               dispose(sc,done);
+               sc.free;
                akttokenpos:=storetokenpos;
             end;
           { set the new mangled name }
@@ -741,17 +741,17 @@ end;
                         Procedure directive handlers
 ****************************************************************************}
 
-procedure pd_far(const procnames:Tstringcontainer);
+procedure pd_far;
 begin
   Message(parser_w_proc_far_ignored);
 end;
 
-procedure pd_near(const procnames:Tstringcontainer);
+procedure pd_near;
 begin
   Message(parser_w_proc_near_ignored);
 end;
 
-procedure pd_export(const procnames:Tstringcontainer);
+procedure pd_export;
 begin
   if assigned(procinfo^._class) then
     Message(parser_e_methods_dont_be_export);
@@ -760,39 +760,39 @@ begin
   { only os/2 needs this }
   if target_info.target=target_i386_os2 then
    begin
-     procnames.insert(aktprocsym^.realname);
+     aktprocsym^.definition^.aliasnames.insert(aktprocsym^.realname);
      procinfo^.exported:=true;
      if cs_link_deffile in aktglobalswitches then
        deffile.AddExport(aktprocsym^.definition^.mangledname);
    end;
 end;
 
-procedure pd_inline(const procnames:Tstringcontainer);
+procedure pd_inline;
 begin
   if not(cs_support_inline in aktmoduleswitches) then
    Message(parser_e_proc_inline_not_supported);
 end;
 
-procedure pd_forward(const procnames:Tstringcontainer);
+procedure pd_forward;
 begin
   aktprocsym^.definition^.forwarddef:=true;
 end;
 
-procedure pd_stdcall(const procnames:Tstringcontainer);
+procedure pd_stdcall;
 begin
 end;
 
-procedure pd_safecall(const procnames:Tstringcontainer);
+procedure pd_safecall;
 begin
 end;
 
-procedure pd_alias(const procnames:Tstringcontainer);
+procedure pd_alias;
 begin
   consume(_COLON);
-  procnames.insert(get_stringconst);
+  aktprocsym^.definition^.aliasnames.insert(get_stringconst);
 end;
 
-procedure pd_asmname(const procnames:Tstringcontainer);
+procedure pd_asmname;
 begin
   aktprocsym^.definition^.setmangledname(target_os.Cprefix+pattern);
   if token=_CCHAR then
@@ -803,13 +803,13 @@ begin
   aktprocsym^.definition^.forwarddef:=false;
 end;
 
-procedure pd_intern(const procnames:Tstringcontainer);
+procedure pd_intern;
 begin
   consume(_COLON);
   aktprocsym^.definition^.extnumber:=get_intconst;
 end;
 
-procedure pd_interrupt(const procnames:Tstringcontainer);
+procedure pd_interrupt;
 begin
 {$ifndef i386}
   Message(parser_w_proc_interrupt_ignored);
@@ -819,12 +819,12 @@ begin
 {$endif i386}
 end;
 
-procedure pd_system(const procnames:Tstringcontainer);
+procedure pd_system;
 begin
   aktprocsym^.definition^.setmangledname(aktprocsym^.realname);
 end;
 
-procedure pd_abstract(const procnames:Tstringcontainer);
+procedure pd_abstract;
 begin
   if (po_virtualmethod in aktprocsym^.definition^.procoptions) then
     include(aktprocsym^.definition^.procoptions,po_abstractmethod)
@@ -834,7 +834,7 @@ begin
   aktprocsym^.definition^.forwarddef:=false;
 end;
 
-procedure pd_virtual(const procnames:Tstringcontainer);
+procedure pd_virtual;
 {$ifdef WITHDMT}
 var
   pt : tnode;
@@ -863,7 +863,7 @@ begin
 {$endif WITHDMT}
 end;
 
-procedure pd_static(const procnames:Tstringcontainer);
+procedure pd_static;
 begin
   if (cs_static_keyword in aktmoduleswitches) then
     begin
@@ -872,17 +872,17 @@ begin
     end;
 end;
 
-procedure pd_override(const procnames:Tstringcontainer);
+procedure pd_override;
 begin
   if not(is_class_or_interface(aktprocsym^.definition^._class)) then
     Message(parser_e_no_object_override);
 end;
 
-procedure pd_overload(const procnames:Tstringcontainer);
+procedure pd_overload;
 begin
 end;
 
-procedure pd_message(const procnames:Tstringcontainer);
+procedure pd_message;
 var
   pt : tnode;
 begin
@@ -890,7 +890,7 @@ begin
   if not(po_containsself in aktprocsym^.definition^.procoptions) and
      ((aktprocsym^.definition^.minparacount<>1) or
       (aktprocsym^.definition^.maxparacount<>1) or
-      (pparaitem(aktprocsym^.definition^.para^.first)^.paratyp<>vs_var)) then
+      (TParaItem(aktprocsym^.definition^.Para.first).paratyp<>vs_var)) then
    Message(parser_e_ill_msg_param);
   pt:=comp_expr(true);
   do_firstpass(pt);
@@ -920,7 +920,7 @@ begin
 end;
 
 
-procedure pd_cdecl(const procnames:Tstringcontainer);
+procedure pd_cdecl;
 begin
   if aktprocsym^.definition^.deftype<>procvardef then
     aktprocsym^.definition^.setmangledname(target_os.Cprefix+aktprocsym^.realname);
@@ -930,7 +930,7 @@ begin
     aktprocsym^.definition^.parast^.foreach({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
 end;
 
-procedure pd_cppdecl(const procnames:Tstringcontainer);
+procedure pd_cppdecl;
 begin
   if aktprocsym^.definition^.deftype<>procvardef then
     aktprocsym^.definition^.setmangledname(
@@ -942,7 +942,7 @@ begin
 end;
 
 
-procedure pd_pascal(const procnames:Tstringcontainer);
+procedure pd_pascal;
 var st,parast : psymtable;
     lastps,ps : psym;
 begin
@@ -966,26 +966,26 @@ begin
 end;
 
 
-procedure pd_register(const procnames:Tstringcontainer);
+procedure pd_register;
 begin
   Message1(parser_w_proc_directive_ignored,'REGISTER');
 end;
 
 
-procedure pd_reintroduce(const procnames:Tstringcontainer);
+procedure pd_reintroduce;
 begin
   Message1(parser_w_proc_directive_ignored,'REINTRODUCE');
 end;
 
 
-procedure pd_syscall(const procnames:Tstringcontainer);
+procedure pd_syscall;
 begin
   aktprocsym^.definition^.forwarddef:=false;
   aktprocsym^.definition^.extnumber:=get_intconst;
 end;
 
 
-procedure pd_external(const procnames:Tstringcontainer);
+procedure pd_external;
 {
   If import_dll=nil the procedure is assumed to be in another
   object file. In that object file it should have the name to
@@ -1027,22 +1027,22 @@ begin
           Message(parser_w_empty_import_name);}
         { this should work both for win32 and Linux !! PM }
         import_name:=aktprocsym^.realname;
-      if not(current_module^.uses_imports) then
+      if not(current_module.uses_imports) then
        begin
-         current_module^.uses_imports:=true;
-         importlib^.preparelib(current_module^.modulename^);
+         current_module.uses_imports:=true;
+         importlib.preparelib(current_module.modulename^);
        end;
       if not(m_repeat_forward in aktmodeswitches) then
         begin
           { we can only have one overloaded here ! }
           if assigned(aktprocsym^.definition^.nextoverloaded) then
-            importlib^.importprocedure(aktprocsym^.definition^.nextoverloaded^.mangledname,
+            importlib.importprocedure(aktprocsym^.definition^.nextoverloaded^.mangledname,
               import_dll,import_nr,import_name)
           else
-            importlib^.importprocedure(aktprocsym^.mangledname,import_dll,import_nr,import_name);
+            importlib.importprocedure(aktprocsym^.mangledname,import_dll,import_nr,import_name);
         end
       else
-        importlib^.importprocedure(aktprocsym^.mangledname,import_dll,import_nr,import_name);
+        importlib.importprocedure(aktprocsym^.mangledname,import_dll,import_nr,import_name);
     end
   else
     begin
@@ -1062,7 +1062,7 @@ begin
 end;
 
 type
-   pd_handler=procedure(const procnames:Tstringcontainer);
+   pd_handler=procedure;
    proc_dir_rec=record
      idtok     : ttoken;
      pd_flags  : longint;
@@ -1392,7 +1392,7 @@ begin
 end;
 
 
-function parse_proc_direc(const proc_names:Tstringcontainer;var pdflags:word):boolean;
+function parse_proc_direc(var pdflags:word):boolean;
 {
   Parse the procedure directive, returns true if a correct directive is found
 }
@@ -1494,12 +1494,12 @@ begin
      pstoredsymtable(aktprocsym^.definition^.parast)^.set_alignment(target_os.size_of_longint);
 
 { Call the handler }
-  if pointer({$ifndef FPC}@{$endif}proc_direcdata[p].handler)<>nil then
-    proc_direcdata[p].handler(proc_names);
+  if pointer({$ifndef FPCPROCVAR}@{$endif}proc_direcdata[p].handler)<>nil then
+    proc_direcdata[p].handler{$ifdef FPCPROCVAR}(){$endif};
 end;
 
 
-procedure parse_proc_directives(Anames:Pstringcontainer;var pdflags:word);
+procedure parse_proc_directives(var pdflags:word);
 {
   Parse the procedure directives. It does not matter if procedure directives
   are written using ;procdir; or ['procdir'] syntax.
@@ -1512,14 +1512,14 @@ begin
      if try_to_consume(_LECKKLAMMER) then
       begin
         repeat
-          parse_proc_direc(Anames^,pdflags);
+          parse_proc_direc(pdflags);
         until not try_to_consume(_COMMA);
         consume(_RECKKLAMMER);
         { we always expect at least '[];' }
         res:=true;
       end
      else
-      res:=parse_proc_direc(Anames^,pdflags);
+      res:=parse_proc_direc(pdflags);
    { A procedure directive normally followed by a semicolon, but in
      a const section we should stop when _EQUAL is found }
      if res then
@@ -1539,13 +1539,11 @@ end;
 
 procedure parse_var_proc_directives(var sym : psym);
 var
-  anames  : pstringcontainer;
   pdflags : word;
   oldsym  : pprocsym;
   pd      : pabstractprocdef;
 begin
   oldsym:=aktprocsym;
-  anames:=new(pstringcontainer,init);
   pdflags:=pd_procvar;
   { we create a temporary aktprocsym to read the directives }
   aktprocsym:=new(pprocsym,init(sym^.name));
@@ -1564,26 +1562,22 @@ begin
   pabstractprocdef(aktprocsym^.definition):=pd;
   { names should never be used anyway }
   inc(lexlevel);
-  parse_proc_directives(anames,pdflags);
+  parse_proc_directives(pdflags);
   dec(lexlevel);
   aktprocsym^.definition:=nil;
   dispose(aktprocsym,done);
-  dispose(anames,done);
   aktprocsym:=oldsym;
 end;
 
 
 procedure parse_object_proc_directives(var sym : pprocsym);
 var
-  anames : pstringcontainer;
   pdflags : word;
 begin
   pdflags:=pd_object;
-  anames:=new(pstringcontainer,init);
   inc(lexlevel);
-  parse_proc_directives(anames,pdflags);
+  parse_proc_directives(pdflags);
   dec(lexlevel);
-  dispose(anames,done);
   if (po_containsself in aktprocsym^.definition^.procoptions) and
      (([po_msgstr,po_msgint]*aktprocsym^.definition^.procoptions)=[]) then
     Message(parser_e_self_in_non_message_handler);
@@ -1749,6 +1743,9 @@ begin
                    else
                      if hd^.extnumber=-1 then
                        hd^.extnumber:=aktprocsym^.definition^.extnumber;
+                   { copy all aliasnames }
+                   while not aktprocsym^.definition^.aliasnames.empty do
+                    hd^.aliasnames.insert(aktprocsym^.definition^.aliasnames.getfirst);
                    { switch parast for warning in implementation  PM }
                    if (m_repeat_forward in aktmodeswitches) or
                       aktprocsym^.definition^.haspara then
@@ -1867,7 +1864,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.9  2000-11-29 00:30:35  florian
+  Revision 1.10  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.9  2000/11/29 00:30:35  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/pdecvar.pas

@@ -64,7 +64,7 @@ implementation
     { => the procedure is also used to read     }
     { a sequence of variable declaration        }
 
-      procedure insert_syms(st : psymtable;sc : pstringcontainer;tt : ttype;is_threadvar : boolean);
+      procedure insert_syms(st : psymtable;sc : tidstringlist;tt : ttype;is_threadvar : boolean);
       { inserts the symbols of sc in st with def as definition or sym as ptypesym, sc is disposed }
         var
            s : string;
@@ -72,9 +72,9 @@ implementation
            ss : pvarsym;
         begin
            filepos:=akttokenpos;
-           while not sc^.empty do
+           while not sc.empty do
              begin
-                s:=sc^.get_with_tokeninfo(akttokenpos);
+                s:=sc.get(akttokenpos);
                 ss:=new(pvarsym,init(s,tt));
                 if is_threadvar then
                   include(ss^.varoptions,vo_is_thread_var);
@@ -91,12 +91,12 @@ implementation
              if strContStack.pop <> sc then
                writeln('problem with strContStack in pdecl (2)');
 {$endif fixLeaksOnError}
-           dispose(sc,done);
+           sc.free;
            akttokenpos:=filepos;
         end;
 
       var
-         sc : pstringcontainer;
+         sc : tidstringList;
          s : stringid;
          old_block_type : tblock_type;
          declarepos,storetokenpos : tfileposinfo;
@@ -170,14 +170,14 @@ implementation
              if is_gpc_name then
                begin
                   storetokenpos:=akttokenpos;
-                  s:=sc^.get_with_tokeninfo(akttokenpos);
-                  if not sc^.empty then
+                  s:=sc.get(akttokenpos);
+                  if not sc.empty then
                    Message(parser_e_absolute_only_one_var);
 {$ifdef fixLeaksOnError}
                    if strContStack.pop <> sc then
                      writeln('problem with strContStack in pdecl (3)');
 {$endif fixLeaksOnError}
-                  dispose(sc,done);
+                  sc.free;
                   aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,tt));
                   include(aktvarsym^.varoptions,vo_is_external);
                   symtablestack^.insert(aktvarsym);
@@ -190,14 +190,14 @@ implementation
               begin
                 consume(_ABSOLUTE);
                 { only allowed for one var }
-                s:=sc^.get_with_tokeninfo(declarepos);
-                if not sc^.empty then
+                s:=sc.get(declarepos);
+                if not sc.empty then
                  Message(parser_e_absolute_only_one_var);
 {$ifdef fixLeaksOnError}
                  if strContStack.pop <> sc then
                    writeln('problem with strContStack in pdecl (4)');
 {$endif fixLeaksOnError}
-                dispose(sc,done);
+                sc.free;
                 { parse the rest }
                 if token=_ID then
                  begin
@@ -277,8 +277,8 @@ implementation
                 not is_record and not is_object then
                begin
                   storetokenpos:=akttokenpos;
-                  s:=sc^.get_with_tokeninfo(akttokenpos);
-                  if not sc^.empty then
+                  s:=sc.get(akttokenpos);
+                  if not sc.empty then
                     Message(parser_e_initialized_only_one_var);
                   pconstsym:=new(ptypedconstsym,inittype(s,tt,false));
                   symtablestack^.insert(pconstsym);
@@ -308,14 +308,14 @@ implementation
                    (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
                  begin
                    { only allowed for one var }
-                   s:=sc^.get_with_tokeninfo(declarepos);
-                   if not sc^.empty then
+                   s:=sc.get(declarepos);
+                   if not sc.empty then
                     Message(parser_e_absolute_only_one_var);
 {$ifdef fixLeaksOnError}
                    if strContStack.pop <> sc then
                      writeln('problem with strContStack in pdecl (5)');
 {$endif fixLeaksOnError}
-                   dispose(sc,done);
+                   sc.free;
                    { defaults }
                    is_dll:=false;
                    is_cdecl:=false;
@@ -384,12 +384,12 @@ implementation
                     begin
                       if is_dll then
                        begin
-                         if not(current_module^.uses_imports) then
+                         if not(current_module.uses_imports) then
                           begin
-                            current_module^.uses_imports:=true;
-                            importlib^.preparelib(current_module^.modulename^);
+                            current_module.uses_imports:=true;
+                            importlib.preparelib(current_module.modulename^);
                           end;
-                         importlib^.importvariable(aktvarsym^.mangledname,dll_name,C_name)
+                         importlib.importvariable(aktvarsym^.mangledname,dll_name,C_name)
                        end
                     end;
                    symdone:=true;
@@ -515,7 +515,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2000-12-17 14:00:18  peter
+  Revision 1.6  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/12/17 14:00:18  peter
     * fixed static variables
 
   Revision 1.4  2000/11/29 00:30:36  florian

compiler/pexports.pas

@@ -53,7 +53,7 @@ implementation
 
     procedure read_exports;
       var
-         hp        : pexported_item;
+         hp        : texported_item;
          DefString : string;
          ProcName  : string;
          InternalProcName : string;
@@ -64,7 +64,7 @@ implementation
          consume(_EXPORTS);
          while true do
            begin
-              hp:=new(pexported_item,init);
+              hp:=texported_item.create;
               if token=_ID then
                 begin
                    getsym(pattern,true);
@@ -77,8 +77,8 @@ implementation
                    consume(_ID);
                    if assigned(srsym) then
                      begin
-                        hp^.sym:=srsym;
-                        if ((hp^.sym^.typ<>procsym) or
+                        hp.sym:=srsym;
+                        if ((hp.sym^.typ<>procsym) or
                             ((tf_need_export in target_info.flags) and
                              not(po_exports in pprocdef(pprocsym(srsym)^.definition)^.procoptions)
                             )
@@ -87,8 +87,8 @@ implementation
                          Message(parser_e_illegal_symbol_exported)
                         else
                          begin
-                          ProcName:=hp^.sym^.name;
-                          InternalProcName:=hp^.sym^.mangledname;
+                          ProcName:=hp.sym^.name;
+                          InternalProcName:=hp.sym^.mangledname;
                           { This is wrong if the first is not
                             an underline }
                           if InternalProcName[1]='_' then
@@ -108,16 +108,16 @@ implementation
                              pt:=comp_expr(true);
                              do_firstpass(pt);
                              if pt.nodetype=ordconstn then
-                               hp^.index:=tordconstnode(pt).value
+                               hp.index:=tordconstnode(pt).value
                              else
                                 begin
-                                   hp^.index:=0;
+                                   hp.index:=0;
                                    consume(_INTCONST);
                                 end;
-                             hp^.options:=hp^.options or eo_index;
+                             hp.options:=hp.options or eo_index;
                              pt.free;
                              if target_os.id=os_i386_win32 then
-                               DefString:=ProcName+'='+InternalProcName+' @ '+tostr(hp^.index)
+                               DefString:=ProcName+'='+InternalProcName+' @ '+tostr(hp.index)
                              else
                                DefString:=ProcName+'='+InternalProcName; {Index ignored!}
                           end;
@@ -127,28 +127,28 @@ implementation
                              pt:=comp_expr(true);
                              do_firstpass(pt);
                              if pt.nodetype=stringconstn then
-                               hp^.name:=stringdup(strpas(tstringconstnode(pt).value_str))
+                               hp.name:=stringdup(strpas(tstringconstnode(pt).value_str))
                              else
                                 begin
-                                   hp^.name:=stringdup('');
+                                   hp.name:=stringdup('');
                                    consume(_CSTRING);
                                 end;
-                             hp^.options:=hp^.options or eo_name;
+                             hp.options:=hp.options or eo_name;
                              pt.free;
-                             DefString:=hp^.name^+'='+InternalProcName;
+                             DefString:=hp.name^+'='+InternalProcName;
                           end;
                         if (idtoken=_RESIDENT) then
                           begin
                              consume(_RESIDENT);
-                             hp^.options:=hp^.options or eo_resident;
+                             hp.options:=hp.options or eo_resident;
                              DefString:=ProcName+'='+InternalProcName;{Resident ignored!}
                           end;
                         if (DefString<>'') and UseDeffileForExport then
                          DefFile.AddExport(DefString);
-                        if hp^.sym^.typ=procsym then
-                          exportlib^.exportprocedure(hp)
+                        if hp.sym^.typ=procsym then
+                          exportlib.exportprocedure(hp)
                         else
-                          exportlib^.exportvar(hp);
+                          exportlib.exportvar(hp);
                      end;
                 end
               else
@@ -167,7 +167,11 @@ end.
 
 {
   $Log$
-  Revision 1.8  2000-11-29 00:30:36  florian
+  Revision 1.9  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.8  2000/11/29 00:30:36  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/pexpr.pas

@@ -828,10 +828,10 @@ implementation
                          while assigned(plist) do
                           begin
                             if p1=nil then
-                              p1:=genloadnode(pvarsym(plist^.sym),st)
+                              p1:=genloadnode(pvarsym(pList^.sym),st)
                             else
-                              p1:=gensubscriptnode(pvarsym(plist^.sym),p1);
-                            plist:=plist^.next;
+                              p1:=gensubscriptnode(pvarsym(pList^.sym),p1);
+                            plist:=pList^.next;
                           end;
                          include(tcallnode(p1).flags,nf_isproperty);
                          consume(_ASSIGNMENT);
@@ -868,10 +868,10 @@ implementation
                           while assigned(plist) do
                            begin
                              if p1=nil then
-                               p1:=genloadnode(pvarsym(plist^.sym),st)
+                               p1:=genloadnode(pvarsym(pList^.sym),st)
                              else
-                               p1:=gensubscriptnode(pvarsym(plist^.sym),p1);
-                             plist:=plist^.next;
+                               p1:=gensubscriptnode(pvarsym(pList^.sym),p1);
+                             plist:=pList^.next;
                            end;
                           include(p1.flags,nf_isproperty);
                        end;
@@ -1755,7 +1755,7 @@ implementation
                          again:=false
                        else
                          if (token=_LKLAMMER) or
-                            ((pprocvardef(pd)^.para^.empty) and
+                            ((pprocvardef(pd)^.para.empty) and
                              (not((token in [_ASSIGNMENT,_UNEQUAL,_EQUAL]))) and
                              (not afterassignment) and
                              (not in_args)) then
@@ -2420,7 +2420,11 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.23  2000-12-19 20:36:03  peter
+  Revision 1.24  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.23  2000/12/19 20:36:03  peter
     * cardinal const expr fix from jonas
 
   Revision 1.22  2000/12/17 14:00:18  peter
@@ -2505,4 +2509,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
-}
+}

compiler/pstatmnt.pas

@@ -727,7 +727,7 @@ implementation
     function _asm_statement : tnode;
       var
         asmstat : tasmnode;
-        Marker : Pai;
+        Marker : tai;
       begin
          Inside_asm_statement:=true;
          case aktasmmode of
@@ -823,10 +823,10 @@ implementation
            this is needed for the optimizer }
          If Assigned(AsmStat.p_asm) Then
            Begin
-             Marker := New(Pai_Marker, Init(AsmBlockStart));
-             AsmStat.p_asm^.Insert(Marker);
-             Marker := New(Pai_Marker, Init(AsmBlockEnd));
-             AsmStat.p_asm^.Concat(Marker);
+             Marker := Tai_Marker.Create(AsmBlockStart);
+             AsmStat.p_asm.Insert(Marker);
+             Marker := Tai_Marker.Create(AsmBlockEnd);
+             AsmStat.p_asm.Concat(Marker);
            End;
          Inside_asm_statement:=false;
          _asm_statement:=asmstat;
@@ -1259,7 +1259,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.18  2000-12-23 19:59:35  peter
+  Revision 1.19  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.18  2000/12/23 19:59:35  peter
     * object to class for ow/og objects
     * split objectdata from objectoutput
 

compiler/psub.pas

@@ -29,8 +29,7 @@ interface
     uses
        cobjects;
 
-    procedure compile_proc_body(const proc_names:Tstringcontainer;
-                                make_global,parent_has_class:boolean);
+    procedure compile_proc_body(make_global,parent_has_class:boolean);
 
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
@@ -174,7 +173,7 @@ implementation
            end;
 
          {Unit initialization?.}
-         if (lexlevel=unit_init_level) and (current_module^.is_unit)
+         if (lexlevel=unit_init_level) and (current_module.is_unit)
             or islibrary then
            begin
              if (token=_END) then
@@ -191,12 +190,12 @@ implementation
                 begin
                    if token=_INITIALIZATION then
                      begin
-                        current_module^.flags:=current_module^.flags or uf_init;
+                        current_module.flags:=current_module.flags or uf_init;
                         block:=statement_block(_INITIALIZATION);
                      end
                    else if (token=_FINALIZATION) then
                      begin
-                        if (current_module^.flags and uf_finalize)<>0 then
+                        if (current_module.flags and uf_finalize)<>0 then
                           block:=statement_block(_FINALIZATION)
                         else
                           begin
@@ -208,7 +207,7 @@ implementation
                      end
                    else
                      begin
-                        current_module^.flags:=current_module^.flags or uf_init;
+                        current_module.flags:=current_module.flags or uf_init;
                         block:=statement_block(_BEGIN);
                      end;
                 end;
@@ -222,8 +221,7 @@ implementation
                        PROCEDURE/FUNCTION COMPILING
 ****************************************************************************}
 
-    procedure compile_proc_body(const proc_names:Tstringcontainer;
-                                make_global,parent_has_class:boolean);
+    procedure compile_proc_body(make_global,parent_has_class:boolean);
       {
         Compile the body of a procedure
       }
@@ -322,7 +320,7 @@ implementation
          entryswitches:=aktlocalswitches;
          localmaxfpuregisters:=aktmaxfpuregisters;
          { parse the code ... }
-         code:=block(current_module^.islibrary);
+         code:=block(current_module.islibrary);
          { get a better entry point }
          if assigned(code) then
            entrypos:=code.fileinfo;
@@ -379,7 +377,7 @@ implementation
            cg^.g_entrycode(procinfo^.aktentrycode,proc_names,make_global,stackframe,parasize,nostackframe,false);
 {$else newcg}
          if assigned(code) then
-           genentrycode(procinfo^.aktentrycode,proc_names,make_global,stackframe,parasize,nostackframe,false);
+           genentrycode(procinfo^.aktentrycode,make_global,stackframe,parasize,nostackframe,false);
 {$endif newcg}
 
          { FPC_POPADDRSTACK destroys all registers (JM) }
@@ -402,8 +400,8 @@ implementation
 {$else newcg}
              aktprocsym^.definition^.usedregisters:=usedinproc;
 {$endif newcg}
-             procinfo^.aktproccode^.insertlist(procinfo^.aktentrycode);
-             procinfo^.aktproccode^.concatlist(procinfo^.aktexitcode);
+             procinfo^.aktproccode.insertlist(procinfo^.aktentrycode);
+             procinfo^.aktproccode.concatlist(procinfo^.aktexitcode);
 {$ifdef i386}
    {$ifndef NoOpt}
              if (cs_optimize in aktglobalswitches) and
@@ -414,18 +412,18 @@ implementation
 {$endif i386}
              { save local data (casetable) also in the same file }
              if assigned(procinfo^.aktlocaldata) and
-                (not procinfo^.aktlocaldata^.empty) then
+                (not procinfo^.aktlocaldata.empty) then
                begin
-                  procinfo^.aktproccode^.concat(new(pai_section,init(sec_data)));
-                  procinfo^.aktproccode^.concatlist(procinfo^.aktlocaldata);
-                  procinfo^.aktproccode^.concat(new(pai_section,init(sec_code)));
+                  procinfo^.aktproccode.concat(Tai_section.Create(sec_data));
+                  procinfo^.aktproccode.concatlist(procinfo^.aktlocaldata);
+                  procinfo^.aktproccode.concat(Tai_section.Create(sec_code));
                end;
              { now we can insert a cut }
              if (cs_create_smart in aktmoduleswitches) then
-               codesegment^.concat(new(pai_cut,init));
+               codeSegment.concat(Tai_cut.Create);
 
              { add the procedure to the codesegment }
-             codesegment^.concatlist(procinfo^.aktproccode);
+             codeSegment.concatlist(procinfo^.aktproccode);
            end;
 {$else NOPASS2}
          if assigned(code) then
@@ -561,7 +559,6 @@ implementation
         oldprocinfo      : pprocinfo;
         oldconstsymtable : Psymtable;
         oldfilepos       : tfileposinfo;
-        names           : Pstringcontainer;
         pdflags         : word;
         prevdef,stdef   : pprocdef;
       begin
@@ -571,10 +568,6 @@ implementation
          oldconstsymtable:=constsymtable;
          oldprocinfo:=procinfo;
       { create a new procedure }
-         new(names,init);
-{$ifdef fixLeaksOnError}
-         strContStack.push(names);
-{$endif fixLeaksOnError}
          codegen_newprocedure;
          with procinfo^ do
           begin
@@ -607,9 +600,9 @@ implementation
          else
           begin
             pdflags:=pd_body;
-            if current_module^.in_implementation then
+            if current_module.in_implementation then
              pdflags:=pdflags or pd_implemen;
-            if (not current_module^.is_unit) or (cs_create_smart in aktmoduleswitches) then
+            if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
              pdflags:=pdflags or pd_global;
             procinfo^.exported:=false;
             aktprocsym^.definition^.forwarddef:=false;
@@ -617,7 +610,7 @@ implementation
 
       { parse the directives that may follow }
          inc(lexlevel);
-         parse_proc_directives(names,pdflags);
+         parse_proc_directives(pdflags);
          dec(lexlevel);
 
       { set aktfilepos to the beginning of the function declaration }
@@ -694,14 +687,14 @@ implementation
            begin
              Message1(parser_p_procedure_start,
                       aktprocsym^.definition^.fullprocname);
-             names^.insert(aktprocsym^.definition^.mangledname);
+             aktprocsym^.definition^.aliasnames.insert(aktprocsym^.definition^.mangledname);
             { set _FAIL as keyword if constructor }
             if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
               tokeninfo^[_FAIL].keyword:=m_all;
             if assigned(aktprocsym^.definition^._class) then
               tokeninfo^[_SELF].keyword:=m_all;
 
-             compile_proc_body(names^,((pdflags and pd_global)<>0),assigned(oldprocinfo^._class));
+             compile_proc_body(((pdflags and pd_global)<>0),assigned(oldprocinfo^._class));
 
             { reset _FAIL as normal }
             if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
@@ -711,11 +704,6 @@ implementation
              consume(_SEMICOLON);
            end;
       { close }
-{$ifdef fixLeaksOnError}
-         if names <> strContStack.pop then
-           writeln('problem with strContStack in psub!');
-{$endif fixLeaksOnError}
-         dispose(names,done);
          codegen_doneprocedure;
       { Restore old state }
          constsymtable:=oldconstsymtable;
@@ -789,7 +777,7 @@ implementation
                    Not_supported_for_inline(token);
                    { here we should be at lexlevel 1, no ? PM }
                    if (lexlevel<>main_program_level) or
-                      (current_module^.is_unit) then
+                      (current_module.is_unit) then
                      begin
                         Message(parser_e_syntax_error);
                         consume_all_until(_SEMICOLON);
@@ -835,7 +823,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2000-11-29 00:30:37  florian
+  Revision 1.24  2000-12-25 00:07:27  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.23  2000/11/29 00:30:37  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/ptconst.pas

@@ -70,7 +70,7 @@ implementation
          p,hp      : tnode;
          i,l,offset,
          strlength : longint;
-         curconstsegment : paasmoutput;
+         curconstsegment : TAAsmoutput;
          ll        : pasmlabel;
          s         : string;
          ca        : pchar;
@@ -108,35 +108,35 @@ implementation
                     bool8bit :
                       begin
                          if is_constboolnode(p) then
-                           curconstsegment^.concat(new(pai_const,init_8bit(tordconstnode(p).value)))
+                           curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value))
                          else
                            Message(cg_e_illegal_expression);
                       end;
                     bool16bit :
                       begin
                          if is_constboolnode(p) then
-                           curconstsegment^.concat(new(pai_const,init_16bit(tordconstnode(p).value)))
+                           curconstSegment.concat(Tai_const.Create_16bit(tordconstnode(p).value))
                          else
                            Message(cg_e_illegal_expression);
                       end;
                     bool32bit :
                       begin
                          if is_constboolnode(p) then
-                           curconstsegment^.concat(new(pai_const,init_32bit(tordconstnode(p).value)))
+                           curconstSegment.concat(Tai_const.Create_32bit(tordconstnode(p).value))
                          else
                            Message(cg_e_illegal_expression);
                       end;
                     uchar :
                       begin
                          if is_constcharnode(p) then
-                           curconstsegment^.concat(new(pai_const,init_8bit(tordconstnode(p).value)))
+                           curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value))
                          else
                            Message(cg_e_illegal_expression);
                       end;
                     uwidechar :
                       begin
                          if is_constcharnode(p) then
-                           curconstsegment^.concat(new(pai_const,init_16bit(tordconstnode(p).value)))
+                           curconstSegment.concat(Tai_const.Create_16bit(tordconstnode(p).value))
                          else
                            Message(cg_e_illegal_expression);
                       end;
@@ -145,7 +145,7 @@ implementation
                       begin
                          if is_constintnode(p) then
                            begin
-                              curconstsegment^.concat(new(pai_const,init_8bit(tordconstnode(p).value)));
+                              curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value));
                               check_range;
                            end
                          else
@@ -156,7 +156,7 @@ implementation
                       begin
                          if is_constintnode(p) then
                            begin
-                             curconstsegment^.concat(new(pai_const,init_16bit(tordconstnode(p).value)));
+                             curconstSegment.concat(Tai_const.Create_16bit(tordconstnode(p).value));
                              check_range;
                            end
                          else
@@ -167,7 +167,7 @@ implementation
                       begin
                          if is_constintnode(p) then
                            begin
-                              curconstsegment^.concat(new(pai_const,init_32bit(tordconstnode(p).value)));
+                              curconstSegment.concat(Tai_const.Create_32bit(tordconstnode(p).value));
                               if porddef(def)^.typ<>u32bit then
                                check_range;
                            end
@@ -180,8 +180,8 @@ implementation
                          if is_constintnode(p) then
                            begin
                               {!!!!! hmmm, we can write yet only consts til 2^32-1 :( (FK) }
-                              curconstsegment^.concat(new(pai_const,init_32bit(tordconstnode(p).value)));
-                              curconstsegment^.concat(new(pai_const,init_32bit(0)));
+                              curconstSegment.concat(Tai_const.Create_32bit(tordconstnode(p).value));
+                              curconstSegment.concat(Tai_const.Create_32bit(0));
                            end
                          else
                            Message(cg_e_illegal_expression);
@@ -204,15 +204,15 @@ implementation
 
               case pfloatdef(def)^.typ of
                  s32real :
-                   curconstsegment^.concat(new(pai_real_32bit,init(value)));
+                   curconstSegment.concat(Tai_real_32bit.Create(value));
                  s64real :
-                   curconstsegment^.concat(new(pai_real_64bit,init(value)));
+                   curconstSegment.concat(Tai_real_64bit.Create(value));
                  s80real :
-                   curconstsegment^.concat(new(pai_real_80bit,init(value)));
+                   curconstSegment.concat(Tai_real_80bit.Create(value));
                  s64comp :
-                   curconstsegment^.concat(new(pai_comp_64bit,init(value)));
+                   curconstSegment.concat(Tai_comp_64bit.Create(value));
                  f32bit :
-                   curconstsegment^.concat(new(pai_const,init_32bit(trunc(value*65536))));
+                   curconstSegment.concat(Tai_const.Create_32bit(trunc(value*65536)));
                  else
                    internalerror(18);
               end;
@@ -228,11 +228,11 @@ implementation
                       if not(pobjectdef(pclassrefdef(p.resulttype)^.pointertype.def)^.is_related(
                         pobjectdef(pclassrefdef(def)^.pointertype.def))) then
                         Message(cg_e_illegal_expression);
-                      curconstsegment^.concat(new(pai_const_symbol,init(newasmsymbol(pobjectdef(
-                        pclassrefdef(p.resulttype)^.pointertype.def)^.vmt_mangledname))));
+                      curconstSegment.concat(Tai_const_symbol.Create(newasmsymbol(pobjectdef(
+                        pclassrefdef(p.resulttype)^.pointertype.def)^.vmt_mangledname)));
                    end;
                  niln:
-                   curconstsegment^.concat(new(pai_const,init_32bit(0)));
+                   curconstSegment.concat(Tai_const.Create_32bit(0));
                  else Message(cg_e_illegal_expression);
               end;
               p.free;
@@ -261,15 +261,15 @@ implementation
                 end;
               { nil pointer ? }
               if p.nodetype=niln then
-                curconstsegment^.concat(new(pai_const,init_32bit(0)))
+                curconstSegment.concat(Tai_const.Create_32bit(0))
               { maybe pchar ? }
               else
                 if is_char(ppointerdef(def)^.pointertype.def) and
                    (p.nodetype<>addrn) then
                   begin
                     getdatalabel(ll);
-                    curconstsegment^.concat(new(pai_const_symbol,init(ll)));
-                    consts^.concat(new(pai_label,init(ll)));
+                    curconstSegment.concat(Tai_const_symbol.Create(ll));
+                    Consts.concat(Tai_label.Create(ll));
                     if p.nodetype=stringconstn then
                       begin
                         len:=tstringconstnode(p).len;
@@ -279,11 +279,11 @@ implementation
                          len:=255;
                         getmem(ca,len+2);
                         move(tstringconstnode(p).value_str^,ca^,len+1);
-                        consts^.concat(new(pai_string,init_length_pchar(ca,len+1)));
+                        Consts.concat(Tai_string.Create_length_pchar(ca,len+1));
                       end
                     else
                       if is_constcharnode(p) then
-                        consts^.concat(new(pai_string,init(char(byte(tordconstnode(p).value))+#0)))
+                        Consts.concat(Tai_string.Create(char(byte(tordconstnode(p).value))+#0))
                     else
                       Message(cg_e_illegal_expression);
                 end
@@ -336,7 +336,7 @@ implementation
                           end;
                         if tloadnode(hp).symtableentry^.typ=constsym then
                           Message(type_e_variable_id_expected);
-                        curconstsegment^.concat(new(pai_const_symbol,initname_offset(tloadnode(hp).symtableentry^.mangledname,offset)));
+                        curconstSegment.concat(Tai_const_symbol.Createname_offset(tloadnode(hp).symtableentry^.mangledname,offset));
                       end
                     else
                       Message(cg_e_illegal_expression);
@@ -348,8 +348,8 @@ implementation
                   begin
                     if (tinlinenode(p).left.nodetype=typen) then
                       begin
-                        curconstsegment^.concat(new(pai_const_symbol,
-                          initname(pobjectdef(tinlinenode(p).left.resulttype)^.vmt_mangledname)));
+                        curconstSegment.concat(Tai_const_symbol.createname(
+                          pobjectdef(tinlinenode(p).left.resulttype)^.vmt_mangledname));
                       end
                     else
                       Message(cg_e_illegal_expression);
@@ -371,7 +371,7 @@ implementation
                      begin
 {$ifdef i386}
                         for l:=0 to def^.size-1 do
-                          curconstsegment^.concat(new(pai_const,init_8bit(tsetconstnode(p).value_set^[l])));
+                          curconstSegment.concat(Tai_const.Create_8bit(tsetconstnode(p).value_set^[l]));
 {$endif}
 {$ifdef m68k}
                         j:=0;
@@ -379,10 +379,10 @@ implementation
                         { HORRIBLE HACK because of endian       }
                         { now use intel endian for constant sets }
                          begin
-                           curconstsegment^.concat(new(pai_const,init_8bit(tordconstnode(p).value_set^[j+3])));
-                           curconstsegment^.concat(new(pai_const,init_8bit(tordconstnode(p).value_set^[j+2])));
-                           curconstsegment^.concat(new(pai_const,init_8bit(tordconstnode(p).value_set^[j+1])));
-                           curconstsegment^.concat(new(pai_const,init_8bit(tordconstnode(p).value_set^[j])));
+                           curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value_set^[j+3]));
+                           curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value_set^[j+2]));
+                           curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value_set^[j+1]));
+                           curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value_set^[j]));
                            Inc(j,4);
                          end;
 {$endif}
@@ -402,9 +402,9 @@ implementation
                      is_subequal(p.resulttype,def) then
                    begin
                      case p.resulttype^.size of
-                       1 : curconstsegment^.concat(new(pai_const,init_8bit(tordconstnode(p).value)));
-                       2 : curconstsegment^.concat(new(pai_const,init_16bit(tordconstnode(p).value)));
-                       4 : curconstsegment^.concat(new(pai_const,init_32bit(tordconstnode(p).value)));
+                       1 : curconstSegment.concat(Tai_const.Create_8bit(tordconstnode(p).value));
+                       2 : curconstSegment.concat(Tai_const.Create_16bit(tordconstnode(p).value));
+                       4 : curconstSegment.concat(Tai_const.Create_32bit(tordconstnode(p).value));
                      end;
                    end
                   else
@@ -449,12 +449,12 @@ implementation
                           message2(parser_w_string_too_long,strpas(strval),tostr(def^.size-1));
                           strlength:=def^.size-1;
                         end;
-                       curconstsegment^.concat(new(pai_const,init_8bit(strlength)));
+                       curconstSegment.concat(Tai_const.Create_8bit(strlength));
                        { this can also handle longer strings }
                        getmem(ca,strlength+1);
                        move(strval^,ca^,strlength);
                        ca[strlength]:=#0;
-                       curconstsegment^.concat(new(pai_string,init_length_pchar(ca,strlength)));
+                       curconstSegment.concat(Tai_string.Create_length_pchar(ca,strlength));
                        { fillup with spaces if size is shorter }
                        if def^.size>strlength then
                         begin
@@ -464,40 +464,40 @@ implementation
                           fillchar(ca[0],def^.size-strlength-1,' ');
                           ca[def^.size-strlength-1]:=#0;
                           { this can also handle longer strings }
-                          curconstsegment^.concat(new(pai_string,init_length_pchar(ca,def^.size-strlength-1)));
+                          curconstSegment.concat(Tai_string.Create_length_pchar(ca,def^.size-strlength-1));
                         end;
                      end;
 {$ifdef UseLongString}
                    st_longstring:
                      begin
                        { first write the maximum size }
-                       curconstsegment^.concat(new(pai_const,init_32bit(strlength)))));
+                       curconstSegment.concat(Tai_const.Create_32bit(strlength))));
                        { fill byte }
-                       curconstsegment^.concat(new(pai_const,init_8bit(0)));
+                       curconstSegment.concat(Tai_const.Create_8bit(0));
                        getmem(ca,strlength+1);
                        move(strval^,ca^,strlength);
                        ca[strlength]:=#0;
                        generate_pascii(consts,ca,strlength);
-                       curconstsegment^.concat(new(pai_const,init_8bit(0)));
+                       curconstSegment.concat(Tai_const.Create_8bit(0));
                      end;
 {$endif UseLongString}
                    st_ansistring:
                      begin
                         { an empty ansi string is nil! }
                         if (strlength=0) then
-                          curconstsegment^.concat(new(pai_const,init_32bit(0)))
+                          curconstSegment.concat(Tai_const.Create_32bit(0))
                         else
                           begin
                             getdatalabel(ll);
-                            curconstsegment^.concat(new(pai_const_symbol,init(ll)));
+                            curconstSegment.concat(Tai_const_symbol.Create(ll));
                             { first write the maximum size }
-                            consts^.concat(new(pai_const,init_32bit(strlength)));
+                            Consts.concat(Tai_const.Create_32bit(strlength));
                             { second write the real length }
-                            consts^.concat(new(pai_const,init_32bit(strlength)));
+                            Consts.concat(Tai_const.Create_32bit(strlength));
                             { redondent with maxlength but who knows ... (PM) }
                             { third write use count (set to -1 for safety ) }
-                            consts^.concat(new(pai_const,init_32bit(-1)));
-                            consts^.concat(new(pai_label,init(ll)));
+                            Consts.concat(Tai_const.Create_32bit(-1));
+                            Consts.concat(Tai_label.Create(ll));
                             getmem(ca,strlength+2);
                             move(strval^,ca^,strlength);
                             { The terminating #0 to be stored in the .data section (JM) }
@@ -505,7 +505,7 @@ implementation
                             { End of the PChar. The memory has to be allocated because in }
                             { tai_string.done, there is a freemem(len+1) (JM)             }
                             ca[strlength+1]:=#0;
-                            consts^.concat(new(pai_string,init_length_pchar(ca,strlength+1)));
+                            Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1));
                           end;
                      end;
                  end;
@@ -557,12 +557,12 @@ implementation
                      begin
                         if i+1-Parraydef(def)^.lowrange<=len then
                           begin
-                             curconstsegment^.concat(new(pai_const,init_8bit(byte(ca^))));
+                             curconstSegment.concat(Tai_const.Create_8bit(byte(ca^)));
                              inc(ca);
                           end
                         else
                           {Fill the remaining positions with #0.}
-                          curconstsegment^.concat(new(pai_const,init_8bit(0)));
+                          curconstSegment.concat(Tai_const.Create_8bit(0));
                      end;
                    p.free;
                 end
@@ -578,7 +578,7 @@ implementation
               { under tp:  =nil or =var under fpc: =nil or =@var }
               if token=_NIL then
                 begin
-                   curconstsegment^.concat(new(pai_const,init_32bit(0)));
+                   curconstSegment.concat(Tai_const.Create_32bit(0));
                    consume(_NIL);
                    exit;
                 end
@@ -662,8 +662,8 @@ implementation
               if (p.nodetype=loadn) and
                  (tloadnode(p).symtableentry^.typ=procsym) then
                begin
-                 curconstsegment^.concat(new(pai_const_symbol,
-                   initname(pprocsym(tloadnode(p).symtableentry)^.definition^.mangledname)));
+                 curconstSegment.concat(Tai_const_symbol.createname(
+                   pprocsym(tloadnode(p).symtableentry)^.definition^.mangledname));
                end
               else
                Message(cg_e_illegal_expression);
@@ -685,11 +685,11 @@ implementation
                       p.free;
                       if string2guid(s,tmpguid) then
                         begin
-                          curconstsegment^.concat(new(pai_const,init_32bit(tmpguid.D1)));
-                          curconstsegment^.concat(new(pai_const,init_16bit(tmpguid.D2)));
-                          curconstsegment^.concat(new(pai_const,init_16bit(tmpguid.D3)));
+                          curconstSegment.concat(Tai_const.Create_32bit(tmpguid.D1));
+                          curconstSegment.concat(Tai_const.Create_16bit(tmpguid.D2));
+                          curconstSegment.concat(Tai_const.Create_16bit(tmpguid.D3));
                           for i:=Low(tmpguid.D4) to High(tmpguid.D4) do
-                            curconstsegment^.concat(new(pai_const,init_8bit(tmpguid.D4[i])));
+                            curconstSegment.concat(Tai_const.Create_8bit(tmpguid.D4[i]));
                         end
                       else
                         Message(parser_e_improper_guid_syntax);
@@ -725,7 +725,7 @@ implementation
                              { if needed fill }
                              if pvarsym(srsym)^.address>aktpos then
                                for i:=1 to pvarsym(srsym)^.address-aktpos do
-                                 curconstsegment^.concat(new(pai_const,init_8bit(0)));
+                                 curconstSegment.concat(Tai_const.Create_8bit(0));
 
                              { new position }
                              aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.vartype.def^.size;
@@ -739,7 +739,7 @@ implementation
                           end;
                    end;
                  for i:=1 to def^.size-aktpos do
-                   curconstsegment^.concat(new(pai_const,init_8bit(0)));
+                   curconstSegment.concat(Tai_const.Create_8bit(0));
                  consume(_RKLAMMER);
               end;
            end;
@@ -757,7 +757,7 @@ implementation
                     end
                   else
                     begin
-                      curconstsegment^.concat(new(pai_const,init_32bit(0)));
+                      curconstSegment.concat(Tai_const.Create_32bit(0));
                     end;
                   p.free;
                 end
@@ -801,7 +801,7 @@ implementation
                              { if needed fill }
                              if pvarsym(srsym)^.address>aktpos then
                                for i:=1 to pvarsym(srsym)^.address-aktpos do
-                                 curconstsegment^.concat(new(pai_const,init_8bit(0)));
+                                 curconstSegment.concat(Tai_const.Create_8bit(0));
 
                              { new position }
                              aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.vartype.def^.size;
@@ -815,7 +815,7 @@ implementation
                           end;
                      end;
                    for i:=1 to def^.size-aktpos do
-                     curconstsegment^.concat(new(pai_const,init_8bit(0)));
+                     curconstSegment.concat(Tai_const.Create_8bit(0));
                    consume(_RKLAMMER);
                 end;
            end;
@@ -837,7 +837,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2000-12-10 20:24:18  peter
+  Revision 1.15  2000-12-25 00:07:28  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.14  2000/12/10 20:24:18  peter
     * allow subtypes for enums
 
   Revision 1.13  2000/11/29 00:30:38  florian

compiler/rautils.pas

@@ -110,7 +110,7 @@ type
     destructor  done;virtual;
     Procedure InitOperands;virtual;
     Procedure BuildOpcode;virtual;
-    procedure ConcatInstruction(p:PAasmoutput);virtual;
+    procedure ConcatInstruction(p:TAAsmoutput);virtual;
     Procedure SwapOperands;
   end;
 
@@ -189,16 +189,16 @@ Function SearchIConstant(const s:string; var l:longint): boolean;
                   Instruction generation routines
 ---------------------------------------------------------------------}
 
-  Procedure ConcatPasString(p : paasmoutput;s:string);
-  Procedure ConcatDirect(p : paasmoutput;s:string);
-  Procedure ConcatLabel(p: paasmoutput;var l : pasmlabel);
-  Procedure ConcatConstant(p : paasmoutput;value: longint; maxvalue: longint);
-  Procedure ConcatConstSymbol(p : paasmoutput;const sym:string;l:longint);
-  Procedure ConcatRealConstant(p : paasmoutput;value: bestreal; real_typ : tfloattype);
-  Procedure ConcatString(p : paasmoutput;s:string);
-  procedure ConcatAlign(p:paasmoutput;l:longint);
-  Procedure ConcatPublic(p:paasmoutput;const s : string);
-  Procedure ConcatLocal(p:paasmoutput;const s : string);
+  Procedure ConcatPasString(p : TAAsmoutput;s:string);
+  Procedure ConcatDirect(p : TAAsmoutput;s:string);
+  Procedure ConcatLabel(p: TAAsmoutput;var l : pasmlabel);
+  Procedure ConcatConstant(p : TAAsmoutput;value: longint; maxvalue: longint);
+  Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;l:longint);
+  Procedure ConcatRealConstant(p : TAAsmoutput;value: bestreal; real_typ : tfloattype);
+  Procedure ConcatString(p : TAAsmoutput;s:string);
+  procedure ConcatAlign(p:TAAsmoutput;l:longint);
+  Procedure ConcatPublic(p:TAAsmoutput;const s : string);
+  Procedure ConcatLocal(p:TAAsmoutput;const s : string);
   Procedure ConcatGlobalBss(const s : string;size : longint);
   Procedure ConcatLocalBss(const s : string;size : longint);
 
@@ -1088,7 +1088,7 @@ Begin
 end;
 
 
-procedure TInstruction.ConcatInstruction(p:PAasmOutput);
+procedure TInstruction.ConcatInstruction(p:TAAsmOutput);
 begin
   abstract;
 end;
@@ -1387,7 +1387,7 @@ end;
  {*************************************************************************}
 
 
-   Procedure ConcatString(p : paasmoutput;s:string);
+   Procedure ConcatString(p : TAAsmoutput;s:string);
   {*********************************************************************}
   { PROCEDURE ConcatString(s:string);                                   }
   {  Description: This routine adds the character chain pointed to in   }
@@ -1397,10 +1397,10 @@ end;
    pc: PChar;
   Begin
      getmem(pc,length(s)+1);
-     p^.concat(new(pai_string,init_length_pchar(strpcopy(pc,s),length(s))));
+     p.concat(Tai_string.Create_length_pchar(strpcopy(pc,s),length(s)));
   end;
 
-  Procedure ConcatPasString(p : paasmoutput;s:string);
+  Procedure ConcatPasString(p : TAAsmoutput;s:string);
   {*********************************************************************}
   { PROCEDURE ConcatPasString(s:string);                                }
   {  Description: This routine adds the character chain pointed to in   }
@@ -1408,10 +1408,10 @@ end;
   {  uses a pascal style string, so it conserves null characters.       }
   {*********************************************************************}
   Begin
-     p^.concat(new(pai_string,init(s)));
+     p.concat(Tai_string.Create(s));
   end;
 
-  Procedure ConcatDirect(p : paasmoutput;s:string);
+  Procedure ConcatDirect(p : TAAsmoutput;s:string);
   {*********************************************************************}
   { PROCEDURE ConcatDirect(s:string)                                    }
   {  Description: This routine output the string directly to the asm    }
@@ -1423,13 +1423,13 @@ end;
    pc: PChar;
   Begin
      getmem(pc,length(s)+1);
-     p^.concat(new(pai_direct,init(strpcopy(pc,s))));
+     p.concat(Tai_direct.Create(strpcopy(pc,s)));
   end;
 
 
 
 
-Procedure ConcatConstant(p: paasmoutput; value: longint; maxvalue: longint);
+Procedure ConcatConstant(p: TAAsmoutput; value: longint; maxvalue: longint);
 {*********************************************************************}
 { PROCEDURE ConcatConstant(value: longint; maxvalue: longint);        }
 {  Description: This routine adds the value constant to the current   }
@@ -1447,23 +1447,23 @@ Begin
      value:=maxvalue;
    end;
   if maxvalue = $ff then
-   p^.concat(new(pai_const,init_8bit(byte(value))))
+   p.concat(Tai_const.Create_8bit(byte(value)))
   else
    if maxvalue = $ffff then
-    p^.concat(new(pai_const,init_16bit(word(value))))
+    p.concat(Tai_const.Create_16bit(word(value)))
   else
    if maxvalue = longint($ffffffff) then
-    p^.concat(new(pai_const,init_32bit(longint(value))));
+    p.concat(Tai_const.Create_32bit(longint(value)));
 end;
 
 
-  Procedure ConcatConstSymbol(p : paasmoutput;const sym:string;l:longint);
+  Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;l:longint);
   begin
-    p^.concat(new(pai_const_symbol,initname_offset(sym,l)));
+    p.concat(Tai_const_symbol.Createname_offset(sym,l));
   end;
 
 
-  Procedure ConcatRealConstant(p : paasmoutput;value: bestreal; real_typ : tfloattype);
+  Procedure ConcatRealConstant(p : TAAsmoutput;value: bestreal; real_typ : tfloattype);
   {***********************************************************************}
   { PROCEDURE ConcatRealConstant(value: bestreal; real_typ : tfloattype); }
   {  Description: This routine adds the value constant to the current     }
@@ -1477,52 +1477,52 @@ end;
   {***********************************************************************}
     Begin
        case real_typ of
-          s32real : p^.concat(new(pai_real_32bit,init(value)));
-          s64real : p^.concat(new(pai_real_64bit,init(value)));
-          s80real : p^.concat(new(pai_real_80bit,init(value)));
-          s64comp : p^.concat(new(pai_comp_64bit,init(value)));
-          f32bit  : p^.concat(new(pai_const,init_32bit(trunc(value*$10000))));
+          s32real : p.concat(Tai_real_32bit.Create(value));
+          s64real : p.concat(Tai_real_64bit.Create(value));
+          s80real : p.concat(Tai_real_80bit.Create(value));
+          s64comp : p.concat(Tai_comp_64bit.Create(value));
+          f32bit  : p.concat(Tai_const.Create_32bit(trunc(value*$10000)));
        end;
     end;
 
-   Procedure ConcatLabel(p: paasmoutput;var l : pasmlabel);
+   Procedure ConcatLabel(p: TAAsmoutput;var l : pasmlabel);
   {*********************************************************************}
   { PROCEDURE ConcatLabel                                               }
   {  Description: This routine either emits a label or a labeled        }
   {  instruction to the linked list of instructions.                    }
   {*********************************************************************}
    begin
-     p^.concat(new(pai_label,init(l)));
+     p.concat(Tai_label.Create(l));
    end;
 
-   procedure ConcatAlign(p:paasmoutput;l:longint);
+   procedure ConcatAlign(p:TAAsmoutput;l:longint);
   {*********************************************************************}
   { PROCEDURE ConcatPublic                                              }
   {  Description: This routine emits an global   definition to the      }
   {  linked list of instructions.(used by AT&T styled asm)              }
   {*********************************************************************}
    begin
-     p^.concat(new(pai_align,init(l)));
+     p.concat(Tai_align.Create(l));
    end;
 
-   procedure ConcatPublic(p:paasmoutput;const s : string);
+   procedure ConcatPublic(p:TAAsmoutput;const s : string);
   {*********************************************************************}
   { PROCEDURE ConcatPublic                                              }
   {  Description: This routine emits an global   definition to the      }
   {  linked list of instructions.(used by AT&T styled asm)              }
   {*********************************************************************}
    begin
-       p^.concat(new(pai_symbol,initname_global(s,0)));
+       p.concat(Tai_symbol.Createname_global(s,0));
    end;
 
-   procedure ConcatLocal(p:paasmoutput;const s : string);
+   procedure ConcatLocal(p:TAAsmoutput;const s : string);
   {*********************************************************************}
   { PROCEDURE ConcatLocal                                               }
   {  Description: This routine emits an local    definition to the      }
   {  linked list of instructions.                                       }
   {*********************************************************************}
    begin
-       p^.concat(new(pai_symbol,initname(s,0)));
+       p.concat(Tai_symbol.Createname(s,0));
    end;
 
   Procedure ConcatGlobalBss(const s : string;size : longint);
@@ -1532,7 +1532,7 @@ end;
   {  linked list of instructions.                                       }
   {*********************************************************************}
    begin
-       bsssegment^.concat(new(pai_datablock,init_global(s,size)));
+       bssSegment.concat(Tai_datablock.Create_global(s,size));
    end;
 
   Procedure ConcatLocalBss(const s : string;size : longint);
@@ -1542,13 +1542,17 @@ end;
   {  linked list of instructions.                                       }
   {*********************************************************************}
    begin
-       bsssegment^.concat(new(pai_datablock,init(s,size)));
+       bssSegment.concat(Tai_datablock.Create(s,size));
    end;
 
 end.
 {
   $Log$
-  Revision 1.13  2000-12-07 17:19:43  jonas
+  Revision 1.14  2000-12-25 00:07:28  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.13  2000/12/07 17:19:43  jonas
     * new constant handling: from now on, hex constants >$7fffffff are
       parsed as unsigned constants (otherwise, $80000000 got sign extended
       and became $ffffffff80000000), all constants in the longint range

compiler/regvars.pas

@@ -33,13 +33,13 @@ interface
        cpubase;
 
     procedure assign_regvars(p: tnode);
-    procedure load_regvars(asml: paasmoutput; p: tnode);
-    procedure cleanup_regvars(asml: paasmoutput);
+    procedure load_regvars(asml: TAAsmoutput; p: tnode);
+    procedure cleanup_regvars(asml: TAAsmoutput);
 {$ifdef i386}
-    procedure store_regvar(asml: paasmoutput; reg: tregister);
-    procedure load_regvar(asml: paasmoutput; vsym: pvarsym);
-    procedure load_regvar_reg(asml: paasmoutput; reg: tregister);
-    procedure load_all_regvars(asml: paasmoutput);
+    procedure store_regvar(asml: TAAsmoutput; reg: tregister);
+    procedure load_regvar(asml: TAAsmoutput; vsym: pvarsym);
+    procedure load_regvar_reg(asml: TAAsmoutput; reg: tregister);
+    procedure load_all_regvars(asml: TAAsmoutput);
 {$endif i386}
 
 implementation
@@ -286,7 +286,7 @@ implementation
 
 
 {$ifdef i386}
-    procedure store_regvar(asml: paasmoutput; reg: tregister);
+    procedure store_regvar(asml: TAAsmoutput; reg: tregister);
     var
       i: longint;
       hr: preference;
@@ -309,15 +309,15 @@ implementation
                   hr^.offset:=-vsym^.address+vsym^.owner^.address_fixup
                 else hr^.offset:=vsym^.address+vsym^.owner^.address_fixup;
                 hr^.base:=procinfo^.framepointer;
-                asml^.concat(new(paicpu,op_reg_ref(A_MOV,regsize(vsym^.reg),vsym^.reg,hr)));
-                asml^.concat(new(pairegalloc,dealloc(reg32(reg))));
+                asml.concat(Taicpu.op_reg_ref(A_MOV,regsize(vsym^.reg),vsym^.reg,hr));
+                asml.concat(Tairegalloc.dealloc(reg32(reg)));
                 regvar_loaded[reg32(reg)] := false;
               end;
             break;
           end;
     end;
 
-    procedure load_regvar(asml: paasmoutput; vsym: pvarsym);
+    procedure load_regvar(asml: TAAsmoutput; vsym: pvarsym);
     var
       hr: preference;
       opsize: topsize;
@@ -325,7 +325,7 @@ implementation
     begin
       if not regvar_loaded[reg32(vsym^.reg)] then
         begin
-          asml^.concat(new(pairegalloc,alloc(reg32(vsym^.reg))));
+          asml.concat(Tairegalloc.alloc(reg32(vsym^.reg)));
           { zero the regvars because the upper 48bits must be clear }
           { for 8bits vars when using them with btrl                }
           { don't care about sign extension, since the upper 24/16  }
@@ -347,23 +347,22 @@ implementation
                 opcode := A_MOVZX;
               end;
           end;
-          asml^.concat(new(pairegalloc,alloc(reg32(vsym^.reg))));
+          asml.concat(Tairegalloc.alloc(reg32(vsym^.reg)));
           new(hr);
           reset_reference(hr^);
           if vsym^.owner^.symtabletype in [inlinelocalsymtable,localsymtable] then
             hr^.offset:=-vsym^.address+vsym^.owner^.address_fixup
           else hr^.offset:=vsym^.address+vsym^.owner^.address_fixup;
           hr^.base:=procinfo^.framepointer;
-          asml^.concat(new(paicpu,op_ref_reg(opcode,opsize,hr,reg32(vsym^.reg))));
+          asml.concat(Taicpu.op_ref_reg(opcode,opsize,hr,reg32(vsym^.reg)));
           regvar_loaded[reg32(vsym^.reg)] := true;
         end;
     end;
 
-    procedure load_regvar_reg(asml: paasmoutput; reg: tregister);
+    procedure load_regvar_reg(asml: TAAsmoutput; reg: tregister);
     var
       i: longint;
       regvarinfo: pregvarinfo;
-      vsym: pvarsym;
     begin
       regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
       if not assigned(regvarinfo) then
@@ -375,7 +374,7 @@ implementation
           load_regvar(asml,pvarsym(regvarinfo^.regvars[i]))
     end;
 
-    procedure load_all_regvars(asml: paasmoutput);
+    procedure load_all_regvars(asml: TAAsmoutput);
     var
       i: longint;
       regvarinfo: pregvarinfo;
@@ -392,10 +391,10 @@ implementation
 {$endif i386}
 
 
-    procedure load_regvars(asml: paasmoutput; p: tnode);
+    procedure load_regvars(asml: TAAsmoutput; p: tnode);
     var
       i: longint;
-      hr      : preference;
+      {hr      : preference;}
       regvarinfo: pregvarinfo;
     begin
       if (cs_regalloc in aktglobalswitches) and
@@ -419,7 +418,7 @@ implementation
                   reset_reference(hr^);
                   hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
                   hr^.base:=procinfo^.framepointer;
-                  asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
+                  asml.concat(Taicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
                     hr,regvarinfo^.regvars[i]^.reg)));
                 end
             end;
@@ -429,9 +428,9 @@ implementation
              if assigned(regvarinfo^.regvars[i]) then
                begin
                 if cs_asm_source in aktglobalswitches then
-                 asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.regvars[i]^.name+
+                 asml.insert(Tai_asm_comment.Create(strpnew(regvarinfo^.regvars[i]^.name+
                   ' with weight '+tostr(regvarinfo^.regvars[i]^.refs)+' assigned to register '+
-                  reg2str(regvarinfo^.regvars[i]^.reg)))));
+                  reg2str(regvarinfo^.regvars[i]^.reg))));
                 if (status.verbosity and v_debug)=v_debug then
                  Message3(cg_d_register_weight,reg2str(regvarinfo^.regvars[i]^.reg),
                   tostr(regvarinfo^.regvars[i]^.refs),regvarinfo^.regvars[i]^.name);
@@ -444,7 +443,7 @@ implementation
 {$ifdef i386}
                   { reserve place on the FPU stack }
                   regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
-                  asml^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
+                  asml.concat(Taicpu.op_none(A_FLDZ,S_NO));
 {$endif i386}
 {$ifdef dummy}
                   { parameter must be load }
@@ -459,11 +458,11 @@ implementation
                       hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
                       hr^.base:=procinfo^.framepointer;
 {$ifdef i386}
-                      asml^.concat(new(paicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
+                      asml.concat(Taicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
                         hr,regvarinfo^.regvars[i]^.reg)));
 {$endif i386}
 {$ifdef m68k}
-                      asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
+                      asml.concat(Taicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
                         hr,regvarinfo^.regvars[i]^.reg)));
 {$endif m68k}
                     end;
@@ -472,28 +471,28 @@ implementation
             end;
           if assigned(p) then
             if cs_asm_source in aktglobalswitches then
-              asml^.insert(new(pai_asm_comment,init(strpnew(tostr(p.registersfpu)+
-              ' registers on FPU stack used by temp. expressions'))));
+              asml.insert(Tai_asm_comment.Create(strpnew(tostr(p.registersfpu)+
+              ' registers on FPU stack used by temp. expressions')));
           for i:=1 to maxfpuvarregs do
             begin
                if assigned(regvarinfo^.fpuregvars[i]) then
                  begin
                     if cs_asm_source in aktglobalswitches then
-                      asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.fpuregvars[i]^.name+
+                      asml.insert(Tai_asm_comment.Create(strpnew(regvarinfo^.fpuregvars[i]^.name+
                         ' with weight '+tostr(regvarinfo^.fpuregvars[i]^.refs)+' assigned to register '+
-                        reg2str(regvarinfo^.fpuregvars[i]^.reg)))));
+                        reg2str(regvarinfo^.fpuregvars[i]^.reg))));
                     if (status.verbosity and v_debug)=v_debug then
                       Message3(cg_d_register_weight,reg2str(regvarinfo^.fpuregvars[i]^.reg),
                         tostr(regvarinfo^.fpuregvars[i]^.refs),regvarinfo^.fpuregvars[i]^.name);
                  end;
             end;
           if cs_asm_source in aktglobalswitches then
-            asml^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
+            asml.insert(Tai_asm_comment.Create(strpnew('Register variable assignment:')));
         end;
     end;
 
 
-    procedure cleanup_regvars(asml: paasmoutput);
+    procedure cleanup_regvars(asml: TAAsmoutput);
     var
       i: longint;
     begin
@@ -508,11 +507,11 @@ implementation
             for i:=1 to maxfpuvarregs do
               if assigned(fpuregvars[i]) then
                 { ... and clean it up }
-                asml^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
+                asml.concat(Taicpu.op_reg(A_FSTP,S_NO,R_ST0));
             for i := 1 to maxvarregs do
               if assigned(regvars[i]) and
                  (regvar_loaded[reg32(regvars[i]^.reg)]) then
-                asml^.concat(new(pairegalloc,dealloc(reg32(regvars[i]^.reg))));
+                asml.concat(Tairegalloc.dealloc(reg32(regvars[i]^.reg)));
           end;
 {$endif i386}
     end;
@@ -521,7 +520,11 @@ end.
 
 {
   $Log$
-  Revision 1.14  2000-12-05 11:44:32  jonas
+  Revision 1.15  2000-12-25 00:07:28  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.14  2000/12/05 11:44:32  jonas
     + new integer regvar handling, should be much more efficient
 
   Revision 1.13  2000/11/29 00:30:39  florian

compiler/scandir.inc

@@ -626,7 +626,7 @@ const
         path  : dirstr;
         name  : namestr;
         ext   : extstr;
-        hp    : pinputfile;
+        hp    : tinputfile;
         i     : longint;
         found : boolean;
       begin
@@ -656,7 +656,7 @@ const
              hs:=getdatestr
            else
             if hs='FILE' then
-             hs:=current_module^.sourcefiles^.get_file_name(aktfilepos.fileindex)
+             hs:=current_module.sourcefiles.get_file_name(aktfilepos.fileindex)
            else
             if hs='LINE' then
              hs:=tostr(aktfilepos.line)
@@ -685,9 +685,9 @@ const
            found:=false;
            if path<>'' then
              path:=path+';';
-           path:=FindFile(name+ext,path+current_scanner^.inputfile^.path^+';.'+DirSep,found);
+           path:=FindFile(name+ext,path+current_scanner^.inputfile.path^+';.'+DirSep,found);
            if (not found) then
-            path:=current_module^.localincludesearchpath.FindFile(name+ext,found);
+            path:=current_module.localincludesearchpath.FindFile(name+ext,found);
            if (not found) then
             path:=includesearchpath.FindFile(name+ext,found);
          { save old postion and decrease linebreak }
@@ -701,7 +701,7 @@ const
            current_scanner^.addfile(hp);
            if not current_scanner^.openinputfile then
             Message1(scan_f_cannot_open_includefile,hs);
-           Message1(scan_t_start_include_file,current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^);
+           Message1(scan_t_start_include_file,current_scanner^.inputfile.path^+current_scanner^.inputfile.name^);
            current_scanner^.reload;
          { process first read char }
            case c of
@@ -710,7 +710,7 @@ const
             #13 : current_scanner^.linebreak;
            end;
          { register for refs }
-           current_module^.sourcefiles^.register_file(hp);
+           current_module.sourcefiles.register_file(hp);
          end;
       end;
 
@@ -799,13 +799,7 @@ const
       begin
         current_scanner^.skipspace;
         s:=AddExtension(FixFileName(current_scanner^.readcomment),target_info.objext);
-      {$IFDEF NEWST}
-        current_module^.linkotherofiles.
-         insert(new(Plinkitem,init(s,link_allways)));
-      {$ELSE}
-        current_module^.linkotherofiles.
-         insert(s,link_allways);
-      {$ENDIF NEWST}
+        current_module.linkotherofiles.add(s,link_allways);
       end;
 
 
@@ -821,15 +815,15 @@ const
           if Assigned(Current_Module) then
             begin
             delete(S,1,1);
-            insert(lower(current_module^.modulename^),S,1);
+            insert(lower(current_module.modulename^),S,1);
             end;
         s:=AddExtension(FixFileName(s),target_info.resext);
         if target_info.res<>res_none then
           if (target_info.res = res_i386_emx) and
-                                 not (Current_Module^.ResourceFiles.Empty) then
+                                 not (Current_module.ResourceFiles.Empty) then
             Message(scan_w_only_one_resourcefile_supported)
           else
-            current_module^.resourcefiles.insert(FixFileName(s))
+            current_module.resourcefiles.insert(FixFileName(s))
         else
           Message(scan_e_resourcefiles_not_supported);
       end;
@@ -863,13 +857,7 @@ const
                 s:=s+orgpattern;
               end;
           end;
-      {$IFDEF NEWST}
-        current_module^.linkOtherSharedLibs.
-         insert(new(Plinkitem,init(s,link_allways)));
-      {$ELSE}
-        current_module^.linkOtherSharedLibs.
-         insert(s,link_allways);
-      {$ENDIF}
+        current_module.linkOtherSharedLibs.add(s,link_allways);
       end;
 {$else PAVEL_LINKLIB}
     procedure dir_linklib(t:tdirectivetoken);
@@ -932,21 +920,9 @@ const
        linkMode:=ExtractLinkMode;
        MangleLibName(linkMode);
        if linkMode=lm_static then
-{$IFDEF NEWST}
-        current_module^.linkOtherStaticLibs.
-         insert(new(Plinkitem,init(FixFileName(libname),link_allways)))
-{$ELSE}
-        current_module^.linkOtherStaticLibs.
-         insert(FixFileName(libname),link_allways)
-{$ENDIF}
+        current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
        else
-{$IFDEF NEWST}
-        current_module^.linkOtherSharedLibs.
-         insert(new(Plinkitem,init(FixFileName(libname),link_allways)));
-{$ELSE}
-        current_module^.linkOtherSharedLibs.
-         insert(FixFileName(libname),link_allways);
-{$ENDIF}
+        current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
       end;
 
 
@@ -955,7 +931,7 @@ const
 
     procedure dir_outputformat(t:tdirectivetoken);
       begin
-        if not current_module^.in_global then
+        if not current_module.in_global then
          Message(scan_w_switch_is_global)
         else
           begin
@@ -970,55 +946,55 @@ const
 
     procedure dir_unitpath(t:tdirectivetoken);
       begin
-        if not current_module^.in_global then
+        if not current_module.in_global then
          Message(scan_w_switch_is_global)
         else
           begin
             current_scanner^.skipspace;
-            current_module^.localunitsearchpath.AddPath(current_scanner^.readcomment,false);
+            current_module.localunitsearchpath.AddPath(current_scanner^.readcomment,false);
           end;
       end;
 
 
     procedure dir_includepath(t:tdirectivetoken);
       begin
-        if not current_module^.in_global then
+        if not current_module.in_global then
          Message(scan_w_switch_is_global)
         else
           begin
             current_scanner^.skipspace;
-            current_module^.localincludesearchpath.AddPath(current_scanner^.readcomment,false);
+            current_module.localincludesearchpath.AddPath(current_scanner^.readcomment,false);
           end;
       end;
 
 
     procedure dir_librarypath(t:tdirectivetoken);
       begin
-        if not current_module^.in_global then
+        if not current_module.in_global then
          Message(scan_w_switch_is_global)
         else
           begin
             current_scanner^.skipspace;
-            current_module^.locallibrarysearchpath.AddPath(current_scanner^.readcomment,false);
+            current_module.locallibrarysearchpath.AddPath(current_scanner^.readcomment,false);
           end;
       end;
 
 
     procedure dir_objectpath(t:tdirectivetoken);
       begin
-        if not current_module^.in_global then
+        if not current_module.in_global then
          Message(scan_w_switch_is_global)
         else
           begin
             current_scanner^.skipspace;
-            current_module^.localobjectsearchpath.AddPath(current_scanner^.readcomment,false);
+            current_module.localobjectsearchpath.AddPath(current_scanner^.readcomment,false);
           end;
       end;
 
 
     procedure dir_mode(t:tdirectivetoken);
       begin
-        if not current_module^.in_global then
+        if not current_module.in_global then
          Message(scan_w_switch_is_global)
         else
           begin
@@ -1155,7 +1131,7 @@ const
       begin
         if target_info.target<>target_i386_win32 then
           Message(scan_w_app_type_not_support);
-        if not current_module^.in_global then
+        if not current_module.in_global then
           Message(scan_w_switch_is_global)
         else
           begin
@@ -1385,20 +1361,20 @@ const
          current_scanner^.gettokenpos;
          current_scanner^.readchar; {Remove the $}
          hs:=current_scanner^.readid;
+{$ifdef PREPROCWRITE}
          if parapreprocess then
           begin
             t:=Get_Directive(hs);
             if not(is_conditional(t) or (t=_DIR_DEFINE) or (t=_DIR_UNDEF)) then
              begin
-{$ifdef PREPROCWRITE}
                preprocfile^.AddSpace;
                preprocfile^.Add('{$'+hs+current_scanner^.readcomment+'}');
-{$endif PREPROCWRITE}
                exit;
              end;
           end;
+{$endif PREPROCWRITE}
          { skip this directive? }
-         if current_scanner^.ignoredirectives.find(hs) then
+         if (current_scanner^.ignoredirectives.find(hs)<>nil) then
           begin
             if (current_scanner^.comment_level>0) then
              current_scanner^.readcomment;
@@ -1461,7 +1437,11 @@ const
 
 {
   $Log$
-  Revision 1.14  2000-12-24 12:24:38  peter
+  Revision 1.15  2000-12-25 00:07:28  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.14  2000/12/24 12:24:38  peter
     * moved preprocessfile into a conditional
 
   Revision 1.13  2000/12/12 19:48:52  peter

compiler/scanner.pas

@@ -27,7 +27,7 @@ unit scanner;
 interface
 
     uses
-       cobjects,
+       cobjects,cclasses,
        globtype,globals,version,tokens,
        verbose,comphook,
        finput,
@@ -70,7 +70,7 @@ interface
 
        pscannerfile = ^tscannerfile;
        tscannerfile = object
-          inputfile    : pinputfile;  { current inputfile list }
+          inputfile    : tinputfile;  { current inputfile list }
 
           inputbuffer,                { input buffer }
           inputpointer : pchar;
@@ -86,7 +86,7 @@ interface
           comment_level,
           yylexcount     : longint;
           lastasmgetchar : char;
-          ignoredirectives : tstringcontainer; { ignore directives, used to give warnings only once }
+          ignoredirectives : tstringlist; { ignore directives, used to give warnings only once }
           preprocstack   : ppreprocstack;
           invalid        : boolean; { flag if sourcefiles have been destroyed ! }
           macros         : pdictionary;
@@ -102,7 +102,7 @@ interface
           procedure saveinputfile;
           procedure restoreinputfile;
           procedure nextfile;
-          procedure addfile(hp:pinputfile);
+          procedure addfile(hp:tinputfile);
           procedure reload;
           procedure insertmacro(const macname:string;p:pchar;len:longint);
         { Scanner things }
@@ -314,7 +314,7 @@ implementation
       begin
         inputfile:=do_openinputfile(fn);
         if assigned(current_module) then
-          current_module^.sourcefiles^.register_file(inputfile);
+          current_module.sourcefiles.register_file(inputfile);
       { reset localinput }
         inputbuffer:=nil;
         inputpointer:=nil;
@@ -330,7 +330,7 @@ implementation
         lasttoken:=NOTOKEN;
         nexttoken:=NOTOKEN;
         lastasmgetchar:=#0;
-        ignoredirectives.init;
+        ignoredirectives:=TStringList.Create;
         invalid:=false;
         in_asm_string:=false;
         new(macros,init);
@@ -355,13 +355,13 @@ implementation
               checkpreprocstack;
            { close file, but only if we are the first compile }
            { probably not necessary anymore with invalid flag PM }
-             if not current_module^.in_second_compile then
+             if not current_module.in_second_compile then
               begin
-                if not inputfile^.closed then
+                if not inputfile.closed then
                  closeinputfile;
               end;
           end;
-         ignoredirectives.done;
+         ignoredirectives.free;
          dispose(macros,done);
        end;
 
@@ -408,11 +408,11 @@ implementation
 
     function tscannerfile.openinputfile:boolean;
       begin
-        openinputfile:=inputfile^.open;
+        openinputfile:=inputfile.open;
       { load buffer }
-        inputbuffer:=inputfile^.buf;
-        inputpointer:=inputfile^.buf;
-        inputstart:=inputfile^.bufstart;
+        inputbuffer:=inputfile.buf;
+        inputpointer:=inputfile.buf;
+        inputstart:=inputfile.bufstart;
       { line }
         line_no:=0;
         lastlinepos:=0;
@@ -422,7 +422,7 @@ implementation
 
     procedure tscannerfile.closeinputfile;
       begin
-        inputfile^.close;
+        inputfile.close;
       { reset buffer }
         inputbuffer:=nil;
         inputpointer:=nil;
@@ -436,18 +436,18 @@ implementation
 
     function tscannerfile.tempopeninputfile:boolean;
       begin
-        tempopeninputfile:=inputfile^.tempopen;
+        tempopeninputfile:=inputfile.tempopen;
       { reload buffer }
-        inputbuffer:=inputfile^.buf;
-        inputpointer:=inputfile^.buf;
-        inputstart:=inputfile^.bufstart;
+        inputbuffer:=inputfile.buf;
+        inputpointer:=inputfile.buf;
+        inputstart:=inputfile.bufstart;
       end;
 
 
     procedure tscannerfile.tempcloseinputfile;
       begin
-        inputfile^.setpos(inputstart+(inputpointer-inputbuffer));
-        inputfile^.tempclose;
+        inputfile.setpos(inputstart+(inputpointer-inputbuffer));
+        inputfile.tempclose;
       { reset buffer }
         inputbuffer:=nil;
         inputpointer:=nil;
@@ -457,47 +457,47 @@ implementation
 
     procedure tscannerfile.saveinputfile;
       begin
-        inputfile^.saveinputpointer:=inputpointer;
-        inputfile^.savelastlinepos:=lastlinepos;
-        inputfile^.saveline_no:=line_no;
+        inputfile.saveinputpointer:=inputpointer;
+        inputfile.savelastlinepos:=lastlinepos;
+        inputfile.saveline_no:=line_no;
       end;
 
 
     procedure tscannerfile.restoreinputfile;
       begin
-        inputpointer:=inputfile^.saveinputpointer;
-        lastlinepos:=inputfile^.savelastlinepos;
-        line_no:=inputfile^.saveline_no;
-        if not inputfile^.is_macro then
-          parser_current_file:=inputfile^.name^;
+        inputpointer:=inputfile.saveinputpointer;
+        lastlinepos:=inputfile.savelastlinepos;
+        line_no:=inputfile.saveline_no;
+        if not inputfile.is_macro then
+          parser_current_file:=inputfile.name^;
       end;
 
 
     procedure tscannerfile.nextfile;
       var
-        to_dispose : pinputfile;
+        to_dispose : tinputfile;
       begin
-        if assigned(inputfile^.next) then
+        if assigned(inputfile.next) then
          begin
-           if inputfile^.is_macro then
+           if inputfile.is_macro then
              to_dispose:=inputfile
            else
              to_dispose:=nil;
            { we can allways close the file, no ? }
-           inputfile^.close;
-           inputfile:=inputfile^.next;
+           inputfile.close;
+           inputfile:=inputfile.next;
            if assigned(to_dispose) then
-             dispose(to_dispose,done);
+             to_dispose.free;
            restoreinputfile;
          end;
       end;
 
 
-    procedure tscannerfile.addfile(hp:pinputfile);
+    procedure tscannerfile.addfile(hp:tinputfile);
       begin
         saveinputfile;
       { add to list }
-        hp^.next:=inputfile;
+        hp.next:=inputfile;
         inputfile:=hp;
       { load new inputfile }
         restoreinputfile;
@@ -506,7 +506,7 @@ implementation
 
     procedure tscannerfile.reload;
       begin
-        with inputfile^ do
+        with inputfile do
          begin
            { when nothing more to read then leave immediatly, so we
              don't change the aktfilepos and leave it point to the last
@@ -518,7 +518,7 @@ implementation
              as a seperator, this can't be used for macro's which can change
              the place of the #0 in the buffer with tempopen }
              if (c=#0) and (bufsize>0) and
-                not(inputfile^.is_macro) and
+                not(inputfile.is_macro) and
                 (inputpointer-inputbuffer<bufsize) then
               begin
                 c:=' ';
@@ -537,7 +537,7 @@ implementation
                  begin
                    line_no:=1;
                    if cs_asm_source in aktglobalswitches then
-                     inputfile^.setline(line_no,bufstart);
+                     inputfile.setline(line_no,bufstart);
                  end;
               end
              else
@@ -547,7 +547,7 @@ implementation
               { close file }
                 closeinputfile;
               { no next module, than EOF }
-                if not assigned(inputfile^.next) then
+                if not assigned(inputfile.next) then
                  begin
                    c:=#26;
                    exit;
@@ -556,7 +556,7 @@ implementation
                 nextfile;
                 tempopeninputfile;
               { status }
-                Message1(scan_t_back_in,inputfile^.name^);
+                Message1(scan_t_back_in,inputfile.name^);
               end;
            { load next char }
              c:=inputpointer^;
@@ -568,7 +568,7 @@ implementation
 
     procedure tscannerfile.insertmacro(const macname:string;p:pchar;len:longint);
       var
-        hp : pinputfile;
+        hp : tinputfile;
       begin
       { save old postion and decrease linebreak }
         if c=newline then
@@ -579,7 +579,7 @@ implementation
         { use special name to dispose after !! }
         hp:=do_openinputfile('_Macro_.'+macname);
         addfile(hp);
-        with inputfile^ do
+        with inputfile do
          begin
            setmacro(p,len);
          { local buffer }
@@ -603,7 +603,7 @@ implementation
         lasttokenpos:=inputstart+(inputpointer-inputbuffer);
         akttokenpos.line:=line_no;
         akttokenpos.column:=lasttokenpos-lastlinepos;
-        akttokenpos.fileindex:=inputfile^.ref_index;
+        akttokenpos.fileindex:=inputfile.ref_index;
         aktfilepos:=akttokenpos;
       end;
 
@@ -641,7 +641,7 @@ implementation
          oldtokenpos,
          oldaktfilepos : tfileposinfo;
       begin
-        with inputfile^ do
+        with inputfile do
          begin
            if (byte(inputpointer^)=0) and not(endoffile) then
             begin
@@ -662,7 +662,7 @@ implementation
            inc(line_no);
          { update linebuffer }
            if cs_asm_source in aktglobalswitches then
-             inputfile^.setline(line_no,lastlinepos);
+             inputfile.setline(line_no,lastlinepos);
          { update for status and call the show status routine,
            but don't touch aktfilepos ! }
            oldaktfilepos:=aktfilepos;
@@ -1270,9 +1270,9 @@ implementation
                 if parapreprocess then
                  begin
                    if c=#10 then
-                    preprocfile^.eolfound:=true
+                    preprocfile.eolfound:=true
                    else
-                    preprocfile^.spacefound:=true;
+                    preprocfile.spacefound:=true;
                  end;
 {$endif PREPROCWRITE}
                 skipspace;
@@ -1946,7 +1946,11 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.12  2000-12-24 12:24:38  peter
+  Revision 1.13  2000-12-25 00:07:28  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.12  2000/12/24 12:24:38  peter
     * moved preprocessfile into a conditional
 
   Revision 1.11  2000/12/18 17:59:01  peter
@@ -1982,4 +1986,4 @@ end.
   Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
 
-}
+}

compiler/script.pas

@@ -27,13 +27,13 @@ unit Script;
 interface
 
 uses
-  CObjects;
+  cclasses;
 
 type
   PScript=^TScript;
   TScript=object
     fn   : string[80];
-    data : TStringQueue;
+    data : TStringList;
     executable : boolean;
     constructor Init(const s:string);
     constructor InitExec(const s:string);
@@ -81,7 +81,7 @@ constructor TScript.Init(const s:string);
 begin
   fn:=FixFileName(s);
   executable:=false;
-  data.Init;
+  data:=TStringList.Create;
 end;
 
 
@@ -89,13 +89,13 @@ constructor TScript.InitExec(const s:string);
 begin
   fn:=FixFileName(s)+source_os.scriptext;
   executable:=true;
-  data.Init;
+  data:=TStringList.Create;
 end;
 
 
 destructor TScript.Done;
 begin
-  data.done;
+  data.Free;
 end;
 
 
@@ -124,7 +124,7 @@ begin
   Assign(t,fn);
   Rewrite(t);
   while not data.Empty do
-   Writeln(t,data.Get);
+   Writeln(t,data.GetFirst);
   Close(t);
 {$ifdef Unix}
   if executable then
@@ -237,7 +237,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-11-13 15:43:07  marco
+  Revision 1.5  2000-12-25 00:07:29  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/11/13 15:43:07  marco
    * Renamefest
 
   Revision 1.3  2000/09/24 15:06:28  peter

compiler/switches.pas

@@ -114,7 +114,7 @@ begin
                        Message(scan_n_stack_check_global_under_linux);
                  end;
       modulesw : begin
-                   if current_module^.in_global then
+                   if current_module.in_global then
                     begin
                       if state='+' then
                         aktmoduleswitches:=aktmoduleswitches+[tmoduleswitch(setsw)]
@@ -130,7 +130,7 @@ begin
                     Message(scan_w_switch_is_global);
                  end;
       globalsw : begin
-                   if current_module^.in_global and (current_module=main_module) then
+                   if current_module.in_global and (current_module=main_module) then
                     begin
                       if state='+' then
                        aktglobalswitches:=aktglobalswitches+[tglobalswitch(setsw)]
@@ -177,7 +177,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-09-24 15:06:28  peter
+  Revision 1.6  2000-12-25 00:07:29  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/09/24 15:06:28  peter
     * use defines.inc
 
   Revision 1.4  2000/09/21 11:30:49  jonas

compiler/symppu.pas

@@ -24,7 +24,7 @@ interface
 
     uses
        cobjects,
-       globtype,
+       globtype,globals,
        symbase,
        ppu;
 
@@ -59,7 +59,6 @@ interface
 implementation
 
     uses
-       globals,
        symconst,
        verbose;
 
@@ -335,7 +334,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-11-29 00:30:41  florian
+  Revision 1.4  2000-12-25 00:07:29  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.3  2000/11/29 00:30:41  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/symsym.pas

@@ -60,7 +60,7 @@ interface
           procedure insert_in_data;virtual;
 {$ifdef GDB}
           function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
           procedure load_references;virtual;
           function  write_references : boolean;virtual;
@@ -89,7 +89,7 @@ interface
           procedure write;virtual;
           procedure restoreunitsym;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        end;
 
@@ -121,7 +121,7 @@ interface
           function  write_references : boolean;virtual;
 {$ifdef GDB}
           function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        end;
 
@@ -147,7 +147,7 @@ interface
           function  write_references : boolean;virtual;
 {$ifdef GDB}
           function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        end;
 
@@ -176,7 +176,7 @@ interface
           function  getpushsize : longint;
 {$ifdef GDB}
           function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        private
           _mangledname  : pchar;
@@ -203,7 +203,7 @@ interface
           procedure dooverride(overriden:ppropertysym);
 {$ifdef GDB}
           function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        end;
 
@@ -219,7 +219,7 @@ interface
           procedure deref;virtual;
           procedure insert_in_data;virtual;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        end;
 
@@ -237,7 +237,7 @@ interface
           procedure write;virtual;
           procedure insert_in_data;virtual;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        end;
 
@@ -277,7 +277,7 @@ interface
           procedure write;virtual;
 {$ifdef GDB}
           function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        end;
 
@@ -292,7 +292,7 @@ interface
           procedure deref;virtual;
           procedure order;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        end;
 
@@ -304,7 +304,7 @@ interface
           destructor  done;virtual;
           procedure write;virtual;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
 {$endif GDB}
        end;
 
@@ -455,7 +455,7 @@ implementation
           ref:=defref;
         while assigned(ref) do
          begin
-           if ref^.moduleindex=current_module^.unit_index then
+           if ref^.moduleindex=current_module.unit_index then
              begin
               { write address to this symbol }
                 if not symref_written then
@@ -520,7 +520,7 @@ implementation
            tostr(fileinfo.line)+',0');
       end;
 
-    procedure tstoredsym.concatstabto(asmlist : paasmoutput);
+    procedure tstoredsym.concatstabto(asmlist : taasmoutput);
 
     var stab_str : pchar;
       begin
@@ -528,7 +528,7 @@ implementation
            begin
               stab_str := stabstring;
               { count_dbx(stab_str); moved to GDB.PAS }
-              asmlist^.concat(new(pai_stabs,init(stab_str)));
+              asmList.concat(Tai_stabs.Create(stab_str));
               isstabwritten:=true;
           end;
     end;
@@ -612,7 +612,7 @@ implementation
       begin
          inherited load;
          typ:=unitsym;
-         unitsymtable:=punitsymtable(current_module^.globalsymtable);
+         unitsymtable:=punitsymtable(current_module.globalsymtable);
          prevsym:=nil;
       end;
 
@@ -657,7 +657,7 @@ implementation
       end;
 
 {$ifdef GDB}
-    procedure tunitsym.concatstabto(asmlist : paasmoutput);
+    procedure tunitsym.concatstabto(asmlist : taasmoutput);
       begin
       {Nothing to write to stabs !}
       end;
@@ -913,11 +913,11 @@ implementation
      freemem(p,length(stabsstr)+255);
     end;
 
-    procedure tprocsym.concatstabto(asmlist : paasmoutput);
+    procedure tprocsym.concatstabto(asmlist : taasmoutput);
     begin
       if (pocall_internproc in definition^.proccalloptions) then exit;
       if not isstabwritten then
-        asmlist^.concat(new(pai_stabs,init(stabstring)));
+        asmList.concat(Tai_stabs.Create(stabstring));
       isstabwritten := true;
       if assigned(definition^.parast) then
         pstoredsymtable(definition^.parast)^.concatstabto(asmlist);
@@ -1067,7 +1067,7 @@ implementation
          stabstring:=strpnew('');
       end;
 
-    procedure tpropertysym.concatstabto(asmlist : paasmoutput);
+    procedure tpropertysym.concatstabto(asmlist : taasmoutput);
       begin
          { !!!! don't know how to handle }
       end;
@@ -1117,7 +1117,7 @@ implementation
       end;
 
 {$ifdef GDB}
-    procedure tfuncretsym.concatstabto(asmlist : paasmoutput);
+    procedure tfuncretsym.concatstabto(asmlist : taasmoutput);
       begin
         { Nothing to do here, it is done in genexitcode  }
       end;
@@ -1268,7 +1268,7 @@ implementation
 
 
 {$ifdef GDB}
-    procedure tabsolutesym.concatstabto(asmlist : paasmoutput);
+    procedure tabsolutesym.concatstabto(asmlist : taasmoutput);
       begin
       { I don't know how to handle this !! }
       end;
@@ -1547,7 +1547,7 @@ implementation
                    { enable unitialized warning for local symbols }
                    varstate:=vs_declared;
                    if (cs_create_smart in aktmoduleswitches) then
-                     bsssegment^.concat(new(pai_cut,init));
+                     bssSegment.concat(Tai_cut.Create);
                    ali:=data_align(l);
                    if ali>1 then
                      begin
@@ -1564,9 +1564,9 @@ implementation
                       DLLSource or
                       (vo_is_exported in varoptions) or
                       (vo_is_C_var in varoptions) then
-                     bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
+                     bssSegment.concat(Tai_datablock.Create_global(mangledname,l))
                    else
-                     bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
+                     bssSegment.concat(Tai_datablock.Create(mangledname,l));
                    { increase datasize }
                    inc(owner^.datasize,l);
                    { this symbol can't be loaded to a register }
@@ -1576,7 +1576,7 @@ implementation
                globalsymtable :
                  begin
                    if (cs_create_smart in aktmoduleswitches) then
-                     bsssegment^.concat(new(pai_cut,init));
+                     bssSegment.concat(Tai_cut.Create);
                    ali:=data_align(l);
                    if ali>1 then
                      begin
@@ -1588,7 +1588,7 @@ implementation
                    if cs_debuginfo in aktmoduleswitches then
                      concatstabto(bsssegment);
 {$endif GDB}
-                   bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)));
+                   bssSegment.concat(Tai_datablock.Create_global(mangledname,l));
                    inc(owner^.datasize,l);
                    { this symbol can't be loaded to a register }
                    exclude(varoptions,vo_regable);
@@ -1775,7 +1775,7 @@ implementation
          stabstring := inherited stabstring;
   end;
 
-    procedure tvarsym.concatstabto(asmlist : paasmoutput);
+    procedure tvarsym.concatstabto(asmlist : taasmoutput);
 {$ifdef i386}
       var stab_str : pchar;
 {$endif i386}
@@ -1791,7 +1791,7 @@ implementation
                      +pstoreddef(vartype.def)^.numberstring+'",'+
                      tostr(N_RSYM)+',0,'+
                      tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
-              asmlist^.concat(new(pai_stabs,init(stab_str)));
+              asmList.concat(Tai_stabs.Create(stab_str));
            end;
 {$endif i386}
       end;
@@ -1869,7 +1869,7 @@ implementation
 
     procedure ttypedconstsym.insert_in_data;
       var
-        curconstsegment : paasmoutput;
+        curconstsegment : taasmoutput;
         l,ali,modulo : longint;
         storefilepos : tfileposinfo;
       begin
@@ -1880,12 +1880,12 @@ implementation
         else
           curconstsegment:=datasegment;
         if (cs_create_smart in aktmoduleswitches) then
-          curconstsegment^.concat(new(pai_cut,init));
+          curconstSegment.concat(Tai_cut.Create);
         l:=getsize;
         ali:=data_align(l);
         if ali>1 then
           begin
-             curconstsegment^.concat(new(pai_align,init(ali)));
+             curconstSegment.concat(Tai_align.Create(ali));
              modulo:=owner^.datasize mod ali;
              if modulo>0 then
                inc(owner^.datasize,ali-modulo);
@@ -1898,16 +1898,16 @@ implementation
 {$endif GDB}
         if owner^.symtabletype=globalsymtable then
           begin
-             curconstsegment^.concat(new(pai_symbol,initdataname_global(mangledname,getsize)));
+             curconstSegment.concat(Tai_symbol.Createdataname_global(mangledname,getsize));
           end
         else
           if owner^.symtabletype<>unitsymtable then
             begin
               if (cs_create_smart in aktmoduleswitches) or
                  DLLSource then
-                curconstsegment^.concat(new(pai_symbol,initdataname_global(mangledname,getsize)))
+                curconstSegment.concat(Tai_symbol.Createdataname_global(mangledname,getsize))
               else
-                curconstsegment^.concat(new(pai_symbol,initdataname(mangledname,getsize)));
+                curconstSegment.concat(Tai_symbol.Createdataname(mangledname,getsize));
             end;
         aktfilepos:=storefilepos;
       end;
@@ -1964,7 +1964,7 @@ implementation
          consttype.reset;
          len:=l;
          if t=constresourcestring then
-           ResStrIndex:=ResourceStrings^.Register(name,
+           ResStrIndex:=ResourceStrings.Register(name,
              pchar(tpointerord(value)),len);
       end;
 
@@ -2160,7 +2160,7 @@ implementation
                     tostr(fileinfo.line)+',0');
     end;
 
-    procedure tconstsym.concatstabto(asmlist : paasmoutput);
+    procedure tconstsym.concatstabto(asmlist : taasmoutput);
       begin
         if consttyp <> conststring then
           inherited concatstabto(asmlist);
@@ -2240,7 +2240,7 @@ implementation
 
 
 {$ifdef GDB}
-    procedure tenumsym.concatstabto(asmlist : paasmoutput);
+    procedure tenumsym.concatstabto(asmlist : taasmoutput);
     begin
     {enum elements have no stab !}
     end;
@@ -2419,7 +2419,7 @@ implementation
       stabstring := strpnew(short);
     end;
 
-    procedure ttypesym.concatstabto(asmlist : paasmoutput);
+    procedure ttypesym.concatstabto(asmlist : taasmoutput);
       begin
       {not stabs for forward defs }
       if assigned(restype.def) then
@@ -2462,7 +2462,7 @@ implementation
       end;
 
 {$ifdef GDB}
-    procedure tsyssym.concatstabto(asmlist : paasmoutput);
+    procedure tsyssym.concatstabto(asmlist : taasmoutput);
       begin
       end;
 {$endif GDB}
@@ -2471,7 +2471,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-11-28 00:25:17  pierre
+  Revision 1.7  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.6  2000/11/28 00:25:17  pierre
    + use int64tostr function for integer consts
 
   Revision 1.5  2000/11/13 14:44:35  jonas

compiler/symtable.pas

@@ -72,7 +72,7 @@ interface
           procedure load_browser;
           procedure write_browser;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : paasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);virtual;
           function getnewtypecount : word; virtual;
 {$endif GDB}
        end;
@@ -92,7 +92,7 @@ interface
           destructor done;virtual;
           procedure writeasunit;
 {$ifdef GDB}
-          procedure concattypestabto(asmlist : paasmoutput);
+          procedure concattypestabto(asmlist : taasmoutput);
           function getnewtypecount : word; virtual;
 {$endif GDB}
           procedure load_symtable_refs;
@@ -273,7 +273,7 @@ implementation
             { do not claim for unit name itself !! }
             (punitsym(p)^.unitsymtable^.symtabletype=unitsymtable) then
            MessagePos2(psym(p)^.fileinfo,sym_n_unit_not_used,
-             p^.name,current_module^.modulename^);
+             p^.name,current_module.modulename^);
       end;
 
     procedure varsymbolused(p : pnamedindexobject);
@@ -335,7 +335,7 @@ implementation
              { all program functions are declared global
                but unused should still be signaled PM }
                 ((psym(p)^.owner^.symtabletype=staticsymtable) and
-                not current_module^.is_unit) then
+                not current_module.is_unit) then
              MessagePos2(psym(p)^.fileinfo,sym_h_local_symbol_not_used,SymTypeName[psym(p)^.typ],psym(p)^.realname);
           end;
       end;
@@ -360,7 +360,7 @@ implementation
 
 {$ifdef GDB}
     var
-      asmoutput : paasmoutput;
+      asmoutput : taasmoutput;
 
     procedure concatstab(p : pnamedindexobject);
       begin
@@ -833,9 +833,9 @@ implementation
              begin
                symtablelevel:=0;
 {$ifndef NEWMAP}
-               current_module^.map^[0]:=@self;
+               current_module.map^[0]:=@self;
 {$else NEWMAP}
-               current_module^.globalsymtable:=@self;
+               current_module.globalsymtable:=@self;
 {$endif NEWMAP}
              end;
            recordsymtable,
@@ -884,7 +884,7 @@ implementation
              begin
 {$ifdef NEWMAP}
                { necessary for dependencies }
-               current_module^.globalsymtable:=nil;
+               current_module.globalsymtable:=nil;
 {$endif NEWMAP}
              end;
            recordsymtable,
@@ -1014,7 +1014,7 @@ implementation
                       end;
                    end;
                 end
-              else if (current_module^.flags and uf_local_browser)=0 then
+              else if (current_module.flags and uf_local_browser)=0 then
                 internalerror(43789);
            end;
 
@@ -1149,7 +1149,7 @@ implementation
            { this was buggy anyway because we could use }
            { unitsyms from other units in _USES !!      }
            {if (symtabletype=unitsymtable) and (hp^.typ=unitsym) and
-              assigned(current_module) and (current_module^.globalsymtable<>@self) then
+              assigned(current_module) and (current_module.globalsymtable<>@self) then
              hp:=nil;}
            if assigned(hp) and
               (cs_browser in aktmoduleswitches) and make_ref then
@@ -1240,7 +1240,7 @@ implementation
 {$endif CHAINPROCSYMS}
 
 {$ifdef GDB}
-    procedure tstoredsymtable.concatstabto(asmlist : paasmoutput);
+    procedure tstoredsymtable.concatstabto(asmlist : taasmoutput);
       begin
         asmoutput:=asmlist;
         if symtabletype in [inlineparasymtable,inlinelocalsymtable] then
@@ -1286,25 +1286,25 @@ implementation
 
     procedure writesourcefiles;
       var
-        hp    : pinputfile;
+        hp  : tinputfile;
         i,j : longint;
       begin
       { second write the used source files }
         current_ppu^.do_crc:=false;
-        hp:=current_module^.sourcefiles^.files;
+        hp:=current_module.sourcefiles.files;
       { write source files directly in good order }
         j:=0;
         while assigned(hp) do
           begin
             inc(j);
-            hp:=hp^.ref_next;
+            hp:=hp.ref_next;
           end;
         while j>0 do
           begin
-            hp:=current_module^.sourcefiles^.files;
+            hp:=current_module.sourcefiles.files;
             for i:=1 to j-1 do
-              hp:=hp^.ref_next;
-            current_ppu^.putstring(hp^.name^);
+              hp:=hp.ref_next;
+            current_ppu^.putstring(hp.name^);
             dec(j);
          end;
         current_ppu^.writeentry(ibsourcefiles);
@@ -1332,23 +1332,23 @@ implementation
 
     procedure writeusedunit;
       var
-        hp      : pused_unit;
+        hp : tused_unit;
       begin
         numberunits;
-        hp:=pused_unit(current_module^.used_units.first);
+        hp:=tused_unit(current_module.used_units.first);
         while assigned(hp) do
          begin
            { implementation units should not change
              the CRC PM }
-           current_ppu^.do_crc:=hp^.in_interface;
-           current_ppu^.putstring(hp^.name^);
+           current_ppu^.do_crc:=hp.in_interface;
+           current_ppu^.putstring(hp.name^);
            { the checksum should not affect the crc of this unit ! (PFV) }
            current_ppu^.do_crc:=false;
-           current_ppu^.putlongint(hp^.checksum);
-           current_ppu^.putlongint(hp^.interface_checksum);
-           current_ppu^.putbyte(byte(hp^.in_interface));
+           current_ppu^.putlongint(hp.checksum);
+           current_ppu^.putlongint(hp.interface_checksum);
+           current_ppu^.putbyte(byte(hp.in_interface));
            current_ppu^.do_crc:=true;
-           hp:=pused_unit(hp^.next);
+           hp:=tused_unit(hp.next);
          end;
         current_ppu^.do_interface_crc:=true;
         current_ppu^.writeentry(ibloadunit);
@@ -1361,7 +1361,7 @@ implementation
         s : string;
         mask : longint;
       begin
-        hcontainer.init;
+        hcontainer:=TLinkContainer.Create;
         while not p.empty do
          begin
            s:=p.get(mask);
@@ -1370,7 +1370,7 @@ implementation
            else
             current_ppu^.putstring(s);
            current_ppu^.putlongint(mask);
-           hcontainer.insert(s,mask);
+           hcontainer.add(s,mask);
          end;
         current_ppu^.writeentry(id);
         p:=hcontainer;
@@ -1382,7 +1382,7 @@ implementation
          Message1(unit_u_ppu_write,s);
 
        { create unit flags }
-         with Current_Module^ do
+         with Current_Module do
           begin
 {$ifdef GDB}
             if cs_gdb_dbx in aktglobalswitches then
@@ -1417,10 +1417,10 @@ implementation
            end
          else
            begin
-             current_ppu^.crc_test:=Current_Module^.crc_array;
-             current_ppu^.crc_index:=Current_Module^.crc_size;
-             current_ppu^.crc_test2:=Current_Module^.crc_array2;
-             current_ppu^.crc_index2:=Current_Module^.crc_size2;
+             current_ppu^.crc_test:=current_module.crc_array;
+             current_ppu^.crc_index:=current_module.crc_size;
+             current_ppu^.crc_test2:=current_module.crc_array2;
+             current_ppu^.crc_index2:=current_module.crc_size2;
            end;
 {$endif def Test_Double_checksum}
 
@@ -1437,21 +1437,21 @@ implementation
          current_ppu^.header.compiler:=wordversion;
          current_ppu^.header.cpu:=word(target_cpu);
          current_ppu^.header.target:=word(target_info.target);
-         current_ppu^.header.flags:=current_module^.flags;
+         current_ppu^.header.flags:=current_module.flags;
          If not only_crc then
            current_ppu^.writeheader;
        { save crc in current_module also }
-         current_module^.crc:=current_ppu^.crc;
-         current_module^.interface_crc:=current_ppu^.interface_crc;
+         current_module.crc:=current_ppu^.crc;
+         current_module.interface_crc:=current_ppu^.interface_crc;
          if only_crc then
           begin
 {$ifdef Test_Double_checksum}
-            Current_Module^.crc_array:=current_ppu^.crc_test;
+            current_module.crc_array:=current_ppu^.crc_test;
             current_ppu^.crc_test:=nil;
-            Current_Module^.crc_size:=current_ppu^.crc_index2;
-            Current_Module^.crc_array2:=current_ppu^.crc_test2;
+            current_module.crc_size:=current_ppu^.crc_index2;
+            current_module.crc_array2:=current_ppu^.crc_test2;
             current_ppu^.crc_test2:=nil;
-            Current_Module^.crc_size2:=current_ppu^.crc_index2;
+            current_module.crc_size2:=current_ppu^.crc_index2;
 {$endif def Test_Double_checksum}
             closecurrentppu;
           end;
@@ -1478,17 +1478,17 @@ implementation
              begin
 {$ifndef EXTDEBUG}
            { if we don't have the sources why tell }
-              if current_module^.sources_avail then
+              if current_module.sources_avail then
 {$endif ndef EXTDEBUG}
                if (not was_defined_at_startup) and
                   was_used and
                   mac^.defined_at_startup then
-                Message2(unit_h_cond_not_set_in_last_compile,hs,current_module^.mainsource^);
+                Message2(unit_h_cond_not_set_in_last_compile,hs,current_module.mainsource^);
              end
            else { not assigned }
              if was_defined_at_startup and
                 was_used then
-              Message2(unit_h_cond_not_set_in_last_compile,hs,current_module^.mainsource^);
+              Message2(unit_h_cond_not_set_in_last_compile,hs,current_module.mainsource^);
          end;
       end;
 
@@ -1502,19 +1502,19 @@ implementation
         is_main       : boolean;
         ppufiletime,
         source_time   : longint;
-        hp            : pinputfile;
+        hp            : tinputfile;
       begin
-        ppufiletime:=getnamedfiletime(current_module^.ppufilename^);
-        current_module^.sources_avail:=true;
+        ppufiletime:=getnamedfiletime(current_module.ppufilename^);
+        current_module.sources_avail:=true;
         is_main:=true;
         main_dir:='';
         while not current_ppu^.endofentry do
          begin
            hs:=current_ppu^.getstring;
            temp_dir:='';
-           if (current_module^.flags and uf_in_library)<>0 then
+           if (current_module.flags and uf_in_library)<>0 then
             begin
-              current_module^.sources_avail:=false;
+              current_module.sources_avail:=false;
               temp:=' library';
             end
            else if pos('Macro ',hs)=1 then
@@ -1526,11 +1526,11 @@ implementation
            else
             begin
               { check the date of the source files }
-              Source_Time:=GetNamedFileTime(current_module^.path^+hs);
+              Source_Time:=GetNamedFileTime(current_module.path^+hs);
               incfile_found:=false;
               main_found:=false;
               if Source_Time<>-1 then
-                hs:=current_module^.path^+hs
+                hs:=current_module.path^+hs
               else
                if not(is_main) then
                 begin
@@ -1552,7 +1552,7 @@ implementation
                 end;
               if Source_Time=-1 then
                begin
-                 current_module^.sources_avail:=false;
+                 current_module.sources_avail:=false;
                  temp:=' not found';
                end
               else
@@ -1569,30 +1569,30 @@ implementation
                     temp:=' time '+filetimestring(source_time);
                     if (source_time>ppufiletime) then
                      begin
-                       current_module^.do_compile:=true;
-                       current_module^.recompile_reason:=rr_sourcenewer;
+                       current_module.do_compile:=true;
+                       current_module.recompile_reason:=rr_sourcenewer;
                        temp:=temp+' *'
                      end;
                   end;
                end;
-              new(hp,init(hs));
+              hp:=tinputfile.create(hs);
               { the indexing is wrong here PM }
-              current_module^.sourcefiles^.register_file(hp);
+              current_module.sourcefiles.register_file(hp);
             end;
            if is_main then
              begin
-               stringdispose(current_module^.mainsource);
-               current_module^.mainsource:=stringdup(hs);
+               stringdispose(current_module.mainsource);
+               current_module.mainsource:=stringdup(hs);
              end;
            Message1(unit_u_ppu_source,hs+temp);
            is_main:=false;
          end;
       { check if we want to rebuild every unit, only if the sources are
         available }
-        if do_build and current_module^.sources_avail then
+        if do_build and current_module.sources_avail then
           begin
-             current_module^.do_compile:=true;
-             current_module^.recompile_reason:=rr_build;
+             current_module.do_compile:=true;
+             current_module.recompile_reason:=rr_build;
           end;
       end;
 
@@ -1610,7 +1610,7 @@ implementation
            checksum:=current_ppu^.getlongint;
            intfchecksum:=current_ppu^.getlongint;
            in_interface:=(current_ppu^.getbyte<>0);
-           current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,intfchecksum,in_interface)));
+           current_module.used_units.concat(tused_unit.create_to_load(hs,checksum,intfchecksum,in_interface));
          end;
       end;
 
@@ -1624,7 +1624,7 @@ implementation
          begin
            s:=current_ppu^.getstring;
            m:=current_ppu^.getlongint;
-           p.insert(s,m);
+           p.add(s,m);
          end;
       end;
 
@@ -1641,12 +1641,12 @@ implementation
              ibmodulename :
                begin
                  newmodulename:=current_ppu^.getstring;
-                 if upper(newmodulename)<>current_module^.modulename^ then
-                   Message2(unit_f_unit_name_error,current_module^.realmodulename^,newmodulename);
-                 stringdispose(current_module^.modulename);
-                 stringdispose(current_module^.realmodulename);
-                 current_module^.modulename:=stringdup(upper(newmodulename));
-                 current_module^.realmodulename:=stringdup(newmodulename);
+                 if upper(newmodulename)<>current_module.modulename^ then
+                   Message2(unit_f_unit_name_error,current_module.realmodulename^,newmodulename);
+                 stringdispose(current_module.modulename);
+                 stringdispose(current_module.realmodulename);
+                 current_module.modulename:=stringdup(upper(newmodulename));
+                 current_module.realmodulename:=stringdup(newmodulename);
                end;
              ibsourcefiles :
                readsourcefiles;
@@ -1655,17 +1655,17 @@ implementation
              ibloadunit :
                readloadunit;
              iblinkunitofiles :
-               readlinkcontainer(current_module^.LinkUnitOFiles);
+               readlinkcontainer(current_module.LinkUnitOFiles);
              iblinkunitstaticlibs :
-               readlinkcontainer(current_module^.LinkUnitStaticLibs);
+               readlinkcontainer(current_module.LinkUnitStaticLibs);
              iblinkunitsharedlibs :
-               readlinkcontainer(current_module^.LinkUnitSharedLibs);
+               readlinkcontainer(current_module.LinkUnitSharedLibs);
              iblinkotherofiles :
-               readlinkcontainer(current_module^.LinkotherOFiles);
+               readlinkcontainer(current_module.LinkotherOFiles);
              iblinkotherstaticlibs :
-               readlinkcontainer(current_module^.LinkotherStaticLibs);
+               readlinkcontainer(current_module.LinkotherStaticLibs);
              iblinkothersharedlibs :
-               readlinkcontainer(current_module^.LinkotherSharedLibs);
+               readlinkcontainer(current_module.LinkotherSharedLibs);
              ibendinterface :
                break;
            else
@@ -1701,10 +1701,10 @@ implementation
              unittypecount:=1;
              if (symtabletype=globalsymtable) then
                pglobaltypecount := @unittypecount;
-             unitid:=current_module^.unitcount;
-             debuglist^.concat(new(pai_asm_comment,init(strpnew('Global '+name^+' has index '+tostr(unitid)))));
-             debuglist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0'))));
-             inc(current_module^.unitcount);
+             unitid:=current_module.unitcount;
+             debugList.concat(Tai_asm_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid))));
+             debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
+             inc(current_module.unitcount);
              dbx_count_ok:=false;
              dbx_counter:=@dbx_count;
              do_count_dbx:=true;
@@ -1735,11 +1735,11 @@ implementation
          inherited loadas(unitsymtable);
 
        { set the name after because it is set to nil in tstoredsymtable.load !! }
-         name:=stringdup(current_module^.modulename^);
+         name:=stringdup(current_module.modulename^);
 
        { dbx count }
 {$ifdef GDB}
-         if (current_module^.flags and uf_has_dbx)<>0 then
+         if (current_module.flags and uf_has_dbx)<>0 then
            begin
               b := current_ppu^.readentry;
               if b <> ibdbxcount then
@@ -1784,14 +1784,14 @@ implementation
             b : byte;
             unitindex : word;
          begin
-         if ((current_module^.flags and uf_local_browser)<>0) then
+         if ((current_module.flags and uf_local_browser)<>0) then
            begin
-              current_module^.localsymtable:=new(punitsymtable,loadas(staticppusymtable));
-              psymtable(current_module^.localsymtable)^.name:=
-                stringdup('implementation of '+psymtable(current_module^.globalsymtable)^.name^);
+              current_module.localsymtable:=new(punitsymtable,loadas(staticppusymtable));
+              psymtable(current_module.localsymtable)^.name:=
+                stringdup('implementation of '+psymtable(current_module.globalsymtable)^.name^);
            end;
          { load browser }
-         if (current_module^.flags and uf_has_browser)<>0 then
+         if (current_module.flags and uf_has_browser)<>0 then
            begin
               {if not (cs_browser in aktmoduleswitches) then
                 current_ppu^.skipuntilentry(ibendbrowser)
@@ -1799,7 +1799,7 @@ implementation
                 begin
                    load_browser;
                    unitindex:=1;
-                   while assigned(current_module^.map^[unitindex]) do
+                   while assigned(current_module.map^[unitindex]) do
                      begin
                         {each unit wrote one browser entry }
                         load_browser;
@@ -1810,17 +1810,17 @@ implementation
                      Message1(unit_f_ppu_invalid_entry,tostr(b));
                 end;
            end;
-         if ((current_module^.flags and uf_local_browser)<>0) then
-           pstoredsymtable(current_module^.localsymtable)^.load_browser;
+         if ((current_module.flags and uf_local_browser)<>0) then
+           pstoredsymtable(current_module.localsymtable)^.load_browser;
          end;
 
 
     procedure tunitsymtable.writeasunit;
       var
-         pu        : pused_unit;
+         pu : tused_unit;
       begin
       { first the unitname }
-        current_ppu^.putstring(current_module^.realmodulename^);
+        current_ppu^.putstring(current_module.realmodulename^);
         current_ppu^.writeentry(ibmodulename);
 
         writesourcefiles;
@@ -1833,12 +1833,12 @@ implementation
         the link.res. All doesn't depend on the crc! It doesn't matter
         if a unit is in a .o or .a file }
         current_ppu^.do_crc:=false;
-        writelinkcontainer(current_module^.linkunitofiles,iblinkunitofiles,true);
-        writelinkcontainer(current_module^.linkunitstaticlibs,iblinkunitstaticlibs,true);
-        writelinkcontainer(current_module^.linkunitsharedlibs,iblinkunitsharedlibs,true);
-        writelinkcontainer(current_module^.linkotherofiles,iblinkotherofiles,false);
-        writelinkcontainer(current_module^.linkotherstaticlibs,iblinkotherstaticlibs,true);
-        writelinkcontainer(current_module^.linkothersharedlibs,iblinkothersharedlibs,true);
+        writelinkcontainer(current_module.linkunitofiles,iblinkunitofiles,true);
+        writelinkcontainer(current_module.linkunitstaticlibs,iblinkunitstaticlibs,true);
+        writelinkcontainer(current_module.linkunitsharedlibs,iblinkunitsharedlibs,true);
+        writelinkcontainer(current_module.linkotherofiles,iblinkotherofiles,false);
+        writelinkcontainer(current_module.linkotherstaticlibs,iblinkotherstaticlibs,true);
+        writelinkcontainer(current_module.linkothersharedlibs,iblinkothersharedlibs,true);
         current_ppu^.do_crc:=true;
 
         current_ppu^.writeentry(ibendinterface);
@@ -1865,24 +1865,24 @@ implementation
 
          { write static symtable
            needed for local debugging of unit functions }
-        if ((current_module^.flags and uf_local_browser)<>0) and
-           assigned(current_module^.localsymtable) then
-          pstoredsymtable(current_module^.localsymtable)^.writeas;
+        if ((current_module.flags and uf_local_browser)<>0) and
+           assigned(current_module.localsymtable) then
+          pstoredsymtable(current_module.localsymtable)^.writeas;
       { write all browser section }
-        if (current_module^.flags and uf_has_browser)<>0 then
+        if (current_module.flags and uf_has_browser)<>0 then
          begin
            write_browser;
-           pu:=pused_unit(current_module^.used_units.first);
+           pu:=tused_unit(current_module.used_units.first);
            while assigned(pu) do
             begin
-              pstoredsymtable(pu^.u^.globalsymtable)^.write_browser;
-              pu:=pused_unit(pu^.next);
+              pstoredsymtable(pu.u.globalsymtable)^.write_browser;
+              pu:=tused_unit(pu.next);
             end;
            current_ppu^.writeentry(ibendbrowser);
          end;
-        if ((current_module^.flags and uf_local_browser)<>0) and
-           assigned(current_module^.localsymtable) then
-          pstoredsymtable(current_module^.localsymtable)^.write_browser;
+        if ((current_module.flags and uf_local_browser)<>0) and
+           assigned(current_module.localsymtable) then
+          pstoredsymtable(current_module.localsymtable)^.write_browser;
 
       { the last entry ibend is written automaticly }
       end;
@@ -1905,37 +1905,36 @@ implementation
       end;
 
 
-      procedure tunitsymtable.concattypestabto(asmlist : paasmoutput);
+      procedure tunitsymtable.concattypestabto(asmlist : taasmoutput);
         var prev_dbx_count : plongint;
         begin
            if is_stab_written then exit;
            if not assigned(name) then name := stringdup('Main_program');
            if (symtabletype = unitsymtable) and
-              (current_module^.globalsymtable<>@Self) then
+              (current_module.globalsymtable<>@Self) then
              begin
-                unitid:=current_module^.unitcount;
-                inc(current_module^.unitcount);
+                unitid:=current_module.unitcount;
+                inc(current_module.unitcount);
              end;
-           asmlist^.concat(new(pai_asm_comment,init(strpnew('Begin unit '+name^
-                  +' has index '+tostr(unitid)))));
+           asmList.concat(Tai_asm_comment.Create(strpnew('Begin unit '+name^
+                  +' has index '+tostr(unitid))));
            if cs_gdb_dbx in aktglobalswitches then
              begin
                 if dbx_count_ok then
                   begin
-                     asmlist^.concat(new(pai_asm_comment,init(strpnew('"repeated" unit '+name^
-                              +' has index '+tostr(unitid)+' dbx count = '+tostr(dbx_count)))));
-                     asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
-                       +tostr(N_EXCL)+',0,0,'+tostr(dbx_count)))));
+                     asmList.concat(Tai_asm_comment.Create(strpnew('"repeated" unit '+name^
+                              +' has index '+tostr(unitid)+' dbx count = '+tostr(dbx_count))));
+                     asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
+                       +tostr(N_EXCL)+',0,0,'+tostr(dbx_count))));
                      exit;
                   end
-                else if (current_module^.globalsymtable<>@Self) then
+                else if (current_module.globalsymtable<>@Self) then
                   begin
                     prev_dbx_count := dbx_counter;
                     dbx_counter := nil;
                     do_count_dbx:=false;
                     if symtabletype = unitsymtable then
-                      asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
-                        +tostr(N_BINCL)+',0,0,0'))));
+                      asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
                     dbx_counter := @dbx_count;
                     dbx_count:=0;
                     do_count_dbx:=assigned(dbx_counter);
@@ -1945,14 +1944,14 @@ implementation
            foreach({$ifdef FPCPROCVAR}@{$endif}concattypestab);
            if cs_gdb_dbx in aktglobalswitches then
              begin
-                if (current_module^.globalsymtable<>@Self) then
+                if (current_module.globalsymtable<>@Self) then
                   begin
                     dbx_counter := prev_dbx_count;
                     do_count_dbx:=false;
-                    asmlist^.concat(new(pai_asm_comment,init(strpnew('End unit '+name^
-                      +' has index '+tostr(unitid)))));
-                    asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
-                      +tostr(N_EINCL)+',0,0,0'))));
+                    asmList.concat(Tai_asm_comment.Create(strpnew('End unit '+name^
+                      +' has index '+tostr(unitid))));
+                    asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
+                      +tostr(N_EINCL)+',0,0,0')));
                     do_count_dbx:=assigned(dbx_counter);
                     dbx_count_ok := {true}false;
                   end;
@@ -1968,29 +1967,29 @@ implementation
     procedure numberunits;
       var
         counter : longint;
-        hp      : pused_unit;
-        hp1     : pmodule;
+        hp      : tused_unit;
+        hp1     : tmodule;
       begin
         { Reset all numbers to -1 }
-        hp1:=pmodule(loaded_units.first);
+        hp1:=tmodule(loaded_units.first);
         while assigned(hp1) do
          begin
-           if assigned(hp1^.globalsymtable) then
-             psymtable(hp1^.globalsymtable)^.unitid:=$ffff;
-           hp1:=pmodule(hp1^.next);
+           if assigned(hp1.globalsymtable) then
+             psymtable(hp1.globalsymtable)^.unitid:=$ffff;
+           hp1:=tmodule(hp1.next);
          end;
         { Our own symtable gets unitid 0, for a program there is
           no globalsymtable }
-        if assigned(current_module^.globalsymtable) then
-          psymtable(current_module^.globalsymtable)^.unitid:=0;
+        if assigned(current_module.globalsymtable) then
+          psymtable(current_module.globalsymtable)^.unitid:=0;
         { number units }
         counter:=1;
-        hp:=pused_unit(current_module^.used_units.first);
+        hp:=tused_unit(current_module.used_units.first);
         while assigned(hp) do
          begin
-           psymtable(hp^.u^.globalsymtable)^.unitid:=counter;
+           psymtable(hp.u.globalsymtable)^.unitid:=counter;
            inc(counter);
-           hp:=pused_unit(hp^.next);
+           hp:=tused_unit(hp.next);
          end;
       end;
 
@@ -2033,7 +2032,7 @@ implementation
              if assigned(st) and (st^.unitid<>0) then
                Message2(sym_h_duplicate_id_where,'unit '+st^.name^,tostr(line))
              else
-               Message2(sym_h_duplicate_id_where,current_module^.sourcefiles^.get_file_name(fileindex),tostr(line));
+               Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line));
            end;
        end;
 
@@ -2092,11 +2091,11 @@ implementation
                 exit
               else
                begin
-                  if (punitsymtable(srsymtable)=punitsymtable(current_module^.globalsymtable)) then
+                  if (punitsymtable(srsymtable)=punitsymtable(current_module.globalsymtable)) then
                     begin
-                       getsymonlyin(psymtable(current_module^.localsymtable),s);
+                       getsymonlyin(psymtable(current_module.localsymtable),s);
                        if assigned(srsym) then
-                         srsymtable:=psymtable(current_module^.localsymtable)
+                         srsymtable:=psymtable(current_module.localsymtable)
                        else
                          identifier_not_found(s);
                     end
@@ -2282,8 +2281,8 @@ implementation
            begin
              if (p^.symtabletype=unitsymtable) and
                assigned(punitsymtable(p)^.unitsym) and
-               ((punitsymtable(p)^.unitsym^.owner=psymtable(current_module^.globalsymtable)) or
-                (punitsymtable(p)^.unitsym^.owner=psymtable(current_module^.localsymtable))) then
+               ((punitsymtable(p)^.unitsym^.owner=psymtable(current_module.globalsymtable)) or
+                (punitsymtable(p)^.unitsym^.owner=psymtable(current_module.localsymtable))) then
                  punitsymtable(p)^.unitsym^.restoreunitsym;
              p:=p^.next;
            end;
@@ -2371,7 +2370,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  2000-12-23 19:50:09  peter
+  Revision 1.23  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.22  2000/12/23 19:50:09  peter
     * fixed mem leak with withsymtable
 
   Revision 1.21  2000/12/10 20:25:32  peter

compiler/symtype.pas

@@ -250,7 +250,7 @@ implementation
         if pos<>nil then
           posinfo:=pos^;
         if assigned(current_module) then
-          moduleindex:=current_module^.unit_index;
+          moduleindex:=current_module.unit_index;
         if assigned(ref) then
           ref^.nextref:=@self;
         is_written:=false;
@@ -493,9 +493,9 @@ implementation
              derefunit :
                begin
 {$ifdef NEWMAP}
-                 st:=psymtable(current_module^.map^[p^.index]^.globalsymtable);
+                 st:=psymtable(current_module.map^[p^.index]^.globalsymtable);
 {$else NEWMAP}
-                 st:=psymtable(current_module^.map^[p^.index]);
+                 st:=psymtable(current_module.map^[p^.index]);
 {$endif NEWMAP}
                end;
              derefrecord :
@@ -567,7 +567,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-11-29 00:30:42  florian
+  Revision 1.4  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.3  2000/11/29 00:30:42  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/t_fbsd.pas

@@ -32,40 +32,38 @@ interface
     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;
+    timportlibfreebsd=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importvariable(const varname,module:string;const name:string);override;
+      procedure generatelib;override;
     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;
+    texportlibfreebsd=class(texportlib)
+      procedure preparelib(const s : string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
     end;
 
-    plinkerfreebsd=^tlinkerfreebsd;
-    tlinkerfreebsd=object(tlinker)
+    tlinkerfreebsd=class(tlinker)
     private
       Glibc2,
       Glibc21 : boolean;
       Function  WriteResponseFile(isdll:boolean) : Boolean;
     public
-      constructor Init;
-      procedure SetDefaultInfo;virtual;
-      function  MakeExecutable:boolean;virtual;
-      function  MakeSharedLibrary:boolean;virtual;
+      constructor Create;
+      procedure SetDefaultInfo;override;
+      function  MakeExecutable:boolean;override;
+      function  MakeSharedLibrary:boolean;override;
     end;
 
 
 implementation
 
   uses
-    cutils,verbose,cobjects,systems,globtype,globals,
+    cutils,cclasses,
+    verbose,systems,globtype,globals,
     symconst,script,
     fmodule,aasm,cpuasm,cpubase,symsym;
 
@@ -81,7 +79,7 @@ end;
 procedure timportlibfreebsd.importprocedure(const func,module : string;index : longint;const name : string);
 begin
   { insert sharedlibrary }
-  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
     aktprocsym^.definition^.setmangledname(name)
@@ -93,7 +91,7 @@ end;
 procedure timportlibfreebsd.importvariable(const varname,module:string;const name:string);
 begin
   { insert sharedlibrary }
-  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
   aktvarsym^.setmangledname(name);
   exclude(aktvarsym^.varoptions,vo_is_dll_var);
@@ -114,76 +112,76 @@ begin
 end;
 
 
-procedure texportlibfreebsd.exportprocedure(hp : pexported_item);
+procedure texportlibfreebsd.exportprocedure(hp : texported_item);
 var
-  hp2 : pexported_item;
+  hp2 : texported_item;
 begin
   { first test the index value }
-  if (hp^.options and eo_index)<>0 then
+  if (hp.options and eo_index)<>0 then
    begin
      Message1(parser_e_no_export_with_index_for_target,'freebsd');
      exit;
    end;
   { use pascal name is none specified }
-  if (hp^.options and eo_name)=0 then
+  if (hp.options and eo_name)=0 then
     begin
-       hp^.name:=stringdup(hp^.sym^.name);
-       hp^.options:=hp^.options or eo_name;
+       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);
+  hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) and
-     (hp^.name^>hp2^.name^) do
-    hp2:=pexported_item(hp2^.next);
+     (hp.name^>hp2.name^) do
+    hp2:=texported_item(hp2.next);
   { insert hp there !! }
-  if assigned(hp2) and (hp2^.name^=hp^.name^) then
+  if assigned(hp2) and (hp2.name^=hp.name^) then
     begin
       { this is not allowed !! }
-      Message1(parser_e_export_name_double,hp^.name^);
+      Message1(parser_e_export_name_double,hp.name^);
       exit;
     end;
-  if hp2=pexported_item(current_module^._exports^.first) then
-    current_module^._exports^.insert(hp)
+  if hp2=texported_item(current_module._exports.first) then
+    current_module._exports.concat(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;
+       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);
+    current_module._exports.concat(hp);
 end;
 
 
-procedure texportlibfreebsd.exportvar(hp : pexported_item);
+procedure texportlibfreebsd.exportvar(hp : texported_item);
 begin
-  hp^.is_var:=true;
+  hp.is_var:=true;
   exportprocedure(hp);
 end;
 
 
 procedure texportlibfreebsd.generatelib;
 var
-  hp2 : pexported_item;
+  hp2 : texported_item;
 begin
-  hp2:=pexported_item(current_module^._exports^.first);
+  hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
-     if not hp2^.is_var then
+     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^)));
+        codeSegment.concat(Tai_align.Create_op(4,$90));
+        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
       end
      else
       Message1(parser_e_no_export_of_variables_for_target,'freebsd');
-     hp2:=pexported_item(hp2^.next);
+     hp2:=texported_item(hp2.next);
    end;
 end;
 
@@ -192,9 +190,9 @@ end;
                                   TLINKERLINUX
 *****************************************************************************}
 
-Constructor TLinkerFreeBSD.Init;
+Constructor TLinkerFreeBSD.Create;
 begin
-  Inherited Init;
+  Inherited Create;
   LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
 end;
 
@@ -241,7 +239,7 @@ Var
   cprtobj,
   gprtobj,
   prtobj       : string[80];
-  HPath        : PStringQueueItem;
+  HPath        : TStringListItem;
   s            : string;
   found,
   linkdynamic,
@@ -250,7 +248,7 @@ begin
   WriteResponseFile:=False;
 { set special options for some targets }
   linkdynamic:=not(SharedLibFiles.empty);
-  linklibc:=SharedLibFiles.Find('c');
+  linklibc:=(SharedLibFiles.Find('c')<>nil);
   prtobj:='prt0';
   cprtobj:='cprt0';
   gprtobj:='gprt0';
@@ -277,17 +275,17 @@ begin
   LinkRes.Init(outputexedir+Info.ResName);
 
   { Write path to search libraries }
-  HPath:=current_module^.locallibrarysearchpath.First;
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('SEARCH_DIR('+HPath^.Data^+')');
-     HPath:=HPath^.Next;
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
    end;
-  HPath:=LibrarySearchPath.First;
+  HPath:=TStringListItem(LibrarySearchPath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('SEARCH_DIR('+HPath^.Data^+')');
-     HPath:=HPath^.Next;
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
    end;
 
   LinkRes.Add('INPUT(');
@@ -307,7 +305,7 @@ begin
   { main objectfiles }
   while not ObjectFiles.Empty do
    begin
-     s:=ObjectFiles.Get;
+     s:=ObjectFiles.GetFirst;
      if s<>'' then
       LinkRes.AddFileName(s);
    end;
@@ -329,7 +327,7 @@ begin
      LinkRes.Add('GROUP(');
      While not StaticLibFiles.Empty do
       begin
-        S:=StaticLibFiles.Get;
+        S:=StaticLibFiles.GetFirst;
         LinkRes.AddFileName(s)
       end;
      LinkRes.Add(')');
@@ -342,7 +340,7 @@ begin
      LinkRes.Add('INPUT(');
      While not SharedLibFiles.Empty do
       begin
-        S:=SharedLibFiles.Get;
+        S:=SharedLibFiles.GetFirst;
         if s<>'c' then
          begin
            i:=Pos(target_os.sharedlibext,S);
@@ -384,7 +382,7 @@ var
   StripStr   : string[40];
 begin
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.exefilename^);
+   Message1(exec_i_linking,current_module.exefilename^);
 
 { Create some replacements }
   StaticStr:='';
@@ -403,7 +401,7 @@ begin
 
 { Call linker }
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module^.exefilename^);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
   Replace(cmdstr,'$STATIC',StaticStr);
@@ -427,14 +425,14 @@ var
 begin
   MakeSharedLibrary:=false;
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.sharedlibfilename^);
+   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,'$EXE',current_module.sharedlibfilename^);
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
   success:=DoExec(FindUtil(binstr),cmdstr,true,false);
@@ -443,7 +441,7 @@ begin
   if success and (cs_link_strip in aktglobalswitches) then
    begin
      SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
-     Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
+     Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
      success:=DoExec(FindUtil(binstr),cmdstr,true,false);
    end;
 
@@ -457,7 +455,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-10-31 22:02:53  peter
+  Revision 1.5  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/10/31 22:02:53  peter
     * symtable splitted, no real code changes
 
   Revision 1.3  2000/09/24 21:33:47  peter
@@ -468,4 +470,4 @@ end.
 
   Revision 1.2  2000/09/16 12:24:00  peter
     * freebsd support routines
-}
+}

compiler/t_go32v1.pas

@@ -31,30 +31,30 @@ interface
     link;
 
   type
-    plinkergo32v1=^tlinkergo32v1;
-    tlinkergo32v1=object(tlinker)
+    tlinkergo32v1=class(tlinker)
     private
        Function  WriteResponseFile(isdll:boolean) : Boolean;
     public
-       constructor Init;
-       procedure SetDefaultInfo;virtual;
-       function  MakeExecutable:boolean;virtual;
+       constructor Create;
+       procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
     end;
 
 
   implementation
 
     uses
-       cutils,globtype,globals,cobjects,systems,verbose,script,fmodule;
+       cutils,cclasses,
+       globtype,globals,systems,verbose,script,fmodule;
 
 
 {****************************************************************************
                                TLinkergo32v1
 ****************************************************************************}
 
-Constructor TLinkergo32v1.Init;
+Constructor TLinkergo32v1.Create;
 begin
-  Inherited Init;
+  Inherited Create;
   { allow duplicated libs (PM) }
   SharedLibFiles.doubles:=true;
   StaticLibFiles.doubles:=true;
@@ -75,7 +75,7 @@ Function TLinkergo32v1.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
   i        : longint;
-  HPath    : PStringQueueItem;
+  HPath    : TStringListItem;
   s        : string;
   linklibc : boolean;
 begin
@@ -85,24 +85,24 @@ begin
   LinkRes.Init(outputexedir+Info.ResName);
 
   { Write path to search libraries }
-  HPath:=current_module^.locallibrarysearchpath.First;
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('-L'+HPath^.Data^);
-     HPath:=HPath^.Next;
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
    end;
-  HPath:=LibrarySearchPath.First;
+  HPath:=TStringListItem(LibrarySearchPath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('-L'+HPath^.Data^);
-     HPath:=HPath^.Next;
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
    end;
 
   { add objectfiles, start with prt0 always }
   LinkRes.AddFileName(FindObjectFile('prt0',''));
   while not ObjectFiles.Empty do
    begin
-     s:=ObjectFiles.Get;
+     s:=ObjectFiles.GetFirst;
      if s<>'' then
       LinkRes.AddFileName(s);
    end;
@@ -113,7 +113,7 @@ begin
      LinkRes.Add('-(');
      While not StaticLibFiles.Empty do
       begin
-        S:=StaticLibFiles.Get;
+        S:=StaticLibFiles.GetFirst;
         LinkRes.AddFileName(s)
       end;
      LinkRes.Add('-)');
@@ -124,7 +124,7 @@ begin
   linklibc:=false;
   While not SharedLibFiles.Empty do
    begin
-     S:=SharedLibFiles.Get;
+     S:=SharedLibFiles.GetFirst;
      if s<>'c' then
       begin
         i:=Pos(target_os.sharedlibext,S);
@@ -161,7 +161,7 @@ var
   StripStr : string[40];
 begin
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.exefilename^);
+   Message1(exec_i_linking,current_module.exefilename^);
 
 { Create some replacements }
   StripStr:='';
@@ -173,7 +173,7 @@ begin
 
 { Call linker }
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module^.exefilename^);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
   Replace(cmdstr,'$STRIP',StripStr);
@@ -189,7 +189,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-09-24 15:06:30  peter
+  Revision 1.5  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/09/24 15:06:30  peter
     * use defines.inc
 
   Revision 1.3  2000/08/27 16:11:54  peter

compiler/t_go32v2.pas

@@ -31,31 +31,31 @@ interface
     link;
 
   type
-    plinkergo32v2=^tlinkergo32v2;
-    tlinkergo32v2=object(tlinker)
+    tlinkergo32v2=class(tlinker)
     private
        Function  WriteResponseFile(isdll:boolean) : Boolean;
        Function  WriteScript(isdll:boolean) : Boolean;
     public
-       constructor Init;
-       procedure SetDefaultInfo;virtual;
-       function  MakeExecutable:boolean;virtual;
+       constructor Create;
+       procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
     end;
 
 
   implementation
 
     uses
-       cutils,globtype,globals,cobjects,systems,verbose,script,fmodule;
+       cutils,cclasses,
+       globtype,globals,systems,verbose,script,fmodule;
 
 
 {****************************************************************************
                                TLinkerGo32v2
 ****************************************************************************}
 
-Constructor TLinkerGo32v2.Init;
+Constructor TLinkerGo32v2.Create;
 begin
-  Inherited Init;
+  Inherited Create;
   { allow duplicated libs (PM) }
   SharedLibFiles.doubles:=true;
   StaticLibFiles.doubles:=true;
@@ -82,7 +82,7 @@ Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
   i        : longint;
-  HPath    : PStringQueueItem;
+  HPath    : TStringListItem;
   s        : string;
   linklibc : boolean;
 begin
@@ -92,24 +92,24 @@ begin
   LinkRes.Init(outputexedir+Info.ResName);
 
   { Write path to search libraries }
-  HPath:=current_module^.locallibrarysearchpath.First;
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('-L'+GetShortName(HPath^.Data^));
-     HPath:=HPath^.Next;
+     LinkRes.Add('-L'+GetShortName(HPath.Str));
+     HPath:=TStringListItem(HPath.Next);
    end;
-  HPath:=LibrarySearchPath.First;
+  HPath:=TStringListItem(LibrarySearchPath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('-L'+GetShortName(HPath^.Data^));
-     HPath:=HPath^.Next;
+     LinkRes.Add('-L'+GetShortName(HPath.Str));
+     HPath:=TStringListItem(HPath.Next);
    end;
 
   { add objectfiles, start with prt0 always }
   LinkRes.AddFileName(GetShortName(FindObjectFile('prt0','')));
   while not ObjectFiles.Empty do
    begin
-     s:=ObjectFiles.Get;
+     s:=ObjectFiles.GetFirst;
      if s<>'' then
       LinkRes.AddFileName(GetShortName(s));
    end;
@@ -120,7 +120,7 @@ begin
      LinkRes.Add('-(');
      While not StaticLibFiles.Empty do
       begin
-        S:=StaticLibFiles.Get;
+        S:=StaticLibFiles.GetFirst;
         LinkRes.AddFileName(GetShortName(s))
       end;
      LinkRes.Add('-)');
@@ -131,7 +131,7 @@ begin
   linklibc:=false;
   While not SharedLibFiles.Empty do
    begin
-     S:=SharedLibFiles.Get;
+     S:=SharedLibFiles.GetFirst;
      if s<>'c' then
       begin
         i:=Pos(target_os.sharedlibext,S);
@@ -175,7 +175,7 @@ begin
 
 {$ifdef dummy}
   { Write path to search libraries }
-  HPath:=current_module^.locallibrarysearchpath.First;
+  HPath:=current_module.locallibrarysearchpath.First;
   while assigned(HPath) do
    begin
      ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
@@ -197,7 +197,7 @@ begin
   ScriptRes.Add('  '+GetShortName(FindObjectFile('prt0',''))+'(.text)');
   while not ObjectFiles.Empty do
    begin
-     s:=ObjectFiles.Get;
+     s:=ObjectFiles.GetFirst;
      if s<>'' then
        begin
           ScriptRes.Add('  . = ALIGN(16);');
@@ -241,7 +241,7 @@ begin
      ScriptRes.Add('-(');
      While not StaticLibFiles.Empty do
       begin
-        S:=StaticLibFiles.Get;
+        S:=StaticLibFiles.GetFirst;
         ScriptRes.AddFileName(GetShortName(s))
       end;
      ScriptRes.Add('-)');
@@ -252,7 +252,7 @@ begin
   linklibc:=false;
   While not SharedLibFiles.Empty do
    begin
-     S:=SharedLibFiles.Get;
+     S:=SharedLibFiles.GetFirst;
      if s<>'c' then
       begin
         i:=Pos(target_os.sharedlibext,S);
@@ -288,7 +288,7 @@ var
   StripStr : string[40];
 begin
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.exefilename^);
+   Message1(exec_i_linking,current_module.exefilename^);
 
 { Create some replacements }
   StripStr:='';
@@ -307,7 +307,7 @@ begin
 
 { Call linker }
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module^.exefilename^);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
   Replace(cmdstr,'$STRIP',StripStr);
@@ -429,7 +429,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-09-24 15:06:31  peter
+  Revision 1.6  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/09/24 15:06:31  peter
     * use defines.inc
 
   Revision 1.4  2000/08/27 16:11:54  peter

compiler/t_linux.pas

@@ -31,40 +31,38 @@ interface
     import,export,link;
 
   type
-    pimportliblinux=^timportliblinux;
-    timportliblinux=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;
+    timportliblinux=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importvariable(const varname,module:string;const name:string);override;
+      procedure generatelib;override;
     end;
 
-    pexportliblinux=^texportliblinux;
-    texportliblinux=object(texportlib)
-      procedure preparelib(const s : string);virtual;
-      procedure exportprocedure(hp : pexported_item);virtual;
-      procedure exportvar(hp : pexported_item);virtual;
-      procedure generatelib;virtual;
+    texportliblinux=class(texportlib)
+      procedure preparelib(const s : string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
     end;
 
-    plinkerlinux=^tlinkerlinux;
-    tlinkerlinux=object(tlinker)
+    tlinkerlinux=class(tlinker)
     private
       Glibc2,
       Glibc21 : boolean;
       Function  WriteResponseFile(isdll:boolean) : Boolean;
     public
-      constructor Init;
-      procedure SetDefaultInfo;virtual;
-      function  MakeExecutable:boolean;virtual;
-      function  MakeSharedLibrary:boolean;virtual;
+      constructor Create;
+      procedure SetDefaultInfo;override;
+      function  MakeExecutable:boolean;override;
+      function  MakeSharedLibrary:boolean;override;
     end;
 
 
 implementation
 
   uses
-    cutils,verbose,cobjects,systems,globtype,globals,
+    cutils,cclasses,
+    verbose,systems,globtype,globals,
     symconst,script,
     fmodule,aasm,cpuasm,cpubase,symsym;
 
@@ -80,7 +78,7 @@ end;
 procedure timportliblinux.importprocedure(const func,module : string;index : longint;const name : string);
 begin
   { insert sharedlibrary }
-  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
     aktprocsym^.definition^.setmangledname(name)
@@ -92,7 +90,7 @@ end;
 procedure timportliblinux.importvariable(const varname,module:string;const name:string);
 begin
   { insert sharedlibrary }
-  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
   aktvarsym^.setmangledname(name);
   exclude(aktvarsym^.varoptions,vo_is_dll_var);
@@ -113,76 +111,76 @@ begin
 end;
 
 
-procedure texportliblinux.exportprocedure(hp : pexported_item);
+procedure texportliblinux.exportprocedure(hp : texported_item);
 var
-  hp2 : pexported_item;
+  hp2 : texported_item;
 begin
   { first test the index value }
-  if (hp^.options and eo_index)<>0 then
+  if (hp.options and eo_index)<>0 then
    begin
      Message1(parser_e_no_export_with_index_for_target,'linux');
      exit;
    end;
   { use pascal name is none specified }
-  if (hp^.options and eo_name)=0 then
+  if (hp.options and eo_name)=0 then
     begin
-       hp^.name:=stringdup(hp^.sym^.name);
-       hp^.options:=hp^.options or eo_name;
+       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);
+  hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) and
-     (hp^.name^>hp2^.name^) do
-    hp2:=pexported_item(hp2^.next);
+     (hp.name^>hp2.name^) do
+    hp2:=texported_item(hp2.next);
   { insert hp there !! }
-  if assigned(hp2) and (hp2^.name^=hp^.name^) then
+  if assigned(hp2) and (hp2.name^=hp.name^) then
     begin
       { this is not allowed !! }
-      Message1(parser_e_export_name_double,hp^.name^);
+      Message1(parser_e_export_name_double,hp.name^);
       exit;
     end;
-  if hp2=pexported_item(current_module^._exports^.first) then
-    current_module^._exports^.insert(hp)
+  if hp2=texported_item(current_module._exports.first) then
+    current_module._exports.concat(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;
+       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);
+    current_module._exports.concat(hp);
 end;
 
 
-procedure texportliblinux.exportvar(hp : pexported_item);
+procedure texportliblinux.exportvar(hp : texported_item);
 begin
-  hp^.is_var:=true;
+  hp.is_var:=true;
   exportprocedure(hp);
 end;
 
 
 procedure texportliblinux.generatelib;
 var
-  hp2 : pexported_item;
+  hp2 : texported_item;
 begin
-  hp2:=pexported_item(current_module^._exports^.first);
+  hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
-     if not hp2^.is_var then
+     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^)));
+        codesegment.concat(Tai_align.Create_op(4,$90));
+        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
       end
      else
       Message1(parser_e_no_export_of_variables_for_target,'linux');
-     hp2:=pexported_item(hp2^.next);
+     hp2:=texported_item(hp2.next);
    end;
 end;
 
@@ -191,9 +189,9 @@ end;
                                   TLINKERLINUX
 *****************************************************************************}
 
-Constructor TLinkerLinux.Init;
+Constructor TLinkerLinux.Create;
 begin
-  Inherited Init;
+  Inherited Create;
   LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
 end;
 
@@ -238,7 +236,7 @@ Var
   cprtobj,
   gprtobj,
   prtobj       : string[80];
-  HPath        : PStringQueueItem;
+  HPath        : TStringListItem;
   s            : string;
   found,
   linkdynamic,
@@ -247,7 +245,7 @@ begin
   WriteResponseFile:=False;
 { set special options for some targets }
   linkdynamic:=not(SharedLibFiles.empty);
-  linklibc:=SharedLibFiles.Find('c');
+  linklibc:=(SharedLibFiles.Find('c')<>nil);
   prtobj:='prt0';
   cprtobj:='cprt0';
   gprtobj:='gprt0';
@@ -274,17 +272,17 @@ begin
   LinkRes.Init(outputexedir+Info.ResName);
 
   { Write path to search libraries }
-  HPath:=current_module^.locallibrarysearchpath.First;
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('SEARCH_DIR('+HPath^.Data^+')');
-     HPath:=HPath^.Next;
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
    end;
-  HPath:=LibrarySearchPath.First;
+  HPath:=TStringListItem(LibrarySearchPath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('SEARCH_DIR('+HPath^.Data^+')');
-     HPath:=HPath^.Next;
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
    end;
 
   LinkRes.Add('INPUT(');
@@ -304,7 +302,7 @@ begin
   { main objectfiles }
   while not ObjectFiles.Empty do
    begin
-     s:=ObjectFiles.Get;
+     s:=ObjectFiles.GetFirst;
      if s<>'' then
       LinkRes.AddFileName(s);
    end;
@@ -326,7 +324,7 @@ begin
      LinkRes.Add('GROUP(');
      While not StaticLibFiles.Empty do
       begin
-        S:=StaticLibFiles.Get;
+        S:=StaticLibFiles.GetFirst;
         LinkRes.AddFileName(s)
       end;
      LinkRes.Add(')');
@@ -339,7 +337,7 @@ begin
      LinkRes.Add('INPUT(');
      While not SharedLibFiles.Empty do
       begin
-        S:=SharedLibFiles.Get;
+        S:=SharedLibFiles.GetFirst;
         if s<>'c' then
          begin
            i:=Pos(target_os.sharedlibext,S);
@@ -381,7 +379,7 @@ var
   StripStr   : string[40];
 begin
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.exefilename^);
+   Message1(exec_i_linking,current_module.exefilename^);
 
 { Create some replacements }
   StaticStr:='';
@@ -400,7 +398,7 @@ begin
 
 { Call linker }
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module^.exefilename^);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
   Replace(cmdstr,'$STATIC',StaticStr);
@@ -424,14 +422,14 @@ var
 begin
   MakeSharedLibrary:=false;
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.sharedlibfilename^);
+   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,'$EXE',current_module.sharedlibfilename^);
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
   success:=DoExec(FindUtil(binstr),cmdstr,true,false);
@@ -440,7 +438,7 @@ begin
   if success and (cs_link_strip in aktglobalswitches) then
    begin
      SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
-     Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
+     Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
      success:=DoExec(FindUtil(binstr),cmdstr,true,false);
    end;
 
@@ -455,7 +453,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.8  2000-10-31 22:02:54  peter
+  Revision 1.9  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.8  2000/10/31 22:02:54  peter
     * symtable splitted, no real code changes
 
   Revision 1.7  2000/09/24 21:33:47  peter
@@ -477,4 +479,4 @@ end.
   Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
 
-}
+}

compiler/t_nwm.pas

@@ -87,37 +87,35 @@ interface
     import,export,link;
 
   type
-    pimportlibnetware=^timportlibnetware;
-    timportlibnetware=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;
+    timportlibnetware=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importvariable(const varname,module:string;const name:string);override;
+      procedure generatelib;override;
     end;
 
-    pexportlibnetware=^texportlibnetware;
-    texportlibnetware=object(texportlib)
-      procedure preparelib(const s : string);virtual;
-      procedure exportprocedure(hp : pexported_item);virtual;
-      procedure exportvar(hp : pexported_item);virtual;
-      procedure generatelib;virtual;
+    texportlibnetware=class(texportlib)
+      procedure preparelib(const s : string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
     end;
 
-    plinkernetware=^tlinkernetware;
-    tlinkernetware=object(tlinker)
+    tlinkernetware=class(tlinker)
     private
       Function  WriteResponseFile(isdll:boolean) : Boolean;
     public
-      constructor Init;
-      procedure SetDefaultInfo;virtual;
-      function  MakeExecutable:boolean;virtual;
+      constructor Create;
+      procedure SetDefaultInfo;override;
+      function  MakeExecutable:boolean;override;
     end;
 
 
 implementation
 
   uses
-    cutils,verbose,systems,globtype,globals,
+    cutils,
+    verbose,systems,globtype,globals,
     symconst,script,
     fmodule,aasm,cpuasm,cpubase,symsym;
 
@@ -133,7 +131,7 @@ end;
 procedure timportlibnetware.importprocedure(const func,module : string;index : longint;const name : string);
 begin
   { insert sharedlibrary }
-  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
     aktprocsym^.definition^.setmangledname(name)
@@ -145,7 +143,7 @@ end;
 procedure timportlibnetware.importvariable(const varname,module:string;const name:string);
 begin
   { insert sharedlibrary }
-  current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
   aktvarsym^.setmangledname(name);
   exclude(aktvarsym^.varoptions,vo_is_dll_var);
@@ -166,76 +164,76 @@ begin
 end;
 
 
-procedure texportlibnetware.exportprocedure(hp : pexported_item);
+procedure texportlibnetware.exportprocedure(hp : texported_item);
 var
-  hp2 : pexported_item;
+  hp2 : texported_item;
 begin
   { first test the index value }
-  if (hp^.options and eo_index)<>0 then
+  if (hp.options and eo_index)<>0 then
    begin
      Comment(V_Error,'can''t export with index under netware');
      exit;
    end;
   { use pascal name is none specified }
-  if (hp^.options and eo_name)=0 then
+  if (hp.options and eo_name)=0 then
     begin
-       hp^.name:=stringdup(hp^.sym^.name);
-       hp^.options:=hp^.options or eo_name;
+       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);
+  hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) and
-     (hp^.name^>hp2^.name^) do
-    hp2:=pexported_item(hp2^.next);
+     (hp.name^>hp2.name^) do
+    hp2:=texported_item(hp2.next);
   { insert hp there !! }
-  if assigned(hp2) and (hp2^.name^=hp^.name^) then
+  if assigned(hp2) and (hp2.name^=hp.name^) then
     begin
       { this is not allowed !! }
-      Message1(parser_e_export_name_double,hp^.name^);
+      Message1(parser_e_export_name_double,hp.name^);
       exit;
     end;
-  if hp2=pexported_item(current_module^._exports^.first) then
-    current_module^._exports^.insert(hp)
+  if hp2=texported_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;
+       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);
+    current_module._exports.concat(hp);
 end;
 
 
-procedure texportlibnetware.exportvar(hp : pexported_item);
+procedure texportlibnetware.exportvar(hp : texported_item);
 begin
-  hp^.is_var:=true;
+  hp.is_var:=true;
   exportprocedure(hp);
 end;
 
 
 procedure texportlibnetware.generatelib;
 var
-  hp2 : pexported_item;
+  hp2 : texported_item;
 begin
-  hp2:=pexported_item(current_module^._exports^.first);
+  hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
-     if not hp2^.is_var then
+     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^)));
+        codeSegment.concat(Tai_align.Create_op(4,$90));
+        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
       end
      else
       Comment(V_Error,'Exporting of variables is not supported under netware');
-     hp2:=pexported_item(hp2^.next);
+     hp2:=texported_item(hp2.next);
    end;
 end;
 
@@ -244,9 +242,9 @@ end;
                                   TLINKERNETWARE
 *****************************************************************************}
 
-Constructor TLinkerNetware.Init;
+Constructor TLinkerNetware.Create;
 begin
-  Inherited Init;
+  Inherited Create;
 end;
 
 
@@ -269,11 +267,11 @@ Var
   found        : boolean;
   ProgNam      : string [80];
   NlmNam       : string [80];
-  hp2          : pexported_item;  { for exports }
+  hp2          : texported_item;  { for exports }
 begin
   WriteResponseFile:=False;
 
-  ProgNam := current_module^.exefilename^;
+  ProgNam := current_module.exefilename^;
   i:=Pos(target_os.exeext,ProgNam);
   if i>0 then
     Delete(ProgNam,i,255);
@@ -299,7 +297,7 @@ begin
   { main objectfiles }
   while not ObjectFiles.Empty do
    begin
-     s:=ObjectFiles.Get;
+     s:=ObjectFiles.GetFirst;
      if s<>'' then
       LinkRes.Add ('INPUT ' + FindObjectFile (s,''));
    end;
@@ -320,7 +318,7 @@ begin
    begin
      While not StaticLibFiles.Empty do
       begin
-        S:=lower (StaticLibFiles.Get);
+        S:=lower (StaticLibFiles.GetFirst);
         if s<>'' then
          begin
            i:=Pos(target_os.staticlibext,S);
@@ -343,7 +341,7 @@ begin
          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 ? }
-        S:=lower (SharedLibFiles.Get);
+        S:=lower (SharedLibFiles.GetFirst);
         if s<>'' then
          begin
            s2:=s;
@@ -359,21 +357,21 @@ begin
    end;
 
   { write exports }
-  hp2:=pexported_item(current_module^._exports^.first);
+  hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
-     if not hp2^.is_var then
+     if not hp2.is_var then
       begin
         { Export the Symbol
           Warning: The Symbol is converted to upper-case if not explicitly
           specified by >>Exports BlaBla NAME 'BlaBla';<< }
-        Comment(V_Debug,'Exporting '+hp2^.name^);
-        LinkRes.Add ('EXPORT '+hp2^.name^);
+        Comment(V_Debug,'Exporting '+hp2.name^);
+        LinkRes.Add ('EXPORT '+hp2.name^);
       end
      else
       { really ? }
       Comment(V_Error,'Exporting of variables is not supported under netware');
-     hp2:=pexported_item(hp2^.next);
+     hp2:=texported_item(hp2.next);
    end;
 
 { Write and Close response }
@@ -394,7 +392,7 @@ var
   StripStr   : string[40];
 begin
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.exefilename^);
+   Message1(exec_i_linking,current_module.exefilename^);
 
 { Create some replacements }
   StaticStr:='';
@@ -406,7 +404,7 @@ begin
 
 { Call linker }
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module^.exefilename^);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
   Replace(cmdstr,'$STATIC',StaticStr);
@@ -424,7 +422,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.4  2000-11-29 00:30:42  florian
+  Revision 1.5  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/11/29 00:30:42  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/t_os2.pas

@@ -37,21 +37,19 @@ uses
   import,link,comprsrc;
 
 type
-  pimportlibos2=^timportlibos2;
-  timportlibos2=object(timportlib)
-    procedure preparelib(const s:string);virtual;
-    procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
-    procedure generatelib;virtual;
+  timportlibos2=class(timportlib)
+    procedure preparelib(const s:string);override;
+    procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+    procedure generatelib;override;
   end;
 
-    plinkeros2=^tlinkeros2;
-    tlinkeros2=object(tlinker)
+    tlinkeros2=class(tlinker)
     private
        Function  WriteResponseFile(isdll:boolean) : Boolean;
     public
-       constructor Init;
-       procedure SetDefaultInfo;virtual;
-       function  MakeExecutable:boolean;virtual;
+       constructor Create;
+       procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
     end;
 
 
@@ -69,7 +67,8 @@ implementation
      strings,
      dos,
 {$endif Delphi}
-     cutils,globtype,cobjects,comphook,systems,
+     cutils,cclasses,
+     globtype,comphook,systems,
      globals,verbose,fmodule,script;
 
 const   profile_flag:boolean=false;
@@ -284,8 +283,8 @@ var
 begin
     libname:=FixFileName(s+'.ao2');
     seq_no:=1;
-    current_module^.linkunitstaticlibs.insert(libname,link_allways);
-    assign(out_file,current_module^.outputpath^+libname);
+    current_module.linkunitstaticlibs.add(libname,link_allways);
+    assign(out_file,current_module.outputpath^+libname);
     rewrite(out_file,1);
     blockwrite(out_file,ar_magic,sizeof(ar_magic));
 end;
@@ -352,9 +351,9 @@ end;
                                TLinkeros2
 ****************************************************************************}
 
-Constructor TLinkeros2.Init;
+Constructor TLinkeros2.Create;
 begin
-  Inherited Init;
+  Inherited Create;
   { allow duplicated libs (PM) }
   SharedLibFiles.doubles:=true;
   StaticLibFiles.doubles:=true;
@@ -375,7 +374,7 @@ Function TLinkeros2.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
   i        : longint;
-  HPath    : PStringQueueItem;
+  HPath    : TStringListItem;
   s        : string;
 begin
   WriteResponseFile:=False;
@@ -384,24 +383,24 @@ begin
   LinkRes.Init(outputexedir+Info.ResName);
 
   { Write path to search libraries }
-  HPath:=current_module^.locallibrarysearchpath.First;
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('-L'+HPath^.Data^);
-     HPath:=HPath^.Next;
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
    end;
-  HPath:=LibrarySearchPath.First;
+  HPath:=TStringListItem(LibrarySearchPath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('-L'+HPath^.Data^);
-     HPath:=HPath^.Next;
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
    end;
 
   { add objectfiles, start with prt0 always }
   LinkRes.AddFileName(FindObjectFile('prt0',''));
   while not ObjectFiles.Empty do
    begin
-     s:=ObjectFiles.Get;
+     s:=ObjectFiles.GetFirst;
      if s<>'' then
       LinkRes.AddFileName(s);
    end;
@@ -410,7 +409,7 @@ begin
   { No group !! This will not work correctly PM }
   While not StaticLibFiles.Empty do
    begin
-     S:=StaticLibFiles.Get;
+     S:=StaticLibFiles.GetFirst;
      LinkRes.AddFileName(s)
    end;
 
@@ -418,7 +417,7 @@ begin
     here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
   While not SharedLibFiles.Empty do
    begin
-     S:=SharedLibFiles.Get;
+     S:=SharedLibFiles.GetFirst;
      i:=Pos(target_os.sharedlibext,S);
      if i>0 then
       Delete(S,i,255);
@@ -444,7 +443,7 @@ var
   RsrcStr : string;
 begin
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.exefilename^);
+   Message1(exec_i_linking,current_module.exefilename^);
 
 { Create some replacements }
   if (cs_link_strip in aktglobalswitches) then
@@ -455,13 +454,13 @@ begin
    PMStr := '-p'
   else
    PMStr := '';
-  if not (Current_Module^.ResourceFiles.Empty) then
-   RsrcStr := '-r ' + Current_Module^.ResourceFiles.Get
+  if not (Current_module.ResourceFiles.Empty) then
+   RsrcStr := '-r ' + Current_module.ResourceFiles.GetFirst
   else
    RsrcStr := '';
 (* Only one resource file supported, discard everything else
    (should be already empty anyway, however. *)
-  Current_Module^.ResourceFiles.Clear;
+  Current_module.ResourceFiles.Clear;
 { Write used files and libraries }
   WriteResponseFile(false);
 
@@ -483,7 +482,7 @@ begin
         Replace(cmdstr,'$RES',outputexedir+Info.ResName);
         Replace(cmdstr,'$OPT',Info.ExtraOptions);
         Replace(cmdstr,'$RSRC',RsrcStr);
-        Replace(cmdstr,'$EXE',current_module^.exefilename^);
+        Replace(cmdstr,'$EXE',current_module.exefilename^);
         success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
 (* We still want to have the PPAS script complete, right?
         if not success then
@@ -503,7 +502,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-09-24 15:06:31  peter
+  Revision 1.6  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/09/24 15:06:31  peter
     * use defines.inc
 
   Revision 1.4  2000/09/20 19:38:34  peter

compiler/t_win32.pas

@@ -34,35 +34,32 @@ interface
      winstackpagesize = 4096;
 
   type
-    pimportlibwin32=^timportlibwin32;
-    timportlibwin32=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;
-      procedure generatesmartlib;virtual;
+    timportlibwin32=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importvariable(const varname,module:string;const name:string);override;
+      procedure generatelib;override;
+      procedure generatesmartlib;override;
     end;
 
-    pexportlibwin32=^texportlibwin32;
-    texportlibwin32=object(texportlib)
+    texportlibwin32=class(texportlib)
       st : string;
       last_index : longint;
-      procedure preparelib(const s:string);virtual;
-      procedure exportprocedure(hp : pexported_item);virtual;
-      procedure exportvar(hp : pexported_item);virtual;
-      procedure generatelib;virtual;
+      procedure preparelib(const s:string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
     end;
 
-    plinkerwin32=^tlinkerwin32;
-    tlinkerwin32=object(tlinker)
+    tlinkerwin32=class(tlinker)
     private
        Function  WriteResponseFile(isdll:boolean) : Boolean;
        Function  PostProcessExecutable(const fn:string;isdll:boolean) : Boolean;
     public
-       Constructor Init;
-       Procedure SetDefaultInfo;virtual;
-       function  MakeExecutable:boolean;virtual;
-       function  MakeSharedLibrary:boolean;virtual;
+       Constructor Create;
+       Procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
+       function  MakeSharedLibrary:boolean;override;
     end;
 
 
@@ -77,7 +74,8 @@ implementation
 {$endif Delphi}
        impdef,
 {$endif PAVEL_LINKLIB}
-       cutils,aasm,fmodule,globtype,globals,cobjects,systems,verbose,
+       cutils,cclasses,
+       aasm,fmodule,globtype,globals,systems,verbose,
        script,gendef,
        cpubase,cpuasm
 {$ifdef GDB}
@@ -103,82 +101,82 @@ implementation
     procedure timportlibwin32.preparelib(const s : string);
       begin
          if not(assigned(importssection)) then
-           importssection:=new(paasmoutput,init);
+           importssection:=TAAsmoutput.create;
       end;
 
 
     procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
       var
-         hp1 : pimportlist;
-         hp2 : pimported_item;
+         hp1 : timportlist;
+         hp2 : timported_item;
          hs  : string;
       begin
          hs:=DllName(module);
          { search for the module }
-         hp1:=pimportlist(current_module^.imports^.first);
+         hp1:=timportlist(current_module.imports.first);
          while assigned(hp1) do
            begin
-              if hs=hp1^.dllname^ then
+              if hs=hp1.dllname^ then
                 break;
-              hp1:=pimportlist(hp1^.next);
+              hp1:=timportlist(hp1.next);
            end;
          { generate a new item ? }
          if not(assigned(hp1)) then
            begin
-              hp1:=new(pimportlist,init(hs));
-              current_module^.imports^.concat(hp1);
+              hp1:=timportlist.create(hs);
+              current_module.imports.concat(hp1);
            end;
          { search for reuse of old import item }
-         hp2:=pimported_item(hp1^.imported_items^.first);
+         hp2:=timported_item(hp1.imported_items.first);
          while assigned(hp2) do
           begin
-            if hp2^.func^=func then
+            if hp2.func^=func then
              break;
-            hp2:=pimported_item(hp2^.next);
+            hp2:=timported_item(hp2.next);
           end;
          if not assigned(hp2) then
           begin
-            hp2:=new(pimported_item,init(func,name,index));
-            hp1^.imported_items^.concat(hp2);
+            hp2:=timported_item.create(func,name,index);
+            hp1.imported_items.concat(hp2);
           end;
       end;
 
 
     procedure timportlibwin32.importvariable(const varname,module:string;const name:string);
       var
-         hp1 : pimportlist;
-         hp2 : pimported_item;
+         hp1 : timportlist;
+         hp2 : timported_item;
          hs  : string;
       begin
          hs:=DllName(module);
          { search for the module }
-         hp1:=pimportlist(current_module^.imports^.first);
+         hp1:=timportlist(current_module.imports.first);
          while assigned(hp1) do
            begin
-              if hs=hp1^.dllname^ then
+              if hs=hp1.dllname^ then
                 break;
-              hp1:=pimportlist(hp1^.next);
+              hp1:=timportlist(hp1.next);
            end;
          { generate a new item ? }
          if not(assigned(hp1)) then
            begin
-              hp1:=new(pimportlist,init(hs));
-              current_module^.imports^.concat(hp1);
+              hp1:=timportlist.create(hs);
+              current_module.imports.concat(hp1);
            end;
-         hp2:=new(pimported_item,init_var(varname,name));
-         hp1^.imported_items^.concat(hp2);
+         hp2:=timported_item.create_var(varname,name);
+         hp1.imported_items.concat(hp2);
       end;
 
 
     procedure timportlibwin32.generatesmartlib;
       var
-         hp1 : pimportlist;
-         hp2 : pimported_item;
+         hp1 : timportlist;
+         hp2 : timported_item;
          lhead,lname,lcode,
          lidata4,lidata5 : pasmlabel;
          r : preference;
       begin
-         hp1:=pimportlist(current_module^.imports^.first);
+         hp1:=timportlist(current_module.imports.first);
          while assigned(hp1) do
            begin
            { Get labels for the sections }
@@ -187,35 +185,35 @@ implementation
              getaddrlabel(lidata4);
              getaddrlabel(lidata5);
            { create header for this importmodule }
-             importssection^.concat(new(pai_cut,init_begin));
-             importssection^.concat(new(pai_section,init(sec_idata2)));
-             importssection^.concat(new(pai_label,init(lhead)));
+             importsSection.concat(Tai_cut.Create_begin);
+             importsSection.concat(Tai_section.Create(sec_idata2));
+             importsSection.concat(Tai_label.Create(lhead));
              { pointer to procedure names }
-             importssection^.concat(new(pai_const_symbol,init_rva(lidata4)));
+             importsSection.concat(Tai_const_symbol.Create_rva(lidata4));
              { two empty entries follow }
-             importssection^.concat(new(pai_const,init_32bit(0)));
-             importssection^.concat(new(pai_const,init_32bit(0)));
+             importsSection.concat(Tai_const.Create_32bit(0));
+             importsSection.concat(Tai_const.Create_32bit(0));
              { pointer to dll name }
-             importssection^.concat(new(pai_const_symbol,init_rva(lname)));
+             importsSection.concat(Tai_const_symbol.Create_rva(lname));
              { pointer to fixups }
-             importssection^.concat(new(pai_const_symbol,init_rva(lidata5)));
+             importsSection.concat(Tai_const_symbol.Create_rva(lidata5));
              { first write the name references }
-             importssection^.concat(new(pai_section,init(sec_idata4)));
-             importssection^.concat(new(pai_const,init_32bit(0)));
-             importssection^.concat(new(pai_label,init(lidata4)));
+             importsSection.concat(Tai_section.Create(sec_idata4));
+             importsSection.concat(Tai_const.Create_32bit(0));
+             importsSection.concat(Tai_label.Create(lidata4));
              { then the addresses and create also the indirect jump }
-             importssection^.concat(new(pai_section,init(sec_idata5)));
-             importssection^.concat(new(pai_const,init_32bit(0)));
-             importssection^.concat(new(pai_label,init(lidata5)));
+             importsSection.concat(Tai_section.Create(sec_idata5));
+             importsSection.concat(Tai_const.Create_32bit(0));
+             importsSection.concat(Tai_label.Create(lidata5));
 
              { create procedures }
-             hp2:=pimported_item(hp1^.imported_items^.first);
+             hp2:=timported_item(hp1.imported_items.first);
              while assigned(hp2) do
                begin
                  { insert cuts }
-                 importssection^.concat(new(pai_cut,init));
+                 importsSection.concat(Tai_cut.Create);
                  { create indirect jump }
-                 if not hp2^.is_var then
+                 if not hp2.is_var then
                   begin
                     getlabel(lcode);
                     new(r);
@@ -223,114 +221,114 @@ implementation
                     r^.symbol:=lcode;
                     { place jump in codesegment, insert a code section in the
                       importsection to reduce the amount of .s files (PFV) }
-                    importssection^.concat(new(pai_section,init(sec_code)));
+                    importsSection.concat(Tai_section.Create(sec_code));
 {$IfDef GDB}
                     if (cs_debuginfo in aktmoduleswitches) then
-                     importssection^.concat(new(pai_stab_function_name,init(nil)));
+                     importsSection.concat(Tai_stab_function_name.Create(nil));
 {$EndIf GDB}
-                    importssection^.concat(new(pai_symbol,initname_global(hp2^.func^,0)));
-                    importssection^.concat(new(paicpu,op_ref(A_JMP,S_NO,r)));
-                    importssection^.concat(new(pai_align,init_op(4,$90)));
+                    importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
+                    importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
+                    importsSection.concat(Tai_align.Create_op(4,$90));
                   end;
                  { create head link }
-                 importssection^.concat(new(pai_section,init(sec_idata7)));
-                 importssection^.concat(new(pai_const_symbol,init_rva(lhead)));
+                 importsSection.concat(Tai_section.Create(sec_idata7));
+                 importsSection.concat(Tai_const_symbol.Create_rva(lhead));
                  { fixup }
-                 getlabel(pasmlabel(hp2^.lab));
-                 importssection^.concat(new(pai_section,init(sec_idata4)));
-                 importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)));
+                 getlabel(pasmlabel(hp2.lab));
+                 importsSection.concat(Tai_section.Create(sec_idata4));
+                 importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
                  { add jump field to importsection }
-                 importssection^.concat(new(pai_section,init(sec_idata5)));
-                 if hp2^.is_var then
-                  importssection^.concat(new(pai_symbol,initname_global(hp2^.func^,0)))
+                 importsSection.concat(Tai_section.Create(sec_idata5));
+                 if hp2.is_var then
+                  importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0))
                  else
-                  importssection^.concat(new(pai_label,init(lcode)));
-                  if hp2^.name^<>'' then
-                    importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)))
+                  importsSection.concat(Tai_label.Create(lcode));
+                  if hp2.name^<>'' then
+                    importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
                   else
-                    importssection^.concat(new(pai_const,init_32bit($80000000 or hp2^.ordnr)));
+                    importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
                  { finally the import information }
-                 importssection^.concat(new(pai_section,init(sec_idata6)));
-                 importssection^.concat(new(pai_label,init(hp2^.lab)));
-                 importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
-                 importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
-                 importssection^.concat(new(pai_align,init_op(2,0)));
-                 hp2:=pimported_item(hp2^.next);
+                 importsSection.concat(Tai_section.Create(sec_idata6));
+                 importsSection.concat(Tai_label.Create(hp2.lab));
+                 importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
+                 importsSection.concat(Tai_string.Create(hp2.name^+#0));
+                 importsSection.concat(Tai_align.Create_op(2,0));
+                 hp2:=timported_item(hp2.next);
                end;
 
               { write final section }
-              importssection^.concat(new(pai_cut,init_end));
+              importsSection.concat(Tai_cut.Create_end);
               { end of name references }
-              importssection^.concat(new(pai_section,init(sec_idata4)));
-              importssection^.concat(new(pai_const,init_32bit(0)));
+              importsSection.concat(Tai_section.Create(sec_idata4));
+              importsSection.concat(Tai_const.Create_32bit(0));
               { end if addresses }
-              importssection^.concat(new(pai_section,init(sec_idata5)));
-              importssection^.concat(new(pai_const,init_32bit(0)));
+              importsSection.concat(Tai_section.Create(sec_idata5));
+              importsSection.concat(Tai_const.Create_32bit(0));
               { dllname }
-              importssection^.concat(new(pai_section,init(sec_idata7)));
-              importssection^.concat(new(pai_label,init(lname)));
-              importssection^.concat(new(pai_string,init(hp1^.dllname^+#0)));
+              importsSection.concat(Tai_section.Create(sec_idata7));
+              importsSection.concat(Tai_label.Create(lname));
+              importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
 
-              hp1:=pimportlist(hp1^.next);
+              hp1:=timportlist(hp1.next);
            end;
        end;
 
 
     procedure timportlibwin32.generatelib;
       var
-         hp1 : pimportlist;
-         hp2 : pimported_item;
+         hp1 : timportlist;
+         hp2 : timported_item;
          l1,l2,l3,l4 : pasmlabel;
          r : preference;
       begin
-         hp1:=pimportlist(current_module^.imports^.first);
+         hp1:=timportlist(current_module.imports.first);
          while assigned(hp1) do
            begin
               { align codesegment for the jumps }
-              importssection^.concat(new(pai_section,init(sec_code)));
-              importssection^.concat(new(pai_align,init_op(4,$90)));
+              importsSection.concat(Tai_section.Create(sec_code));
+              importsSection.concat(Tai_align.Create_op(4,$90));
               { Get labels for the sections }
               getlabel(l1);
               getlabel(l2);
               getlabel(l3);
-              importssection^.concat(new(pai_section,init(sec_idata2)));
+              importsSection.concat(Tai_section.Create(sec_idata2));
               { pointer to procedure names }
-              importssection^.concat(new(pai_const_symbol,init_rva(l2)));
+              importsSection.concat(Tai_const_symbol.Create_rva(l2));
               { two empty entries follow }
-              importssection^.concat(new(pai_const,init_32bit(0)));
-              importssection^.concat(new(pai_const,init_32bit(0)));
+              importsSection.concat(Tai_const.Create_32bit(0));
+              importsSection.concat(Tai_const.Create_32bit(0));
               { pointer to dll name }
-              importssection^.concat(new(pai_const_symbol,init_rva(l1)));
+              importsSection.concat(Tai_const_symbol.Create_rva(l1));
               { pointer to fixups }
-              importssection^.concat(new(pai_const_symbol,init_rva(l3)));
+              importsSection.concat(Tai_const_symbol.Create_rva(l3));
 
               { only create one section for each else it will
                 create a lot of idata* }
 
               { first write the name references }
-              importssection^.concat(new(pai_section,init(sec_idata4)));
-              importssection^.concat(new(pai_label,init(l2)));
+              importsSection.concat(Tai_section.Create(sec_idata4));
+              importsSection.concat(Tai_label.Create(l2));
 
-              hp2:=pimported_item(hp1^.imported_items^.first);
+              hp2:=timported_item(hp1.imported_items.first);
               while assigned(hp2) do
                 begin
-                   getlabel(pasmlabel(hp2^.lab));
-                   if hp2^.name^<>'' then
-                     importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)))
+                   getlabel(pasmlabel(hp2.lab));
+                   if hp2.name^<>'' then
+                     importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
                    else
-                     importssection^.concat(new(pai_const,init_32bit($80000000 or hp2^.ordnr)));
-                   hp2:=pimported_item(hp2^.next);
+                     importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
+                   hp2:=timported_item(hp2.next);
                 end;
               { finalize the names ... }
-              importssection^.concat(new(pai_const,init_32bit(0)));
+              importsSection.concat(Tai_const.Create_32bit(0));
 
               { then the addresses and create also the indirect jump }
-              importssection^.concat(new(pai_section,init(sec_idata5)));
-              importssection^.concat(new(pai_label,init(l3)));
-              hp2:=pimported_item(hp1^.imported_items^.first);
+              importsSection.concat(Tai_section.Create(sec_idata5));
+              importsSection.concat(Tai_label.Create(l3));
+              hp2:=timported_item(hp1.imported_items.first);
               while assigned(hp2) do
                 begin
-                   if not hp2^.is_var then
+                   if not hp2.is_var then
                     begin
                       getlabel(l4);
                       { create indirect jump }
@@ -338,42 +336,42 @@ implementation
                       reset_reference(r^);
                       r^.symbol:=l4;
                       { place jump in codesegment }
-                      importssection^.concat(new(pai_section,init(sec_code)));
-                      importssection^.concat(new(pai_symbol,initname_global(hp2^.func^,0)));
-                      importssection^.concat(new(paicpu,op_ref(A_JMP,S_NO,r)));
-                      importssection^.concat(new(pai_align,init_op(4,$90)));
+                      importsSection.concat(Tai_section.Create(sec_code));
+                      importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
+                      importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
+                      importsSection.concat(Tai_align.Create_op(4,$90));
                       { add jump field to importsection }
-                      importssection^.concat(new(pai_section,init(sec_idata5)));
-                      importssection^.concat(new(pai_label,init(l4)));
+                      importsSection.concat(Tai_section.Create(sec_idata5));
+                      importsSection.concat(Tai_label.Create(l4));
                     end
                    else
                     begin
-                      importssection^.concat(new(pai_symbol,initname_global(hp2^.func^,0)));
+                      importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
                     end;
-                   importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)));
-                   hp2:=pimported_item(hp2^.next);
+                   importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
+                   hp2:=timported_item(hp2.next);
                 end;
               { finalize the addresses }
-              importssection^.concat(new(pai_const,init_32bit(0)));
+              importsSection.concat(Tai_const.Create_32bit(0));
 
               { finally the import information }
-              importssection^.concat(new(pai_section,init(sec_idata6)));
-              hp2:=pimported_item(hp1^.imported_items^.first);
+              importsSection.concat(Tai_section.Create(sec_idata6));
+              hp2:=timported_item(hp1.imported_items.first);
               while assigned(hp2) do
                 begin
-                   importssection^.concat(new(pai_label,init(hp2^.lab)));
+                   importsSection.concat(Tai_label.Create(hp2.lab));
                    { the ordinal number }
-                   importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
-                   importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
-                   importssection^.concat(new(pai_align,init_op(2,0)));
-                   hp2:=pimported_item(hp2^.next);
+                   importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
+                   importsSection.concat(Tai_string.Create(hp2.name^+#0));
+                   importsSection.concat(Tai_align.Create_op(2,0));
+                   hp2:=timported_item(hp2.next);
                 end;
               { create import dll name }
-              importssection^.concat(new(pai_section,init(sec_idata7)));
-              importssection^.concat(new(pai_label,init(l1)));
-              importssection^.concat(new(pai_string,init(hp1^.dllname^+#0)));
+              importsSection.concat(Tai_section.Create(sec_idata7));
+              importsSection.concat(Tai_label.Create(l1));
+              importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
 
-              hp1:=pimportlist(hp1^.next);
+              hp1:=timportlist(hp1.next);
            end;
       end;
 
@@ -385,80 +383,80 @@ implementation
     procedure texportlibwin32.preparelib(const s:string);
       begin
          if not(assigned(exportssection)) then
-           exportssection:=new(paasmoutput,init);
+           exportssection:=TAAsmoutput.create;
          last_index:=0;
       end;
 
 
 
-    procedure texportlibwin32.exportvar(hp : pexported_item);
+    procedure texportlibwin32.exportvar(hp : texported_item);
       begin
          { same code used !! PM }
          exportprocedure(hp);
       end;
 
 
-    procedure texportlibwin32.exportprocedure(hp : pexported_item);
+    procedure texportlibwin32.exportprocedure(hp : texported_item);
       { must be ordered at least for win32 !! }
       var
-        hp2 : pexported_item;
+        hp2 : texported_item;
       begin
         { first test the index value }
-        if (hp^.options and eo_index)<>0 then
+        if (hp.options and eo_index)<>0 then
           begin
-             if (hp^.index<=0) or (hp^.index>$ffff) then
+             if (hp.index<=0) or (hp.index>$ffff) then
                begin
-                 message1(parser_e_export_invalid_index,tostr(hp^.index));
+                 message1(parser_e_export_invalid_index,tostr(hp.index));
                  exit;
                end;
-             if (hp^.index<=last_index) then
+             if (hp.index<=last_index) then
                begin
-                 message1(parser_e_export_ordinal_double,tostr(hp^.index));
+                 message1(parser_e_export_ordinal_double,tostr(hp.index));
                  { disregard index value }
                  inc(last_index);
-                 hp^.index:=last_index;
+                 hp.index:=last_index;
                  exit;
                end
              else
                begin
-                 last_index:=hp^.index;
+                 last_index:=hp.index;
                end;
           end
         else
           begin
              inc(last_index);
-             hp^.index:=last_index;
+             hp.index:=last_index;
           end;
         { use pascal name is none specified }
-        if (hp^.options and eo_name)=0 then
+        if (hp.options and eo_name)=0 then
           begin
-             hp^.name:=stringdup(hp^.sym^.name);
-             hp^.options:=hp^.options or eo_name;
+             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);
+        hp2:=texported_item(current_module._exports.first);
         while assigned(hp2) and
-           (hp^.name^>hp2^.name^) do
-          hp2:=pexported_item(hp2^.next);
+           (hp.name^>hp2.name^) do
+          hp2:=texported_item(hp2.next);
         { insert hp there !! }
-        if assigned(hp2) and (hp2^.name^=hp^.name^) then
+        if assigned(hp2) and (hp2.name^=hp.name^) then
           begin
              { this is not allowed !! }
-             message1(parser_e_export_name_double,hp^.name^);
+             message1(parser_e_export_name_double,hp.name^);
              exit;
           end;
-        if hp2=pexported_item(current_module^._exports^.first) then
-          current_module^._exports^.insert(hp)
+        if hp2=texported_item(current_module._exports.first) then
+          current_module._exports.concat(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;
+             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);
+          current_module._exports.concat(hp);
       end;
 
 
@@ -469,13 +467,13 @@ implementation
          entries,named_entries : longint;
          name_label,dll_name_label,export_address_table : pasmlabel;
          export_name_table_pointers,export_ordinal_table : pasmlabel;
-         hp,hp2 : pexported_item;
-         tempexport : plinkedlist;
+         hp,hp2 : texported_item;
+         temtexport : TLinkedList;
          address_table,name_table_pointers,
-         name_table,ordinal_table : paasmoutput;
+         name_table,ordinal_table : TAAsmoutput;
       begin
 
-         hp:=pexported_item(current_module^._exports^.first);
+         hp:=texported_item(current_module._exports.first);
          if not assigned(hp) then
            exit;
 
@@ -492,13 +490,13 @@ implementation
          while assigned(hp) do
            begin
               inc(entries);
-              if (hp^.index>ordinal_max) then
-                ordinal_max:=hp^.index;
-              if (hp^.index>0) and (hp^.index<ordinal_min) then
-                ordinal_min:=hp^.index;
-              if assigned(hp^.name) then
+              if (hp.index>ordinal_max) then
+                ordinal_max:=hp.index;
+              if (hp.index>0) and (hp.index<ordinal_min) then
+                ordinal_min:=hp.index;
+              if assigned(hp.name) then
                 inc(named_entries);
-              hp:=pexported_item(hp^.next);
+              hp:=texported_item(hp.next);
            end;
 
          { no support for higher ordinal base yet !! }
@@ -507,118 +505,118 @@ implementation
          { we must also count the holes !! }
          entries:=ordinal_max-ordinal_base+1;
 
-         exportssection^.concat(new(pai_section,init(sec_edata)));
+         exportsSection.concat(Tai_section.Create(sec_edata));
          { export flags }
-         exportssection^.concat(new(pai_const,init_32bit(0)));
+         exportsSection.concat(Tai_const.Create_32bit(0));
          { date/time stamp }
-         exportssection^.concat(new(pai_const,init_32bit(0)));
+         exportsSection.concat(Tai_const.Create_32bit(0));
          { major version }
-         exportssection^.concat(new(pai_const,init_16bit(0)));
+         exportsSection.concat(Tai_const.Create_16bit(0));
          { minor version }
-         exportssection^.concat(new(pai_const,init_16bit(0)));
+         exportsSection.concat(Tai_const.Create_16bit(0));
          { pointer to dll name }
-         exportssection^.concat(new(pai_const_symbol,init_rva(dll_name_label)));
+         exportsSection.concat(Tai_const_symbol.Create_rva(dll_name_label));
          { ordinal base normally set to 1 }
-         exportssection^.concat(new(pai_const,init_32bit(ordinal_base)));
+         exportsSection.concat(Tai_const.Create_32bit(ordinal_base));
          { number of entries }
-         exportssection^.concat(new(pai_const,init_32bit(entries)));
+         exportsSection.concat(Tai_const.Create_32bit(entries));
          { number of named entries }
-         exportssection^.concat(new(pai_const,init_32bit(named_entries)));
+         exportsSection.concat(Tai_const.Create_32bit(named_entries));
          { address of export address table }
-         exportssection^.concat(new(pai_const_symbol,init_rva(export_address_table)));
+         exportsSection.concat(Tai_const_symbol.Create_rva(export_address_table));
          { address of name pointer pointers }
-         exportssection^.concat(new(pai_const_symbol,init_rva(export_name_table_pointers)));
+         exportsSection.concat(Tai_const_symbol.Create_rva(export_name_table_pointers));
          { address of ordinal number pointers }
-         exportssection^.concat(new(pai_const_symbol,init_rva(export_ordinal_table)));
+         exportsSection.concat(Tai_const_symbol.Create_rva(export_ordinal_table));
          { the name }
-         exportssection^.concat(new(pai_label,init(dll_name_label)));
+         exportsSection.concat(Tai_label.Create(dll_name_label));
          if st='' then
-           exportssection^.concat(new(pai_string,init(current_module^.modulename^+target_os.sharedlibext+#0)))
+           exportsSection.concat(Tai_string.Create(current_module.modulename^+target_os.sharedlibext+#0))
          else
-           exportssection^.concat(new(pai_string,init(st+target_os.sharedlibext+#0)));
+           exportsSection.concat(Tai_string.Create(st+target_os.sharedlibext+#0));
 
          {  export address table }
-         address_table:=new(paasmoutput,init);
-         address_table^.concat(new(pai_align,init_op(4,0)));
-         address_table^.concat(new(pai_label,init(export_address_table)));
-         name_table_pointers:=new(paasmoutput,init);
-         name_table_pointers^.concat(new(pai_align,init_op(4,0)));
-         name_table_pointers^.concat(new(pai_label,init(export_name_table_pointers)));
-         ordinal_table:=new(paasmoutput,init);
-         ordinal_table^.concat(new(pai_align,init_op(4,0)));
-         ordinal_table^.concat(new(pai_label,init(export_ordinal_table)));
-         name_table:=new(paasmoutput,init);
-         name_table^.concat(new(pai_align,init_op(4,0)));
+         address_table:=TAAsmoutput.create;
+         address_table.concat(Tai_align.Create_op(4,0));
+         address_table.concat(Tai_label.Create(export_address_table));
+         name_table_pointers:=TAAsmoutput.create;
+         name_table_pointers.concat(Tai_align.Create_op(4,0));
+         name_table_pointers.concat(Tai_label.Create(export_name_table_pointers));
+         ordinal_table:=TAAsmoutput.create;
+         ordinal_table.concat(Tai_align.Create_op(4,0));
+         ordinal_table.concat(Tai_label.Create(export_ordinal_table));
+         name_table:=TAAsmoutput.Create;
+         name_table.concat(Tai_align.Create_op(4,0));
          { write each address }
-         hp:=pexported_item(current_module^._exports^.first);
+         hp:=texported_item(current_module._exports.first);
          while assigned(hp) do
            begin
-              if (hp^.options and eo_name)<>0 then
+              if (hp.options and eo_name)<>0 then
                 begin
                    getlabel(name_label);
-                   name_table_pointers^.concat(new(pai_const_symbol,init_rva(name_label)));
-                   ordinal_table^.concat(new(pai_const,init_16bit(hp^.index-ordinal_base)));
-                   name_table^.concat(new(pai_align,init_op(2,0)));
-                   name_table^.concat(new(pai_label,init(name_label)));
-                   name_table^.concat(new(pai_string,init(hp^.name^+#0)));
+                   name_table_pointers.concat(Tai_const_symbol.Create_rva(name_label));
+                   ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base));
+                   name_table.concat(Tai_align.Create_op(2,0));
+                   name_table.concat(Tai_label.Create(name_label));
+                   name_table.concat(Tai_string.Create(hp.name^+#0));
                 end;
-              hp:=pexported_item(hp^.next);
+              hp:=texported_item(hp.next);
            end;
          { order in increasing ordinal values }
-         { into tempexport list }
-         tempexport:=new(plinkedlist,init);
-         hp:=pexported_item(current_module^._exports^.first);
+         { into temtexport list }
+         temtexport:=TLinkedList.Create;
+         hp:=texported_item(current_module._exports.first);
          while assigned(hp) do
            begin
-              current_module^._exports^.remove(hp);
-              hp2:=pexported_item(tempexport^.first);
-              while assigned(hp2) and (hp^.index>hp2^.index) do
+              current_module._exports.remove(hp);
+              hp2:=texported_item(temtexport.first);
+              while assigned(hp2) and (hp.index>hp2.index) do
                 begin
-                   hp2:=pexported_item(hp2^.next);
+                   hp2:=texported_item(hp2.next);
                 end;
-              if hp2=pexported_item(tempexport^.first) then
-                 tempexport^.insert(hp)
+              if hp2=texported_item(temtexport.first) then
+                 temtexport.insert(hp)
               else
                 begin
                    if assigned(hp2) then
                      begin
-                        hp^.next:=hp2;
-                        hp^.previous:=hp2^.previous;
-                        hp2^.previous:=hp;
-                        if assigned(hp^.previous) then
-                          hp^.previous^.next:=hp;
+                        hp.next:=hp2;
+                        hp.previous:=hp2.previous;
+                        hp2.previous:=hp;
+                        if assigned(hp.previous) then
+                          hp.previous.next:=hp;
                       end
                     else
-                      tempexport^.concat(hp);
+                      temtexport.concat(hp);
                 end;
-              hp:=pexported_item(current_module^._exports^.first);;
+              hp:=texported_item(current_module._exports.first);;
            end;
 
          { write the export adress table }
          current_index:=ordinal_base;
-         hp:=pexported_item(tempexport^.first);
+         hp:=texported_item(temtexport.first);
          while assigned(hp) do
            begin
               { fill missing values }
-              while current_index<hp^.index do
+              while current_index<hp.index do
                 begin
-                   address_table^.concat(new(pai_const,init_32bit(0)));
+                   address_table.concat(Tai_const.Create_32bit(0));
                    inc(current_index);
                 end;
-              address_table^.concat(new(pai_const_symbol,initname_rva(hp^.sym^.mangledname)));
+              address_table.concat(Tai_const_symbol.Createname_rva(hp.sym^.mangledname));
               inc(current_index);
-              hp:=pexported_item(hp^.next);
+              hp:=texported_item(hp.next);
            end;
 
-         exportssection^.concatlist(address_table);
-         exportssection^.concatlist(name_table_pointers);
-         exportssection^.concatlist(ordinal_table);
-         exportssection^.concatlist(name_table);
-         dispose(address_table,done);
-         dispose(name_table_pointers,done);
-         dispose(ordinal_table,done);
-         dispose(name_table,done);
-         dispose(tempexport,done);
+         exportsSection.concatlist(address_table);
+         exportsSection.concatlist(name_table_pointers);
+         exportsSection.concatlist(ordinal_table);
+         exportsSection.concatlist(name_table);
+         address_table.Free;
+         name_table_pointers.free;
+         ordinal_table.free;
+         name_table.free;
+         temtexport.free;
       end;
 
 
@@ -627,9 +625,9 @@ implementation
 ****************************************************************************}
 
 
-Constructor TLinkerWin32.Init;
+Constructor TLinkerWin32.Create;
 begin
-  Inherited Init;
+  Inherited Create;
   { allow duplicated libs (PM) }
   SharedLibFiles.doubles:=true;
   StaticLibFiles.doubles:=true;
@@ -661,7 +659,7 @@ Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
   i        : longint;
-  HPath    : PStringQueueItem;
+  HPath    : TStringListItem;
   s,s2        : string;
   found,linklibc : boolean;
 begin
@@ -671,17 +669,17 @@ begin
   LinkRes.Init(outputexedir+Info.ResName);
 
   { Write path to search libraries }
-  HPath:=current_module^.locallibrarysearchpath.First;
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath^.Data^)+')');
-     HPath:=HPath^.Next;
+     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
+     HPath:=TStringListItem(HPath.Next);
    end;
-  HPath:=LibrarySearchPath.First;
+  HPath:=TStringListItem(LibrarySearchPath.First);
   while assigned(HPath) do
    begin
-     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath^.Data^)+')');
-     HPath:=HPath^.Next;
+     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
+     HPath:=TStringListItem(HPath.Next);
    end;
 
   { add objectfiles, start with prt0 always }
@@ -692,7 +690,7 @@ begin
    LinkRes.AddFileName(GetShortName(FindObjectFile('wprt0','')));
   while not ObjectFiles.Empty do
    begin
-     s:=ObjectFiles.Get;
+     s:=ObjectFiles.GetFirst;
      if s<>'' then
       LinkRes.AddFileName(GetShortName(s));
    end;
@@ -704,7 +702,7 @@ begin
      LinkRes.Add('GROUP(');
      While not StaticLibFiles.Empty do
       begin
-        S:=StaticLibFiles.Get;
+        S:=StaticLibFiles.GetFirst;
         LinkRes.AddFileName(GetShortName(s));
       end;
      LinkRes.Add(')');
@@ -718,7 +716,7 @@ begin
      LinkRes.Add('INPUT(');
      While not SharedLibFiles.Empty do
       begin
-        S:=SharedLibFiles.Get;
+        S:=SharedLibFiles.GetFirst;
         if pos('.',s)=0 then
           { we never directly link a DLL
             its allways through an import library PM }
@@ -889,7 +887,7 @@ begin
   LinkRes.Init(outputexedir+Info.ResName);
 
   { Write path to search libraries }
-  HPath:=current_module^.locallibrarysearchpath.First;
+  HPath:=current_module.locallibrarysearchpath.First;
   while assigned(HPath) do
    begin
      LinkRes.Add('SEARCH_DIR('+GetShortName(HPath^.Data^)+')');
@@ -951,7 +949,7 @@ var
   ImageBaseStr : string[40];
 begin
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.exefilename^);
+   Message1(exec_i_linking,current_module.exefilename^);
 
 { Create some replacements }
   RelocStr:='';
@@ -979,7 +977,7 @@ begin
      SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
      if binstr<>'' then
       begin
-        Replace(cmdstr,'$EXE',current_module^.exefilename^);
+        Replace(cmdstr,'$EXE',current_module.exefilename^);
         Replace(cmdstr,'$OPT',Info.ExtraOptions);
         Replace(cmdstr,'$RES',outputexedir+Info.ResName);
         Replace(cmdstr,'$APPTYPE',AppTypeStr);
@@ -1002,7 +1000,7 @@ begin
 
 { Post process }
   if success then
-   success:=PostProcessExecutable(current_module^.exefilename^,false);
+   success:=PostProcessExecutable(current_module.exefilename^,false);
 
 { Remove ReponseFile }
   if (success) and not(cs_link_extern in aktglobalswitches) then
@@ -1032,7 +1030,7 @@ var
 begin
   MakeSharedLibrary:=false;
   if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module^.sharedlibfilename^);
+   Message1(exec_i_linking,current_module.sharedlibfilename^);
 
 { Create some replacements }
   RelocStr:='';
@@ -1060,7 +1058,7 @@ begin
      SplitBinCmd(Info.DllCmd[i],binstr,cmdstr);
      if binstr<>'' then
       begin
-        Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
+        Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
         Replace(cmdstr,'$OPT',Info.ExtraOptions);
         Replace(cmdstr,'$RES',outputexedir+Info.ResName);
         Replace(cmdstr,'$APPTYPE',AppTypeStr);
@@ -1083,7 +1081,7 @@ begin
 
 { Post process }
   if success then
-   success:=PostProcessExecutable(current_module^.sharedlibfilename^,true);
+   success:=PostProcessExecutable(current_module.sharedlibfilename^,true);
 
 { Remove ReponseFile }
   if (success) and not(cs_link_extern in aktglobalswitches) then
@@ -1305,7 +1303,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  2000-11-12 22:20:37  peter
+  Revision 1.7  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.6  2000/11/12 22:20:37  peter
     * create generic toutputsection for binary writers
 
   Revision 1.5  2000/09/24 15:06:31  peter

compiler/temp_gen.pas

@@ -46,7 +46,7 @@ interface
       ptemprecord = ^ttemprecord;
       ttemprecord = record
          temptype   : ttemptype;
-         pos    : longint;
+         pos        : longint;
          size       : longint;
          next       : ptemprecord;
          nextfree   : ptemprecord; { for faster freeblock checking }
@@ -101,7 +101,7 @@ interface
         while assigned(templist) do
          begin
 {$ifdef EXTDEBUG}
-           case templist^.temptype of
+           case tempList^.temptype of
              tt_normal,
              tt_persistant :
                Comment(V_Warning,'temporary assignment of size '+
@@ -256,7 +256,7 @@ const
 {$ifdef EXTDEBUG}
          tl^.posinfo:=aktfilepos;
 {$endif}
-         exprasmlist^.concat(new(paitempalloc,alloc(ofs,size)));
+         exprasmList.concat(Taitempalloc.alloc(ofs,size));
          gettempofsize:=ofs;
       end;
 
@@ -332,7 +332,7 @@ const
 {$endif}
             templist^.temptype:=usedtype;
           end;
-         exprasmlist^.concat(new(paitempalloc,alloc(ref.offset,target_os.size_of_pointer)));
+         exprasmList.concat(Taitempalloc.alloc(ref.offset,target_os.size_of_pointer));
       end;
 
     function ungettemppointeriftype(const ref : treference; const usedtype, freetype: ttemptype) : boolean;
@@ -349,7 +349,7 @@ const
                begin
                  tl^.temptype:=freetype;
                  ungettemppointeriftype:=true;
-                 exprasmlist^.concat(new(paitempalloc,dealloc(tl^.pos,tl^.size)));
+                 exprasmList.concat(Taitempalloc.dealloc(tl^.pos,tl^.size));
                  exit;
 {$ifdef EXTDEBUG}
                end
@@ -467,7 +467,7 @@ const
                 begin
                   exit;
                 end;
-               exprasmlist^.concat(new(paitempalloc,dealloc(hp^.pos,hp^.size)));
+               exprasmList.concat(Taitempalloc.dealloc(hp^.pos,hp^.size));
                { set this block to free }
                hp^.temptype:=tt_free;
                { Update tempfreelist }
@@ -556,7 +556,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2000-11-30 22:16:50  florian
+  Revision 1.9  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.8  2000/11/30 22:16:50  florian
     * moved to i386
 
   Revision 1.7  2000/11/29 00:30:42  florian

compiler/types.pas

@@ -27,7 +27,7 @@ unit types;
 interface
 
     uses
-       cobjects,
+       cobjects,cclasses,
        cpuinfo,
        node,
        symbase,symtype,symdef,symsym;
@@ -205,12 +205,12 @@ interface
     type
       compare_type = ( cp_none, cp_value_equal_const, cp_all);
 
-    function equal_paras(paralist1,paralist2 : plinkedlist; acp : compare_type) : boolean;
+    function equal_paras(paralist1,paralist2 : tlinkedlist; acp : compare_type) : boolean;
 
 
     { true if a type can be allowed for another one
       in a func var }
-    function convertable_paras(paralist1,paralist2 : plinkedlist; acp : compare_type) : boolean;
+    function convertable_paras(paralist1,paralist2 : tlinkedlist; acp : compare_type) : boolean;
 
     { true if a function can be assigned to a procvar }
     function proc_to_procvar_equal(def1:pprocdef;def2:pprocvardef) : boolean;
@@ -312,21 +312,21 @@ implementation
 
     {  compare_type = ( cp_none, cp_value_equal_const, cp_all); }
 
-    function equal_paras(paralist1,paralist2 : plinkedlist; acp : compare_type) : boolean;
+    function equal_paras(paralist1,paralist2 : TLinkedList; acp : compare_type) : boolean;
       var
-        def1,def2 : pparaitem;
+        def1,def2 : TParaItem;
       begin
-         def1:=pparaitem(paralist1^.first);
-         def2:=pparaitem(paralist2^.first);
+         def1:=TParaItem(paralist1.first);
+         def2:=TParaItem(paralist2.first);
          while (assigned(def1)) and (assigned(def2)) do
            begin
              case acp of
               cp_value_equal_const :
                 begin
-                   if not(is_equal(def1^.paratype.def,def2^.paratype.def)) or
-                     ((def1^.paratyp<>def2^.paratyp) and
-                      ((def1^.paratyp in [vs_var,vs_out]) or
-                       (def2^.paratyp in [vs_var,vs_out])
+                   if not(is_equal(def1.paratype.def,def2.paratype.def)) or
+                     ((def1.paratyp<>def2.paratyp) and
+                      ((def1.paratyp in [vs_var,vs_out]) or
+                       (def2.paratyp in [vs_var,vs_out])
                       )
                      ) then
                      begin
@@ -336,8 +336,8 @@ implementation
                 end;
               cp_all :
                 begin
-                   if not(is_equal(def1^.paratype.def,def2^.paratype.def)) or
-                     (def1^.paratyp<>def2^.paratyp) then
+                   if not(is_equal(def1.paratype.def,def2.paratype.def)) or
+                     (def1.paratyp<>def2.paratyp) then
                      begin
                         equal_paras:=false;
                         exit;
@@ -345,16 +345,16 @@ implementation
                 end;
               cp_none :
                 begin
-                   if not(is_equal(def1^.paratype.def,def2^.paratype.def)) then
+                   if not(is_equal(def1.paratype.def,def2.paratype.def)) then
                      begin
                         equal_paras:=false;
                         exit;
                      end;
                    { also check default value if both have it declared }
-                   if assigned(def1^.defaultvalue) and
-                      assigned(def2^.defaultvalue) then
+                   if assigned(def1.defaultvalue) and
+                      assigned(def2.defaultvalue) then
                     begin
-                      if not equal_constsym(pconstsym(def1^.defaultvalue),pconstsym(def2^.defaultvalue)) then
+                      if not equal_constsym(pconstsym(def1.defaultvalue),pconstsym(def2.defaultvalue)) then
                        begin
                          equal_paras:=false;
                          exit;
@@ -362,8 +362,8 @@ implementation
                     end;
                 end;
               end;
-              def1:=pparaitem(def1^.next);
-              def2:=pparaitem(def2^.next);
+              def1:=TParaItem(def1.next);
+              def2:=TParaItem(def2.next);
            end;
          if (def1=nil) and (def2=nil) then
            equal_paras:=true
@@ -371,22 +371,22 @@ implementation
            equal_paras:=false;
       end;
 
-    function convertable_paras(paralist1,paralist2 : plinkedlist;acp : compare_type) : boolean;
+    function convertable_paras(paralist1,paralist2 : TLinkedList;acp : compare_type) : boolean;
       var
-        def1,def2 : pparaitem;
+        def1,def2 : TParaItem;
         doconv : tconverttype;
       begin
-         def1:=pparaitem(paralist1^.first);
-         def2:=pparaitem(paralist2^.first);
+         def1:=TParaItem(paralist1.first);
+         def2:=TParaItem(paralist2.first);
          while (assigned(def1)) and (assigned(def2)) do
            begin
               case acp of
               cp_value_equal_const :
                 begin
-                   if (isconvertable(def1^.paratype.def,def2^.paratype.def,doconv,nil,callparan,false)=0) or
-                     ((def1^.paratyp<>def2^.paratyp) and
-                      ((def1^.paratyp in [vs_out,vs_var]) or
-                       (def2^.paratyp in [vs_out,vs_var])
+                   if (isconvertable(def1.paratype.def,def2.paratype.def,doconv,nil,callparan,false)=0) or
+                     ((def1.paratyp<>def2.paratyp) and
+                      ((def1.paratyp in [vs_out,vs_var]) or
+                       (def2.paratyp in [vs_out,vs_var])
                       )
                      ) then
                      begin
@@ -396,8 +396,8 @@ implementation
                 end;
               cp_all :
                 begin
-                   if (isconvertable(def1^.paratype.def,def2^.paratype.def,doconv,nil,callparan,false)=0) or
-                     (def1^.paratyp<>def2^.paratyp) then
+                   if (isconvertable(def1.paratype.def,def2.paratype.def,doconv,nil,callparan,false)=0) or
+                     (def1.paratyp<>def2.paratyp) then
                      begin
                         convertable_paras:=false;
                         exit;
@@ -405,15 +405,15 @@ implementation
                 end;
               cp_none :
                 begin
-                   if (isconvertable(def1^.paratype.def,def2^.paratype.def,doconv,nil,callparan,false)=0) then
+                   if (isconvertable(def1.paratype.def,def2.paratype.def,doconv,nil,callparan,false)=0) then
                      begin
                         convertable_paras:=false;
                         exit;
                      end;
                 end;
               end;
-              def1:=pparaitem(def1^.next);
-              def2:=pparaitem(def2^.next);
+              def1:=TParaItem(def1.next);
+              def2:=TParaItem(def2.next);
            end;
          if (def1=nil) and (def2=nil) then
            convertable_paras:=true
@@ -1187,8 +1187,8 @@ implementation
           while passproc<>nil do
             begin
               if is_equal(passproc^.rettype.def,to_def) and
-                 (is_equal(pparaitem(passproc^.para^.first)^.paratype.def,from_def) or
-                 (isconvertable(from_def,pparaitem(passproc^.para^.first)^.paratype.def,convtyp,nil,ordconstn,false)=1)) then
+                 (is_equal(TParaItem(passproc^.Para.first).paratype.def,from_def) or
+                 (isconvertable(from_def,TParaItem(passproc^.Para.first).paratype.def,convtyp,nil,ordconstn,false)=1)) then
                 begin
                    assignment_overloaded:=passproc;
                    break;
@@ -1730,7 +1730,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.28  2000-12-22 22:38:12  peter
+  Revision 1.29  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.28  2000/12/22 22:38:12  peter
     * fixed bug #1286
 
   Revision 1.27  2000/12/20 15:59:40  jonas
@@ -1826,4 +1830,4 @@ end.
   Revision 1.2  2000/07/13 11:32:53  michael
   + removed logs
 
-}
+}

compiler/verbose.pas

@@ -31,7 +31,7 @@ interface
 
 uses
   cutils,cobjects,
-  finput,
+  globals,finput,
   messages;
 
 {$ifndef EXTERN_MSG}
@@ -72,7 +72,7 @@ function  SetVerbosity(const s:string):boolean;
 
 procedure LoadMsgFile(const fn:string);
 
-procedure SetCompileModule(p:pmodulebase);
+procedure SetCompileModule(p:tmodulebase);
 procedure Stop;
 procedure ShowStatus;
 function  ErrorCount:longint;
@@ -95,538 +95,540 @@ procedure DoneVerbose;
 
 
 implementation
-uses
-  comphook,
-  globals;
+
+    uses
+      comphook;
 
 var
-  redirexitsave  : pointer;
-  current_module : pmodulebase;
+  current_module : tmodulebase;
 
 {****************************************************************************
                        Extra Handlers for default compiler
 ****************************************************************************}
 
-procedure DoneRedirectFile;
-begin
-  exitproc:=redirexitsave;
-  if status.use_redir then
-   close(status.redirfile);
-end;
-
-
-procedure SetRedirectFile(const fn:string);
-begin
-  assign(status.redirfile,fn);
-  {$I-}
-   append(status.redirfile);
-   if ioresult <> 0 then
-    rewrite(status.redirfile);
-  {$I+}
-  status.use_redir:=(ioresult=0);
-  if status.use_redir then
-   begin
-     redirexitsave:=exitproc;
-     exitproc:=@DoneRedirectFile;
-   end;
-end;
-
-
-function SetVerbosity(const s:string):boolean;
-var
-  m : Longint;
-  i : Integer;
-  inverse : boolean;
-  c : char;
-begin
-  Setverbosity:=false;
-  val(s,m,i);
-  if (i=0) and (s<>'') then
-   status.verbosity:=m
-  else
-   begin
-     i:=1;
-     while i<=length(s) do
-       begin
-          c:=upcase(s[i]);
-          inverse:=false;
-          { on/off ? }
-          if (i<length(s)) then
-           case s[i+1] of
-            '-' : begin
-                    inc(i);
-                    inverse:=true;
-                  end;
-            '+' : inc(i);
-           end;
-          { handle switch }
-          case c of
-          { Special cases }
-           'A' : status.verbosity:=V_All;
-           '0' : status.verbosity:=V_Default;
-           'R' : begin
-                    if inverse then
-                      begin
-                         status.use_gccoutput:=false;
-                         status.use_stderr:=false;
-                      end
-                    else
-                      begin
-                         status.use_gccoutput:=true;
-                         status.use_stderr:=true;
-                      end;
+    procedure DoneRedirectFile;
+      begin
+        if status.use_redir then
+         begin
+           close(status.redirfile);
+           status.use_redir:=false;
+         end;
+      end;
+
+
+    procedure SetRedirectFile(const fn:string);
+      begin
+        assign(status.redirfile,fn);
+        {$I-}
+         append(status.redirfile);
+         if ioresult <> 0 then
+          rewrite(status.redirfile);
+        {$I+}
+        status.use_redir:=(ioresult=0);
+      end;
+
+
+    function SetVerbosity(const s:string):boolean;
+      var
+        m : Longint;
+        i : Integer;
+        inverse : boolean;
+        c : char;
+      begin
+        Setverbosity:=false;
+        val(s,m,i);
+        if (i=0) and (s<>'') then
+         status.verbosity:=m
+        else
+         begin
+           i:=1;
+           while i<=length(s) do
+             begin
+                c:=upcase(s[i]);
+                inverse:=false;
+                { on/off ? }
+                if (i<length(s)) then
+                 case s[i+1] of
+                  '-' : begin
+                          inc(i);
+                          inverse:=true;
+                        end;
+                  '+' : inc(i);
                  end;
-          { Normal cases - do an or }
-           'E' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Error)
-                 else
-                   status.verbosity:=status.verbosity or V_Error;
-           'I' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Info)
-                 else
-                   status.verbosity:=status.verbosity or V_Info;
-           'W' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Warning)
-                 else
-                   status.verbosity:=status.verbosity or V_Warning;
-           'N' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Note)
-                 else
-                   status.verbosity:=status.verbosity or V_Note;
-           'H' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Hint)
-                 else
-                   status.verbosity:=status.verbosity or V_Hint;
-           'L' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Status)
-                 else
-                   status.verbosity:=status.verbosity or V_Status;
-           'U' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Used)
-                 else
-                   status.verbosity:=status.verbosity or V_Used;
-           'T' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Tried)
-                 else
-                   status.verbosity:=status.verbosity or V_Tried;
-           'M' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Macro)
-                 else
-                   status.verbosity:=status.verbosity or V_Macro;
-           'P' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Procedure)
-                 else
-                   status.verbosity:=status.verbosity or V_Procedure;
-           'C' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Conditional)
-                 else
-                   status.verbosity:=status.verbosity or V_Conditional;
-           'D' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Debug)
-                 else
-                   status.verbosity:=status.verbosity or V_Debug;
-           'B' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Declarations)
-                 else
-                   status.verbosity:=status.verbosity or V_Declarations;
-           'X' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Executable)
-                 else
-                   status.verbosity:=status.verbosity or V_Executable;
-           'Z' : if inverse then
-                   status.verbosity:=status.verbosity and (not V_Assem)
-                 else
-                   status.verbosity:=status.verbosity or V_Assem;
+                { handle switch }
+                case c of
+                { Special cases }
+                 'A' : status.verbosity:=V_All;
+                 '0' : status.verbosity:=V_Default;
+                 'R' : begin
+                          if inverse then
+                            begin
+                               status.use_gccoutput:=false;
+                               status.use_stderr:=false;
+                            end
+                          else
+                            begin
+                               status.use_gccoutput:=true;
+                               status.use_stderr:=true;
+                            end;
+                       end;
+                { Normal cases - do an or }
+                 'E' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Error)
+                       else
+                         status.verbosity:=status.verbosity or V_Error;
+                 'I' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Info)
+                       else
+                         status.verbosity:=status.verbosity or V_Info;
+                 'W' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Warning)
+                       else
+                         status.verbosity:=status.verbosity or V_Warning;
+                 'N' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Note)
+                       else
+                         status.verbosity:=status.verbosity or V_Note;
+                 'H' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Hint)
+                       else
+                         status.verbosity:=status.verbosity or V_Hint;
+                 'L' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Status)
+                       else
+                         status.verbosity:=status.verbosity or V_Status;
+                 'U' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Used)
+                       else
+                         status.verbosity:=status.verbosity or V_Used;
+                 'T' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Tried)
+                       else
+                         status.verbosity:=status.verbosity or V_Tried;
+                 'M' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Macro)
+                       else
+                         status.verbosity:=status.verbosity or V_Macro;
+                 'P' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Procedure)
+                       else
+                         status.verbosity:=status.verbosity or V_Procedure;
+                 'C' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Conditional)
+                       else
+                         status.verbosity:=status.verbosity or V_Conditional;
+                 'D' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Debug)
+                       else
+                         status.verbosity:=status.verbosity or V_Debug;
+                 'B' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Declarations)
+                       else
+                         status.verbosity:=status.verbosity or V_Declarations;
+                 'X' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Executable)
+                       else
+                         status.verbosity:=status.verbosity or V_Executable;
+                 'Z' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Assem)
+                       else
+                         status.verbosity:=status.verbosity or V_Assem;
+                 end;
+                inc(i);
+             end;
            end;
-          inc(i);
-       end;
-     end;
-  if status.verbosity=0 then
-   status.verbosity:=V_Default;
-  setverbosity:=true;
-end;
-
-
-procedure LoadPrefixes;
-
-  function loadprefix(w:longint):string;
-  var
-    s : string;
-    idx : longint;
-  begin
-    s:=msg^.get(w);
-    idx:=pos('_',s);
-    if idx>0 then
-     LoadPrefix:=Copy(s,idx+1,255)
-    else
-     LoadPrefix:=s;
-  end;
-
-begin
-{ Load the prefixes }
-  fatalstr:=LoadPrefix(general_i_fatal);
-  errorstr:=LoadPrefix(general_i_error);
-  warningstr:=LoadPrefix(general_i_warning);
-  notestr:=LoadPrefix(general_i_note);
-  hintstr:=LoadPrefix(general_i_hint);
-end;
-
-
-procedure LoadMsgFile(const fn:string);
-begin
-  { reload the internal messages if not already loaded }
+        if status.verbosity=0 then
+         status.verbosity:=V_Default;
+        setverbosity:=true;
+      end;
+
+
+    procedure LoadPrefixes;
+
+        function loadprefix(w:longint):string;
+        var
+          s : string;
+          idx : longint;
+        begin
+          s:=msg^.get(w);
+          idx:=pos('_',s);
+          if idx>0 then
+           LoadPrefix:=Copy(s,idx+1,255)
+          else
+           LoadPrefix:=s;
+        end;
+
+      begin
+      { Load the prefixes }
+        fatalstr:=LoadPrefix(general_i_fatal);
+        errorstr:=LoadPrefix(general_i_error);
+        warningstr:=LoadPrefix(general_i_warning);
+        notestr:=LoadPrefix(general_i_note);
+        hintstr:=LoadPrefix(general_i_hint);
+      end;
+
+
+    procedure LoadMsgFile(const fn:string);
+      begin
+        { reload the internal messages if not already loaded }
 {$ifndef EXTERN_MSG}
-  if not msg^.msgintern then
-   msg^.LoadIntern(@msgtxt,msgtxtsize);
+        if not msg^.msgintern then
+         msg^.LoadIntern(@msgtxt,msgtxtsize);
 {$endif}
-  if not msg^.LoadExtern(fn) then
-   begin
+        if not msg^.LoadExtern(fn) then
+         begin
 {$ifdef EXTERN_MSG}
-     writeln('Fatal: Cannot find error message file.');
-     halt(3);
+           writeln('Fatal: Cannot find error message file.');
+           halt(3);
 {$else}
-     msg^.LoadIntern(@msgtxt,msgtxtsize);
+           msg^.LoadIntern(@msgtxt,msgtxtsize);
 {$endif}
-   end;
-  { reload the prefixes using the new messages }
-  LoadPrefixes;
-end;
-
-
-procedure SetCompileModule(p:pmodulebase);
-begin
-  current_module:=p;
-end;
+         end;
+        { reload the prefixes using the new messages }
+        LoadPrefixes;
+      end;
+
+
+    procedure SetCompileModule(p:tmodulebase);
+      begin
+        current_module:=p;
+      end;
+
+
+      var
+        lastfileidx,
+        lastmoduleidx : longint;
+    Procedure UpdateStatus;
+      begin
+      { fix status }
+        status.currentline:=aktfilepos.line;
+        status.currentcolumn:=aktfilepos.column;
+        if assigned(current_module) and
+           assigned(current_module.sourcefiles) and
+           ((current_module.unit_index<>lastmoduleidx) or
+            (aktfilepos.fileindex<>lastfileidx)) then
+         begin
+           { update status record }
+           status.currentmodule:=current_module.modulename^;
+           status.currentsource:=current_module.sourcefiles.get_file_name(aktfilepos.fileindex);
+           status.currentsourcepath:=current_module.sourcefiles.get_file_path(aktfilepos.fileindex);
+           { update lastfileidx only if name known PM }
+           if status.currentsource<>'' then
+             lastfileidx:=aktfilepos.fileindex
+           else
+             lastfileidx:=0;
+           lastmoduleidx:=current_module.unit_index;
+         end;
+      end;
 
 
-var
-  lastfileidx,
-  lastmoduleidx : longint;
-Procedure UpdateStatus;
-begin
-{ fix status }
-  status.currentline:=aktfilepos.line;
-  status.currentcolumn:=aktfilepos.column;
-  if assigned(current_module) and
-     assigned(current_module^.sourcefiles) and
-     ((current_module^.unit_index<>lastmoduleidx) or
-      (aktfilepos.fileindex<>lastfileidx)) then
-   begin
-     { update status record }
-     status.currentmodule:=current_module^.modulename^;
-     status.currentsource:=current_module^.sourcefiles^.get_file_name(aktfilepos.fileindex);
-     status.currentsourcepath:=current_module^.sourcefiles^.get_file_path(aktfilepos.fileindex);
-     { update lastfileidx only if name known PM }
-     if status.currentsource<>'' then
-       lastfileidx:=aktfilepos.fileindex
-     else
-       lastfileidx:=0;
-     lastmoduleidx:=current_module^.unit_index;
-   end;
-end;
-
-
-procedure stop;
-begin
-  do_stop{$ifdef FPCPROCVAR}(){$endif};
-end;
+    procedure stop;
+      begin
+        do_stop{$ifdef FPCPROCVAR}(){$endif};
+      end;
 
 
-procedure ShowStatus;
-begin
-  UpdateStatus;
-  if do_status{$ifdef FPCPROCVAR}(){$endif} then
-   stop;
-end;
+    procedure ShowStatus;
+      begin
+        UpdateStatus;
+        if do_status{$ifdef FPCPROCVAR}(){$endif} then
+         stop;
+      end;
 
 
-function ErrorCount:longint;
-begin
-  ErrorCount:=status.errorcount;
-end;
+    function ErrorCount:longint;
+      begin
+        ErrorCount:=status.errorcount;
+      end;
 
 
-procedure SetErrorFlags(const s:string);
-var
-  code : integer;
-  i,j,l : longint;
-begin
-{ empty string means error count = 1 for backward compatibility (PFV) }
-  if s='' then
-   begin
-     status.maxerrorcount:=1;
-     exit;
-   end;
-  i:=0;
-  while (i<length(s)) do
-   begin
-     inc(i);
-     case s[i] of
-       '0'..'9' :
+    procedure SetErrorFlags(const s:string);
+      var
+        code : integer;
+        i,j,l : longint;
+      begin
+      { empty string means error count = 1 for backward compatibility (PFV) }
+        if s='' then
+         begin
+           status.maxerrorcount:=1;
+           exit;
+         end;
+        i:=0;
+        while (i<length(s)) do
+         begin
+           inc(i);
+           case s[i] of
+             '0'..'9' :
+                begin
+                  j:=i;
+                  while (j<=length(s)) and (s[j] in ['0'..'9']) do
+                   inc(j);
+                  val(copy(s,i,j-i),l,code);
+                  if code<>0 then
+                   l:=1;
+                  status.maxerrorcount:=l;
+                  i:=j;
+                end;
+              'w','W' :
+                status.errorwarning:=true;
+              'n','N' :
+                status.errornote:=true;
+              'h','H' :
+                status.errorhint:=true;
+           end;
+         end;
+      end;
+
+
+    procedure GenerateError;
+      begin
+        inc(status.errorcount);
+      end;
+
+
+    procedure internalerror(i : longint);
+      begin
+        UpdateStatus;
+        do_internalerror(i);
+        inc(status.errorcount);
+        stop;
+      end;
+
+
+    procedure Comment(l:longint;s:string);
+      var
+        dostop : boolean;
+      begin
+        dostop:=((l and V_Fatal)<>0);
+        if ((l and V_Error)<>0) or
+           (status.errorwarning and ((l and V_Warning)<>0)) or
+           (status.errornote and ((l and V_Note)<>0)) or
+           (status.errorhint and ((l and V_Hint)<>0)) then
+         inc(status.errorcount);
+      { Create status info }
+        UpdateStatus;
+      { Fix replacements }
+        DefaultReplacements(s);
+      { show comment }
+        if do_comment(l,s) or dostop then
+         stop;
+        if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
+         begin
+           Message1(unit_f_errors_in_unit,tostr(status.errorcount));
+           status.skip_error:=true;
+           stop;
+         end;
+      end;
+
+
+    Procedure Msg2Comment(s:string);
+      var
+        idx,i,v : longint;
+        dostop  : boolean;
+      begin
+      {Reset}
+        dostop:=false;
+        v:=0;
+      {Parse options}
+        idx:=pos('_',s);
+        if idx=0 then
+         v:=V_Normal
+        else
+         if (idx >= 1) And (idx <= 5) then
           begin
-            j:=i;
-            while (j<=length(s)) and (s[j] in ['0'..'9']) do
-             inc(j);
-            val(copy(s,i,j-i),l,code);
-            if code<>0 then
-             l:=1;
-            status.maxerrorcount:=l;
-            i:=j;
+            for i:=1 to idx do
+             begin
+               case upcase(s[i]) of
+                'F' :
+                  begin
+                    v:=v or V_Fatal;
+                    inc(status.errorcount);
+                    dostop:=true;
+                  end;
+                'E' :
+                  begin
+                    v:=v or V_Error;
+                    inc(status.errorcount);
+                  end;
+                'O' :
+                  v:=v or V_Normal;
+                'W':
+                  begin
+                    v:=v or V_Warning;
+                    if status.errorwarning then
+                     inc(status.errorcount);
+                  end;
+                'N' :
+                  begin
+                    v:=v or V_Note;
+                    if status.errornote then
+                     inc(status.errorcount);
+                  end;
+                'H' :
+                  begin
+                    v:=v or V_Hint;
+                    if status.errorhint then
+                     inc(status.errorcount);
+                  end;
+                'I' :
+                  v:=v or V_Info;
+                'L' :
+                  v:=v or V_Status;
+                'U' :
+                  v:=v or V_Used;
+                'T' :
+                  v:=v or V_Tried;
+                'M' :
+                  v:=v or V_Macro;
+                'P' :
+                  v:=v or V_Procedure;
+                'C' :
+                  v:=v or V_Conditional;
+                'D' :
+                  v:=v or V_Debug;
+                'B' :
+                  v:=v or V_Declarations;
+                'X' :
+                  v:=v or V_Executable;
+                'Z' :
+                  v:=v or V_Assem;
+                'S' :
+                  dostop:=true;
+                '_' : ;
+               end;
+             end;
           end;
-        'w','W' :
-          status.errorwarning:=true;
-        'n','N' :
-          status.errornote:=true;
-        'h','H' :
-          status.errorhint:=true;
-     end;
-   end;
-end;
-
-
-procedure GenerateError;
-begin
-  inc(status.errorcount);
-end;
-
-
-procedure internalerror(i : longint);
-begin
-  UpdateStatus;
-  do_internalerror(i);
-  inc(status.errorcount);
-  stop;
-end;
-
-
-procedure Comment(l:longint;s:string);
-var
-  dostop : boolean;
-begin
-  dostop:=((l and V_Fatal)<>0);
-  if ((l and V_Error)<>0) or
-     (status.errorwarning and ((l and V_Warning)<>0)) or
-     (status.errornote and ((l and V_Note)<>0)) or
-     (status.errorhint and ((l and V_Hint)<>0)) then
-   inc(status.errorcount);
-{ Create status info }
-  UpdateStatus;
-{ Fix replacements }
-  DefaultReplacements(s);
-{ show comment }
-  if do_comment(l,s) or dostop then
-   stop;
-  if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
-   begin
-     Message1(unit_f_errors_in_unit,tostr(status.errorcount));
-     status.skip_error:=true;
-     stop;
-   end;
-end;
-
-
-Procedure Msg2Comment(s:string);
-var
-  idx,i,v : longint;
-  dostop  : boolean;
-begin
-{Reset}
-  dostop:=false;
-  v:=0;
-{Parse options}
-  idx:=pos('_',s);
-  if idx=0 then
-   v:=V_Normal
-  else
-   if (idx >= 1) And (idx <= 5) then
-    begin
-      for i:=1 to idx do
-       begin
-         case upcase(s[i]) of
-          'F' :
-            begin
-              v:=v or V_Fatal;
-              inc(status.errorcount);
-              dostop:=true;
-            end;
-          'E' :
-            begin
-              v:=v or V_Error;
-              inc(status.errorcount);
-            end;
-          'O' :
-            v:=v or V_Normal;
-          'W':
-            begin
-              v:=v or V_Warning;
-              if status.errorwarning then
-               inc(status.errorcount);
-            end;
-          'N' :
-            begin
-              v:=v or V_Note;
-              if status.errornote then
-               inc(status.errorcount);
-            end;
-          'H' :
-            begin
-              v:=v or V_Hint;
-              if status.errorhint then
-               inc(status.errorcount);
-            end;
-          'I' :
-            v:=v or V_Info;
-          'L' :
-            v:=v or V_Status;
-          'U' :
-            v:=v or V_Used;
-          'T' :
-            v:=v or V_Tried;
-          'M' :
-            v:=v or V_Macro;
-          'P' :
-            v:=v or V_Procedure;
-          'C' :
-            v:=v or V_Conditional;
-          'D' :
-            v:=v or V_Debug;
-          'B' :
-            v:=v or V_Declarations;
-          'X' :
-            v:=v or V_Executable;
-          'Z' :
-            v:=v or V_Assem;
-          'S' :
-            dostop:=true;
-          '_' : ;
+        Delete(s,1,idx);
+      { fix status }
+        UpdateStatus;
+      { Fix replacements }
+        DefaultReplacements(s);
+      { show comment }
+        if do_comment(v,s) or dostop then
+         stop;
+        if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
+         begin
+           Message1(unit_f_errors_in_unit,tostr(status.errorcount));
+           status.skip_error:=true;
+           stop;
+         end;
+      end;
+
+
+    function  MessagePchar(w:longint):pchar;
+      begin
+        MessagePchar:=msg^.GetPchar(w)
+      end;
+
+
+    procedure Message(w:longint);
+      begin
+        Msg2Comment(msg^.Get(w));
+      end;
+
+
+    procedure Message1(w:longint;const s1:string);
+      begin
+        Msg2Comment(msg^.Get1(w,s1));
+      end;
+
+
+    procedure Message2(w:longint;const s1,s2:string);
+      begin
+        Msg2Comment(msg^.Get2(w,s1,s2));
+      end;
+
+
+    procedure Message3(w:longint;const s1,s2,s3:string);
+      begin
+        Msg2Comment(msg^.Get3(w,s1,s2,s3));
+      end;
+
+
+    procedure MessagePos(const pos:tfileposinfo;w:longint);
+      var
+        oldpos : tfileposinfo;
+      begin
+        oldpos:=aktfilepos;
+        aktfilepos:=pos;
+        Msg2Comment(msg^.Get(w));
+        aktfilepos:=oldpos;
+      end;
+
+
+    procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string);
+      var
+        oldpos : tfileposinfo;
+      begin
+        oldpos:=aktfilepos;
+        aktfilepos:=pos;
+        Msg2Comment(msg^.Get1(w,s1));
+        aktfilepos:=oldpos;
+      end;
+
+
+    procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string);
+      var
+        oldpos : tfileposinfo;
+      begin
+        oldpos:=aktfilepos;
+        aktfilepos:=pos;
+        Msg2Comment(msg^.Get2(w,s1,s2));
+        aktfilepos:=oldpos;
+      end;
+
+
+    procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:string);
+      var
+        oldpos : tfileposinfo;
+      begin
+        oldpos:=aktfilepos;
+        aktfilepos:=pos;
+        Msg2Comment(msg^.Get3(w,s1,s2,s3));
+        aktfilepos:=oldpos;
+      end;
+
+
+    procedure InitVerbose;
+      begin
+      { Init }
+        msg:=new(pmessage,Init(20,msgidxmax));
+        if msg=nil then
+         begin
+           writeln('Fatal: MsgIdx Wrong');
+           halt(3);
          end;
-       end;
-    end;
-  Delete(s,1,idx);
-{ fix status }
-  UpdateStatus;
-{ Fix replacements }
-  DefaultReplacements(s);
-{ show comment }
-  if do_comment(v,s) or dostop then
-   stop;
-  if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
-   begin
-     Message1(unit_f_errors_in_unit,tostr(status.errorcount));
-     status.skip_error:=true;
-     stop;
-   end;
-end;
-
-
-function  MessagePchar(w:longint):pchar;
-begin
-  MessagePchar:=msg^.GetPchar(w)
-end;
-
-
-procedure Message(w:longint);
-begin
-  Msg2Comment(msg^.Get(w));
-end;
-
-
-procedure Message1(w:longint;const s1:string);
-begin
-  Msg2Comment(msg^.Get1(w,s1));
-end;
-
-
-procedure Message2(w:longint;const s1,s2:string);
-begin
-  Msg2Comment(msg^.Get2(w,s1,s2));
-end;
-
-
-procedure Message3(w:longint;const s1,s2,s3:string);
-begin
-  Msg2Comment(msg^.Get3(w,s1,s2,s3));
-end;
-
-
-procedure MessagePos(const pos:tfileposinfo;w:longint);
-var
-  oldpos : tfileposinfo;
-begin
-  oldpos:=aktfilepos;
-  aktfilepos:=pos;
-  Msg2Comment(msg^.Get(w));
-  aktfilepos:=oldpos;
-end;
-
-
-procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string);
-var
-  oldpos : tfileposinfo;
-begin
-  oldpos:=aktfilepos;
-  aktfilepos:=pos;
-  Msg2Comment(msg^.Get1(w,s1));
-  aktfilepos:=oldpos;
-end;
-
-
-procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string);
-var
-  oldpos : tfileposinfo;
-begin
-  oldpos:=aktfilepos;
-  aktfilepos:=pos;
-  Msg2Comment(msg^.Get2(w,s1,s2));
-  aktfilepos:=oldpos;
-end;
-
-
-procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:string);
-var
-  oldpos : tfileposinfo;
-begin
-  oldpos:=aktfilepos;
-  aktfilepos:=pos;
-  Msg2Comment(msg^.Get3(w,s1,s2,s3));
-  aktfilepos:=oldpos;
-end;
-
-
-procedure InitVerbose;
-begin
-{ Init }
-  msg:=new(pmessage,Init(20,msgidxmax));
-  if msg=nil then
-   begin
-     writeln('Fatal: MsgIdx Wrong');
-     halt(3);
-   end;
 {$ifndef EXTERN_MSG}
-  msg^.LoadIntern(@msgtxt,msgtxtsize);
-{$else}
-  LoadMsgFile(exepath+'errore.msg');
-{$endif}
-  FillChar(Status,sizeof(TCompilerStatus),0);
-  status.verbosity:=V_Default;
-  Status.MaxErrorCount:=50;
-  LoadPrefixes;
-end;
-
-
-procedure DoneVerbose;
-begin
-  if assigned(msg) then
-   begin
-     dispose(msg,Done);
-     msg:=nil;
-   end;
-end;
+        msg^.LoadIntern(@msgtxt,msgtxtsize);
+{$else EXTERN_MSG}
+        LoadMsgFile(exepath+'errore.msg');
+{$endif EXTERN_MSG}
+        FillChar(Status,sizeof(TCompilerStatus),0);
+        status.verbosity:=V_Default;
+        Status.MaxErrorCount:=50;
+        LoadPrefixes;
+      end;
+
+
+    procedure DoneVerbose;
+      begin
+        if assigned(msg) then
+         begin
+           dispose(msg,Done);
+           msg:=nil;
+         end;
+        if status.use_redir then
+         DoneRedirectFile;
+      end;
 
 end.
 {
   $Log$
-  Revision 1.9  2000-12-07 17:19:45  jonas
+  Revision 1.10  2000-12-25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.9  2000/12/07 17:19:45  jonas
     * new constant handling: from now on, hex constants >$7fffffff are
       parsed as unsigned constants (otherwise, $80000000 got sign extended
       and became $ffffffff80000000), all constants in the longint range