* obsolete

compiler/symdef.inc

@@ -1,4805 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
-
-    Symbol table implementation for the definitions
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
-}
-
-{****************************************************************************
-                     TDEF (base class for definitions)
-****************************************************************************}
-
-    function tparalinkedlist.count:longint;
-      begin
-        { You must use tabstractprocdef.minparacount and .maxparacount instead }
-        internalerror(432432978);
-        count:=0;
-      end;
-
-
-{****************************************************************************
-                     TDEF (base class for definitions)
-****************************************************************************}
-
-
-    constructor tdef.init;
-      begin
-         inherited init;
-         deftype:=abstractdef;
-         owner := nil;
-         typesym := nil;
-         savesize := 0;
-         if registerdef then
-           symtablestack^.registerdef(@self);
-         has_rtti:=false;
-         has_inittable:=false;
-{$ifdef GDB}
-         is_def_stab_written := not_written;
-         globalnb := 0;
-{$endif GDB}
-         if assigned(lastglobaldef) then
-           begin
-              lastglobaldef^.nextglobal := @self;
-              previousglobal:=lastglobaldef;
-           end
-         else
-           begin
-              firstglobaldef := @self;
-              previousglobal := nil;
-           end;
-         lastglobaldef := @self;
-         nextglobal := nil;
-      end;
-
-{$ifdef MEMDEBUG}
-   var
-       manglenamesize : longint;
-{$endif}
-
-    constructor tdef.load;
-      begin
-         inherited init;
-         deftype:=abstractdef;
-         owner := nil;
-         has_rtti:=false;
-         has_inittable:=false;
-{$ifdef GDB}
-         is_def_stab_written := not_written;
-         globalnb := 0;
-{$endif GDB}
-         if assigned(lastglobaldef) then
-           begin
-              lastglobaldef^.nextglobal := @self;
-              previousglobal:=lastglobaldef;
-           end
-         else
-           begin
-              firstglobaldef := @self;
-              previousglobal:=nil;
-           end;
-         lastglobaldef := @self;
-         nextglobal := nil;
-      { load }
-         indexnr:=readword;
-         typesym:=ptypesym(readsymref);
-      end;
-
-
-    destructor tdef.done;
-      begin
-         { first element  ? }
-         if not(assigned(previousglobal)) then
-           begin
-              firstglobaldef := nextglobal;
-              if assigned(firstglobaldef) then
-                firstglobaldef^.previousglobal:=nil;
-           end
-         else
-           begin
-              { remove reference in the element before }
-              previousglobal^.nextglobal:=nextglobal;
-           end;
-         { last element ? }
-         if not(assigned(nextglobal)) then
-           begin
-              lastglobaldef := previousglobal;
-              if assigned(lastglobaldef) then
-                lastglobaldef^.nextglobal:=nil;
-           end
-         else
-           nextglobal^.previousglobal:=previousglobal;
-         previousglobal:=nil;
-         nextglobal:=nil;
-{$ifdef SYNONYM}
-         while assigned(typesym) do
-           begin
-              typesym^.restype.setdef(nil);
-              typesym:=typesym^.synonym;
-           end;
-{$endif}
-      end;
-
-    { used for enumdef because the symbols are
-      inserted in the owner symtable }
-    procedure tdef.correct_owner_symtable;
-      var
-         st : psymtable;
-      begin
-         if assigned(owner) and
-            (owner^.symtabletype in [recordsymtable,objectsymtable]) then
-           begin
-              owner^.defindex^.deleteindex(@self);
-              st:=owner;
-              while (st^.symtabletype in [recordsymtable,objectsymtable]) do
-                st:=st^.next;
-              st^.registerdef(@self);
-           end;
-      end;
-
-
-    function tdef.typename:string;
-      begin
-        if assigned(typesym) and not(deftype=procvardef) and
-          assigned(typesym^._realname) and
-          (typesym^._realname^[1]<>'$') then
-         typename:=typesym^._realname^
-        else
-         typename:=gettypename;
-      end;
-
-    function tdef.gettypename : string;
-
-      begin
-         gettypename:='<unknown type>'
-      end;
-
-    function tdef.is_in_current : boolean;
-      var
-        p : psymtable;
-      begin
-         p:=owner;
-         is_in_current:=false;
-         while assigned(p) do
-           begin
-              if (p=current_module^.globalsymtable) or (p=current_module^.localsymtable)
-                 or (p^.symtabletype in [globalsymtable,staticsymtable]) then
-                begin
-                   is_in_current:=true;
-                   exit;
-                end
-              else if p^.symtabletype in [localsymtable,parasymtable,objectsymtable] then
-                begin
-                  if assigned(p^.defowner) then
-                    p:=pobjectdef(p^.defowner)^.owner
-                  else
-                    exit;
-                end
-              else
-                exit;
-           end;
-
-      end;
-
-    procedure tdef.write;
-      begin
-        writeword(indexnr);
-        writesymref(typesym);
-{$ifdef GDB}
-        if globalnb = 0 then
-          begin
-            if assigned(owner) then
-              globalnb := owner^.getnewtypecount
-            else
-              begin
-                globalnb := PGlobalTypeCount^;
-                Inc(PGlobalTypeCount^);
-              end;
-           end;
-{$endif GDB}
-      end;
-
-
-    function tdef.size : longint;
-      begin
-         size:=savesize;
-      end;
-
-
-    function tdef.alignment : longint;
-      begin
-         { normal alignment by default }
-         alignment:=0;
-      end;
-
-
-{$ifdef GDB}
-   procedure tdef.set_globalnb;
-     begin
-         globalnb :=PGlobalTypeCount^;
-         inc(PglobalTypeCount^);
-     end;
-
-    function tdef.stabstring : pchar;
-      begin
-      stabstring := strpnew('t'+numberstring+';');
-      end;
-
-
-    function tdef.numberstring : string;
-      var table : psymtable;
-      begin
-      {formal def have no type !}
-      if deftype = formaldef then
-        begin
-        numberstring := voiddef^.numberstring;
-        exit;
-        end;
-      if (not assigned(typesym)) or (not typesym^.isusedinstab) then
-        begin
-           {set even if debuglist is not defined}
-           if assigned(typesym) then
-             typesym^.isusedinstab := true;
-           if assigned(debuglist) and (is_def_stab_written = not_written) then
-             concatstabto(debuglist);
-        end;
-      if not (cs_gdb_dbx in aktglobalswitches) then
-        begin
-           if globalnb = 0 then
-             set_globalnb;
-           numberstring := tostr(globalnb);
-        end
-      else
-        begin
-           if globalnb = 0 then
-             begin
-                if assigned(owner) then
-                  globalnb := owner^.getnewtypecount
-                else
-                  begin
-                     globalnb := PGlobalTypeCount^;
-                     Inc(PGlobalTypeCount^);
-                  end;
-             end;
-           if assigned(typesym) then
-             begin
-                table := typesym^.owner;
-                if table^.unitid > 0 then
-                  numberstring := '('+tostr(table^.unitid)+','+tostr(typesym^.restype.def^.globalnb)+')'
-                else
-                  numberstring := tostr(globalnb);
-                exit;
-             end;
-           numberstring := tostr(globalnb);
-        end;
-      end;
-
-
-    function tdef.allstabstring : pchar;
-    var stabchar : string[2];
-        ss,st : pchar;
-        sname : string;
-        sym_line_no : longint;
-      begin
-      ss := stabstring;
-      getmem(st,strlen(ss)+512);
-      stabchar := 't';
-      if deftype in tagtypes then
-        stabchar := 'Tt';
-      if assigned(typesym) then
-        begin
-           sname := typesym^.name;
-           sym_line_no:=typesym^.fileinfo.line;
-        end
-      else
-        begin
-           sname := ' ';
-           sym_line_no:=0;
-        end;
-      strpcopy(st,'"'+sname+':'+stabchar+numberstring+'=');
-      strpcopy(strecopy(strend(st),ss),'",'+tostr(N_LSYM)+',0,'+tostr(sym_line_no)+',0');
-      allstabstring := strnew(st);
-      freemem(st,strlen(ss)+512);
-      strdispose(ss);
-      end;
-
-
-    procedure tdef.concatstabto(asmlist : paasmoutput);
-     var stab_str : pchar;
-    begin
-    if ((typesym = nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches))
-      and (is_def_stab_written = not_written) then
-      begin
-      If cs_gdb_dbx in aktglobalswitches then
-        begin
-           { otherwise you get two of each def }
-           If assigned(typesym) then
-             begin
-                if typesym^.typ=symconst.typesym then
-                  typesym^.isusedinstab:=true;
-                if (typesym^.owner = nil) or
-                  ((typesym^.owner^.symtabletype = unitsymtable) and
-                 punitsymtable(typesym^.owner)^.dbx_count_ok)  then
-                begin
-                   {with DBX we get the definition from the other objects }
-                   is_def_stab_written := written;
-                   exit;
-                end;
-             end;
-        end;
-      { to avoid infinite loops }
-      is_def_stab_written := being_written;
-      stab_str := allstabstring;
-      asmlist^.concat(new(pai_stabs,init(stab_str)));
-      is_def_stab_written := written;
-      end;
-    end;
-{$endif GDB}
-
-
-    procedure tdef.deref;
-      begin
-        resolvesym(psym(typesym));
-      end;
-
-
-    { rtti generation }
-    procedure tdef.generate_rtti;
-      begin
-         if not has_rtti then
-          begin
-            has_rtti:=true;
-            getdatalabel(rtti_label);
-            write_child_rtti_data;
-            rttilist^.concat(new(pai_symbol,init(rtti_label,0)));
-            write_rtti_data;
-            rttilist^.concat(new(pai_symbol_end,init(rtti_label)));
-          end;
-      end;
-
-
-    function tdef.get_rtti_label : string;
-      begin
-         generate_rtti;
-         get_rtti_label:=rtti_label^.name;
-      end;
-
-
-    { init table handling }
-    function tdef.needs_inittable : boolean;
-      begin
-         needs_inittable:=false;
-      end;
-
-
-    procedure tdef.generate_inittable;
-      begin
-         has_inittable:=true;
-         getdatalabel(inittable_label);
-         write_child_init_data;
-         rttilist^.concat(new(pai_label,init(inittable_label)));
-         write_init_data;
-      end;
-
-
-    procedure tdef.write_init_data;
-      begin
-         write_rtti_data;
-      end;
-
-
-    procedure tdef.write_child_init_data;
-      begin
-         write_child_rtti_data;
-      end;
-
-
-    function tdef.get_inittable_label : pasmlabel;
-      begin
-         if not(has_inittable) then
-           generate_inittable;
-         get_inittable_label:=inittable_label;
-      end;
-
-
-    procedure tdef.write_rtti_name;
-      var
-         str : string;
-      begin
-         { name }
-         if assigned(typesym) then
-           begin
-              str:=typesym^.realname;
-              rttilist^.concat(new(pai_string,init(chr(length(str))+str)));
-           end
-         else
-           rttilist^.concat(new(pai_string,init(#0)))
-      end;
-
-
-    { returns true, if the definition can be published }
-    function tdef.is_publishable : boolean;
-      begin
-         is_publishable:=false;
-      end;
-
-
-    procedure tdef.write_rtti_data;
-      begin
-      end;
-
-
-    procedure tdef.write_child_rtti_data;
-      begin
-      end;
-
-
-   function tdef.is_intregable : boolean;
-
-     begin
-        is_intregable:=false;
-        case deftype of
-          pointerdef,
-          enumdef,
-          procvardef :
-            is_intregable:=true;
-          orddef :
-            case porddef(@self)^.typ of
-              bool8bit,bool16bit,bool32bit,
-              u8bit,u16bit,u32bit,
-              s8bit,s16bit,s32bit:
-                is_intregable:=true;
-            end;
-          setdef:
-            is_intregable:=is_smallset(@self);
-        end;
-     end;
-
-   function tdef.is_fpuregable : boolean;
-
-     begin
-        is_fpuregable:=(deftype=floatdef) and not(pfloatdef(@self)^.typ in [f32bit,f16bit]);
-     end;
-
-{****************************************************************************
-                               TSTRINGDEF
-****************************************************************************}
-
-    constructor tstringdef.shortinit(l : byte);
-      begin
-         tdef.init;
-         string_typ:=st_shortstring;
-         deftype:=stringdef;
-         len:=l;
-         savesize:=len+1;
-      end;
-
-
-    constructor tstringdef.shortload;
-      begin
-         tdef.load;
-         string_typ:=st_shortstring;
-         deftype:=stringdef;
-         len:=readbyte;
-         savesize:=len+1;
-      end;
-
-
-    constructor tstringdef.longinit(l : longint);
-      begin
-         tdef.init;
-         string_typ:=st_longstring;
-         deftype:=stringdef;
-         len:=l;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    constructor tstringdef.longload;
-      begin
-         tdef.load;
-         deftype:=stringdef;
-         string_typ:=st_longstring;
-         len:=readlong;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    constructor tstringdef.ansiinit(l : longint);
-      begin
-         tdef.init;
-         string_typ:=st_ansistring;
-         deftype:=stringdef;
-         len:=l;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    constructor tstringdef.ansiload;
-      begin
-         tdef.load;
-         deftype:=stringdef;
-         string_typ:=st_ansistring;
-         len:=readlong;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    constructor tstringdef.wideinit(l : longint);
-      begin
-         tdef.init;
-         string_typ:=st_widestring;
-         deftype:=stringdef;
-         len:=l;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    constructor tstringdef.wideload;
-      begin
-         tdef.load;
-         deftype:=stringdef;
-         string_typ:=st_widestring;
-         len:=readlong;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    function tstringdef.stringtypname:string;
-      const
-        typname:array[tstringtype] of string[8]=('',
-          'SHORTSTR','LONGSTR','ANSISTR','WIDESTR'
-        );
-      begin
-        stringtypname:=typname[string_typ];
-      end;
-
-
-    function tstringdef.size : longint;
-      begin
-        size:=savesize;
-      end;
-
-
-    procedure tstringdef.write;
-      begin
-         tdef.write;
-         if string_typ=st_shortstring then
-           writebyte(len)
-         else
-           writelong(len);
-         case string_typ of
-           st_shortstring : current_ppu^.writeentry(ibshortstringdef);
-            st_longstring : current_ppu^.writeentry(iblongstringdef);
-            st_ansistring : current_ppu^.writeentry(ibansistringdef);
-            st_widestring : current_ppu^.writeentry(ibwidestringdef);
-         end;
-      end;
-
-
-{$ifdef GDB}
-    function tstringdef.stabstring : pchar;
-      var
-        bytest,charst,longst : string;
-      begin
-        case string_typ of
-           st_shortstring:
-             begin
-               charst := typeglobalnumber('char');
-               { this is what I found in stabs.texinfo but
-                 gdb 4.12 for go32 doesn't understand that !! }
-             {$IfDef GDBknowsstrings}
-               stabstring := strpnew('n'+charst+';'+tostr(len));
-             {$else}
-               bytest := typeglobalnumber('byte');
-               stabstring := strpnew('s'+tostr(len+1)+'length:'+bytest
-                  +',0,8;st:ar'+bytest
-                  +';1;'+tostr(len)+';'+charst+',8,'+tostr(len*8)+';;');
-             {$EndIf}
-             end;
-           st_longstring:
-             begin
-               charst := typeglobalnumber('char');
-               { this is what I found in stabs.texinfo but
-                 gdb 4.12 for go32 doesn't understand that !! }
-             {$IfDef GDBknowsstrings}
-               stabstring := strpnew('n'+charst+';'+tostr(len));
-             {$else}
-               bytest := typeglobalnumber('byte');
-               longst := typeglobalnumber('longint');
-               stabstring := strpnew('s'+tostr(len+5)+'length:'+longst
-                  +',0,32;dummy:'+bytest+',32,8;st:ar'+bytest
-                  +';1;'+tostr(len)+';'+charst+',40,'+tostr(len*8)+';;');
-             {$EndIf}
-             end;
-           st_ansistring:
-             begin
-               { an ansi string looks like a pchar easy !! }
-               stabstring:=strpnew('*'+typeglobalnumber('char'));
-             end;
-           st_widestring:
-             begin
-               { an ansi string looks like a pchar easy !! }
-               stabstring:=strpnew('*'+typeglobalnumber('char'));
-             end;
-      end;
-    end;
-
-
-    procedure tstringdef.concatstabto(asmlist : paasmoutput);
-      begin
-        inherited concatstabto(asmlist);
-      end;
-{$endif GDB}
-
-
-    function tstringdef.needs_inittable : boolean;
-      begin
-         needs_inittable:=string_typ in [st_ansistring,st_widestring];
-      end;
-
-    function tstringdef.gettypename : string;
-
-      const
-         names : array[tstringtype] of string[20] = ('',
-           'ShortString','LongString','AnsiString','WideString');
-
-      begin
-         gettypename:=names[string_typ];
-      end;
-
-    procedure tstringdef.write_rtti_data;
-      begin
-         case string_typ of
-            st_ansistring:
-              begin
-                 rttilist^.concat(new(pai_const,init_8bit(tkAString)));
-                 write_rtti_name;
-              end;
-            st_widestring:
-              begin
-                 rttilist^.concat(new(pai_const,init_8bit(tkWString)));
-                 write_rtti_name;
-              end;
-            st_longstring:
-              begin
-                 rttilist^.concat(new(pai_const,init_8bit(tkLString)));
-                 write_rtti_name;
-              end;
-            st_shortstring:
-              begin
-                 rttilist^.concat(new(pai_const,init_8bit(tkSString)));
-                 write_rtti_name;
-                 rttilist^.concat(new(pai_const,init_8bit(len)));
-              end;
-         end;
-      end;
-
-
-    function tstringdef.is_publishable : boolean;
-      begin
-         is_publishable:=true;
-      end;
-
-
-{****************************************************************************
-                                 TENUMDEF
-****************************************************************************}
-
-    constructor tenumdef.init;
-      begin
-         tdef.init;
-         deftype:=enumdef;
-         minval:=0;
-         maxval:=0;
-         calcsavesize;
-         has_jumps:=false;
-         basedef:=nil;
-         rangenr:=0;
-         firstenum:=nil;
-         correct_owner_symtable;
-      end;
-
-    constructor tenumdef.init_subrange(_basedef:penumdef;_min,_max:longint);
-      begin
-         tdef.init;
-         deftype:=enumdef;
-         minval:=_min;
-         maxval:=_max;
-         basedef:=_basedef;
-         calcsavesize;
-         has_jumps:=false;
-         rangenr:=0;
-         firstenum:=basedef^.firstenum;
-         while assigned(firstenum) and (penumsym(firstenum)^.value<>minval) do
-          firstenum:=firstenum^.nextenum;
-         correct_owner_symtable;
-      end;
-
-
-    constructor tenumdef.load;
-      begin
-         tdef.load;
-         deftype:=enumdef;
-         basedef:=penumdef(readdefref);
-         minval:=readlong;
-         maxval:=readlong;
-         savesize:=readlong;
-         has_jumps:=false;
-         firstenum:=Nil;
-      end;
-
-
-    procedure tenumdef.calcsavesize;
-      begin
-        if (aktpackenum=4) or (min<0) or (max>65535) then
-         savesize:=4
-        else
-         if (aktpackenum=2) or (min<0) or (max>255) then
-          savesize:=2
-        else
-         savesize:=1;
-      end;
-
-
-    procedure tenumdef.setmax(_max:longint);
-      begin
-        maxval:=_max;
-        calcsavesize;
-      end;
-
-
-    procedure tenumdef.setmin(_min:longint);
-      begin
-        minval:=_min;
-        calcsavesize;
-      end;
-
-
-    function tenumdef.min:longint;
-      begin
-        min:=minval;
-      end;
-
-
-    function tenumdef.max:longint;
-      begin
-        max:=maxval;
-      end;
-
-
-    procedure tenumdef.deref;
-      begin
-        inherited deref;
-        resolvedef(pdef(basedef));
-      end;
-
-
-    destructor tenumdef.done;
-      begin
-        inherited done;
-      end;
-
-
-    procedure tenumdef.write;
-      begin
-         tdef.write;
-         writedefref(basedef);
-         writelong(min);
-         writelong(max);
-         writelong(savesize);
-         current_ppu^.writeentry(ibenumdef);
-      end;
-
-
-    function tenumdef.getrangecheckstring : string;
-      begin
-         if (cs_create_smart in aktmoduleswitches) then
-           getrangecheckstring:='R_'+current_module^.modulename^+tostr(rangenr)
-         else
-           getrangecheckstring:='R_'+tostr(rangenr);
-      end;
-
-
-    procedure tenumdef.genrangecheck;
-      begin
-         if rangenr=0 then
-           begin
-              { generate two constant for bounds }
-              getlabelnr(rangenr);
-              if (cs_create_smart in aktmoduleswitches) then
-                datasegment^.concat(new(pai_symbol,initname_global(getrangecheckstring,8)))
-              else
-                datasegment^.concat(new(pai_symbol,initname(getrangecheckstring,8)));
-              datasegment^.concat(new(pai_const,init_32bit(min)));
-              datasegment^.concat(new(pai_const,init_32bit(max)));
-           end;
-      end;
-
-
-{$ifdef GDB}
-    function tenumdef.stabstring : pchar;
-      var st,st2 : pchar;
-          p : penumsym;
-          s : string;
-          memsize : word;
-      begin
-        memsize := memsizeinc;
-        getmem(st,memsize);
-        strpcopy(st,'e');
-        p := firstenum;
-        while assigned(p) do
-          begin
-            s :=p^.name+':'+tostr(p^.value)+',';
-            { place for the ending ';' also }
-            if (strlen(st)+length(s)+1<memsize) then
-              strpcopy(strend(st),s)
-            else
-              begin
-                getmem(st2,memsize+memsizeinc);
-                strcopy(st2,st);
-                freemem(st,memsize);
-                st := st2;
-                memsize := memsize+memsizeinc;
-                strpcopy(strend(st),s);
-              end;
-            p := p^.nextenum;
-          end;
-        strpcopy(strend(st),';');
-        stabstring := strnew(st);
-        freemem(st,memsize);
-      end;
-{$endif GDB}
-
-
-    procedure tenumdef.write_child_rtti_data;
-      begin
-         if assigned(basedef) then
-           basedef^.get_rtti_label;
-      end;
-
-
-    procedure tenumdef.write_rtti_data;
-
-      var
-         hp : penumsym;
-
-      begin
-         rttilist^.concat(new(pai_const,init_8bit(tkEnumeration)));
-         write_rtti_name;
-         case savesize of
-            1:
-              rttilist^.concat(new(pai_const,init_8bit(otUByte)));
-            2:
-              rttilist^.concat(new(pai_const,init_8bit(otUWord)));
-            4:
-              rttilist^.concat(new(pai_const,init_8bit(otULong)));
-         end;
-         rttilist^.concat(new(pai_const,init_32bit(min)));
-         rttilist^.concat(new(pai_const,init_32bit(max)));
-         if assigned(basedef) then
-           rttilist^.concat(new(pai_const_symbol,initname(basedef^.get_rtti_label)))
-         else
-           rttilist^.concat(new(pai_const,init_32bit(0)));
-         hp:=firstenum;
-         while assigned(hp) do
-           begin
-              rttilist^.concat(new(pai_const,init_8bit(length(hp^.name))));
-              rttilist^.concat(new(pai_string,init(lower(hp^.name))));
-              hp:=hp^.nextenum;
-           end;
-         rttilist^.concat(new(pai_const,init_8bit(0)));
-      end;
-
-
-    function tenumdef.is_publishable : boolean;
-      begin
-         is_publishable:=true;
-      end;
-
-    function tenumdef.gettypename : string;
-
-      begin
-         gettypename:='<enumeration type>';
-      end;
-
-{****************************************************************************
-                                 TORDDEF
-****************************************************************************}
-
-    constructor torddef.init(t : tbasetype;v,b : longint);
-      begin
-         inherited init;
-         deftype:=orddef;
-         low:=v;
-         high:=b;
-         typ:=t;
-         rangenr:=0;
-         setsize;
-      end;
-
-
-    constructor torddef.load;
-      begin
-         inherited load;
-         deftype:=orddef;
-         typ:=tbasetype(readbyte);
-         low:=readlong;
-         high:=readlong;
-         rangenr:=0;
-         setsize;
-      end;
-
-
-    procedure torddef.setsize;
-      begin
-         if typ=uauto then
-           begin
-              { generate a unsigned range if high<0 and low>=0 }
-              if (low>=0) and (high<0) then
-                begin
-                   savesize:=4;
-                   typ:=u32bit;
-                end
-              else if (low>=0) and (high<=255) then
-                begin
-                   savesize:=1;
-                   typ:=u8bit;
-                end
-              else if (low>=-128) and (high<=127) then
-                begin
-                   savesize:=1;
-                   typ:=s8bit;
-                end
-              else if (low>=0) and (high<=65536) then
-                begin
-                   savesize:=2;
-                   typ:=u16bit;
-                end
-              else if (low>=-32768) and (high<=32767) then
-                begin
-                   savesize:=2;
-                   typ:=s16bit;
-                end
-              else
-                begin
-                   savesize:=4;
-                   typ:=s32bit;
-                end;
-           end
-         else
-           begin
-             case typ of
-                u8bit,s8bit,
-                uchar,bool8bit:
-                  savesize:=1;
-
-                u16bit,s16bit,
-                bool16bit,uwidechar:
-                  savesize:=2;
-
-                s32bit,u32bit,
-                bool32bit:
-                  savesize:=4;
-
-                u64bit,s64bit:
-                  savesize:=8;
-             else
-               savesize:=0;
-             end;
-           end;
-       { there are no entrys for range checking }
-         rangenr:=0;
-      end;
-
-    function torddef.getrangecheckstring : string;
-
-      begin
-         if (cs_create_smart in aktmoduleswitches) then
-           getrangecheckstring:='R_'+current_module^.modulename^+tostr(rangenr)
-         else
-           getrangecheckstring:='R_'+tostr(rangenr);
-      end;
-
-    procedure torddef.genrangecheck;
-      var
-        rangechecksize : longint;
-      begin
-         if rangenr=0 then
-           begin
-              if low<=high then
-               rangechecksize:=8
-              else
-               rangechecksize:=16;
-              { generate two constant for bounds }
-              getlabelnr(rangenr);
-              if (cs_create_smart in aktmoduleswitches) then
-                datasegment^.concat(new(pai_symbol,initname_global(getrangecheckstring,rangechecksize)))
-              else
-                datasegment^.concat(new(pai_symbol,initname(getrangecheckstring,rangechecksize)));
-              if low<=high then
-                begin
-                   datasegment^.concat(new(pai_const,init_32bit(low)));
-                   datasegment^.concat(new(pai_const,init_32bit(high)));
-                end
-              { for u32bit we need two bounds }
-              else
-                begin
-                   datasegment^.concat(new(pai_const,init_32bit(low)));
-                   datasegment^.concat(new(pai_const,init_32bit($7fffffff)));
-                   datasegment^.concat(new(pai_const,init_32bit($80000000)));
-                   datasegment^.concat(new(pai_const,init_32bit(high)));
-                end;
-           end;
-      end;
-
-
-    procedure torddef.write;
-      begin
-         tdef.write;
-         writebyte(byte(typ));
-         writelong(low);
-         writelong(high);
-         current_ppu^.writeentry(iborddef);
-      end;
-
-
-{$ifdef GDB}
-    function torddef.stabstring : pchar;
-      begin
-        case typ of
-            uvoid : stabstring := strpnew(numberstring+';');
-         {GDB 4.12 for go32 doesn't like boolean as range for 0 to 1 !!!}
-{$ifdef Use_integer_types_for_boolean}
-         bool8bit,
-        bool16bit,
-        bool32bit : stabstring := strpnew('r'+numberstring+';0;255;');
-{$else : not Use_integer_types_for_boolean}
-         bool8bit : stabstring := strpnew('-21;');
-        bool16bit : stabstring := strpnew('-22;');
-        bool32bit : stabstring := strpnew('-23;');
-        u64bit    : stabstring := strpnew('-32;');
-        s64bit    : stabstring := strpnew('-31;');
-{$endif not Use_integer_types_for_boolean}
-         { u32bit : stabstring := strpnew('r'+
-              s32bitdef^.numberstring+';0;-1;'); }
-        else
-          stabstring := strpnew('r'+s32bitdef^.numberstring+';'+tostr(low)+';'+tostr(high)+';');
-        end;
-      end;
-{$endif GDB}
-
-
-    procedure torddef.write_rtti_data;
-
-        procedure dointeger;
-        const
-          trans : array[uchar..bool8bit] of byte =
-            (otUByte,otUByte,otUWord,otULong,otSByte,otSWord,otSLong,otUByte);
-        begin
-          write_rtti_name;
-          rttilist^.concat(new(pai_const,init_8bit(byte(trans[typ]))));
-          rttilist^.concat(new(pai_const,init_32bit(low)));
-          rttilist^.concat(new(pai_const,init_32bit(high)));
-        end;
-
-      begin
-        case typ of
-          s64bit :
-            begin
-              rttilist^.concat(new(pai_const,init_8bit(tkInt64)));
-              write_rtti_name;
-              { low }
-              rttilist^.concat(new(pai_const,init_32bit($0)));
-              rttilist^.concat(new(pai_const,init_32bit($8000)));
-              { high }
-              rttilist^.concat(new(pai_const,init_32bit($ffff)));
-              rttilist^.concat(new(pai_const,init_32bit($7fff)));
-            end;
-          u64bit :
-            begin
-              rttilist^.concat(new(pai_const,init_8bit(tkQWord)));
-              write_rtti_name;
-              { low }
-              rttilist^.concat(new(pai_const,init_32bit($0)));
-              rttilist^.concat(new(pai_const,init_32bit($0)));
-              { high }
-              rttilist^.concat(new(pai_const,init_32bit($0)));
-              rttilist^.concat(new(pai_const,init_32bit($8000)));
-            end;
-          bool8bit:
-            begin
-              rttilist^.concat(new(pai_const,init_8bit(tkBool)));
-              dointeger;
-            end;
-          uchar:
-            begin
-              rttilist^.concat(new(pai_const,init_8bit(tkWChar)));
-              dointeger;
-            end;
-          uwidechar:
-            begin
-              rttilist^.concat(new(pai_const,init_8bit(tkChar)));
-              dointeger;
-            end;
-          else
-            begin
-              rttilist^.concat(new(pai_const,init_8bit(tkInteger)));
-              dointeger;
-            end;
-        end;
-      end;
-
-
-    function torddef.is_publishable : boolean;
-      begin
-         is_publishable:=typ in [uchar..bool8bit];
-      end;
-
-    function torddef.gettypename : string;
-
-      const
-        names : array[tbasetype] of string[20] = ('<unknown type>',
-          'untyped','Char','Byte','Word','DWord','ShortInt',
-          'SmallInt','LongInt','Boolean','WordBool',
-          'LongBool','QWord','Int64','WideChar');
-
-      begin
-         gettypename:=names[typ];
-      end;
-
-{****************************************************************************
-                                TFLOATDEF
-****************************************************************************}
-
-    constructor tfloatdef.init(t : tfloattype);
-      begin
-         inherited init;
-         deftype:=floatdef;
-         typ:=t;
-         setsize;
-      end;
-
-
-    constructor tfloatdef.load;
-      begin
-         inherited load;
-         deftype:=floatdef;
-         typ:=tfloattype(readbyte);
-         setsize;
-      end;
-
-
-    procedure tfloatdef.setsize;
-      begin
-         case typ of
-            f16bit : savesize:=2;
-            f32bit,
-           s32real : savesize:=4;
-           s64real : savesize:=8;
-           s80real : savesize:=extended_size;
-           s64comp : savesize:=8;
-         else
-           savesize:=0;
-         end;
-      end;
-
-
-    procedure tfloatdef.write;
-      begin
-         inherited write;
-         writebyte(byte(typ));
-         current_ppu^.writeentry(ibfloatdef);
-      end;
-
-
-{$ifdef GDB}
-    function tfloatdef.stabstring : pchar;
-      begin
-         case typ of
-            s32real,
-            s64real : stabstring := strpnew('r'+
-               s32bitdef^.numberstring+';'+tostr(savesize)+';0;');
-            { for fixed real use longint instead to be able to }
-            { debug something at least                         }
-            f32bit:
-              stabstring := s32bitdef^.stabstring;
-            f16bit:
-              stabstring := strpnew('r'+s32bitdef^.numberstring+';0;'+
-                tostr($ffff)+';');
-            { found this solution in stabsread.c from GDB v4.16 }
-            s64comp : stabstring := strpnew('r'+
-               s32bitdef^.numberstring+';-'+tostr(savesize)+';0;');
-{$ifdef i386}
-            { under dos at least you must give a size of twelve instead of 10 !! }
-            { this is probably do to the fact that in gcc all is pushed in 4 bytes size }
-            s80real : stabstring := strpnew('r'+s32bitdef^.numberstring+';12;0;');
-{$endif i386}
-            else
-              internalerror(10005);
-         end;
-      end;
-{$endif GDB}
-
-
-    procedure tfloatdef.write_rtti_data;
-      const
-         {tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
-         translate : array[tfloattype] of byte =
-           (ftSingle,ftDouble,ftExtended,ftComp,ftFixed16,ftFixed32);
-      begin
-         rttilist^.concat(new(pai_const,init_8bit(tkFloat)));
-         write_rtti_name;
-         rttilist^.concat(new(pai_const,init_8bit(translate[typ])));
-      end;
-
-
-    function tfloatdef.is_publishable : boolean;
-      begin
-         is_publishable:=true;
-      end;
-
-    function tfloatdef.gettypename : string;
-
-      const
-        names : array[tfloattype] of string[20] = (
-          'Single','Double','Extended','Comp','Fixed','Fixed16');
-
-      begin
-         gettypename:=names[typ];
-      end;
-
-{****************************************************************************
-                                TFILEDEF
-****************************************************************************}
-
-    constructor tfiledef.inittext;
-      begin
-         inherited init;
-         deftype:=filedef;
-         filetyp:=ft_text;
-         typedfiletype.reset;
-         setsize;
-      end;
-
-
-    constructor tfiledef.inituntyped;
-      begin
-         inherited init;
-         deftype:=filedef;
-         filetyp:=ft_untyped;
-         typedfiletype.reset;
-         setsize;
-      end;
-
-
-    constructor tfiledef.inittyped(const tt : ttype);
-      begin
-         inherited init;
-         deftype:=filedef;
-         filetyp:=ft_typed;
-         typedfiletype:=tt;
-         setsize;
-      end;
-
-
-    constructor tfiledef.inittypeddef(p : pdef);
-      begin
-         inherited init;
-         deftype:=filedef;
-         filetyp:=ft_typed;
-         typedfiletype.setdef(p);
-         setsize;
-      end;
-
-
-    constructor tfiledef.load;
-      begin
-         inherited load;
-         deftype:=filedef;
-         filetyp:=tfiletyp(readbyte);
-         if filetyp=ft_typed then
-           typedfiletype.load
-         else
-           typedfiletype.reset;
-         setsize;
-      end;
-
-
-    procedure tfiledef.deref;
-      begin
-        inherited deref;
-        if filetyp=ft_typed then
-          typedfiletype.resolve;
-      end;
-
-
-    procedure tfiledef.setsize;
-      begin
-        case filetyp of
-          ft_text :
-            savesize:=572;
-          ft_typed,
-          ft_untyped :
-            savesize:=316;
-        end;
-      end;
-
-
-    procedure tfiledef.write;
-      begin
-         inherited write;
-         writebyte(byte(filetyp));
-         if filetyp=ft_typed then
-           typedfiletype.write;
-         current_ppu^.writeentry(ibfiledef);
-      end;
-
-
-{$ifdef GDB}
-    function tfiledef.stabstring : pchar;
-      begin
-   {$IfDef GDBknowsfiles}
-      case filetyp of
-        ft_typed :
-          stabstring := strpnew('d'+typedfiletype.def^.numberstring{+';'});
-        ft_untyped :
-          stabstring := strpnew('d'+voiddef^.numberstring{+';'});
-        ft_text :
-          stabstring := strpnew('d'+cchardef^.numberstring{+';'});
-      end;
-   {$Else}
-      {based on
-        FileRec = Packed Record
-          Handle,
-          Mode,
-          RecSize   : longint;
-          _private  : array[1..32] of byte;
-          UserData  : array[1..16] of byte;
-          name      : array[0..255] of char;
-        End; }
-      { the buffer part is still missing !! (PM) }
-      { but the string could become too long !! }
-      stabstring := strpnew('s'+tostr(savesize)+
-                     'HANDLE:'+typeglobalnumber('longint')+',0,32;'+
-                     'MODE:'+typeglobalnumber('longint')+',32,32;'+
-                     'RECSIZE:'+typeglobalnumber('longint')+',64,32;'+
-                     '_PRIVATE:ar'+typeglobalnumber('word')+';1;32;'+typeglobalnumber('byte')
-                        +',96,256;'+
-                     'USERDATA:ar'+typeglobalnumber('word')+';1;16;'+typeglobalnumber('byte')
-                        +',352,128;'+
-                     'NAME:ar'+typeglobalnumber('word')+';0;255;'+typeglobalnumber('char')
-                        +',480,2048;;');
-   {$EndIf}
-      end;
-
-
-    procedure tfiledef.concatstabto(asmlist : paasmoutput);
-      begin
-      { most file defs are unnamed !!! }
-      if ((typesym = nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
-         (is_def_stab_written  = not_written) then
-        begin
-        if assigned(typedfiletype.def) then forcestabto(asmlist,typedfiletype.def);
-        inherited concatstabto(asmlist);
-        end;
-      end;
-{$endif GDB}
-
-    function tfiledef.gettypename : string;
-
-      begin
-         case filetyp of
-           ft_untyped:
-             gettypename:='File';
-           ft_typed:
-             gettypename:='File Of '+typedfiletype.def^.typename;
-           ft_text:
-             gettypename:='Text'
-         end;
-      end;
-
-
-
-{****************************************************************************
-                               TPOINTERDEF
-****************************************************************************}
-
-    constructor tpointerdef.init(const tt : ttype);
-      begin
-        tdef.init;
-        deftype:=pointerdef;
-        pointertype:=tt;
-        is_far:=false;
-        savesize:=target_os.size_of_pointer;
-        pointertypeis_forwarddef:=assigned(pointertype.def) and (pointertype.def^.deftype=forwarddef);
-      end;
-
-
-    constructor tpointerdef.initfar(const tt : ttype);
-      begin
-        tdef.init;
-        deftype:=pointerdef;
-        pointertype:=tt;
-        is_far:=true;
-        savesize:=target_os.size_of_pointer;
-        pointertypeis_forwarddef:=assigned(pointertype.def) and (pointertype.def^.deftype=forwarddef);
-      end;
-
-
-    constructor tpointerdef.initdef(p : pdef);
-      var
-        t : ttype;
-      begin
-        t.setdef(p);
-        tpointerdef.init(t);
-      end;
-
-
-    constructor tpointerdef.initfardef(p : pdef);
-      var
-        t : ttype;
-      begin
-        t.setdef(p);
-        tpointerdef.initfar(t);
-      end;
-
-
-
-    constructor tpointerdef.load;
-      begin
-         tdef.load;
-         deftype:=pointerdef;
-         pointertype.load;
-         is_far:=(readbyte<>0);
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    destructor tpointerdef.done;
-      begin
-        if {assigned(pointertype.def) and
-           (pointertype.def^.deftype=forwarddef)} pointertypeis_forwarddef then
-         begin
-           dispose(pointertype.def,done);
-           pointertype.reset;
-         end;
-        inherited done;
-      end;
-
-
-    procedure tpointerdef.deref;
-      begin
-        inherited deref;
-        pointertype.resolve;
-      end;
-
-
-    procedure tpointerdef.write;
-      begin
-         inherited write;
-         pointertype.write;
-         writebyte(byte(is_far));
-         current_ppu^.writeentry(ibpointerdef);
-      end;
-
-
-{$ifdef GDB}
-    function tpointerdef.stabstring : pchar;
-      begin
-        stabstring := strpnew('*'+pointertype.def^.numberstring);
-      end;
-
-
-    procedure tpointerdef.concatstabto(asmlist : paasmoutput);
-      var st,nb : string;
-          sym_line_no : longint;
-      begin
-      if assigned(pointertype.def) and
-         (pointertype.def^.deftype=forwarddef) then
-        exit;
-
-      if ( (typesym=nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
-         (is_def_stab_written = not_written) then
-        begin
-          is_def_stab_written := being_written;
-        if assigned(pointertype.def) and
-           (pointertype.def^.deftype in [recorddef,objectdef]) then
-          begin
-            nb:=pointertype.def^.numberstring;
-            {to avoid infinite recursion in record with next-like fields }
-            if pointertype.def^.is_def_stab_written = being_written then
-              begin
-                if assigned(pointertype.def^.typesym) then
-                  begin
-                    if assigned(typesym) then
-                      begin
-                         st := typesym^.name;
-                         sym_line_no:=typesym^.fileinfo.line;
-                      end
-                    else
-                      begin
-                         st := ' ';
-                         sym_line_no:=0;
-                      end;
-                    st := '"'+st+':t'+numberstring+'=*'+nb
-                          +'=xs'+pointertype.def^.typesym^.name+':",'+tostr(N_LSYM)+',0,'+tostr(sym_line_no)+',0';
-                    asmlist^.concat(new(pai_stabs,init(strpnew(st))));
-                    end;
-              end
-            else
-              begin
-                is_def_stab_written := not_written;
-                inherited concatstabto(asmlist);
-              end;
-            is_def_stab_written := written;
-          end
-        else
-          begin
-            if assigned(pointertype.def) then
-              forcestabto(asmlist,pointertype.def);
-            is_def_stab_written := not_written;
-            inherited concatstabto(asmlist);
-          end;
-        end;
-      end;
-{$endif GDB}
-
-    function tpointerdef.gettypename : string;
-
-      begin
-         gettypename:='^'+pointertype.def^.typename;
-      end;
-
-{****************************************************************************
-                              TCLASSREFDEF
-****************************************************************************}
-
-    constructor tclassrefdef.init(def : pdef);
-      begin
-         inherited initdef(def);
-         deftype:=classrefdef;
-      end;
-
-
-    constructor tclassrefdef.load;
-      begin
-         { be careful, tclassdefref inherits from tpointerdef }
-         tdef.load;
-         deftype:=classrefdef;
-         pointertype.load;
-         is_far:=false;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    procedure tclassrefdef.write;
-      begin
-         { be careful, tclassdefref inherits from tpointerdef }
-         tdef.write;
-         pointertype.write;
-         current_ppu^.writeentry(ibclassrefdef);
-      end;
-
-
-{$ifdef GDB}
-    function tclassrefdef.stabstring : pchar;
-      begin
-         stabstring:=strpnew(pvmtdef^.numberstring+';');
-      end;
-
-
-    procedure tclassrefdef.concatstabto(asmlist : paasmoutput);
-      begin
-        inherited concatstabto(asmlist);
-      end;
-{$endif GDB}
-
-    function tclassrefdef.gettypename : string;
-
-      begin
-         gettypename:='Class Of '+pointertype.def^.typename;
-      end;
-
-
-{***************************************************************************
-                                   TSETDEF
-***************************************************************************}
-
-{ For i386 smallsets work,
-  for m68k there are problems
-  can be test by compiling with -dusesmallset PM }
-{$ifdef i386}
-{$define usesmallset}
-{$endif i386}
-
-    constructor tsetdef.init(s : pdef;high : longint);
-      begin
-         inherited init;
-         deftype:=setdef;
-         elementtype.setdef(s);
-{$ifdef usesmallset}
-         { small sets only working for i386 PM }
-         if high<32 then
-           begin
-            settype:=smallset;
-           {$ifdef testvarsets}
-            if aktsetalloc=0 THEN      { $PACKSET Fixed?}
-           {$endif}
-            savesize:=Sizeof(longint)
-           {$ifdef testvarsets}
-           else                       {No, use $PACKSET VALUE for rounding}
-            savesize:=aktsetalloc*((high+aktsetalloc*8-1) DIV (aktsetalloc*8))
-           {$endif}
-              ;
-          end
-         else
-{$endif usesmallset}
-         if high<256 then
-           begin
-              settype:=normset;
-              savesize:=32;
-           end
-         else
-{$ifdef testvarsets}
-         if high<$10000 then
-           begin
-              settype:=varset;
-              savesize:=4*((high+31) div 32);
-           end
-         else
-{$endif testvarsets}
-          Message(sym_e_ill_type_decl_set);
-      end;
-
-
-    constructor tsetdef.load;
-      begin
-         inherited load;
-         deftype:=setdef;
-         elementtype.load;
-         settype:=tsettype(readbyte);
-         case settype of
-            normset : savesize:=32;
-            varset : savesize:=readlong;
-            smallset : savesize:=Sizeof(longint);
-         end;
-      end;
-
-
-    destructor tsetdef.done;
-      begin
-        inherited done;
-      end;
-
-
-    procedure tsetdef.write;
-      begin
-         inherited write;
-         elementtype.write;
-         writebyte(byte(settype));
-         if settype=varset then
-           writelong(savesize);
-         current_ppu^.writeentry(ibsetdef);
-      end;
-
-
-{$ifdef GDB}
-    function tsetdef.stabstring : pchar;
-      begin
-         { For small sets write a longint, which can at least be seen
-           in the current GDB's (PFV)
-           this is obsolete with GDBPAS !!
-           and anyhow creates problems with version 4.18!! PM
-         if settype=smallset then
-           stabstring := strpnew('r'+s32bitdef^.numberstring+';0;0xffffffff;')
-         else }
-           stabstring := strpnew('S'+elementtype.def^.numberstring);
-      end;
-
-
-    procedure tsetdef.concatstabto(asmlist : paasmoutput);
-      begin
-      if ( not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
-          (is_def_stab_written = not_written) then
-        begin
-          if assigned(elementtype.def) then
-            forcestabto(asmlist,elementtype.def);
-          inherited concatstabto(asmlist);
-        end;
-      end;
-{$endif GDB}
-
-
-    procedure tsetdef.deref;
-      begin
-        inherited deref;
-        elementtype.resolve;
-      end;
-
-
-    procedure tsetdef.write_rtti_data;
-      begin
-         rttilist^.concat(new(pai_const,init_8bit(tkSet)));
-         write_rtti_name;
-         rttilist^.concat(new(pai_const,init_8bit(otULong)));
-         rttilist^.concat(new(pai_const_symbol,initname(elementtype.def^.get_rtti_label)));
-      end;
-
-
-    procedure tsetdef.write_child_rtti_data;
-      begin
-         elementtype.def^.get_rtti_label;
-      end;
-
-
-    function tsetdef.is_publishable : boolean;
-      begin
-         is_publishable:=settype=smallset;
-      end;
-
-    function tsetdef.gettypename : string;
-
-      begin
-         if assigned(elementtype.def) then
-          gettypename:='Set Of '+elementtype.def^.typename
-         else
-          gettypename:='Empty Set';
-      end;
-
-
-{***************************************************************************
-                                 TFORMALDEF
-***************************************************************************}
-
-    constructor tformaldef.init;
-      var
-         stregdef : boolean;
-      begin
-         stregdef:=registerdef;
-         registerdef:=false;
-         inherited init;
-         deftype:=formaldef;
-         registerdef:=stregdef;
-         { formaldef must be registered at unit level !! }
-         if registerdef and assigned(current_module) then
-            if assigned(current_module^.localsymtable) then
-              psymtable(current_module^.localsymtable)^.registerdef(@self)
-            else if assigned(current_module^.globalsymtable) then
-              psymtable(current_module^.globalsymtable)^.registerdef(@self);
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    constructor tformaldef.load;
-      begin
-         inherited load;
-         deftype:=formaldef;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    procedure tformaldef.write;
-      begin
-         inherited write;
-         current_ppu^.writeentry(ibformaldef);
-      end;
-
-
-{$ifdef GDB}
-    function tformaldef.stabstring : pchar;
-      begin
-      stabstring := strpnew('formal'+numberstring+';');
-      end;
-
-
-    procedure tformaldef.concatstabto(asmlist : paasmoutput);
-      begin
-      { formaldef can't be stab'ed !}
-      end;
-{$endif GDB}
-
-    function tformaldef.gettypename : string;
-
-      begin
-         gettypename:='Var';
-      end;
-
-{***************************************************************************
-                           TARRAYDEF
-***************************************************************************}
-
-    constructor tarraydef.init(l,h : longint;rd : pdef);
-      begin
-         inherited init;
-         deftype:=arraydef;
-         lowrange:=l;
-         highrange:=h;
-         rangetype.setdef(rd);
-         elementtype.reset;
-         IsVariant:=false;
-         IsConstructor:=false;
-         IsArrayOfConst:=false;
-         IsDynamicArray:=false;
-         rangenr:=0;
-      end;
-
-
-    constructor tarraydef.load;
-      begin
-         inherited load;
-         deftype:=arraydef;
-         { the addresses are calculated later }
-         elementtype.load;
-         rangetype.load;
-         lowrange:=readlong;
-         highrange:=readlong;
-         IsArrayOfConst:=boolean(readbyte);
-         IsVariant:=false;
-         IsConstructor:=false;
-{$warning FIXME!!!!!}
-         IsDynamicArray:=false;
-         rangenr:=0;
-      end;
-
-
-    function tarraydef.getrangecheckstring : string;
-      begin
-         if (cs_create_smart in aktmoduleswitches) then
-           getrangecheckstring:='R_'+current_module^.modulename^+tostr(rangenr)
-         else
-           getrangecheckstring:='R_'+tostr(rangenr);
-      end;
-
-
-    procedure tarraydef.genrangecheck;
-      begin
-         if rangenr=0 then
-           begin
-              { generates the data for range checking }
-              getlabelnr(rangenr);
-              if (cs_create_smart in aktmoduleswitches) then
-                datasegment^.concat(new(pai_symbol,initname_global(getrangecheckstring,8)))
-              else
-                datasegment^.concat(new(pai_symbol,initname(getrangecheckstring,8)));
-              if lowrange<=highrange then
-                begin
-                  datasegment^.concat(new(pai_const,init_32bit(lowrange)));
-                  datasegment^.concat(new(pai_const,init_32bit(highrange)));
-                end
-              { for big arrays we need two bounds }
-              else
-                begin
-                  datasegment^.concat(new(pai_const,init_32bit(lowrange)));
-                  datasegment^.concat(new(pai_const,init_32bit($7fffffff)));
-                  datasegment^.concat(new(pai_const,init_32bit($80000000)));
-                  datasegment^.concat(new(pai_const,init_32bit(highrange)));
-                end;
-           end;
-      end;
-
-
-    procedure tarraydef.deref;
-      begin
-        inherited deref;
-        elementtype.resolve;
-        rangetype.resolve;
-      end;
-
-
-    procedure tarraydef.write;
-      begin
-         inherited write;
-         elementtype.write;
-         rangetype.write;
-         writelong(lowrange);
-         writelong(highrange);
-         writebyte(byte(IsArrayOfConst));
-         current_ppu^.writeentry(ibarraydef);
-      end;
-
-
-{$ifdef GDB}
-    function tarraydef.stabstring : pchar;
-      begin
-      stabstring := strpnew('ar'+rangetype.def^.numberstring+';'
-                    +tostr(lowrange)+';'+tostr(highrange)+';'+elementtype.def^.numberstring);
-      end;
-
-
-    procedure tarraydef.concatstabto(asmlist : paasmoutput);
-      begin
-      if (not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches))
-        and (is_def_stab_written = not_written) then
-        begin
-        {when array are inserted they have no definition yet !!}
-        if assigned(elementtype.def) then
-          inherited concatstabto(asmlist);
-        end;
-      end;
-{$endif GDB}
-
-
-    function tarraydef.elesize : longint;
-      begin
-        if isconstructor or is_open_array(@self) then
-         begin
-           { strings are stored by address only }
-           case elementtype.def^.deftype of
-             stringdef :
-               elesize:=4;
-             else
-               elesize:=elementtype.def^.size;
-           end;
-         end
-        else
-         elesize:=elementtype.def^.size;
-      end;
-
-
-    function tarraydef.size : longint;
-      begin
-        {Tarraydef.size may never be called for an open array!}
-        if IsDynamicArray then
-          begin
-             size:=4;
-             exit;
-          end;
-        if highrange<lowrange then
-            internalerror(99080501);
-        If (elesize>0) and
-           (
-            (highrange-lowrange = $7fffffff) or
-            { () are needed around elesize-1 to avoid a possible
-              integer overflow for elesize=1 !! PM }
-            (($7fffffff div elesize + (elesize -1)) < (highrange - lowrange))
-           ) Then
-          Begin
-            Message(sym_e_segment_too_large);
-            size := 4
-          End
-        Else size:=(highrange-lowrange+1)*elesize;
-      end;
-
-
-    function tarraydef.alignment : longint;
-      begin
-         { alignment is the size of the elements }
-         if elementtype.def^.deftype=recorddef then
-          alignment:=elementtype.def^.alignment
-         else
-          alignment:=elesize;
-      end;
-
-
-    function tarraydef.needs_inittable : boolean;
-      begin
-         needs_inittable:=IsDynamicArray or elementtype.def^.needs_inittable;
-      end;
-
-
-    procedure tarraydef.write_child_rtti_data;
-      begin
-         elementtype.def^.get_rtti_label;
-      end;
-
-
-    procedure tarraydef.write_rtti_data;
-      begin
-         if IsDynamicArray then
-           rttilist^.concat(new(pai_const,init_8bit(tkdynarray)))
-         else
-           rttilist^.concat(new(pai_const,init_8bit(tkarray)));
-         write_rtti_name;
-         { size of elements }
-         rttilist^.concat(new(pai_const,init_32bit(elesize)));
-         { count of elements }
-         if not(IsDynamicArray) then
-           rttilist^.concat(new(pai_const,init_32bit(highrange-lowrange+1)));
-         { element type }
-         rttilist^.concat(new(pai_const_symbol,initname(elementtype.def^.get_rtti_label)));
-         { variant type }
-         // !!!!!!!!!!!!!!!!
-      end;
-
-    function tarraydef.gettypename : string;
-
-      begin
-         if isarrayofconst or isConstructor then
-           begin
-             if isvariant or ((highrange=-1) and (lowrange=0)) then
-               gettypename:='Array Of Const'
-             else
-               gettypename:='Array Of '+elementtype.def^.typename;
-           end
-         else if is_open_array(@self) or IsDynamicArray then
-           gettypename:='Array Of '+elementtype.def^.typename
-         else
-           begin
-              if rangetype.def^.deftype=enumdef then
-                gettypename:='Array['+rangetype.def^.typename+'] Of '+elementtype.def^.typename
-              else
-                gettypename:='Array['+tostr(lowrange)+'..'+
-                  tostr(highrange)+'] Of '+elementtype.def^.typename
-           end;
-      end;
-
-{***************************************************************************
-                                  trecorddef
-***************************************************************************}
-
-    constructor trecorddef.init(p : psymtable);
-      begin
-         inherited init;
-         deftype:=recorddef;
-         symtable:=p;
-         symtable^.defowner := @self;
-         symtable^.dataalignment:=packrecordalignment[aktpackrecords];
-      end;
-
-
-    constructor trecorddef.load;
-      var
-         oldread_member : boolean;
-      begin
-         inherited load;
-         deftype:=recorddef;
-         savesize:=readlong;
-         oldread_member:=read_member;
-         read_member:=true;
-         symtable:=new(psymtable,loadas(recordsymtable));
-         read_member:=oldread_member;
-         symtable^.defowner := @self;
-      end;
-
-
-    destructor trecorddef.done;
-      begin
-         if assigned(symtable) then
-           dispose(symtable,done);
-         inherited done;
-      end;
-
-
-    var
-       binittable : boolean;
-
-    procedure check_rec_inittable(s : pnamedindexobject);
-
-      begin
-         if (not binittable) and
-            (psym(s)^.typ=varsym) and
-            assigned(pvarsym(s)^.vartype.def) then
-          begin
-            if (pvarsym(s)^.vartype.def^.deftype<>objectdef) or
-               not is_class(pvarsym(s)^.vartype.def) then
-             binittable:=pvarsym(s)^.vartype.def^.needs_inittable;
-          end;
-      end;
-
-
-    function trecorddef.needs_inittable : boolean;
-      var
-         oldb : boolean;
-      begin
-         { there are recursive calls to needs_rtti possible, }
-         { so we have to change to old value how else should }
-         { we do that ? check_rec_rtti can't be a nested     }
-         { procedure of needs_rtti !                         }
-         oldb:=binittable;
-         binittable:=false;
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}check_rec_inittable);
-         needs_inittable:=binittable;
-         binittable:=oldb;
-      end;
-
-
-    procedure trecorddef.deref;
-      var
-         oldrecsyms : psymtable;
-      begin
-         inherited deref;
-         oldrecsyms:=aktrecordsymtable;
-         aktrecordsymtable:=symtable;
-         { now dereference the definitions }
-         symtable^.deref;
-         aktrecordsymtable:=oldrecsyms;
-      end;
-
-
-    procedure trecorddef.write;
-      var
-         oldread_member : boolean;
-      begin
-         oldread_member:=read_member;
-         read_member:=true;
-         inherited write;
-         writelong(savesize);
-         current_ppu^.writeentry(ibrecorddef);
-         self.symtable^.writeas;
-         read_member:=oldread_member;
-      end;
-
-    function trecorddef.size:longint;
-      begin
-        size:=symtable^.datasize;
-      end;
-
-
-    function trecorddef.alignment:longint;
-      var
-        l  : longint;
-        hp : pvarsym;
-      begin
-        { also check the first symbol for it's size, because a
-          packed record has dataalignment of 1, but the first
-          sym could be a longint which should be aligned on 4 bytes,
-          this is compatible with C record packing (PFV) }
-        hp:=pvarsym(symtable^.symindex^.first);
-        if assigned(hp) then
-         begin
-           l:=hp^.vartype.def^.size;
-           if l>symtable^.dataalignment then
-            begin
-              if l>=4 then
-               alignment:=4
-              else
-               if l>=2 then
-                alignment:=2
-              else
-               alignment:=1;
-            end
-           else
-            alignment:=symtable^.dataalignment;
-         end
-        else
-         alignment:=symtable^.dataalignment;
-      end;
-
-{$ifdef GDB}
-    Const StabRecString : pchar = Nil;
-          StabRecSize : longint = 0;
-          RecOffset : Longint = 0;
-
-    procedure addname(p : pnamedindexobject);
-    var
-      news, newrec : pchar;
-      spec : string[3];
-      size : longint;
-    begin
-    { static variables from objects are like global objects }
-    if (sp_static in psym(p)^.symoptions) then
-      exit;
-    If psym(p)^.typ = varsym then
-       begin
-         if (sp_protected in psym(p)^.symoptions) then
-           spec:='/1'
-         else if (sp_private in psym(p)^.symoptions) then
-           spec:='/0'
-         else
-           spec:='';
-         if not assigned(pvarsym(p)^.vartype.def) then
-          writeln(pvarsym(p)^.name);
-         { class fields are pointers PM, obsolete now PM }
-         {if (pvarsym(p)^.vartype.def^.deftype=objectdef) and
-            pobjectdef(pvarsym(p)^.vartype.def)^.is_class then
-            spec:=spec+'*'; }
-         size:=pvarsym(p)^.vartype.def^.size;
-         { open arrays made overflows !! }
-         if size>$fffffff then
-           size:=$fffffff;
-         newrec := strpnew(p^.name+':'+spec+pvarsym(p)^.vartype.def^.numberstring
-                       +','+tostr(pvarsym(p)^.address*8)+','
-                       +tostr(size*8)+';');
-         if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
-           begin
-              getmem(news,stabrecsize+memsizeinc);
-              strcopy(news,stabrecstring);
-              freemem(stabrecstring,stabrecsize);
-              stabrecsize:=stabrecsize+memsizeinc;
-              stabrecstring:=news;
-           end;
-         strcat(StabRecstring,newrec);
-         strdispose(newrec);
-         {This should be used for case !!}
-         RecOffset := RecOffset + pvarsym(p)^.vartype.def^.size;
-       end;
-    end;
-
-
-    function trecorddef.stabstring : pchar;
-      Var oldrec : pchar;
-          oldsize : longint;
-      begin
-        oldrec := stabrecstring;
-        oldsize:=stabrecsize;
-        GetMem(stabrecstring,memsizeinc);
-        stabrecsize:=memsizeinc;
-        strpcopy(stabRecString,'s'+tostr(size));
-        RecOffset := 0;
-        symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}addname);
-        { FPC doesn't want to convert a char to a pchar}
-        { is this a bug ? }
-        strpcopy(strend(StabRecString),';');
-        stabstring := strnew(StabRecString);
-        Freemem(stabrecstring,stabrecsize);
-        stabrecstring := oldrec;
-        stabrecsize:=oldsize;
-      end;
-
-
-    procedure trecorddef.concatstabto(asmlist : paasmoutput);
-      begin
-        if (not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
-           (is_def_stab_written = not_written)  then
-          inherited concatstabto(asmlist);
-      end;
-
-{$endif GDB}
-
-    var
-       count : longint;
-
-    procedure count_inittable_fields(sym : pnamedindexobject);
-      begin
-         if ((psym(sym)^.typ=varsym) and
-            pvarsym(sym)^.vartype.def^.needs_inittable)
-            and ((pvarsym(sym)^.vartype.def^.deftype<>objectdef) or
-                  not(is_class(pvarsym(sym)^.vartype.def))) then
-           inc(count);
-      end;
-
-
-    procedure count_fields(sym : pnamedindexobject);
-      begin
-            inc(count);
-      end;
-
-
-    procedure write_field_inittable(sym : pnamedindexobject);
-      begin
-         if ((psym(sym)^.typ=varsym) and
-            pvarsym(sym)^.vartype.def^.needs_inittable) and
-            ((pvarsym(sym)^.vartype.def^.deftype<>objectdef) or
-             not(is_class(pvarsym(sym)^.vartype.def))) then
-           begin
-              rttilist^.concat(new(pai_const_symbol,init(pvarsym(sym)^.vartype.def^.get_inittable_label)));
-              rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
-           end;
-      end;
-
-
-    procedure write_field_rtti(sym : pnamedindexobject);
-      begin
-         rttilist^.concat(new(pai_const_symbol,initname(pvarsym(sym)^.vartype.def^.get_rtti_label)));
-         rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
-      end;
-
-
-    procedure generate_child_inittable(sym:pnamedindexobject);
-      begin
-         if (psym(sym)^.typ=varsym) and
-            pvarsym(sym)^.vartype.def^.needs_inittable then
-         { force inittable generation }
-           pvarsym(sym)^.vartype.def^.get_inittable_label;
-      end;
-
-
-    procedure generate_child_rtti(sym : pnamedindexobject);
-      begin
-         pvarsym(sym)^.vartype.def^.get_rtti_label;
-      end;
-
-
-    procedure trecorddef.write_child_rtti_data;
-      begin
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}generate_child_rtti);
-      end;
-
-
-    procedure trecorddef.write_child_init_data;
-      begin
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}generate_child_inittable);
-      end;
-
-
-    procedure trecorddef.write_rtti_data;
-      begin
-         rttilist^.concat(new(pai_const,init_8bit(tkrecord)));
-         write_rtti_name;
-         rttilist^.concat(new(pai_const,init_32bit(size)));
-         count:=0;
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_fields);
-         rttilist^.concat(new(pai_const,init_32bit(count)));
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}write_field_rtti);
-      end;
-
-
-    procedure trecorddef.write_init_data;
-      begin
-         rttilist^.concat(new(pai_const,init_8bit(tkrecord)));
-         write_rtti_name;
-         rttilist^.concat(new(pai_const,init_32bit(size)));
-         count:=0;
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_inittable_fields);
-         rttilist^.concat(new(pai_const,init_32bit(count)));
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}write_field_inittable);
-      end;
-
-    function trecorddef.gettypename : string;
-
-      begin
-         gettypename:='<record type>'
-      end;
-
-
-{***************************************************************************
-                       TABSTRACTPROCDEF
-***************************************************************************}
-
-    constructor tabstractprocdef.init;
-      begin
-         inherited init;
-         new(para,init);
-         minparacount:=0;
-         maxparacount:=0;
-         fpu_used:=0;
-         proctypeoption:=potype_none;
-         proccalloptions:=[];
-         procoptions:=[];
-         rettype.setdef(voiddef);
-         symtablelevel:=0;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
-    destructor tabstractprocdef.done;
-      begin
-         dispose(para,done);
-         inherited done;
-      end;
-
-
-    procedure tabstractprocdef.concatpara(tt:ttype;vsp : tvarspez;defval:psym);
-      var
-        hp : pparaitem;
-      begin
-        new(hp,init);
-        hp^.paratyp:=vsp;
-        hp^.paratype:=tt;
-        hp^.register:=R_NO;
-        hp^.defaultvalue:=defval;
-        para^.insert(hp);
-        if not assigned(defval) then
-         inc(minparacount);
-        inc(maxparacount);
-      end;
-
-
-    { all functions returning in FPU are
-      assume to use 2 FPU registers
-      until the function implementation
-      is processed   PM }
-    procedure tabstractprocdef.test_if_fpu_result;
-      begin
-         if assigned(rettype.def) and is_fpu(rettype.def) then
-           fpu_used:=2;
-      end;
-
-
-    procedure tabstractprocdef.deref;
-      var
-         hp : pparaitem;
-      begin
-         inherited deref;
-         rettype.resolve;
-         hp:=pparaitem(para^.first);
-         while assigned(hp) do
-          begin
-            hp^.paratype.resolve;
-            resolvesym(psym(hp^.defaultvalue));
-            hp:=pparaitem(hp^.next);
-          end;
-      end;
-
-
-    constructor tabstractprocdef.load;
-      var
-         hp : pparaitem;
-         count,i : word;
-      begin
-         inherited load;
-         new(para,init);
-         minparacount:=0;
-         maxparacount:=0;
-         rettype.load;
-         fpu_used:=readbyte;
-         proctypeoption:=tproctypeoption(readlong);
-         readsmallset(proccalloptions,sizeof(proccalloptions));
-         readsmallset(procoptions,sizeof(procoptions));
-         count:=readword;
-         savesize:=target_os.size_of_pointer;
-         for i:=1 to count do
-          begin
-            new(hp,init);
-            hp^.paratyp:=tvarspez(readbyte);
-            { hp^.register:=tregister(readbyte); }
-            hp^.register:=R_NO;
-            hp^.paratype.load;
-            hp^.defaultvalue:=readsymref;
-            if not assigned(hp^.defaultvalue) then
-             inc(minparacount);
-            inc(maxparacount);
-            para^.concat(hp);
-          end;
-      end;
-
-
-    procedure tabstractprocdef.write;
-      var
-        hp : pparaitem;
-        oldintfcrc : boolean;
-      begin
-         inherited write;
-         rettype.write;
-         oldintfcrc:=current_ppu^.do_interface_crc;
-         current_ppu^.do_interface_crc:=false;
-         writebyte(fpu_used);
-         writelong(ord(proctypeoption));
-         writesmallset(proccalloptions,sizeof(proccalloptions));
-         writesmallset(procoptions,sizeof(procoptions));
-         current_ppu^.do_interface_crc:=oldintfcrc;
-         writeword(maxparacount);
-         hp:=pparaitem(para^.first);
-         while assigned(hp) do
-          begin
-            writebyte(byte(hp^.paratyp));
-            { writebyte(byte(hp^.register)); }
-            hp^.paratype.write;
-            writesymref(hp^.defaultvalue);
-            hp:=pparaitem(hp^.next);
-          end;
-      end;
-
-
-    function tabstractprocdef.para_size(alignsize:longint) : longint;
-      var
-         pdc : pparaitem;
-         l : longint;
-      begin
-         l:=0;
-         pdc:=pparaitem(para^.first);
-         while assigned(pdc) do
-          begin
-            case pdc^.paratyp of
-              vs_out,
-              vs_var   : inc(l,target_os.size_of_pointer);
-              vs_value,
-              vs_const : if push_addr_param(pdc^.paratype.def) then
-                          inc(l,target_os.size_of_pointer)
-                         else
-                          inc(l,pdc^.paratype.def^.size);
-            end;
-            l:=align(l,alignsize);
-            pdc:=pparaitem(pdc^.next);
-          end;
-         para_size:=l;
-      end;
-
-
-    function tabstractprocdef.demangled_paras : string;
-      var
-        hs,s : string;
-        hp : pparaitem;
-        hpc : pconstsym;
-      begin
-        s:='(';
-        hp:=pparaitem(para^.last);
-        while assigned(hp) do
-         begin
-           if assigned(hp^.paratype.def^.typesym) then
-             s:=s+hp^.paratype.def^.typesym^.name
-           else if hp^.paratyp=vs_out then
-             s:=s+'out'
-           else if hp^.paratyp=vs_var then
-             s:=s+'var'
-           else if hp^.paratyp=vs_const then
-             s:=s+'const'
-           else if hp^.paratyp=vs_out then
-             s:=s+'out';
-           { default value }
-           if assigned(hp^.defaultvalue) then
-            begin
-              hpc:=pconstsym(hp^.defaultvalue);
-              hs:='';
-              case hpc^.consttyp of
-                conststring,
-                constresourcestring :
-                  hs:=strpas(pchar(tpointerord(hpc^.value)));
-                constreal :
-                  str(pbestreal(tpointerord(hpc^.value))^,hs);
-                constord,
-                constpointer :
-                  hs:=tostr(hpc^.value);
-                constbool :
-                  begin
-                    if hpc^.value<>0 then
-                     hs:='TRUE'
-                    else
-                     hs:='FALSE';
-                  end;
-                constnil :
-                  hs:='nil';
-                constchar :
-                  hs:=chr(hpc^.value);
-                constset :
-                  hs:='<set>';
-              end;
-              if hs<>'' then
-               s:=s+'="'+hs+'"';
-            end;
-           hp:=pparaitem(hp^.previous);
-           if assigned(hp) then
-            s:=s+',';
-         end;
-        s:=s+')';
-        demangled_paras:=s;
-      end;
-
-
-    function tabstractprocdef.proccalloption2str : string;
-      type
-        tproccallopt=record
-          mask : tproccalloption;
-          str  : string[30];
-        end;
-      const
-        proccallopts=13;
-        proccallopt : array[1..proccallopts] of tproccallopt=(
-           (mask:pocall_none;         str:''),
-           (mask:pocall_clearstack;   str:'ClearStack'),
-           (mask:pocall_leftright;    str:'LeftRight'),
-           (mask:pocall_cdecl;        str:'CDecl'),
-           (mask:pocall_register;     str:'Register'),
-           (mask:pocall_stdcall;      str:'StdCall'),
-           (mask:pocall_safecall;     str:'SafeCall'),
-           (mask:pocall_palmossyscall;str:'PalmOSSysCall'),
-           (mask:pocall_system;       str:'System'),
-           (mask:pocall_inline;       str:'Inline'),
-           (mask:pocall_internproc;   str:'InternProc'),
-           (mask:pocall_internconst;  str:'InternConst'),
-           (mask:pocall_cdecl;        str:'CPPDecl')
-        );
-      var
-        s : string;
-        i : longint;
-        first : boolean;
-      begin
-        s:='';
-        first:=true;
-        for i:=1to proccallopts do
-         if (proccallopt[i].mask in proccalloptions) then
-          begin
-            if first then
-              first:=false
-            else
-              s:=s+';';
-            s:=s+proccallopt[i].str;
-          end;
-        proccalloption2str:=s;
-      end;
-
-
-{$ifdef GDB}
-    function tabstractprocdef.stabstring : pchar;
-      begin
-        stabstring := strpnew('abstractproc'+numberstring+';');
-      end;
-
-
-    procedure tabstractprocdef.concatstabto(asmlist : paasmoutput);
-      begin
-         if (not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches))
-            and (is_def_stab_written = not_written)  then
-           begin
-              if assigned(rettype.def) then forcestabto(asmlist,rettype.def);
-              inherited concatstabto(asmlist);
-           end;
-      end;
-{$endif GDB}
-
-
-{***************************************************************************
-                                  TPROCDEF
-***************************************************************************}
-
-    constructor tprocdef.init;
-      begin
-         inherited init;
-         deftype:=procdef;
-         _mangledname:=nil;
-         nextoverloaded:=nil;
-         fileinfo:=aktfilepos;
-         extnumber:=-1;
-         localst:=new(psymtable,init(localsymtable));
-         parast:=new(psymtable,init(parasymtable));
-         localst^.defowner:=@self;
-         parast^.defowner:=@self;
-         { this is used by insert
-          to check same names in parast and localst }
-         localst^.next:=parast;
-         defref:=nil;
-         crossref:=nil;
-         lastwritten:=nil;
-         refcount:=0;
-         if (cs_browser in aktmoduleswitches) and make_ref then
-          begin
-            defref:=new(pref,init(defref,@tokenpos));
-            inc(refcount);
-          end;
-         lastref:=defref;
-       { first, we assume that all registers are used }
-{$ifdef newcg}
-         usedregisters:=[firstreg..lastreg];
-{$else newcg}
-{$ifdef i386}
-         usedregisters:=$ff;
-{$endif i386}
-{$ifdef m68k}
-         usedregisters:=$FFFF;
-{$endif}
-{$endif newcg}
-         forwarddef:=true;
-         interfacedef:=false;
-         hasforward:=false;
-         _class := nil;
-         code:=nil;
-         regvarinfo := nil;
-         count:=false;
-         is_used:=false;
-      end;
-
-
-    constructor tprocdef.load;
-      begin
-         inherited load;
-         deftype:=procdef;
-
-{$ifdef newcg}
-         readnormalset(usedregisters);
-{$else newcg}
-{$ifdef i386}
-         usedregisters:=readbyte;
-{$endif i386}
-{$ifdef m68k}
-         usedregisters:=readword;
-{$endif}
-{$endif newcg}
-         _mangledname:=stringdup(readstring);
-
-         extnumber:=readlong;
-         nextoverloaded:=pprocdef(readdefref);
-         _class := pobjectdef(readdefref);
-         readposinfo(fileinfo);
-
-         procsym:=pprocsym(readsymref);
-
-         if (cs_link_deffile in aktglobalswitches) and
-            (tf_need_export in target_info.flags) and
-            (po_exports in procoptions) then
-           deffile.AddExport(mangledname);
-
-         new(parast,loadas(parasymtable));
-         parast^.defowner:=@self;
-         {new(localst,loadas(localsymtable));
-         localst^.defowner:=@self;
-         parast^.next:=localst;
-         localst^.next:=owner;}
-
-         forwarddef:=false;
-         interfacedef:=false;
-         hasforward:=false;
-         code := nil;
-         regvarinfo := nil;
-         lastref:=nil;
-         lastwritten:=nil;
-         defref:=nil;
-         refcount:=0;
-         count:=true;
-         is_used:=false;
-      end;
-
-
-Const local_symtable_index : longint = $8001;
-
-    procedure tprocdef.load_references;
-      var
-        pos : tfileposinfo;
-{$ifndef NOLOCALBROWSER}
-        oldsymtablestack,
-        st : psymtable;
-{$endif ndef NOLOCALBROWSER}
-        move_last : boolean;
-      begin
-        move_last:=lastwritten=lastref;
-        while (not current_ppu^.endofentry) do
-         begin
-           readposinfo(pos);
-           inc(refcount);
-           lastref:=new(pref,init(lastref,@pos));
-           lastref^.is_written:=true;
-           if refcount=1 then
-            defref:=lastref;
-         end;
-        if move_last then
-          lastwritten:=lastref;
-        if ((current_module^.flags and uf_local_browser)<>0)
-           and is_in_current then
-          begin
-{$ifndef NOLOCALBROWSER}
-             oldsymtablestack:=symtablestack;
-             st:=aktlocalsymtable;
-             new(parast,loadas(parasymtable));
-             parast^.defowner:=@self;
-             aktlocalsymtable:=parast;
-             parast^.deref;
-             parast^.next:=owner;
-             parast^.load_browser;
-             aktlocalsymtable:=st;
-             new(localst,loadas(localsymtable));
-             localst^.defowner:=@self;
-             aktlocalsymtable:=localst;
-             symtablestack:=parast;
-             localst^.deref;
-             localst^.next:=parast;
-             localst^.load_browser;
-             aktlocalsymtable:=st;
-             symtablestack:=oldsymtablestack;
-{$endif ndef NOLOCALBROWSER}
-          end;
-      end;
-
-
-    function tprocdef.write_references : boolean;
-      var
-        ref : pref;
-{$ifndef NOLOCALBROWSER}
-        st : psymtable;
-        pdo : pobjectdef;
-{$endif ndef NOLOCALBROWSER}
-        move_last : boolean;
-      begin
-        move_last:=lastwritten=lastref;
-        if move_last and (((current_module^.flags and uf_local_browser)=0)
-           or not is_in_current) then
-          exit;
-      { write address of this symbol }
-        writedefref(@self);
-      { write refs }
-        if assigned(lastwritten) then
-          ref:=lastwritten
-        else
-          ref:=defref;
-        while assigned(ref) do
-         begin
-           if ref^.moduleindex=current_module^.unit_index then
-             begin
-                writeposinfo(ref^.posinfo);
-                ref^.is_written:=true;
-                if move_last then
-                  lastwritten:=ref;
-             end
-           else if not ref^.is_written then
-             move_last:=false
-           else if move_last then
-             lastwritten:=ref;
-           ref:=ref^.nextref;
-         end;
-        current_ppu^.writeentry(ibdefref);
-        write_references:=true;
-        if ((current_module^.flags and uf_local_browser)<>0)
-           and is_in_current then
-          begin
-{$ifndef NOLOCALBROWSER}
-             pdo:=_class;
-             if (owner^.symtabletype<>localsymtable) then
-               while assigned(pdo) do
-                 begin
-                    if pdo^.symtable<>aktrecordsymtable then
-                      begin
-                         pdo^.symtable^.unitid:=local_symtable_index;
-                         inc(local_symtable_index);
-                      end;
-                    pdo:=pdo^.childof;
-                 end;
-
-             { we need TESTLOCALBROWSER para and local symtables
-               PPU files are then easier to read PM }
-             if not assigned(parast) then
-               parast:=new(psymtable,init(parasymtable));
-             parast^.defowner:=@self;
-             st:=aktlocalsymtable;
-             aktlocalsymtable:=parast;
-             parast^.writeas;
-             parast^.unitid:=local_symtable_index;
-             inc(local_symtable_index);
-             parast^.write_browser;
-             if not assigned(localst) then
-               localst:=new(psymtable,init(localsymtable));
-             localst^.defowner:=@self;
-             aktlocalsymtable:=localst;
-             localst^.writeas;
-             localst^.unitid:=local_symtable_index;
-             inc(local_symtable_index);
-             localst^.write_browser;
-             aktlocalsymtable:=st;
-             { decrement for }
-             local_symtable_index:=local_symtable_index-2;
-             pdo:=_class;
-             if (owner^.symtabletype<>localsymtable) then
-               while assigned(pdo) do
-                 begin
-                    if pdo^.symtable<>aktrecordsymtable then
-                      dec(local_symtable_index);
-                    pdo:=pdo^.childof;
-                 end;
-{$endif ndef NOLOCALBROWSER}
-          end;
-      end;
-
-
-{$ifdef BrowserLog}
-    procedure tprocdef.add_to_browserlog;
-      begin
-         if assigned(defref) then
-          begin
-            browserlog.AddLog('***'+mangledname);
-            browserlog.AddLogRefs(defref);
-            if (current_module^.flags and uf_local_browser)<>0 then
-              begin
-                 if assigned(parast) then
-                   parast^.writebrowserlog;
-                 if assigned(localst) then
-                   localst^.writebrowserlog;
-              end;
-          end;
-      end;
-{$endif BrowserLog}
-
-
-    destructor tprocdef.done;
-      begin
-         if assigned(defref) then
-           begin
-             defref^.freechain;
-             dispose(defref,done);
-           end;
-         if assigned(parast) then
-           dispose(parast,done);
-         if assigned(localst) and (localst^.symtabletype<>staticsymtable) then
-           dispose(localst,done);
-         if (pocall_inline in proccalloptions) and assigned(code) then
-           tnode(code).free;
-         if assigned(regvarinfo) then
-           dispose(pregvarinfo(regvarinfo));
-         if (po_msgstr in procoptions) then
-           strdispose(messageinf.str);
-         if assigned(_mangledname) then
-           stringdispose(_mangledname);
-         inherited done;
-      end;
-
-
-    procedure tprocdef.write;
-      var
-        oldintfcrc : boolean;
-      begin
-         inherited write;
-         oldintfcrc:=current_ppu^.do_interface_crc;
-         current_ppu^.do_interface_crc:=false;
-   { set all registers to used for simplified compilation PM }
-         if simplify_ppu then
-           begin
-{$ifdef newcg}
-             usedregisters:=[firstreg..lastreg];
-{$else newcg}
-{$ifdef i386}
-             usedregisters:=$ff;
-{$endif i386}
-{$ifdef m68k}
-             usedregisters:=$ffff;
-{$endif}
-{$endif newcg}
-           end;
-
-{$ifdef newcg}
-         writenormalset(usedregisters);
-{$else newcg}
-{$ifdef i386}
-         writebyte(usedregisters);
-{$endif i386}
-{$ifdef m68k}
-         writeword(usedregisters);
-{$endif}
-{$endif newcg}
-         current_ppu^.do_interface_crc:=oldintfcrc;
-         writestring(mangledname);
-         writelong(extnumber);
-         if (proctypeoption<>potype_operator) then
-           writedefref(nextoverloaded)
-         else
-           begin
-              { only write the overloads from the same unit }
-              if assigned(nextoverloaded) and
-                 (nextoverloaded^.owner=owner) then
-                writedefref(nextoverloaded)
-              else
-                writedefref(nil);
-           end;
-         writedefref(_class);
-         writeposinfo(fileinfo);
-         writesymref(procsym);
-         if (pocall_inline in proccalloptions) then
-           begin
-              { we need to save
-                - the para and the local symtable
-                - the code ptree !! PM
-               writesymtable(parast);
-               writesymtable(localst);
-               writeptree(ptree(code));
-               }
-           end;
-         current_ppu^.writeentry(ibprocdef);
-
-         { Save the para and local symtable, for easier reading
-           save both always, they don't influence the interface crc }
-         oldintfcrc:=current_ppu^.do_interface_crc;
-         current_ppu^.do_interface_crc:=false;
-         if not assigned(parast) then
-          begin
-            parast:=new(psymtable,init(parasymtable));
-            parast^.defowner:=@self;
-          end;
-         parast^.writeas;
-         {if not assigned(localst) then
-          begin
-            localst:=new(psymtable,init(localsymtable));
-            localst^.defowner:=@self;
-          end;
-         localst^.writeas;}
-         current_ppu^.do_interface_crc:=oldintfcrc;
-      end;
-
-
-    function tprocdef.haspara:boolean;
-      begin
-        haspara:=assigned(aktprocsym^.definition^.parast^.symindex^.first);
-      end;
-
-
-{$ifdef GDB}
-    procedure addparaname(p : psym);
-      var vs : char;
-      begin
-      if pvarsym(p)^.varspez = vs_value then vs := '1'
-        else vs := '0';
-      strpcopy(strend(StabRecString),p^.name+':'+pvarsym(p)^.vartype.def^.numberstring+','+vs+';');
-      end;
-
-
-    function tprocdef.stabstring : pchar;
-      var
-          i : longint;
-          oldrec : pchar;
-      begin
-      oldrec := stabrecstring;
-      getmem(StabRecString,1024);
-      strpcopy(StabRecString,'f'+rettype.def^.numberstring);
-      i:=maxparacount;
-      if i>0 then
-        begin
-        strpcopy(strend(StabRecString),','+tostr(i)+';');
-        (* confuse gdb !! PM
-        if assigned(parast) then
-          parast^.foreach({$ifdef FPCPROCVAR}@{$endif}addparaname)
-          else
-          begin
-          param := para1;
-          i := 0;
-          while assigned(param) do
-            begin
-            inc(i);
-            if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
-            {Here we have lost the parameter names !!}
-            {using lower case parameters }
-            strpcopy(strend(stabrecstring),'p'+tostr(i)
-               +':'+param^.paratype.def^.numberstring+','+vartyp+';');
-            param := param^.next;
-            end;
-          end;   *)
-        {strpcopy(strend(StabRecString),';');}
-        end;
-      stabstring := strnew(stabrecstring);
-      freemem(stabrecstring,1024);
-      stabrecstring := oldrec;
-      end;
-
-
-    procedure tprocdef.concatstabto(asmlist : paasmoutput);
-      begin
-      end;
-{$endif GDB}
-
-
-    procedure tprocdef.deref;
-      var
-        oldsymtablestack,
-        oldlocalsymtable : psymtable;
-      begin
-         inherited deref;
-         resolvedef(pdef(nextoverloaded));
-         resolvedef(pdef(_class));
-         { parast }
-         oldsymtablestack:=symtablestack;
-         oldlocalsymtable:=aktlocalsymtable;
-         aktlocalsymtable:=parast;
-         parast^.deref;
-         {symtablestack:=parast;
-         aktlocalsymtable:=localst;
-         localst^.deref;}
-         aktlocalsymtable:=oldlocalsymtable;
-         symtablestack:=oldsymtablestack;
-      end;
-
-
-    function tprocdef.mangledname : string;
-      begin
-         if assigned(_mangledname) then
-           mangledname:=_mangledname^
-         else
-           mangledname:='';
-         if count then
-           is_used:=true;
-      end;
-
-
-{$ifdef dummy}
-    function tprocdef.procname: string;
-      var
-        s : string;
-        l : longint;
-      begin
-         if assigned(procsym) then
-           begin
-             procname:=procsym^.name;
-             exit;
-           end;
-         s:=mangledname;
-         { delete leading $$'s }
-         l:=pos('$$',s);
-         while l<>0 do
-           begin
-              delete(s,1,l+1);
-              l:=pos('$$',s);
-           end;
-         { delete leading _$'s }
-         l:=pos('_$',s);
-         while l<>0 do
-           begin
-              delete(s,1,l+1);
-              l:=pos('_$',s);
-           end;
-         l:=pos('$',s);
-         if l=0 then
-          procname:=s
-         else
-          procname:=Copy(s,1,l-1);
-      end;
-{$endif}
-
-    function tprocdef.cplusplusmangledname : string;
-
-      function getcppparaname(p : pdef) : string;
-
-        const
-           ordtype2str : array[tbasetype] of string[2] = (
-             '','','c',
-             'Uc','Us','Ui',
-             'Sc','s','i',
-             'b','b','b',
-             'Us','x','w');
-
-        var
-           s : string;
-
-        begin
-           case p^.deftype of
-              orddef:
-                s:=ordtype2str[porddef(p)^.typ];
-              pointerdef:
-                s:='P'+getcppparaname(ppointerdef(p)^.pointertype.def);
-              else
-                internalerror(2103001);
-           end;
-           getcppparaname:=s;
-        end;
-
-      var
-         s,s2 : string;
-         param : pparaitem;
-
-      begin
-         s := procsym^.realname;
-         if procsym^.owner^.symtabletype=objectsymtable then
-           begin
-              s2:=upper(pobjectdef(procsym^.owner^.defowner)^.typesym^.realname);
-              case proctypeoption of
-                 potype_destructor:
-                   s:='_$_'+tostr(length(s2))+s2;
-                 potype_constructor:
-                   s:='___'+tostr(length(s2))+s2;
-                 else
-                   s:='_'+s+'__'+tostr(length(s2))+s2;
-              end;
-
-           end
-         else s:=s+'__';
-
-         s:=s+'F';
-
-         { concat modifiers }
-         { !!!!! }
-
-         { now we handle the parameters }
-         param := pparaitem(para^.first);
-         if assigned(param) then
-           while assigned(param) do
-             begin
-                s2:=getcppparaname(param^.paratype.def);
-                if param^.paratyp in [vs_var,vs_out] then
-                  s2:='R'+s2;
-                s:=s+s2;
-                param:=pparaitem(param^.next);
-             end
-         else
-           s:=s+'v';
-         cplusplusmangledname:=s;
-      end;
-
-    procedure tprocdef.setmangledname(const s : string);
-      begin
-         if assigned(_mangledname) then
-           begin
-{$ifdef MEMDEBUG}
-              dec(manglenamesize,length(_mangledname^));
-{$endif}
-              stringdispose(_mangledname);
-           end;
-         _mangledname:=stringdup(s);
-{$ifdef MEMDEBUG}
-         inc(manglenamesize,length(s));
-{$endif}
-{$ifdef EXTDEBUG}
-         if assigned(parast) then
-           begin
-              stringdispose(parast^.name);
-              parast^.name:=stringdup('args of '+s);
-           end;
-         if assigned(localst) then
-           begin
-              stringdispose(localst^.name);
-              localst^.name:=stringdup('locals of '+s);
-           end;
-{$endif}
-      end;
-
-
-{***************************************************************************
-                                 TPROCVARDEF
-***************************************************************************}
-
-    constructor tprocvardef.init;
-      begin
-         inherited init;
-         deftype:=procvardef;
-      end;
-
-
-    constructor tprocvardef.load;
-      begin
-         inherited load;
-         deftype:=procvardef;
-      end;
-
-
-    procedure tprocvardef.write;
-      begin
-         { here we cannot get a real good value so just give something }
-         { plausible (PM) }
-         { a more secure way would be
-           to allways store in a temp }
-         if is_fpu(rettype.def) then
-           fpu_used:=2
-         else
-           fpu_used:=0;
-         inherited write;
-         current_ppu^.writeentry(ibprocvardef);
-      end;
-
-
-    function tprocvardef.size : longint;
-      begin
-         if (po_methodpointer in procoptions) then
-           size:=2*target_os.size_of_pointer
-         else
-           size:=target_os.size_of_pointer;
-      end;
-
-
-{$ifdef GDB}
-    function tprocvardef.stabstring : pchar;
-      var
-         nss : pchar;
-        { i   : longint; }
-      begin
-        { i := maxparacount; }
-        getmem(nss,1024);
-        { it is not a function but a function pointer !! (PM) }
-
-        strpcopy(nss,'*f'+rettype.def^.numberstring{+','+tostr(i)}+';');
-        { this confuses gdb !!
-          we should use 'F' instead of 'f' but
-          as we use c++ language mode
-          it does not like that either
-          Please do not remove this part
-          might be used once
-          gdb for pascal is ready PM }
-        (*
-        param := para1;
-        i := 0;
-        while assigned(param) do
-          begin
-          inc(i);
-                   vs_out  : paraspec := pfOut;
-          if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
-          {Here we have lost the parameter names !!}
-          pst := strpnew('p'+tostr(i)+':'+param^.paratype.def^.numberstring+','+vartyp+';');
-          strcat(nss,pst);
-          strdispose(pst);
-          param := param^.next;
-          end; *)
-        {strpcopy(strend(nss),';');}
-        stabstring := strnew(nss);
-        freemem(nss,1024);
-      end;
-
-
-    procedure tprocvardef.concatstabto(asmlist : paasmoutput);
-      begin
-         if ( not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches))
-           and (is_def_stab_written = not_written)  then
-           inherited concatstabto(asmlist);
-         is_def_stab_written:=written;
-      end;
-{$endif GDB}
-
-
-    procedure tprocvardef.write_rtti_data;
-      var
-         pdc : pparaitem;
-         methodkind, paraspec : byte;
-      begin
-        if po_methodpointer in procoptions then
-          begin
-             { write method id and name }
-             rttilist^.concat(new(pai_const,init_8bit(tkmethod)));
-             write_rtti_name;
-
-             { write kind of method (can only be function or procedure)}
-             if rettype.def = pdef(voiddef) then    { ### typecast shoudln't be necessary! (sg) }
-               methodkind := mkProcedure
-             else
-               methodkind := mkFunction;
-             rttilist^.concat(new(pai_const,init_8bit(methodkind)));
-
-             { get # of parameters }
-             rttilist^.concat(new(pai_const,init_8bit(maxparacount)));
-
-             { write parameter info. The parameters must be written in reverse order
-               if this method uses right to left parameter pushing! }
-             if (pocall_leftright in proccalloptions) then
-              pdc:=pparaitem(para^.last)
-             else
-              pdc:=pparaitem(para^.first);
-             while assigned(pdc) do
-               begin
-                 case pdc^.paratyp of
-                   vs_value: paraspec := 0;
-                   vs_const: paraspec := pfConst;
-                   vs_var  : paraspec := pfVar;
-                   vs_out  : paraspec := pfOut;
-                 end;
-                 { write flags for current parameter }
-                 rttilist^.concat(new(pai_const,init_8bit(paraspec)));
-                 { write name of current parameter ### how can I get this??? (sg)}
-                 rttilist^.concat(new(pai_const,init_8bit(0)));
-
-                 { write name of type of current parameter }
-                 pdc^.paratype.def^.write_rtti_name;
-
-                 if (pocall_leftright in proccalloptions) then
-                  pdc:=pparaitem(pdc^.previous)
-                 else
-                  pdc:=pparaitem(pdc^.next);
-               end;
-
-             { write name of result type }
-             rettype.def^.write_rtti_name;
-          end;
-      end;
-
-
-    procedure tprocvardef.write_child_rtti_data;
-      begin
-         {!!!!!!!!}
-      end;
-
-
-    function tprocvardef.is_publishable : boolean;
-      begin
-         is_publishable:=(po_methodpointer in procoptions);
-      end;
-
-    function tprocvardef.gettypename : string;
-      begin
-         if assigned(rettype.def) and
-            (rettype.def<>pdef(voiddef)) then
-           gettypename:='<procedure variable type of function'+demangled_paras+
-             ':'+rettype.def^.gettypename+';'+proccalloption2str+'>'
-         else
-           gettypename:='<procedure variable type of procedure'+demangled_paras+
-             ';'+proccalloption2str+'>';
-      end;
-
-
-{***************************************************************************
-                              TOBJECTDEF
-***************************************************************************}
-
-{$ifdef GDB}
-    const
-       vtabletype : word = 0;
-       vtableassigned : boolean = false;
-{$endif GDB}
-
-   constructor tobjectdef.init(odt : tobjectdeftype; const n : string;c : pobjectdef);
-     begin
-        tdef.init;
-        deftype:=objectdef;
-        objecttype:=odt;
-        objectoptions:=[];
-        childof:=nil;
-        symtable:=new(psymtable,init(objectsymtable));
-        symtable^.name := stringdup(n);
-        { create space for vmt !! }
-        vmt_offset:=0;
-        symtable^.datasize:=0;
-        symtable^.defowner:=@self;
-        symtable^.dataalignment:=packrecordalignment[aktpackrecords];
-
-        set_parent(c);
-        objname:=stringdup(n);
-        lastvtableindex:=0;
-
-        { set up guid }
-        isiidguidvalid:=true; { default null guid }
-        fillchar(iidguid,sizeof(iidguid),0); { default null guid }
-        iidstr:=stringdup(''); { default is empty string }
-
-        { set£p implemented interfaces }
-        if objecttype in [odt_class,odt_interfacecorba] then
-          new(implementedinterfaces,init)
-        else
-          implementedinterfaces:=nil;
-
-{$ifdef GDB}
-        writing_stabs:=false;
-        classglobalnb:=0;
-        classptrglobalnb:=0;
-{$endif GDB}
-     end;
-
-
-    constructor tobjectdef.load;
-      var
-         oldread_member : boolean;
-         implintfcount: longint;
-         i: longint;
-      begin
-         tdef.load;
-         deftype:=objectdef;
-         objecttype:=tobjectdeftype(readbyte);
-         savesize:=readlong;
-         vmt_offset:=readlong;
-         objname:=stringdup(readstring);
-         childof:=pobjectdef(readdefref);
-         readsmallset(objectoptions,sizeof(objectoptions));
-         has_rtti:=boolean(readbyte);
-
-         { load guid }
-         iidstr:=nil;
-         if objecttype in [odt_interfacecom,odt_interfacecorba] then
-           begin
-              isiidguidvalid:=boolean(readbyte);
-              readguid(iidguid);
-              iidstr:=stringdup(readstring);
-              lastvtableindex:=readlong;
-           end;
-
-         { load implemented interfaces }
-         if objecttype in [odt_class,odt_interfacecorba] then
-           begin
-             new(implementedinterfaces,init);
-             implintfcount:=readlong;
-             for i:=1 to implintfcount do
-               begin
-                  implementedinterfaces^.addintfref(readdefref);
-                  implementedinterfaces^.ioffsets(i)^:=readlong;
-               end;
-           end
-         else
-           implementedinterfaces:=nil;
-
-         oldread_member:=read_member;
-         read_member:=true;
-         symtable:=new(psymtable,loadas(objectsymtable));
-         read_member:=oldread_member;
-
-         symtable^.defowner:=@self;
-         symtable^.name := stringdup(objname^);
-
-         { handles the predefined class tobject  }
-         { the last TOBJECT which is loaded gets }
-         { it !                                  }
-         if (childof=nil) and
-            (objecttype=odt_class) and
-            (upper(objname^)='TOBJECT') then
-           class_tobject:=@self;
-         if (childof=nil) and (objecttype=odt_interfacecom) and
-           (objname^='IUNKNOWN') then
-           interface_iunknown:=@self;
-{$ifdef GDB}
-         writing_stabs:=false;
-         classglobalnb:=0;
-         classptrglobalnb:=0;
-{$endif GDB}
-       end;
-
-
-   destructor tobjectdef.done;
-     begin
-        if assigned(symtable) then
-          dispose(symtable,done);
-        if (oo_is_forward in objectoptions) then
-          Message1(sym_e_class_forward_not_resolved,objname^);
-        stringdispose(objname);
-        stringdispose(iidstr);
-        if assigned(implementedinterfaces) then
-          dispose(implementedinterfaces,done);
-        tdef.done;
-     end;
-
-
-    procedure tobjectdef.write;
-      var
-         oldread_member : boolean;
-         implintfcount : longint;
-         i : longint;
-      begin
-         tdef.write;
-         writebyte(ord(objecttype));
-         writelong(size);
-         writelong(vmt_offset);
-         writestring(objname^);
-         writedefref(childof);
-         writesmallset(objectoptions,sizeof(objectoptions));
-         writebyte(byte(has_rtti));
-         if objecttype in [odt_interfacecom,odt_interfacecorba] then
-           begin
-              writebyte(byte(isiidguidvalid));
-              writeguid(iidguid);
-              writestring(iidstr^);
-              writelong(lastvtableindex);
-           end;
-
-         if objecttype in [odt_class,odt_interfacecorba] then
-           begin
-              implintfcount:=implementedinterfaces^.count;
-              writelong(implintfcount);
-              for i:=1 to implintfcount do
-                begin
-                   writedefref(implementedinterfaces^.interfaces(i));
-                   writelong(implementedinterfaces^.ioffsets(i)^);
-                end;
-           end;
-
-         current_ppu^.writeentry(ibobjectdef);
-
-         oldread_member:=read_member;
-         read_member:=true;
-         symtable^.writeas;
-         read_member:=oldread_member;
-      end;
-
-
-    procedure tobjectdef.deref;
-      var
-         oldrecsyms : psymtable;
-      begin
-         inherited deref;
-         resolvedef(pdef(childof));
-         oldrecsyms:=aktrecordsymtable;
-         aktrecordsymtable:=symtable;
-         symtable^.deref;
-         aktrecordsymtable:=oldrecsyms;
-         if objecttype in [odt_class,odt_interfacecorba] then
-           implementedinterfaces^.deref;
-      end;
-
-
-    procedure tobjectdef.set_parent( c : pobjectdef);
-      begin
-        { nothing to do if the parent was not forward !}
-        if assigned(childof) then
-          exit;
-        childof:=c;
-        { some options are inherited !! }
-        if assigned(c) then
-          begin
-             { only important for classes }
-             lastvtableindex:=c^.lastvtableindex;
-             objectoptions:=objectoptions+(c^.objectoptions*
-               [oo_has_virtual,oo_has_private,oo_has_protected,oo_has_constructor,oo_has_destructor]);
-             if not (objecttype in [odt_interfacecom,odt_interfacecorba]) then
-               begin
-                  { add the data of the anchestor class }
-                  inc(symtable^.datasize,c^.symtable^.datasize);
-                  if (oo_has_vmt in objectoptions) and
-                     (oo_has_vmt in c^.objectoptions) then
-                    dec(symtable^.datasize,target_os.size_of_pointer);
-                  { if parent has a vmt field then
-                    the offset is the same for the child PM }
-                  if (oo_has_vmt in c^.objectoptions) or is_class(@self) then
-                    begin
-                       vmt_offset:=c^.vmt_offset;
-                       include(objectoptions,oo_has_vmt);
-                    end;
-               end;
-          end;
-        savesize := symtable^.datasize;
-      end;
-
-
-   procedure tobjectdef.insertvmt;
-     begin
-        if objecttype in [odt_interfacecom,odt_interfacecorba] then exit;
-        if (oo_has_vmt in objectoptions) then
-          internalerror(12345)
-        else
-          begin
-             { first round up to multiple of 4 }
-             if (symtable^.dataalignment=2) then
-               begin
-                 if (symtable^.datasize and 1)<>0 then
-                   inc(symtable^.datasize);
-               end
-             else
-              if (symtable^.dataalignment>=4) then
-               begin
-                 if (symtable^.datasize mod 4) <> 0 then
-                   inc(symtable^.datasize,4-(symtable^.datasize mod 4));
-               end;
-             vmt_offset:=symtable^.datasize;
-             inc(symtable^.datasize,target_os.size_of_pointer);
-             include(objectoptions,oo_has_vmt);
-          end;
-     end;
-
-
-   procedure tobjectdef.check_forwards;
-     begin
-        if objecttype in [odt_interfacecom,odt_interfacecorba] then exit; { Kaz: ??? }
-        symtable^.check_forwards;
-        if (oo_is_forward in objectoptions) then
-          begin
-             { ok, in future, the forward can be resolved }
-             Message1(sym_e_class_forward_not_resolved,objname^);
-             exclude(objectoptions,oo_is_forward);
-          end;
-     end;
-
-
-   { true, if self inherits from d (or if they are equal) }
-   function tobjectdef.is_related(d : pobjectdef) : boolean;
-     var
-        hp : pobjectdef;
-     begin
-        hp:=@self;
-        while assigned(hp) do
-          begin
-             if hp=d then
-               begin
-                  is_related:=true;
-                  exit;
-               end;
-             hp:=hp^.childof;
-          end;
-        is_related:=false;
-     end;
-
-   var
-      sd : pprocdef;
-
-   procedure _searchdestructor(sym : pnamedindexobject);
-
-     var
-        p : pprocdef;
-
-     begin
-        { if we found already a destructor, then we exit }
-        if assigned(sd) then
-          exit;
-        if psym(sym)^.typ=procsym then
-          begin
-             p:=pprocsym(sym)^.definition;
-             while assigned(p) do
-               begin
-                  if p^.proctypeoption=potype_destructor then
-                    begin
-                       sd:=p;
-                       exit;
-                    end;
-                  p:=p^.nextoverloaded;
-               end;
-          end;
-     end;
-
-   function tobjectdef.searchdestructor : pprocdef;
-
-     var
-        o : pobjectdef;
-
-     begin
-        searchdestructor:=nil;
-        o:=@self;
-        sd:=nil;
-        while assigned(o) do
-          begin
-             symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}_searchdestructor);
-             if assigned(sd) then
-               begin
-                  searchdestructor:=sd;
-                  exit;
-               end;
-             o:=o^.childof;
-          end;
-     end;
-
-    function tobjectdef.size : longint;
-      begin
-        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba] then
-          size:=target_os.size_of_pointer
-        else
-          size:=symtable^.datasize;
-      end;
-
-
-    function tobjectdef.alignment:longint;
-      begin
-        alignment:=symtable^.dataalignment;
-      end;
-
-
-    function tobjectdef.vmtmethodoffset(index:longint):longint;
-      begin
-        { for offset of methods for classes, see rtl/inc/objpash.inc }
-        if objecttype in [odt_interfacecom,odt_interfacecorba] then
-          vmtmethodoffset:=index*target_os.size_of_pointer
-        else if (objecttype=odt_class) then
-           vmtmethodoffset:=(index+12)*target_os.size_of_pointer
-        else
-{$ifdef WITHDMT}
-         vmtmethodoffset:=(index+4)*target_os.size_of_pointer;
-{$else WITHDMT}
-         vmtmethodoffset:=(index+3)*target_os.size_of_pointer;
-{$endif WITHDMT}
-      end;
-
-
-    function tobjectdef.vmt_mangledname : string;
-    {DM: I get a nil pointer on the owner name. I don't know if this
-     may happen, and I have therefore fixed the problem by doing nil pointer
-     checks.}
-    var
-      s1,s2:string;
-    begin
-        if not(oo_has_vmt in objectoptions) then
-          Message1(parser_object_has_no_vmt,objname^);
-        if owner^.name=nil then
-          s1:=''
-        else
-          s1:=owner^.name^;
-        if objname=nil then
-          s2:=''
-        else
-          s2:=Upper(objname^);
-        vmt_mangledname:='VMT_'+s1+'$_'+s2;
-    end;
-
-
-    function tobjectdef.rtti_name : string;
-    var
-      s1,s2:string;
-    begin
-       if owner^.name=nil then
-         s1:=''
-       else
-         s1:=owner^.name^;
-       if objname=nil then
-         s2:=''
-       else
-         s2:=Upper(objname^);
-       rtti_name:='RTTI_'+s1+'$_'+s2;
-    end;
-
-
-{$ifdef GDB}
-    procedure addprocname(p :pnamedindexobject);
-    var virtualind,argnames : string;
-        news, newrec : pchar;
-        pd,ipd : pprocdef;
-        lindex : longint;
-        para : pparaitem;
-        arglength : byte;
-        sp : char;
-
-    begin
-      If psym(p)^.typ = procsym then
-       begin
-                pd := pprocsym(p)^.definition;
-                { this will be used for full implementation of object stabs
-                not yet done }
-                ipd := pd;
-                while assigned(ipd^.nextoverloaded) do ipd := ipd^.nextoverloaded;
-                if (po_virtualmethod in pd^.procoptions) then
-                  begin
-                    lindex := pd^.extnumber;
-                    {doesnt seem to be necessary
-                    lindex := lindex or $80000000;}
-                    virtualind := '*'+tostr(lindex)+';'+ipd^._class^.classnumberstring+';'
-                  end
-                 else
-                  virtualind := '.';
-
-                 { used by gdbpas to recognize constructor and destructors }
-                 if (pd^.proctypeoption=potype_constructor) then
-                   argnames:='__ct__'
-                 else if (pd^.proctypeoption=potype_destructor) then
-                   argnames:='__dt__'
-                 else
-                   argnames := '';
-
-                { arguments are not listed here }
-                {we don't need another definition}
-                 para := pparaitem(pd^.para^.first);
-                 while assigned(para) do
-                   begin
-                   if para^.paratype.def^.deftype = formaldef then
-                     begin
-                        if para^.paratyp=vs_out then
-                          argnames := argnames+'3out'
-                        else if para^.paratyp=vs_var then
-                          argnames := argnames+'3var'
-                        else if para^.paratyp=vs_const then
-                          argnames:=argnames+'5const'
-                        else if para^.paratyp=vs_out then
-                          argnames:=argnames+'3out';
-                     end
-                   else
-                     begin
-                     { if the arg definition is like (v: ^byte;..
-                     there is no sym attached to data !!! }
-                     if assigned(para^.paratype.def^.typesym) then
-                       begin
-                          arglength := length(para^.paratype.def^.typesym^.name);
-                          argnames := argnames + tostr(arglength)+para^.paratype.def^.typesym^.name;
-                       end
-                     else
-                       begin
-                          argnames:=argnames+'11unnamedtype';
-                       end;
-                     end;
-                   para := pparaitem(para^.next);
-                   end;
-                ipd^.is_def_stab_written := written;
-                { here 2A must be changed for private and protected }
-                { 0 is private 1 protected and 2 public }
-                if (sp_private in psym(p)^.symoptions) then sp:='0'
-                else if (sp_protected in psym(p)^.symoptions) then sp:='1'
-                else sp:='2';
-                newrec := strpnew(p^.name+'::'+ipd^.numberstring
-                     +'=##'+pd^.rettype.def^.numberstring+';:'+argnames+';'+sp+'A'
-                     +virtualind+';');
-               { get spare place for a string at the end }
-               if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
-                 begin
-                    getmem(news,stabrecsize+memsizeinc);
-                    strcopy(news,stabrecstring);
-                    freemem(stabrecstring,stabrecsize);
-                    stabrecsize:=stabrecsize+memsizeinc;
-                    stabrecstring:=news;
-                 end;
-               strcat(StabRecstring,newrec);
-               {freemem(newrec,memsizeinc);    }
-               strdispose(newrec);
-               {This should be used for case !!}
-               RecOffset := RecOffset + pd^.size;
-       end;
-    end;
-
-
-    function tobjectdef.stabstring : pchar;
-      var anc : pobjectdef;
-          oldrec : pchar;
-          storenb, oldrecsize : longint;
-          str_end : string;
-      begin
-        if not (is_class(@self)) or writing_stabs then
-          begin
-            storenb:=globalnb;
-            globalnb:=classptrglobalnb;
-            oldrec := stabrecstring;
-            oldrecsize:=stabrecsize;
-            stabrecsize:=memsizeinc;
-            GetMem(stabrecstring,stabrecsize);
-            strpcopy(stabRecString,'s'+tostr(symtable^.datasize));
-            if assigned(childof) then
-              begin
-                {only one ancestor not virtual, public, at base offset 0 }
-                {       !1           ,    0       2         0    ,       }
-                strpcopy(strend(stabrecstring),'!1,020,'+childof^.classnumberstring+';');
-              end;
-            {virtual table to implement yet}
-            RecOffset := 0;
-            symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}addname);
-            if (oo_has_vmt in objectoptions) then
-              if not assigned(childof) or not(oo_has_vmt in childof^.objectoptions) then
-                 begin
-                    strpcopy(strend(stabrecstring),'$vf'+classnumberstring+':'+typeglobalnumber('vtblarray')
-                      +','+tostr(vmt_offset*8)+';');
-                 end;
-            symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}addprocname);
-            if (oo_has_vmt in objectoptions) then
-              begin
-                 anc := @self;
-                 while assigned(anc^.childof) and (oo_has_vmt in anc^.childof^.objectoptions) do
-                   anc := anc^.childof;
-                 { just in case anc = self }
-                 str_end:=';~%'+anc^.classnumberstring+';';
-              end
-            else
-              str_end:=';';
-            strpcopy(strend(stabrecstring),str_end);
-            stabstring := strnew(StabRecString);
-            freemem(stabrecstring,stabrecsize);
-            stabrecstring := oldrec;
-            stabrecsize:=oldrecsize;
-            globalnb:=storenb;
-          end
-        else
-          begin
-            stabstring:=strpnew('*'+classnumberstring);
-          end;
-      end;
-
-   procedure tobjectdef.set_globalnb;
-     begin
-         classglobalnb:=PGlobalTypeCount^;
-         globalnb:=classglobalnb;
-         inc(PglobalTypeCount^);
-         { classes need two type numbers, the globalnb is set to the ptr }
-         if objecttype=odt_class then
-           begin
-             classptrglobalnb:=PGlobalTypeCount^;
-             globalnb:=classptrglobalnb;
-             inc(PglobalTypeCount^);
-           end;
-     end;
-
-   function tobjectdef.classnumberstring : string;
-     var
-       onb : word;
-     begin
-       if globalnb=0 then
-         numberstring;
-       if objecttype=odt_class then
-         begin
-           onb:=globalnb;
-           globalnb:=classglobalnb;
-           classnumberstring:=numberstring;
-           globalnb:=onb;
-         end
-       else
-         classnumberstring:=numberstring;
-     end;
-
-   function tobjectdef.classptrnumberstring : string;
-     var
-       onb : word;
-     begin
-       if globalnb=0 then
-         numberstring;
-       if objecttype=odt_class then
-         begin
-           onb:=globalnb;
-           globalnb:=classptrglobalnb;
-           classptrnumberstring:=numberstring;
-           globalnb:=onb;
-         end
-       else
-         classptrnumberstring:=numberstring;
-     end;
-
-    procedure tobjectdef.concatstabto(asmlist : paasmoutput);
-      var st : pstring;
-      begin
-        if not(objecttype=odt_class) then
-          begin
-            inherited concatstabto(asmlist);
-            exit;
-          end;
-
-      if ((typesym=nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
-         (is_def_stab_written = not_written) then
-        begin
-          if globalnb=0 then
-            set_globalnb;
-          { Write the record class itself }
-          writing_stabs:=true;
-          if assigned(typesym) then
-            begin
-              st:=typesym^._name;
-              typesym^._name:=stringdup(' ');
-            end;
-          globalnb:=classglobalnb;
-          inherited concatstabto(asmlist);
-          if assigned(typesym) then
-            begin
-              stringdispose(typesym^._name);
-              typesym^._name:=st;
-            end;
-          globalnb:=classptrglobalnb;
-          writing_stabs:=false;
-          { Write the invisible pointer class }
-          is_def_stab_written:=not_written;
-          inherited concatstabto(asmlist);
-        end;
-      end;
-{$endif GDB}
-
-
-    procedure tobjectdef.write_child_init_data;
-      begin
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}generate_child_inittable);
-      end;
-
-
-    procedure tobjectdef.write_init_data;
-      begin
-         case objecttype of
-            odt_class:
-              rttilist^.concat(new(pai_const,init_8bit(tkclass)));
-            odt_object:
-              rttilist^.concat(new(pai_const,init_8bit(tkobject)));
-            odt_interfacecom:
-              rttilist^.concat(new(pai_const,init_8bit(tkinterface)));
-            odt_interfacecorba:
-              rttilist^.concat(new(pai_const,init_8bit(tkinterfaceCorba)));
-          else
-            exit;
-          end;
-
-         { generate the name }
-         rttilist^.concat(new(pai_const,init_8bit(length(objname^))));
-         rttilist^.concat(new(pai_string,init(objname^)));
-
-         rttilist^.concat(new(pai_const,init_32bit(size)));
-         count:=0;
-         if objecttype in [odt_interfacecom,odt_interfacecorba] then
-           begin
-           end
-         else
-           begin
-              symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_inittable_fields);
-              rttilist^.concat(new(pai_const,init_32bit(count)));
-              symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}write_field_inittable);
-           end;
-      end;
-
-
-    function tobjectdef.needs_inittable : boolean;
-      var
-         oldb : boolean;
-      begin
-         case objecttype of
-            odt_interfacecom: needs_inittable:=true;
-            odt_object:
-              begin
-                 { there are recursive calls to needs_inittable possible, }
-                 { so we have to change to old value how else should      }
-                 { we do that ? check_rec_rtti can't be a nested          }
-                 { procedure of needs_rtti !                              }
-                 oldb:=binittable;
-                 binittable:=false;
-                 symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}check_rec_inittable);
-                 needs_inittable:=binittable;
-                 binittable:=oldb;
-              end;
-            else needs_inittable:=false;
-         end;
-      end;
-
-
-    procedure count_published_properties(sym:pnamedindexobject);
-      begin
-         if needs_prop_entry(psym(sym)) and
-          (psym(sym)^.typ<>varsym) then
-           inc(count);
-      end;
-
-
-    procedure write_property_info(sym : pnamedindexobject);
-      var
-         proctypesinfo : byte;
-
-      procedure writeproc(proc : psymlist; shiftvalue : byte);
-
-        var
-           typvalue : byte;
-           hp : psymlistitem;
-           address : longint;
-
-        begin
-           if not(assigned(proc) and assigned(proc^.firstsym))  then
-             begin
-                rttilist^.concat(new(pai_const,init_32bit(1)));
-                typvalue:=3;
-             end
-           else if proc^.firstsym^.sym^.typ=varsym then
-             begin
-                address:=0;
-                hp:=proc^.firstsym;
-                while assigned(hp) do
-                  begin
-                     inc(address,pvarsym(hp^.sym)^.address);
-                     hp:=hp^.next;
-                  end;
-                rttilist^.concat(new(pai_const,init_32bit(address)));
-                typvalue:=0;
-             end
-           else
-             begin
-                if not(po_virtualmethod in pprocdef(proc^.def)^.procoptions) then
-                  begin
-                     rttilist^.concat(new(pai_const_symbol,initname(pprocdef(proc^.def)^.mangledname)));
-                     typvalue:=1;
-                  end
-                else
-                  begin
-                     { virtual method, write vmt offset }
-                     rttilist^.concat(new(pai_const,init_32bit(
-                       pprocdef(proc^.def)^._class^.vmtmethodoffset(pprocdef(proc^.def)^.extnumber))));
-                     typvalue:=2;
-                  end;
-             end;
-           proctypesinfo:=proctypesinfo or (typvalue shl shiftvalue);
-        end;
-
-      begin
-         if needs_prop_entry(psym(sym)) then
-           case psym(sym)^.typ of
-              varsym:
-                begin
-{$ifdef dummy}
-                   if not(pvarsym(sym)^.vartype.def^.deftype=objectdef) or
-                     not(pobjectdef(pvarsym(sym)^.vartype.def)^.is_class) then
-                     internalerror(1509992);
-                   { access to implicit class property as field }
-                   proctypesinfo:=(0 shl 0) or (0 shl 2) or (0 shl 4);
-                   rttilist^.concat(new(pai_const_symbol,initname(pvarsym(sym)^.vartype.def^.get_rtti_label)));
-                   rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
-                   rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
-                   { per default stored }
-                   rttilist^.concat(new(pai_const,init_32bit(1)));
-                   { index as well as ... }
-                   rttilist^.concat(new(pai_const,init_32bit(0)));
-                   { default value are zero }
-                   rttilist^.concat(new(pai_const,init_32bit(0)));
-                   rttilist^.concat(new(pai_const,init_16bit(count)));
-                   inc(count);
-                   rttilist^.concat(new(pai_const,init_8bit(proctypesinfo)));
-                   rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.realname))));
-                   rttilist^.concat(new(pai_string,init(pvarsym(sym)^.realname)));
-{$endif dummy}
-                end;
-              propertysym:
-                begin
-                   if ppo_indexed in ppropertysym(sym)^.propoptions then
-                     proctypesinfo:=$40
-                   else
-                     proctypesinfo:=0;
-                   rttilist^.concat(new(pai_const_symbol,initname(ppropertysym(sym)^.proptype.def^.get_rtti_label)));
-                   writeproc(ppropertysym(sym)^.readaccess,0);
-                   writeproc(ppropertysym(sym)^.writeaccess,2);
-                   { isn't it stored ? }
-                   if not(ppo_stored in ppropertysym(sym)^.propoptions) then
-                     begin
-                        rttilist^.concat(new(pai_const,init_32bit(0)));
-                        proctypesinfo:=proctypesinfo or (3 shl 4);
-                     end
-                   else
-                     writeproc(ppropertysym(sym)^.storedaccess,4);
-                   rttilist^.concat(new(pai_const,init_32bit(ppropertysym(sym)^.index)));
-                   rttilist^.concat(new(pai_const,init_32bit(ppropertysym(sym)^.default)));
-                   rttilist^.concat(new(pai_const,init_16bit(count)));
-                   inc(count);
-                   rttilist^.concat(new(pai_const,init_8bit(proctypesinfo)));
-                   rttilist^.concat(new(pai_const,init_8bit(length(ppropertysym(sym)^.realname))));
-                   rttilist^.concat(new(pai_string,init(ppropertysym(sym)^.realname)));
-                end;
-              else internalerror(1509992);
-           end;
-      end;
-
-
-    procedure generate_published_child_rtti(sym : pnamedindexobject);
-      begin
-         if needs_prop_entry(psym(sym)) then
-           case psym(sym)^.typ of
-              varsym:
-                ;
-                { now ignored:
-                ;
-                { now ignored
-                pvarsym(sym)^.vartype.def^.get_rtti_label;
-                }
-                }
-              propertysym:
-                ppropertysym(sym)^.proptype.def^.get_rtti_label;
-              else
-                internalerror(1509991);
-           end;
-      end;
-
-
-    procedure tobjectdef.write_child_rtti_data;
-      begin
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}generate_published_child_rtti);
-      end;
-
-
-    procedure tobjectdef.generate_rtti;
-      begin
-         if not has_rtti then
-          begin
-            has_rtti:=true;
-            getdatalabel(rtti_label);
-            write_child_rtti_data;
-            rttilist^.concat(new(pai_symbol,initname_global(rtti_name,0)));
-            rttilist^.concat(new(pai_label,init(rtti_label)));
-            write_rtti_data;
-            rttilist^.concat(new(pai_symbol_end,initname(rtti_name)));
-          end;
-      end;
-
-    type
-       tclasslistitem = object(tlinkedlist_item)
-          index : longint;
-          p : pobjectdef;
-       end;
-       pclasslistitem = ^tclasslistitem;
-
-    var
-       classtablelist : tlinkedlist;
-       tablecount : longint;
-
-    function searchclasstablelist(p : pobjectdef) : pclasslistitem;
-
-      var
-         hp : pclasslistitem;
-
-      begin
-         hp:=pclasslistitem(classtablelist.first);
-         while assigned(hp) do
-           if hp^.p=p then
-             begin
-                searchclasstablelist:=hp;
-                exit;
-             end
-           else
-             hp:=pclasslistitem(hp^.next);
-         searchclasstablelist:=nil;
-      end;
-
-    procedure count_published_fields(sym:pnamedindexobject);
-      var
-         hp : pclasslistitem;
-      begin
-         if needs_prop_entry(psym(sym)) and
-          (psym(sym)^.typ=varsym) then
-          begin
-             if pvarsym(sym)^.vartype.def^.deftype<>objectdef then
-               internalerror(0206001);
-             hp:=searchclasstablelist(pobjectdef(pvarsym(sym)^.vartype.def));
-             if not(assigned(hp)) then
-               begin
-                  hp:=new(pclasslistitem,init);
-                  hp^.p:=pobjectdef(pvarsym(sym)^.vartype.def);
-                  hp^.index:=tablecount;
-                  classtablelist.concat(hp);
-                  inc(tablecount);
-               end;
-             inc(count);
-          end;
-      end;
-
-    procedure writefields(sym:pnamedindexobject);
-      var
-         hp : pclasslistitem;
-      begin
-         if needs_prop_entry(psym(sym)) and
-          (psym(sym)^.typ=varsym) then
-          begin
-             rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
-             hp:=searchclasstablelist(pobjectdef(pvarsym(sym)^.vartype.def));
-             if not(assigned(hp)) then
-               internalerror(0206002);
-             rttilist^.concat(new(pai_const,init_16bit(hp^.index)));
-             rttilist^.concat(new(pai_const,init_8bit(length(pvarsym(sym)^.realname))));
-             rttilist^.concat(new(pai_string,init(pvarsym(sym)^.realname)));
-          end;
-      end;
-
-    function tobjectdef.generate_field_table : pasmlabel;
-
-      var
-         fieldtable,
-         classtable : pasmlabel;
-         hp : pclasslistitem;
-
-      begin
-         classtablelist.init;
-         getdatalabel(fieldtable);
-         getdatalabel(classtable);
-         count:=0;
-         tablecount:=0;
-         symtable^.foreach({$ifdef FPC}@{$endif}count_published_fields);
-         rttilist^.concat(new(pai_label,init(fieldtable)));
-         rttilist^.concat(new(pai_const,init_16bit(count)));
-         rttilist^.concat(new(pai_const_symbol,init(classtable)));
-         symtable^.foreach({$ifdef FPC}@{$endif}writefields);
-
-         { generate the class table }
-         rttilist^.concat(new(pai_label,init(classtable)));
-         rttilist^.concat(new(pai_const,init_16bit(tablecount)));
-         hp:=pclasslistitem(classtablelist.first);
-         while assigned(hp) do
-           begin
-              rttilist^.concat(new(pai_const_symbol,initname(pobjectdef(hp^.p)^.vmt_mangledname)));
-              hp:=pclasslistitem(hp^.next);
-           end;
-
-         generate_field_table:=fieldtable;
-         classtablelist.done;
-      end;
-
-    function tobjectdef.next_free_name_index : longint;
-      var
-         i : longint;
-      begin
-         if assigned(childof) and (oo_can_have_published in childof^.objectoptions) then
-           i:=childof^.next_free_name_index
-         else
-           i:=0;
-         count:=0;
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_published_properties);
-         next_free_name_index:=i+count;
-      end;
-
-
-    procedure tobjectdef.write_rtti_data;
-      begin
-         case objecttype of
-           odt_class: rttilist^.concat(new(pai_const,init_8bit(tkclass)));
-           odt_object: rttilist^.concat(new(pai_const,init_8bit(tkobject)));
-           odt_interfacecom: rttilist^.concat(new(pai_const,init_8bit(tkinterface)));
-           odt_interfacecorba: rttilist^.concat(new(pai_const,init_8bit(tkinterfaceCorba)));
-         else
-           exit;
-         end;
-
-         { generate the name }
-         rttilist^.concat(new(pai_const,init_8bit(length(objname^))));
-         rttilist^.concat(new(pai_string,init(objname^)));
-
-         { write class type }
-         if objecttype in [odt_interfacecom,odt_interfacecorba] then
-           rttilist^.concat(new(pai_const,init_32bit(0)))
-         else
-           rttilist^.concat(new(pai_const_symbol,initname(vmt_mangledname)));
-
-         { write owner typeinfo }
-         if assigned(childof) and (oo_can_have_published in childof^.objectoptions) then
-           rttilist^.concat(new(pai_const_symbol,initname(childof^.get_rtti_label)))
-         else
-           rttilist^.concat(new(pai_const,init_32bit(0)));
-
-         { count total number of properties }
-         if assigned(childof) and (oo_can_have_published in childof^.objectoptions) then
-           count:=childof^.next_free_name_index
-         else
-           count:=0;
-
-         { write it }
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_published_properties);
-         rttilist^.concat(new(pai_const,init_16bit(count)));
-
-         { write unit name }
-         rttilist^.concat(new(pai_const,init_8bit(length(current_module^.realmodulename^))));
-         rttilist^.concat(new(pai_string,init(current_module^.realmodulename^)));
-
-         { write published properties count }
-         count:=0;
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}count_published_properties);
-         rttilist^.concat(new(pai_const,init_16bit(count)));
-
-         { count is used to write nameindex   }
-
-         { but we need an offset of the owner }
-         { to give each property an own slot  }
-         if assigned(childof) and (oo_can_have_published in childof^.objectoptions) then
-           count:=childof^.next_free_name_index
-         else
-           count:=0;
-
-         symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}write_property_info);
-      end;
-
-
-    function tobjectdef.is_publishable : boolean;
-      begin
-         is_publishable:=objecttype in [odt_class,odt_interfacecom,odt_interfacecorba];
-      end;
-
-    function  tobjectdef.get_rtti_label : string;
-
-      begin
-         generate_rtti;
-         get_rtti_label:=rtti_name;
-      end;
-
-{****************************************************************************
-                                TFORWARDDEF
-****************************************************************************}
-
-   constructor tforwarddef.init(const s:string;const pos : tfileposinfo);
-     var
-       oldregisterdef : boolean;
-     begin
-        { never register the forwarddefs, they are disposed at the
-          end of the type declaration block }
-        oldregisterdef:=registerdef;
-        registerdef:=false;
-        inherited init;
-        registerdef:=oldregisterdef;
-        deftype:=forwarddef;
-        tosymname:=s;
-        forwardpos:=pos;
-     end;
-
-
-    function tforwarddef.gettypename:string;
-      begin
-        gettypename:='unresolved forward to '+tosymname;
-      end;
-
-
-{****************************************************************************
-                             TIMPLEMENTEDINTERFACES
-****************************************************************************}
-    type
-      pnamemap = ^tnamemap;
-      tnamemap = object(tnamedindexobject)
-        newname: pstring;
-        constructor init(const aname, anewname: string);
-        destructor  done; virtual;
-      end;
-
-    constructor tnamemap.init(const aname, anewname: string);
-      begin
-        inherited initname(name);
-        newname:=stringdup(anewname);
-      end;
-
-    destructor  tnamemap.done;
-      begin
-        stringdispose(newname);
-        inherited done;
-      end;
-
-
-    type
-      pprocdefstore = ^tprocdefstore;
-      tprocdefstore = object(tnamedindexobject)
-        procdef: pprocdef;
-        constructor init(aprocdef: pprocdef);
-      end;
-
-    constructor tprocdefstore.init(aprocdef: pprocdef);
-      begin
-        inherited init;
-        procdef:=aprocdef;
-      end;
-
-
-    type
-      pimplintfentry = ^timplintfentry;
-      timplintfentry = object(tnamedindexobject)
-        intf: pobjectdef;
-        ioffs: longint;
-        namemappings: pdictionary;
-        procdefs: pindexarray;
-        constructor init(aintf: pobjectdef);
-        destructor  done; virtual;
-      end;
-
-    constructor timplintfentry.init(aintf: pobjectdef);
-      begin
-        inherited init;
-        intf:=aintf;
-        ioffs:=-1;
-        namemappings:=nil;
-        procdefs:=nil;
-      end;
-
-    destructor  timplintfentry.done;
-      begin
-        if assigned(namemappings) then
-          dispose(namemappings,done);
-        if assigned(procdefs) then
-          dispose(procdefs,done);
-        inherited done;
-      end;
-
-
-    constructor timplementedinterfaces.init;
-      begin
-        finterfaces.init(1);
-      end;
-
-    destructor  timplementedinterfaces.done;
-      begin
-        finterfaces.done;
-      end;
-
-    function  timplementedinterfaces.count: longint;
-      begin
-        count:=finterfaces.count;
-      end;
-
-    procedure timplementedinterfaces.checkindex(intfindex: longint);
-      begin
-        if (intfindex<1) or (intfindex>count) then
-          InternalError(200006123);
-      end;
-
-    function  timplementedinterfaces.interfaces(intfindex: longint): pobjectdef;
-      begin
-        checkindex(intfindex);
-        interfaces:=pimplintfentry(finterfaces.search(intfindex))^.intf;
-      end;
-
-    function  timplementedinterfaces.ioffsets(intfindex: longint): plongint;
-      begin
-        checkindex(intfindex);
-        ioffsets:=@pimplintfentry(finterfaces.search(intfindex))^.ioffs;
-      end;
-
-    function  timplementedinterfaces.searchintf(def: pdef): longint;
-      var
-        i: longint;
-      begin
-        i:=1;
-        while (i<=count) and (pdef(interfaces(i))<>def) do inc(i);
-        if i<=count then
-          searchintf:=i
-        else
-          searchintf:=-1;
-      end;
-
-    procedure timplementedinterfaces.deref;
-      var
-        i: longint;
-      begin
-        for i:=1 to count do
-          with pimplintfentry(finterfaces.search(i))^ do
-            resolvedef(pdef(intf));
-      end;
-
-    procedure timplementedinterfaces.addintfref(def: pdef);
-      begin
-        finterfaces.insert(new(pimplintfentry,init(pobjectdef(def))));
-      end;
-
-    procedure timplementedinterfaces.addintf(def: pdef);
-      begin
-        if not assigned(def) or (searchintf(def)<>-1) or (def^.deftype<>objectdef) or
-           not (pobjectdef(def)^.objecttype in [odt_interfacecom,odt_interfacecorba]) then
-          internalerror(200006124);
-        finterfaces.insert(new(pimplintfentry,init(pobjectdef(def))));
-      end;
-
-    procedure timplementedinterfaces.clearmappings;
-      var
-        i: longint;
-      begin
-        for i:=1 to count do
-          with pimplintfentry(finterfaces.search(i))^ do
-            begin
-             if assigned(namemappings) then
-               dispose(namemappings,done);
-             namemappings:=nil;
-            end;
-      end;
-
-    procedure timplementedinterfaces.addmappings(intfindex: longint; const name, newname: string);
-      begin
-        checkindex(intfindex);
-        with pimplintfentry(finterfaces.search(intfindex))^ do
-          begin
-            if not assigned(namemappings) then
-              new(namemappings,init);
-            namemappings^.insert(new(pnamemap,init(name,newname)));
-          end;
-      end;
-
-    function  timplementedinterfaces.getmappings(intfindex: longint; const name: string; var nextexist: pointer): string;
-      begin
-        checkindex(intfindex);
-        if not assigned(nextexist) then
-          with pimplintfentry(finterfaces.search(intfindex))^ do
-            begin
-              if assigned(namemappings) then
-                nextexist:=namemappings^.search(name)
-              else
-                nextexist:=nil;
-            end;
-        if assigned(nextexist) then
-          begin
-            getmappings:=pnamemap(nextexist)^.newname^;
-            nextexist:=pnamemap(nextexist)^.listnext;
-          end
-        else
-          getmappings:='';
-      end;
-
-    procedure timplementedinterfaces.clearimplprocs;
-      var
-        i: longint;
-      begin
-        for i:=1 to count do
-          with pimplintfentry(finterfaces.search(i))^ do
-            begin
-              if assigned(procdefs) then
-                dispose(procdefs,done);
-              procdefs:=nil;
-            end;
-      end;
-
-    procedure timplementedinterfaces.addimplproc(intfindex: longint; procdef: pprocdef);
-      begin
-        checkindex(intfindex);
-        with pimplintfentry(finterfaces.search(intfindex))^ do
-          begin
-            if not assigned(procdefs) then
-              new(procdefs,init(4));
-            procdefs^.insert(new(pprocdefstore,init(procdef)));
-          end;
-      end;
-
-    function  timplementedinterfaces.implproccount(intfindex: longint): longint;
-      begin
-        checkindex(intfindex);
-        with pimplintfentry(finterfaces.search(intfindex))^ do
-          if assigned(procdefs) then
-            implproccount:=procdefs^.count
-          else
-            implproccount:=0;
-      end;
-
-    function  timplementedinterfaces.implprocs(intfindex: longint; procindex: longint): pprocdef;
-      begin
-        checkindex(intfindex);
-        with pimplintfentry(finterfaces.search(intfindex))^ do
-          if assigned(procdefs) then
-            implprocs:=pprocdefstore(procdefs^.search(procindex))^.procdef
-          else
-            internalerror(200006131);
-      end;
-
-    function  timplementedinterfaces.isimplmergepossible(intfindex, remainindex: longint; var weight: longint): boolean;
-      var
-        possible: boolean;
-        i: longint;
-        iiep1: pindexarray;
-        iiep2: pindexarray;
-      begin
-        checkindex(intfindex);
-        checkindex(remainindex);
-        iiep1:=pimplintfentry(finterfaces.search(intfindex))^.procdefs;
-        iiep2:=pimplintfentry(finterfaces.search(remainindex))^.procdefs;
-        if not assigned(iiep1) then { empty interface is mergeable :-) }
-          begin
-            possible:=true;
-            weight:=0;
-          end
-        else
-          begin
-            possible:=assigned(iiep2) and (iiep1^.count<=iiep2^.count);
-            i:=1;
-            while (possible) and (i<=iiep1^.count) do
-              begin
-                possible:=
-                  pprocdefstore(iiep1^.search(i))^.procdef=
-                  pprocdefstore(iiep2^.search(i))^.procdef;
-                inc(i);
-              end;
-            if possible then
-              weight:=iiep1^.count;
-          end;
-        isimplmergepossible:=possible;
-      end;
-
-{****************************************************************************
-                                  TERRORDEF
-****************************************************************************}
-
-   constructor terrordef.init;
-     begin
-        inherited init;
-        deftype:=errordef;
-     end;
-
-
-{$ifdef GDB}
-    function terrordef.stabstring : pchar;
-      begin
-         stabstring:=strpnew('error'+numberstring);
-      end;
-{$endif GDB}
-
-    function terrordef.gettypename:string;
-
-      begin
-         gettypename:='<erroneous type>';
-      end;
-
-{
-  $Log$
-  Revision 1.26  2000-11-04 14:25:22  florian
-    + merged Attila's changes for interfaces, not tested yet
-
-  Revision 1.25  2000/10/31 22:02:52  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.24  2000/10/21 18:16:12  florian
-    * a lot of changes:
-       - basic dyn. array support
-       - basic C++ support
-       - some work for interfaces done
-       ....
-
-  Revision 1.23  2000/10/15 07:47:52  peter
-    * unit names and procedure names are stored mixed case
-
-  Revision 1.22  2000/10/14 10:14:52  peter
-    * moehrendorf oct 2000 rewrite
-
-  Revision 1.21  2000/10/04 23:16:48  pierre
-   * object stabs fix (merged)
-
-  Revision 1.20  2000/10/01 19:48:25  peter
-    * lot of compile updates for cg11
-
-  Revision 1.19  2000/09/24 21:19:52  peter
-    * delphi compile fixes
-
-  Revision 1.18  2000/09/24 15:06:28  peter
-    * use defines.inc
-
-  Revision 1.17  2000/09/19 23:08:02  pierre
-   * fixes for local class debuggging problem (merged)
-
-  Revision 1.16  2000/09/10 20:13:37  peter
-    * fixed array of const writing instead of array of tvarrec (merged)
-
-  Revision 1.15  2000/09/09 18:36:40  peter
-    * fixed C alignment of array of record (merged)
-
-  Revision 1.14  2000/08/27 20:19:39  peter
-    * store strings with case in ppu, when an internal symbol is created
-      a '$' is prefixed so it's not automatic uppercased
-
-  Revision 1.13  2000/08/27 16:11:53  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.12  2000/08/21 11:27:44  pierre
-   * fix the stabs problems
-
-  Revision 1.11  2000/08/16 18:33:54  peter
-    * splitted namedobjectitem.next into indexnext and listnext so it
-      can be used in both lists
-    * don't allow "word = word" type definitions (merged)
-
-  Revision 1.10  2000/08/16 13:06:06  florian
-    + support of 64 bit integer constants
-
-  Revision 1.9  2000/08/13 13:06:37  peter
-    * store parast always for procdef (browser needs still update)
-    * add default parameter value to demangledpara
-
-  Revision 1.8  2000/08/08 19:28:57  peter
-    * memdebug/memory patches (merged)
-    * only once illegal directive (merged)
-
-  Revision 1.7  2000/08/06 19:39:28  peter
-    * default parameters working !
-
-  Revision 1.6  2000/08/06 14:17:15  peter
-    * overload fixes (merged)
-
-  Revision 1.5  2000/08/03 13:17:26  jonas
-    + allow regvars to be used inside inlined procs, which required  the
-      following changes:
-        + load regvars in genentrycode/free them in genexitcode (cgai386)
-        * moved all regvar related code to new regvars unit
-        + added pregvarinfo type to hcodegen
-        + added regvarinfo field to tprocinfo (symdef/symdefh)
-        * deallocate the regvars of the caller in secondprocinline before
-          inlining the called procedure and reallocate them afterwards
-
-  Revision 1.4  2000/08/02 19:49:59  peter
-    * first things for default parameters
-
-  Revision 1.3  2000/07/13 12:08:27  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:49  michael
-  + removed logs
-
-}

compiler/symdefh.inc

@@ -1,654 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
-
-    Interface for the definition types of the symtable
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
-}
-
-{************************************************
-                    TDef
-************************************************}
-
-       tdef = object(tsymtableentry)
-          deftype    : tdeftype;
-          typesym    : ptypesym;  { which type the definition was generated this def }
-
-          has_inittable : boolean;
-          { adress of init informations }
-          inittable_label : pasmlabel;
-
-          has_rtti   : boolean;
-          { address of rtti }
-          rtti_label : pasmlabel;
-
-          nextglobal,
-          previousglobal : pdef;
-{$ifdef GDB}
-          globalnb       : word;
-          is_def_stab_written : tdefstabstatus;
-{$endif GDB}
-          constructor init;
-          constructor load;
-          destructor  done;virtual;
-          procedure deref;virtual;
-          function  typename:string;
-          procedure write;virtual;
-          function  size:longint;virtual;
-          function  alignment:longint;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          function  is_in_current : boolean;
-          procedure correct_owner_symtable; { registers enumdef inside objects or
-                                              record directly in the owner symtable !! }
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-          function  NumberString:string;
-          procedure set_globalnb;virtual;
-          function  allstabstring : pchar;
-{$endif GDB}
-          { init. tables }
-          function  needs_inittable : boolean;virtual;
-          procedure generate_inittable;
-          function  get_inittable_label : pasmlabel;
-          { the default implemenation calls write_rtti_data     }
-          { if init and rtti data is different these procedures }
-          { must be overloaded                                  }
-          procedure write_init_data;virtual;
-          procedure write_child_init_data;virtual;
-          { rtti }
-          procedure write_rtti_name;
-          function  get_rtti_label : string;virtual;
-          procedure generate_rtti;virtual;
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-          function is_intregable : boolean;
-          function is_fpuregable : boolean;
-       private
-          savesize  : longint;
-       end;
-
-       targconvtyp = (act_convertable,act_equal,act_exact);
-
-       tvarspez = (vs_value,vs_const,vs_var,vs_out);
-
-       pparaitem = ^tparaitem;
-       tparaitem = object(tlinkedlist_item)
-          paratype     : ttype;
-          paratyp      : tvarspez;
-          argconvtyp   : targconvtyp;
-          convertlevel : byte;
-          register     : tregister;
-          defaultvalue : psym; { pconstsym }
-       end;
-
-       { this is only here to override the count method,
-         which can't be used }
-       pparalinkedlist = ^tparalinkedlist;
-       tparalinkedlist = object(tlinkedlist)
-          function count:longint;
-       end;
-
-       tfiletyp = (ft_text,ft_typed,ft_untyped);
-
-       pfiledef = ^tfiledef;
-       tfiledef = object(tdef)
-          filetyp : tfiletyp;
-          typedfiletype : ttype;
-          constructor inittext;
-          constructor inituntyped;
-          constructor inittyped(const tt : ttype);
-          constructor inittypeddef(p : pdef);
-          constructor load;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  gettypename:string;virtual;
-          procedure setsize;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pformaldef = ^tformaldef;
-       tformaldef = object(tdef)
-          constructor init;
-          constructor load;
-          procedure write;virtual;
-          function  gettypename:string;virtual;
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pforwarddef = ^tforwarddef;
-       tforwarddef = object(tdef)
-          tosymname : string;
-          forwardpos : tfileposinfo;
-          constructor init(const s:string;const pos : tfileposinfo);
-          function  gettypename:string;virtual;
-       end;
-
-       perrordef = ^terrordef;
-       terrordef = object(tdef)
-          constructor init;
-          function  gettypename:string;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-{$endif GDB}
-       end;
-
-       { tpointerdef and tclassrefdef should get a common
-         base class, but I derived tclassrefdef from tpointerdef
-         to avoid problems with bugs (FK)
-       }
-
-       ppointerdef = ^tpointerdef;
-       tpointerdef = object(tdef)
-          pointertype : ttype;
-          is_far : boolean;
-          constructor init(const tt : ttype);
-          constructor initfar(const tt : ttype);
-          constructor initdef(p : pdef);
-          constructor initfardef(p : pdef);
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  gettypename:string;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          {private}
-          public
-            { I don't know the use of this FK }
-            pointertypeis_forwarddef: boolean;
-       end;
-
-       pprocdef = ^tprocdef;
-       pimplementedinterfaces = ^timplementedinterfaces;
-
-       pobjectdef = ^tobjectdef;
-       tobjectdef = object(tdef)
-          childof  : pobjectdef;
-          objname  : pstring;
-          symtable : psymtable;
-          objectoptions : tobjectoptions;
-          { to be able to have a variable vmt position }
-          { and no vmt field for objects without virtuals }
-          vmt_offset : longint;
-{$ifdef GDB}
-          classglobalnb,
-          classptrglobalnb : word;
-          writing_stabs : boolean;
-{$endif GDB}
-          objecttype : tobjectdeftype;
-          isiidguidvalid: boolean;
-          iidguid: TGUID;
-          iidstr: pstring;
-          lastvtableindex: longint;
-          { store implemented interfaces defs and name mappings }
-          implementedinterfaces: pimplementedinterfaces;
-
-          constructor init(odt : tobjectdeftype; const n : string;c : pobjectdef);
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  size : longint;virtual;
-          function  alignment:longint;virtual;
-          function  vmtmethodoffset(index:longint):longint;
-          function  is_publishable : boolean;virtual;
-          function  vmt_mangledname : string;
-          function  rtti_name : string;
-          procedure check_forwards;
-          function  is_related(d : pobjectdef) : boolean;
-          function  next_free_name_index : longint;
-          procedure insertvmt;
-          procedure set_parent(c : pobjectdef);
-          function searchdestructor : pprocdef;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure set_globalnb;virtual;
-          function  classnumberstring : string;
-          function  classptrnumberstring : string;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { init/final }
-          function  needs_inittable : boolean;virtual;
-          procedure write_init_data;virtual;
-          procedure write_child_init_data;virtual;
-          { rtti }
-          function  get_rtti_label : string;virtual;
-          procedure generate_rtti;virtual;
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-          function generate_field_table : pasmlabel;
-       end;
-
-       timplementedinterfaces = object
-         constructor init;
-         destructor  done; virtual;
-
-         function  count: longint;
-         function  interfaces(intfindex: longint): pobjectdef;
-         function  ioffsets(intfindex: longint): plongint;
-         function  searchintf(def: pdef): longint;
-         procedure addintf(def: pdef);
-
-         procedure deref;
-         procedure addintfref(def: pdef);
-
-         procedure clearmappings;
-         procedure addmappings(intfindex: longint; const name, newname: string);
-         function  getmappings(intfindex: longint; const name: string; var nextexist: pointer): string;
-
-         procedure clearimplprocs;
-         procedure addimplproc(intfindex: longint; procdef: pprocdef);
-         function  implproccount(intfindex: longint): longint;
-         function  implprocs(intfindex: longint; procindex: longint): pprocdef;
-         function  isimplmergepossible(intfindex, remainindex: longint; var weight: longint): boolean;
-
-       private
-         finterfaces: tindexarray;
-         procedure checkindex(intfindex: longint);
-       end;
-
-
-       pclassrefdef = ^tclassrefdef;
-       tclassrefdef = object(tpointerdef)
-          constructor init(def : pdef);
-          constructor load;
-          procedure write;virtual;
-          function gettypename:string;virtual;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       parraydef = ^tarraydef;
-       tarraydef = object(tdef)
-       private
-          rangenr    : longint;
-       public
-          lowrange,
-          highrange  : longint;
-          elementtype,
-          rangetype  : ttype;
-          IsDynamicArray,
-          IsVariant,
-          IsConstructor,
-          IsArrayOfConst : boolean;
-          function gettypename:string;virtual;
-          function elesize : longint;
-          constructor init(l,h : longint;rd : pdef);
-          constructor load;
-          procedure write;virtual;
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          procedure deref;virtual;
-          function size : longint;virtual;
-          function alignment : longint;virtual;
-          { generates the ranges needed by the asm instruction BOUND (i386)
-            or CMP2 (Motorola) }
-          procedure genrangecheck;
-
-          { returns the label of the range check string }
-          function getrangecheckstring : string;
-          function needs_inittable : boolean;virtual;
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-       end;
-
-       precorddef = ^trecorddef;
-       trecorddef = object(tdef)
-          symtable : psymtable;
-          constructor init(p : psymtable);
-          constructor load;
-          destructor done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  size:longint;virtual;
-          function  alignment : longint;virtual;
-          function  gettypename:string;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { init/final }
-          procedure write_init_data;virtual;
-          procedure write_child_init_data;virtual;
-          function  needs_inittable : boolean;virtual;
-          { rtti }
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-       end;
-
-       porddef = ^torddef;
-       torddef = object(tdef)
-        private
-          rangenr  : longint;
-        public
-          low,high : longint;
-          typ      : tbasetype;
-          constructor init(t : tbasetype;v,b : longint);
-          constructor load;
-          procedure write;virtual;
-          function  is_publishable : boolean;virtual;
-          function  gettypename:string;virtual;
-          procedure setsize;
-          { generates the ranges needed by the asm instruction BOUND }
-          { or CMP2 (Motorola)                                       }
-          procedure genrangecheck;
-          function  getrangecheckstring : string;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_rtti_data;virtual;
-       end;
-
-       pfloatdef = ^tfloatdef;
-       tfloatdef = object(tdef)
-          typ : tfloattype;
-          constructor init(t : tfloattype);
-          constructor load;
-          procedure write;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          procedure setsize;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_rtti_data;virtual;
-       end;
-
-       pabstractprocdef = ^tabstractprocdef;
-       tabstractprocdef = object(tdef)
-          { saves a definition to the return type }
-          rettype         : ttype;
-          proctypeoption  : tproctypeoption;
-          proccalloptions : tproccalloptions;
-          procoptions     : tprocoptions;
-          para            : pparalinkedlist;
-          maxparacount,
-          minparacount    : longint;
-          symtablelevel   : byte;
-          fpu_used        : byte;    { how many stack fpu must be empty }
-          constructor init;
-          constructor load;
-          destructor done;virtual;
-          procedure  write;virtual;
-          procedure deref;virtual;
-          procedure concatpara(tt:ttype;vsp : tvarspez;defval:psym);
-          function  para_size(alignsize:longint) : longint;
-          function  demangled_paras : string;
-          function  proccalloption2str : string;
-          procedure test_if_fpu_result;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-       end;
-
-       pprocvardef = ^tprocvardef;
-       tprocvardef = object(tabstractprocdef)
-          constructor init;
-          constructor load;
-          procedure write;virtual;
-          function  size : longint;virtual;
-          function gettypename:string;virtual;
-          function is_publishable : boolean;virtual;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput); virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_child_rtti_data;virtual;
-          procedure write_rtti_data;virtual;
-       end;
-
-       tmessageinf = record
-         case integer of
-           0 : (str : pchar);
-           1 : (i : longint);
-       end;
-
-       tprocdef = object(tabstractprocdef)
-       private
-          _mangledname : pstring;
-       public
-          extnumber  : longint;
-          messageinf : tmessageinf;
-          nextoverloaded : pprocdef;
-          { where is this function defined, needed here because there
-            is only one symbol for all overloaded functions }
-          fileinfo : tfileposinfo;
-          { pointer to the local symbol table }
-          localst : psymtable;
-          { pointer to the parameter symbol table }
-          parast : psymtable;
-          { symbol owning this definition }
-          procsym : pprocsym;
-          { browser info }
-          lastref,
-          defref,
-          crossref,
-          lastwritten : pref;
-          refcount : longint;
-          _class : pobjectdef;
-          { it's a tree, but this not easy to handle }
-          { used for inlined procs                   }
-          code : pointer;
-          { info about register variables (JM) }
-          regvarinfo: pointer;
-          { true, if the procedure is only declared }
-          { (forward procedure) }
-          forwarddef,
-          { true if the procedure is declared in the interface }
-          interfacedef : boolean;
-          { true if the procedure has a forward declaration }
-          hasforward : boolean;
-          { check the problems of manglednames }
-          count      : boolean;
-          is_used    : boolean;
-          { small set which contains the modified registers }
-{$ifdef newcg}
-          usedregisters : tregisterset;
-{$else newcg}
-          usedregisters : longint;
-{$endif newcg}
-          constructor init;
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  haspara:boolean;
-          function  mangledname : string;
-          procedure setmangledname(const s : string);
-          procedure load_references;
-          function  write_references : boolean;
-{$ifdef dummy}
-          function  procname: string;
-{$endif dummy}
-          function  cplusplusmangledname : string;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { browser }
-{$ifdef BrowserLog}
-          procedure add_to_browserlog;
-{$endif BrowserLog}
-       end;
-
-       pstringdef = ^tstringdef;
-       tstringdef = object(tdef)
-          string_typ : tstringtype;
-          len        : longint;
-          constructor shortinit(l : byte);
-          constructor shortload;
-          constructor longinit(l : longint);
-          constructor longload;
-          constructor ansiinit(l : longint);
-          constructor ansiload;
-          constructor wideinit(l : longint);
-          constructor wideload;
-          function  stringtypname:string;
-          function  size : longint;virtual;
-          procedure write;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { init/final }
-          function  needs_inittable : boolean;virtual;
-          { rtti }
-          procedure write_rtti_data;virtual;
-       end;
-
-       penumdef = ^tenumdef;
-       tenumdef = object(tdef)
-          rangenr,
-          minval,
-          maxval    : longint;
-          has_jumps : boolean;
-          firstenum : penumsym;
-          basedef   : penumdef;
-          constructor init;
-          constructor init_subrange(_basedef:penumdef;_min,_max:longint);
-          constructor load;
-          destructor done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          procedure calcsavesize;
-          procedure setmax(_max:longint);
-          procedure setmin(_min:longint);
-          function  min:longint;
-          function  max:longint;
-          function  getrangecheckstring:string;
-          procedure genrangecheck;
-          { debug }
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_child_rtti_data;virtual;
-          procedure write_rtti_data;virtual;
-       end;
-
-       psetdef = ^tsetdef;
-       tsetdef = object(tdef)
-          elementtype : ttype;
-          settype : tsettype;
-          constructor init(s : pdef;high : longint);
-          constructor load;
-          destructor  done;virtual;
-          procedure write;virtual;
-          procedure deref;virtual;
-          function  gettypename:string;virtual;
-          function  is_publishable : boolean;virtual;
-          { debug }
-{$ifdef GDB}
-          function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
-          { rtti }
-          procedure write_rtti_data;virtual;
-          procedure write_child_rtti_data;virtual;
-       end;
-
-{
-  $Log$
-  Revision 1.15  2000-11-04 14:25:22  florian
-    + merged Attila's changes for interfaces, not tested yet
-
-  Revision 1.14  2000/10/31 22:02:52  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.13  2000/10/21 18:16:12  florian
-    * a lot of changes:
-       - basic dyn. array support
-       - basic C++ support
-       - some work for interfaces done
-       ....
-
-  Revision 1.12  2000/10/15 07:47:52  peter
-    * unit names and procedure names are stored mixed case
-
-  Revision 1.11  2000/10/14 10:14:53  peter
-    * moehrendorf oct 2000 rewrite
-
-  Revision 1.10  2000/09/24 15:06:29  peter
-    * use defines.inc
-
-  Revision 1.9  2000/09/19 23:08:03  pierre
-   * fixes for local class debuggging problem (merged)
-
-  Revision 1.8  2000/08/21 11:27:44  pierre
-   * fix the stabs problems
-
-  Revision 1.7  2000/08/06 19:39:28  peter
-    * default parameters working !
-
-  Revision 1.6  2000/08/06 14:17:15  peter
-    * overload fixes (merged)
-
-  Revision 1.5  2000/08/03 13:17:26  jonas
-    + allow regvars to be used inside inlined procs, which required  the
-      following changes:
-        + load regvars in genentrycode/free them in genexitcode (cgai386)
-        * moved all regvar related code to new regvars unit
-        + added pregvarinfo type to hcodegen
-        + added regvarinfo field to tprocinfo (symdef/symdefh)
-        * deallocate the regvars of the caller in secondprocinline before
-          inlining the called procedure and reallocate them afterwards
-
-  Revision 1.4  2000/08/02 19:49:59  peter
-    * first things for default parameters
-
-  Revision 1.3  2000/07/13 12:08:27  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:49  michael
-  + removed logs
-
-}

compiler/symppu.inc

@@ -1,782 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
-
-    Implementation of the reading of PPU Files for the symtable
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
-}
-
-    const
-{$ifdef FPC}
-       ppubufsize=32768;
-{$ELSE}
-    {$IFDEF USEOVERLAY}
-       ppubufsize=512;
-    {$ELSE}
-       ppubufsize=4096;
-    {$ENDIF}
-{$ENDIF}
-
-{$define ORDERSOURCES}
-
-{*****************************************************************************
-                                 PPU Writing
-*****************************************************************************}
-
-    procedure writebyte(b:byte);
-      begin
-        current_ppu^.putbyte(b);
-      end;
-
-
-    procedure writeword(w:word);
-      begin
-        current_ppu^.putword(w);
-      end;
-
-
-    procedure writelong(l:longint);
-      begin
-        current_ppu^.putlongint(l);
-      end;
-
-
-    procedure writereal(d:bestreal);
-      begin
-        current_ppu^.putreal(d);
-      end;
-
-
-    procedure writestring(const s:string);
-      begin
-        current_ppu^.putstring(s);
-      end;
-
-
-    procedure writenormalset(var s); {You cannot pass an array[0..31] of byte!}
-      begin
-        current_ppu^.putdata(s,sizeof(tnormalset));
-      end;
-
-
-    procedure writesmallset(var s; size: longint);
-      var
-        tmpl: longint;
-      begin
-        { The minimum size of a set under Delphi isn't 32 bit }
-        { this is only binary compatible with FPC if first element's value of the set is 0 }
-        tmpl:=0; move(s,tmpl,size);
-        current_ppu^.putdata(tmpl,4);
-        {old code: current_ppu^.putdata(s,4);}
-      end;
-
-    procedure writeguid(var g: tguid);
-      begin
-        current_ppu^.putdata(g,sizeof(g));
-      end;
-
-    { posinfo is not relevant for changes in PPU }
-    procedure writeposinfo(const p:tfileposinfo);
-      var
-        oldcrc : boolean;
-      begin
-        oldcrc:=current_ppu^.do_crc;
-        current_ppu^.do_crc:=false;
-        current_ppu^.putword(p.fileindex);
-        current_ppu^.putlongint(p.line);
-        current_ppu^.putword(p.column);
-        current_ppu^.do_crc:=oldcrc;
-      end;
-
-
-    procedure writederef(p : psymtableentry);
-      begin
-        if p=nil then
-         current_ppu^.putbyte(ord(derefnil))
-        else
-         begin
-           { Static symtable ? }
-           if p^.owner^.symtabletype=staticsymtable then
-            begin
-              current_ppu^.putbyte(ord(derefaktstaticindex));
-              current_ppu^.putword(p^.indexnr);
-            end
-           { Local record/object symtable ? }
-           else if (p^.owner=aktrecordsymtable) then
-            begin
-              current_ppu^.putbyte(ord(derefaktrecordindex));
-              current_ppu^.putword(p^.indexnr);
-            end
-           { Local local/para symtable ? }
-           else if (p^.owner=aktlocalsymtable) then
-            begin
-              current_ppu^.putbyte(ord(derefaktlocal));
-              current_ppu^.putword(p^.indexnr);
-            end
-           else
-            begin
-              current_ppu^.putbyte(ord(derefindex));
-              current_ppu^.putword(p^.indexnr);
-           { Current unit symtable ? }
-              repeat
-                if not assigned(p) then
-                 internalerror(556655);
-                case p^.owner^.symtabletype of
-                 { when writing the pseudo PPU file
-                   to get CRC values the globalsymtable is not yet
-                   a unitsymtable PM }
-                  globalsymtable,
-                  unitsymtable :
-                    begin
-                      { check if the unit is available in the uses
-                        clause, else it's an error }
-                      if p^.owner^.unitid=$ffff then
-                       internalerror(55665566);
-                      current_ppu^.putbyte(ord(derefunit));
-                      current_ppu^.putword(p^.owner^.unitid);
-                      break;
-                    end;
-                  staticsymtable :
-                    begin
-                      current_ppu^.putbyte(ord(derefaktstaticindex));
-                      current_ppu^.putword(p^.indexnr);
-                      break;
-                    end;
-                  localsymtable :
-                    begin
-                      p:=p^.owner^.defowner;
-                      current_ppu^.putbyte(ord(dereflocal));
-                      current_ppu^.putword(p^.indexnr);
-                    end;
-                  parasymtable :
-                    begin
-                      p:=p^.owner^.defowner;
-                      current_ppu^.putbyte(ord(derefpara));
-                      current_ppu^.putword(p^.indexnr);
-                    end;
-                  objectsymtable,
-                  recordsymtable :
-                    begin
-                      p:=p^.owner^.defowner;
-                      current_ppu^.putbyte(ord(derefrecord));
-                      current_ppu^.putword(p^.indexnr);
-                    end;
-                  else
-                    internalerror(556656);
-                end;
-              until false;
-            end;
-         end;
-      end;
-
-    procedure writedefref(p : pdef);
-      begin
-        writederef(p);
-      end;
-
-    procedure writesymref(p : psym);
-      begin
-        writederef(p);
-      end;
-
-    procedure writesourcefiles;
-      var
-        hp    : pinputfile;
-{$ifdef ORDERSOURCES}
-        i,j : longint;
-{$endif ORDERSOURCES}
-      begin
-      { second write the used source files }
-        current_ppu^.do_crc:=false;
-        hp:=current_module^.sourcefiles^.files;
-{$ifdef ORDERSOURCES}
-      { write source files directly in good order }
-        j:=0;
-        while assigned(hp) do
-          begin
-            inc(j);
-            hp:=hp^.ref_next;
-          end;
-        while j>0 do
-          begin
-            hp:=current_module^.sourcefiles^.files;
-            for i:=1 to j-1 do
-              hp:=hp^.ref_next;
-            current_ppu^.putstring(hp^.name^);
-            dec(j);
-         end;
-{$else not ORDERSOURCES}
-        while assigned(hp) do
-         begin
-         { only name and extension }
-           current_ppu^.putstring(hp^.name^);
-           hp:=hp^.ref_next;
-         end;
-{$endif ORDERSOURCES}
-        current_ppu^.writeentry(ibsourcefiles);
-        current_ppu^.do_crc:=true;
-      end;
-
-    procedure writeusedmacros;
-      var
-        hp    : pmacrosym;
-        i     : longint;
-      begin
-      { second write the used source files }
-        current_ppu^.do_crc:=false;
-        for i:=1 to macros^.symindex^.count do
-         begin
-           hp:=pmacrosym(macros^.symindex^.search(i));
-         { only used or init defined macros are stored }
-           if hp^.is_used or hp^.defined_at_startup then
-             begin
-               current_ppu^.putstring(hp^.name);
-               current_ppu^.putbyte(byte(hp^.defined_at_startup));
-               current_ppu^.putbyte(byte(hp^.is_used));
-             end;
-         end;
-        current_ppu^.writeentry(ibusedmacros);
-        current_ppu^.do_crc:=true;
-      end;
-
-
-    procedure writeusedunit;
-      var
-        hp      : pused_unit;
-      begin
-        numberunits;
-        hp:=pused_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^);
-           { 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^.do_crc:=true;
-           hp:=pused_unit(hp^.next);
-         end;
-        current_ppu^.do_interface_crc:=true;
-        current_ppu^.writeentry(ibloadunit);
-      end;
-
-
-    procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
-      var
-        hcontainer : tlinkcontainer;
-        s : string;
-        mask : longint;
-      begin
-        hcontainer.init;
-        while not p.empty do
-         begin
-           s:=p.get(mask);
-           if strippath then
-            current_ppu^.putstring(SplitFileName(s))
-           else
-            current_ppu^.putstring(s);
-           current_ppu^.putlongint(mask);
-           hcontainer.insert(s,mask);
-         end;
-        current_ppu^.writeentry(id);
-        p:=hcontainer;
-      end;
-
-
-    procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
-      begin
-         Message1(unit_u_ppu_write,s);
-
-       { create unit flags }
-         with Current_Module^ do
-          begin
-{$ifdef GDB}
-            if cs_gdb_dbx in aktglobalswitches then
-             flags:=flags or uf_has_dbx;
-{$endif GDB}
-            if target_os.endian=endian_big then
-             flags:=flags or uf_big_endian;
-            if cs_browser in aktmoduleswitches then
-             flags:=flags or uf_has_browser;
-            if cs_local_browser in aktmoduleswitches then
-             flags:=flags or uf_local_browser;
-          end;
-
-{$ifdef Test_Double_checksum_write}
-        If only_crc then
-          Assign(CRCFile,s+'.INT')
-        else
-          Assign(CRCFile,s+'.IMP');
-        Rewrite(CRCFile);
-{$endif def Test_Double_checksum_write}
-       { open ppufile }
-         current_ppu:=new(pppufile,init(s));
-         current_ppu^.crc_only:=only_crc;
-         if not current_ppu^.create then
-           Message(unit_f_ppu_cannot_write);
-
-{$ifdef Test_Double_checksum}
-         if only_crc then
-           begin
-              new(current_ppu^.crc_test);
-              new(current_ppu^.crc_test2);
-           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;
-           end;
-{$endif def Test_Double_checksum}
-
-         current_ppu^.change_endian:=source_os.endian<>target_os.endian;
-       { write symbols and definitions }
-         unittable^.writeasunit;
-
-       { flush to be sure }
-         current_ppu^.flush;
-       { create and write header }
-         current_ppu^.header.size:=current_ppu^.size;
-         current_ppu^.header.checksum:=current_ppu^.crc;
-         current_ppu^.header.interface_checksum:=current_ppu^.interface_crc;
-         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;
-         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;
-         if only_crc then
-          begin
-{$ifdef Test_Double_checksum}
-            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_ppu^.crc_test2:=nil;
-            Current_Module^.crc_size2:=current_ppu^.crc_index2;
-{$endif def Test_Double_checksum}
-            closecurrentppu;
-          end;
-{$ifdef Test_Double_checksum_write}
-        close(CRCFile);
-{$endif Test_Double_checksum_write}
-      end;
-
-
-    procedure closecurrentppu;
-      begin
-{$ifdef Test_Double_checksum}
-         if assigned(current_ppu^.crc_test) then
-           dispose(current_ppu^.crc_test);
-         if assigned(current_ppu^.crc_test2) then
-           dispose(current_ppu^.crc_test2);
-{$endif Test_Double_checksum}
-       { close }
-         current_ppu^.close;
-         dispose(current_ppu,done);
-         current_ppu:=nil;
-      end;
-
-
-{*****************************************************************************
-                                 PPU Reading
-*****************************************************************************}
-
-    function readbyte:byte;
-      begin
-        readbyte:=current_ppu^.getbyte;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readword:word;
-      begin
-        readword:=current_ppu^.getword;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readlong:longint;
-      begin
-        readlong:=current_ppu^.getlongint;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readreal : bestreal;
-      begin
-        readreal:=current_ppu^.getreal;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    function readstring : string;
-      begin
-        readstring:=current_ppu^.getstring;
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    procedure readnormalset(var s);   {You cannot pass an array [0..31] of byte.}
-      begin
-        current_ppu^.getdata(s,sizeof(tnormalset));
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    procedure readsmallset(var s;size: longint);
-      var
-        tmpl: longint;
-      begin
-        { The minimum size of a set under Delphi isn't 32 bit }
-        { this is only binary compatible if first element's value of the set is 0 }
-        current_ppu^.getdata(tmpl,4);
-        move(tmpl,s,size);
-        {old code: current_ppu^.getdata(s,4); }
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-
-    procedure readguid(var g: tguid);
-      begin
-        current_ppu^.getdata(g,sizeof(g));
-        if current_ppu^.error then
-         Message(unit_f_ppu_read_error);
-      end;
-
-    procedure readposinfo(var p:tfileposinfo);
-      begin
-        p.fileindex:=current_ppu^.getword;
-        p.line:=current_ppu^.getlongint;
-        p.column:=current_ppu^.getword;
-      end;
-
-
-    function readderef : pderef;
-      var
-        hp,p : pderef;
-        b : tdereftype;
-      begin
-        p:=nil;
-        repeat
-          hp:=p;
-          b:=tdereftype(current_ppu^.getbyte);
-          case b of
-            derefnil :
-              break;
-            derefunit,
-            derefaktrecordindex,
-            derefaktlocal,
-            derefaktstaticindex :
-              begin
-                new(p,init(b,current_ppu^.getword));
-                p^.next:=hp;
-                break;
-              end;
-            derefindex,
-            dereflocal,
-            derefpara,
-            derefrecord :
-              begin
-                new(p,init(b,current_ppu^.getword));
-                p^.next:=hp;
-              end;
-          end;
-        until false;
-        readderef:=p;
-      end;
-
-    function readdefref : pdef;
-      begin
-        readdefref:=pdef(readderef);
-      end;
-
-    function readsymref : psym;
-      begin
-        readsymref:=psym(readderef);
-      end;
-
-    procedure readusedmacros;
-      var
-        hs : string;
-        mac : pmacrosym;
-        was_defined_at_startup,
-        was_used : boolean;
-      begin
-        while not current_ppu^.endofentry do
-         begin
-           hs:=current_ppu^.getstring;
-           was_defined_at_startup:=boolean(current_ppu^.getbyte);
-           was_used:=boolean(current_ppu^.getbyte);
-           mac:=pmacrosym(macros^.search(hs));
-           if assigned(mac) then
-             begin
-{$ifndef EXTDEBUG}
-           { if we don't have the sources why tell }
-              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^);
-             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^);
-         end;
-      end;
-
-    procedure readsourcefiles;
-      var
-        temp,hs       : string;
-        temp_dir      : string;
-{$ifdef ORDERSOURCES}
-        main_dir      : string;
-{$endif ORDERSOURCES}
-        incfile_found,
-        main_found,
-        is_main       : boolean;
-        ppufiletime,
-        source_time   : longint;
-        hp            : pinputfile;
-      begin
-        ppufiletime:=getnamedfiletime(current_module^.ppufilename^);
-        current_module^.sources_avail:=true;
-{$ifdef ORDERSOURCES}
-        is_main:=true;
-        main_dir:='';
-{$endif ORDERSOURCES}
-        while not current_ppu^.endofentry do
-         begin
-           hs:=current_ppu^.getstring;
-{$ifndef ORDERSOURCES}
-           is_main:=current_ppu^.endofentry;
-{$endif ORDERSOURCES}
-           temp_dir:='';
-           if (current_module^.flags and uf_in_library)<>0 then
-            begin
-              current_module^.sources_avail:=false;
-              temp:=' library';
-            end
-           else if pos('Macro ',hs)=1 then
-            begin
-              { we don't want to find this file }
-              { but there is a problem with file indexing !! }
-              temp:='';
-            end
-           else
-            begin
-              { check the date of the source files }
-              Source_Time:=GetNamedFileTime(current_module^.path^+hs);
-              incfile_found:=false;
-              main_found:=false;
-              if Source_Time<>-1 then
-                hs:=current_module^.path^+hs
-{$ifdef ORDERSOURCES}
-              else if not(is_main) then
-                begin
-                  Source_Time:=GetNamedFileTime(main_dir+hs);
-                  if Source_Time<>-1 then
-                    hs:=main_dir+hs;
-                end
-{$endif def ORDERSOURCES}
-                   ;
-              if (Source_Time=-1) then
-                begin
-                  if is_main then
-                    temp_dir:=unitsearchpath.FindFile(hs,main_found)
-                  else
-                    temp_dir:=includesearchpath.FindFile(hs,incfile_found);
-                  if incfile_found or main_found then
-                   begin
-                     hs:=temp_dir+hs;
-                     Source_Time:=GetNamedFileTime(hs);
-                   end
-                end;
-              if Source_Time=-1 then
-               begin
-                 current_module^.sources_avail:=false;
-                 temp:=' not found';
-               end
-              else
-               begin
-                 if main_found then
-                   main_dir:=temp_dir;
-                 { time newer? But only allow if the file is not searched
-                   in the include path (PFV), else you've problems with
-                   units which use the same includefile names }
-                 if incfile_found then
-                  temp:=' found'
-                 else
-                  begin
-                    temp:=' time '+filetimestring(source_time);
-                    if (source_time>ppufiletime) then
-                     begin
-                       current_module^.do_compile:=true;
-                       current_module^.recompile_reason:=rr_sourcenewer;
-                       temp:=temp+' *'
-                     end;
-                  end;
-               end;
-              new(hp,init(hs));
-              { the indexing is wrong here PM }
-              current_module^.sourcefiles^.register_file(hp);
-            end;
-{$ifdef ORDERSOURCES}
-           if is_main then
-             begin
-               stringdispose(current_module^.mainsource);
-               current_module^.mainsource:=stringdup(hs);
-             end;
-{$endif ORDERSOURCES}
-           Message1(unit_u_ppu_source,hs+temp);
-{$ifdef ORDERSOURCES}
-           is_main:=false;
-{$endif ORDERSOURCES}
-         end;
-{$ifndef ORDERSOURCES}
-      { main source is always the last }
-        stringdispose(current_module^.mainsource);
-        current_module^.mainsource:=stringdup(hs);
-
-        { the indexing is corrected here PM }
-        current_module^.sourcefiles^.inverse_register_indexes;
-{$endif ORDERSOURCES}
-      { check if we want to rebuild every unit, only if the sources are
-        available }
-        if do_build and current_module^.sources_avail then
-          begin
-             current_module^.do_compile:=true;
-             current_module^.recompile_reason:=rr_build;
-          end;
-      end;
-
-
-    procedure readloadunit;
-      var
-        hs : string;
-        intfchecksum,
-        checksum : longint;
-        in_interface : boolean;
-      begin
-        while not current_ppu^.endofentry do
-         begin
-           hs:=current_ppu^.getstring;
-           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)));
-         end;
-      end;
-
-
-    procedure readlinkcontainer(var p:tlinkcontainer);
-      var
-        s : string;
-        m : longint;
-      begin
-        while not current_ppu^.endofentry do
-         begin
-           s:=current_ppu^.getstring;
-           m:=current_ppu^.getlongint;
-           p.insert(s,m);
-         end;
-      end;
-
-
-    procedure load_interface;
-      var
-        b : byte;
-        newmodulename : string;
-      begin
-       { read interface part }
-         repeat
-           b:=current_ppu^.readentry;
-           case b of
-             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);
-               end;
-             ibsourcefiles :
-               readsourcefiles;
-             ibusedmacros :
-               readusedmacros;
-             ibloadunit :
-               readloadunit;
-             iblinkunitofiles :
-               readlinkcontainer(current_module^.LinkUnitOFiles);
-             iblinkunitstaticlibs :
-               readlinkcontainer(current_module^.LinkUnitStaticLibs);
-             iblinkunitsharedlibs :
-               readlinkcontainer(current_module^.LinkUnitSharedLibs);
-             iblinkotherofiles :
-               readlinkcontainer(current_module^.LinkotherOFiles);
-             iblinkotherstaticlibs :
-               readlinkcontainer(current_module^.LinkotherStaticLibs);
-             iblinkothersharedlibs :
-               readlinkcontainer(current_module^.LinkotherSharedLibs);
-             ibendinterface :
-               break;
-           else
-             Message1(unit_f_ppu_invalid_entry,tostr(b));
-           end;
-         until false;
-      end;
-
-{
-  $Log$
-  Revision 1.7  2000-11-04 14:25:22  florian
-    + merged Attila's changes for interfaces, not tested yet
-
-  Revision 1.6  2000/10/31 22:02:52  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.5  2000/10/15 07:47:53  peter
-    * unit names and procedure names are stored mixed case
-
-  Revision 1.4  2000/09/24 21:33:47  peter
-    * message updates merges
-
-  Revision 1.3  2000/09/21 20:56:19  pierre
-   * fix for bugs 1084/1128 (merged)
-
-  Revision 1.2  2000/07/13 11:32:49  michael
-  + removed logs
-
-}

compiler/symsym.inc

@@ -1,2263 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
-
-    Implementation for the symbols types of the symtable
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
-}
-
-{****************************************************************************
-                          TSYM (base for all symtypes)
-****************************************************************************}
-
-    constructor tsym.init(const n : string);
-      begin
-         if n[1]='$' then
-          inherited initname(copy(n,2,255))
-         else
-          inherited initname(upper(n));
-         _realname:=stringdup(n);
-         typ:=abstractsym;
-         symoptions:=current_object_option;
-{$ifdef GDB}
-         isstabwritten := false;
-{$endif GDB}
-         fileinfo:=tokenpos;
-         defref:=nil;
-         refs:=0;
-         lastwritten:=nil;
-         refcount:=0;
-         if (cs_browser in aktmoduleswitches) and make_ref then
-          begin
-            defref:=new(pref,init(defref,@tokenpos));
-            inc(refcount);
-          end;
-         lastref:=defref;
-      end;
-
-
-    constructor tsym.load;
-      begin
-         inherited init;
-         indexnr:=readword;
-         _realname:=stringdup(readstring);
-         if _realname^[1]='$' then
-          setname(copy(_realname^,2,255))
-         else
-          setname(upper(_realname^));
-         typ:=abstractsym;
-         readsmallset(symoptions,sizeof(symoptions));
-         readposinfo(fileinfo);
-         lastref:=nil;
-         defref:=nil;
-         refs:=0;
-         lastwritten:=nil;
-         refcount:=0;
-{$ifdef GDB}
-         isstabwritten := false;
-{$endif GDB}
-      end;
-
-
-    procedure tsym.load_references;
-      var
-        pos : tfileposinfo;
-        move_last : boolean;
-      begin
-        move_last:=lastwritten=lastref;
-        while (not current_ppu^.endofentry) do
-         begin
-           readposinfo(pos);
-           inc(refcount);
-           lastref:=new(pref,init(lastref,@pos));
-           lastref^.is_written:=true;
-           if refcount=1 then
-            defref:=lastref;
-         end;
-        if move_last then
-          lastwritten:=lastref;
-      end;
-
-    { big problem here :
-      wrong refs were written because of
-      interface parsing of other units PM
-      moduleindex must be checked !! }
-
-    function tsym.write_references : boolean;
-      var
-        ref   : pref;
-        symref_written,move_last : boolean;
-      begin
-        write_references:=false;
-        if lastwritten=lastref then
-          exit;
-      { should we update lastref }
-        move_last:=true;
-        symref_written:=false;
-      { write symbol refs }
-        if assigned(lastwritten) then
-          ref:=lastwritten
-        else
-          ref:=defref;
-        while assigned(ref) do
-         begin
-           if ref^.moduleindex=current_module^.unit_index then
-             begin
-              { write address to this symbol }
-                if not symref_written then
-                  begin
-                     writesymref(@self);
-                     symref_written:=true;
-                  end;
-                writeposinfo(ref^.posinfo);
-                ref^.is_written:=true;
-                if move_last then
-                  lastwritten:=ref;
-             end
-           else if not ref^.is_written then
-             move_last:=false
-           else if move_last then
-             lastwritten:=ref;
-           ref:=ref^.nextref;
-         end;
-        if symref_written then
-          current_ppu^.writeentry(ibsymref);
-        write_references:=symref_written;
-      end;
-
-
-{$ifdef BrowserLog}
-    procedure tsym.add_to_browserlog;
-      begin
-        if assigned(defref) then
-         begin
-           browserlog.AddLog('***'+name+'***');
-           browserlog.AddLogRefs(defref);
-         end;
-      end;
-{$endif BrowserLog}
-
-
-    destructor tsym.done;
-      begin
-        if assigned(defref) then
-         begin
-           defref^.freechain;
-           dispose(defref,done);
-         end;
-        stringdispose(_realname);
-        inherited done;
-      end;
-
-
-    procedure tsym.write;
-      begin
-         writeword(indexnr);
-         writestring(_realname^);
-         writesmallset(symoptions,sizeof(symoptions));
-         writeposinfo(fileinfo);
-      end;
-
-
-    procedure tsym.prederef;
-      begin
-      end;
-
-
-    procedure tsym.deref;
-      begin
-      end;
-
-
-    function tsym.realname : string;
-      begin
-        if assigned(_realname) then
-         realname:=_realname^
-        else
-         realname:=name;
-      end;
-
-
-    function tsym.mangledname : string;
-      begin
-         mangledname:=name;
-      end;
-
-
-    { for most symbol types there is nothing to do at all }
-    procedure tsym.insert_in_data;
-      begin
-      end;
-
-
-{$ifdef GDB}
-    function tsym.stabstring : pchar;
-
-      begin
-         stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
-           tostr(fileinfo.line)+',0');
-      end;
-
-    procedure tsym.concatstabto(asmlist : paasmoutput);
-
-    var stab_str : pchar;
-      begin
-         if not isstabwritten then
-           begin
-              stab_str := stabstring;
-              { count_dbx(stab_str); moved to GDB.PAS }
-              asmlist^.concat(new(pai_stabs,init(stab_str)));
-              isstabwritten:=true;
-          end;
-    end;
-{$endif GDB}
-
-
-{****************************************************************************
-                                 TLABELSYM
-****************************************************************************}
-
-    constructor tlabelsym.init(const n : string; l : pasmlabel);
-
-      begin
-         inherited init(n);
-         typ:=labelsym;
-         lab:=l;
-         used:=false;
-         defined:=false;
-         code:=nil;
-      end;
-
-    constructor tlabelsym.load;
-
-      begin
-         tsym.load;
-         typ:=labelsym;
-         { this is all dummy
-           it is only used for local browsing }
-         lab:=nil;
-         code:=nil;
-         used:=false;
-         defined:=true;
-      end;
-
-    destructor tlabelsym.done;
-
-      begin
-         inherited done;
-      end;
-
-
-    function tlabelsym.mangledname : string;
-      begin
-         mangledname:=lab^.name;
-      end;
-
-
-    procedure tlabelsym.write;
-      begin
-         if owner^.symtabletype in [unitsymtable,globalsymtable] then
-           Message(sym_e_ill_label_decl)
-         else
-           begin
-              tsym.write;
-              current_ppu^.writeentry(iblabelsym);
-           end;
-      end;
-
-
-{****************************************************************************
-                                  TUNITSYM
-****************************************************************************}
-
-    constructor tunitsym.init(const n : string;ref : punitsymtable);
-      var
-        old_make_ref : boolean;
-      begin
-         old_make_ref:=make_ref;
-         make_ref:=false;
-         inherited init(n);
-         make_ref:=old_make_ref;
-         typ:=unitsym;
-         unitsymtable:=ref;
-         prevsym:=ref^.unitsym;
-         ref^.unitsym:=@self;
-         refs:=0;
-      end;
-
-    constructor tunitsym.load;
-
-      begin
-         tsym.load;
-         typ:=unitsym;
-         unitsymtable:=punitsymtable(current_module^.globalsymtable);
-         prevsym:=nil;
-      end;
-
-    { we need to remove it from the prevsym chain ! }
-
-    procedure tunitsym.restoreunitsym;
-      var pus,ppus : punitsym;
-      begin
-         if assigned(unitsymtable) then
-           begin
-             ppus:=nil;
-             pus:=unitsymtable^.unitsym;
-             if pus=@self then
-               unitsymtable^.unitsym:=prevsym
-             else while assigned(pus) do
-               begin
-                  if pus=@self then
-                    begin
-                       ppus^.prevsym:=prevsym;
-                       break;
-                    end
-                  else
-                    begin
-                       ppus:=pus;
-                       pus:=ppus^.prevsym;
-                    end;
-               end;
-           end;
-         prevsym:=nil;
-      end;
-
-    destructor tunitsym.done;
-      begin
-         restoreunitsym;
-         inherited done;
-      end;
-
-    procedure tunitsym.write;
-      begin
-         tsym.write;
-         current_ppu^.writeentry(ibunitsym);
-      end;
-
-{$ifdef GDB}
-    procedure tunitsym.concatstabto(asmlist : paasmoutput);
-      begin
-      {Nothing to write to stabs !}
-      end;
-{$endif GDB}
-
-{****************************************************************************
-                                  TPROCSYM
-****************************************************************************}
-
-    constructor tprocsym.init(const n : string);
-
-      begin
-         tsym.init(n);
-         typ:=procsym;
-         definition:=nil;
-         owner:=nil;
-         is_global := false;
-      end;
-
-    constructor tprocsym.load;
-
-      begin
-         tsym.load;
-         typ:=procsym;
-         definition:=pprocdef(readdefref);
-         is_global := false;
-      end;
-
-    destructor tprocsym.done;
-
-      begin
-         { don't check if errors !! }
-         if Errorcount=0 then
-           check_forward;
-         tsym.done;
-      end;
-
-    function tprocsym.mangledname : string;
-
-      begin
-         mangledname:=definition^.mangledname;
-      end;
-
-
-    function tprocsym.declarationstr(p : pprocdef):string;
-      begin
-        declarationstr:=realname+p^.demangled_paras;
-      end;
-
-
-    procedure tprocsym.write_parameter_lists(skipdef:pprocdef);
-      var
-         p : pprocdef;
-      begin
-         p:=definition;
-         while assigned(p) do
-           begin
-              if p<>skipdef then
-                MessagePos1(p^.fileinfo,sym_b_param_list,name+p^.demangled_paras);
-              p:=p^.nextoverloaded;
-           end;
-      end;
-
-
-    procedure tprocsym.check_forward;
-      var
-         pd : pprocdef;
-      begin
-         pd:=definition;
-         while assigned(pd) do
-           begin
-              if pd^.forwarddef then
-                begin
-                   if assigned(pd^._class) then
-                     MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^._class^.objname^+'.'+declarationstr(pd))
-                   else
-                     MessagePos1(fileinfo,sym_e_forward_not_resolved,declarationstr(pd));
-                   { Turn futher error messages off }
-                   pd^.forwarddef:=false;
-                end;
-              pd:=pd^.nextoverloaded;
-              { do not check defs of operators in other units }
-              if assigned(pd) and (pd^.procsym<>@self) then
-                pd:=nil;
-           end;
-      end;
-
-
-    procedure tprocsym.deref;
-{$ifdef DONOTCHAINOPERATORS}
-      var
-        t    : ttoken;
-        last,pd : pprocdef;
-{$endif DONOTCHAINOPERATORS}
-      begin
-         resolvedef(pdef(definition));
-{$ifdef DONOTCHAINOPERATORS}
-         if (definition^.proctypeoption=potype_operator) then
-           begin
-              last:=definition;
-              while assigned(last^.nextoverloaded) do
-                last:=last^.nextoverloaded;
-              for t:=first_overloaded to last_overloaded do
-              if (name=overloaded_names[t]) then
-                begin
-                   if assigned(overloaded_operators[t]) then
-                     begin
-                       pd:=overloaded_operators[t]^.definition;
-                       { test if not already in list, bug report by KC Wong PM }
-                       while assigned(pd) do
-                         if pd=last then
-                           break
-                         else
-                           pd:=pd^.nextoverloaded;
-                       if pd=last then
-                         break;
-                       last^.nextoverloaded:=overloaded_operators[t]^.definition;
-                     end;
-                   overloaded_operators[t]:=@self;
-                   break;
-                end;
-           end;
-{$endif DONOTCHAINOPERATORS}
-      end;
-
-    procedure tprocsym.order_overloaded;
-      var firstdef,currdef,lastdef,nextopdef : pprocdef;
-      begin
-         if not assigned(definition) then
-           exit;
-         firstdef:=definition;
-         currdef:=definition;
-         while assigned(currdef) and (currdef^.owner=firstdef^.owner) do
-           begin
-             currdef^.count:=false;
-             currdef:=currdef^.nextoverloaded;
-           end;
-         nextopdef:=currdef;
-         definition:=definition^.nextoverloaded;
-         firstdef^.nextoverloaded:=nil;
-         while (definition<>nextopdef) do
-           begin
-             currdef:=firstdef;
-             lastdef:=definition;
-             definition:=definition^.nextoverloaded;
-             if lastdef^.mangledname<firstdef^.mangledname then
-               begin
-                 lastdef^.nextoverloaded:=firstdef;
-                 firstdef:=lastdef;
-               end
-             else
-               begin
-                 while assigned(currdef^.nextoverloaded) and
-                    (lastdef^.mangledname>currdef^.nextoverloaded^.mangledname) do
-                   currdef:=currdef^.nextoverloaded;
-                 lastdef^.nextoverloaded:=currdef^.nextoverloaded;
-                 currdef^.nextoverloaded:=lastdef;
-               end;
-           end;
-         definition:=firstdef;
-         currdef:=definition;
-         while assigned(currdef) do
-           begin
-             currdef^.count:=true;
-             lastdef:=currdef;
-             currdef:=currdef^.nextoverloaded;
-           end;
-         lastdef^.nextoverloaded:=nextopdef;
-      end;
-
-    procedure tprocsym.write;
-      begin
-         tsym.write;
-         writedefref(pdef(definition));
-         current_ppu^.writeentry(ibprocsym);
-      end;
-
-
-    procedure tprocsym.load_references;
-      (*var
-        prdef,prdef2 : pprocdef;
-        b : byte; *)
-      begin
-         inherited load_references;
-         (*prdef:=definition;
-           done in tsymtable.load_browser (PM)
-         { take care about operators !!  }
-         if (current_module^.flags and uf_has_browser) <>0 then
-           while assigned(prdef) and (prdef^.owner=definition^.owner) do
-             begin
-                b:=current_ppu^.readentry;
-                if b<>ibdefref then
-                  Message(unit_f_ppu_read_error);
-                prdef2:=pprocdef(readdefref);
-                resolvedef(prdef2);
-                if prdef<>prdef2 then
-                  Message(unit_f_ppu_read_error);
-                prdef^.load_references;
-                prdef:=prdef^.nextoverloaded;
-             end; *)
-      end;
-
-    function tprocsym.write_references : boolean;
-      var
-        prdef : pprocdef;
-      begin
-         write_references:=false;
-         if not inherited write_references then
-           exit;
-         write_references:=true;
-         prdef:=definition;
-         while assigned(prdef) and (prdef^.owner=definition^.owner) do
-          begin
-            prdef^.write_references;
-            prdef:=prdef^.nextoverloaded;
-          end;
-      end;
-
-
-{$ifdef BrowserLog}
-    procedure tprocsym.add_to_browserlog;
-      var
-        prdef : pprocdef;
-      begin
-         inherited add_to_browserlog;
-         prdef:=definition;
-         while assigned(prdef) do
-           begin
-              pprocdef(prdef)^.add_to_browserlog;
-              prdef:=pprocdef(prdef)^.nextoverloaded;
-           end;
-      end;
-{$endif BrowserLog}
-
-
-{$ifdef GDB}
-    function tprocsym.stabstring : pchar;
-     Var RetType : Char;
-         Obj,Info : String;
-         stabsstr : string;
-         p : pchar;
-    begin
-      obj := name;
-      info := '';
-      if is_global then
-       RetType := 'F'
-      else
-       RetType := 'f';
-     if assigned(owner) then
-      begin
-        if (owner^.symtabletype = objectsymtable) then
-         obj := upper(owner^.name^)+'__'+name;
-        { this code was correct only as long as the local symboltable
-          of the parent had the same name as the function
-          but this is no true anymore !! PM
-        if (owner^.symtabletype=localsymtable) and assigned(owner^.name) then
-         info := ','+name+','+owner^.name^;  }
-        if (owner^.symtabletype=localsymtable) and assigned(owner^.defowner) and
-           assigned(pprocdef(owner^.defowner)^.procsym) then
-          info := ','+name+','+pprocdef(owner^.defowner)^.procsym^.name;
-      end;
-     stabsstr:=definition^.mangledname;
-     getmem(p,length(stabsstr)+255);
-     strpcopy(p,'"'+obj+':'+RetType
-           +definition^.rettype.def^.numberstring+info+'",'+tostr(n_function)
-           +',0,'+
-           tostr(aktfilepos.line)
-           +',');
-     strpcopy(strend(p),stabsstr);
-     stabstring:=strnew(p);
-     freemem(p,length(stabsstr)+255);
-    end;
-
-    procedure tprocsym.concatstabto(asmlist : paasmoutput);
-    begin
-      if (pocall_internproc in definition^.proccalloptions) then exit;
-      if not isstabwritten then
-        asmlist^.concat(new(pai_stabs,init(stabstring)));
-      isstabwritten := true;
-      if assigned(definition^.parast) then
-        definition^.parast^.concatstabto(asmlist);
-      { local type defs and vars should not be written
-        inside the main proc stab }
-      if assigned(definition^.localst) and
-         (lexlevel>main_program_level) then
-        definition^.localst^.concatstabto(asmlist);
-      definition^.is_def_stab_written := written;
-    end;
-{$endif GDB}
-
-
-{****************************************************************************
-                                  TERRORSYM
-****************************************************************************}
-
-    constructor terrorsym.init;
-      begin
-        inherited init('');
-        typ:=errorsym;
-      end;
-
-{****************************************************************************
-                                TPROPERTYSYM
-****************************************************************************}
-
-    constructor tpropertysym.init(const n : string);
-      begin
-         inherited init(n);
-         typ:=propertysym;
-         propoptions:=[];
-         index:=0;
-         default:=0;
-         proptype.reset;
-         indextype.reset;
-         new(readaccess,init);
-         new(writeaccess,init);
-         new(storedaccess,init);
-      end;
-
-
-    constructor tpropertysym.load;
-      begin
-         inherited load;
-         typ:=propertysym;
-         readsmallset(propoptions,sizeof(propoptions));
-         if (ppo_is_override in propoptions) then
-          begin
-            propoverriden:=ppropertysym(readsymref);
-            { we need to have these objects initialized }
-            new(readaccess,init);
-            new(writeaccess,init);
-            new(storedaccess,init);
-          end
-         else
-          begin
-            proptype.load;
-            index:=readlong;
-            default:=readlong;
-            indextype.load;
-            new(readaccess,load);
-            new(writeaccess,load);
-            new(storedaccess,load);
-          end;
-      end;
-
-
-    destructor tpropertysym.done;
-      begin
-         dispose(readaccess,done);
-         dispose(writeaccess,done);
-         dispose(storedaccess,done);
-         inherited done;
-      end;
-
-
-    procedure tpropertysym.deref;
-      begin
-        if (ppo_is_override in propoptions) then
-         begin
-           resolvesym(psym(propoverriden));
-           dooverride(propoverriden);
-         end
-        else
-         begin
-           proptype.resolve;
-           indextype.resolve;
-           readaccess^.resolve;
-           writeaccess^.resolve;
-           storedaccess^.resolve;
-         end;
-      end;
-
-
-    function tpropertysym.getsize : longint;
-      begin
-         getsize:=0;
-      end;
-
-
-    procedure tpropertysym.write;
-      begin
-        tsym.write;
-        writesmallset(propoptions,sizeof(propoptions));
-        if (ppo_is_override in propoptions) then
-         writesymref(propoverriden)
-        else
-         begin
-           proptype.write;
-           writelong(index);
-           writelong(default);
-           indextype.write;
-           readaccess^.write;
-           writeaccess^.write;
-           storedaccess^.write;
-         end;
-        current_ppu^.writeentry(ibpropertysym);
-      end;
-
-
-    procedure tpropertysym.dooverride(overriden:ppropertysym);
-      begin
-        propoverriden:=overriden;
-        proptype:=overriden^.proptype;
-        propoptions:=overriden^.propoptions+[ppo_is_override];
-        index:=overriden^.index;
-        default:=overriden^.default;
-        indextype:=overriden^.indextype;
-        readaccess^.clear;
-        readaccess:=overriden^.readaccess^.getcopy;
-        writeaccess^.clear;
-        writeaccess:=overriden^.writeaccess^.getcopy;
-        storedaccess^.clear;
-        storedaccess:=overriden^.storedaccess^.getcopy;
-      end;
-
-
-{$ifdef GDB}
-    function tpropertysym.stabstring : pchar;
-      begin
-         { !!!! don't know how to handle }
-         stabstring:=strpnew('');
-      end;
-
-    procedure tpropertysym.concatstabto(asmlist : paasmoutput);
-      begin
-         { !!!! don't know how to handle }
-      end;
-{$endif GDB}
-
-{****************************************************************************
-                                  TFUNCRETSYM
-****************************************************************************}
-
-    constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
-
-      begin
-         tsym.init(n);
-         typ:=funcretsym;
-         funcretprocinfo:=approcinfo;
-         rettype:=pprocinfo(approcinfo)^.returntype;
-         { address valid for ret in param only }
-         { otherwise set by insert             }
-         address:=pprocinfo(approcinfo)^.return_offset;
-      end;
-
-    constructor tfuncretsym.load;
-      begin
-         tsym.load;
-         rettype.load;
-         address:=readlong;
-         funcretprocinfo:=nil;
-         typ:=funcretsym;
-      end;
-
-    destructor tfuncretsym.done;
-      begin
-        inherited done;
-      end;
-
-    procedure tfuncretsym.write;
-      begin
-         tsym.write;
-         rettype.write;
-         writelong(address);
-         current_ppu^.writeentry(ibfuncretsym);
-      end;
-
-    procedure tfuncretsym.deref;
-      begin
-         rettype.resolve;
-      end;
-
-{$ifdef GDB}
-    procedure tfuncretsym.concatstabto(asmlist : paasmoutput);
-      begin
-        { Nothing to do here, it is done in genexitcode  }
-      end;
-{$endif GDB}
-
-    procedure tfuncretsym.insert_in_data;
-      var
-        l : longint;
-      begin
-        { if retoffset is already set then reuse it, this is needed
-          when inserting the result variable }
-        if procinfo^.return_offset<>0 then
-         address:=procinfo^.return_offset
-        else
-         begin
-           { allocate space in local if ret in acc or in fpu }
-           if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def^.deftype=floatdef) then
-            begin
-              l:=rettype.def^.size;
-              inc(owner^.datasize,l);
-{$ifdef m68k}
-              { word alignment required for motorola }
-              if (l=1) then
-               inc(owner^.datasize,1)
-              else
-{$endif}
-              if (l>=4) and ((owner^.datasize and 3)<>0) then
-                inc(owner^.datasize,4-(owner^.datasize and 3))
-              else if (l>=2) and ((owner^.datasize and 1)<>0) then
-                inc(owner^.datasize,2-(owner^.datasize and 1));
-              address:=owner^.datasize;
-              procinfo^.return_offset:=-owner^.datasize;
-            end;
-         end;
-      end;
-
-
-{****************************************************************************
-                                  TABSOLUTESYM
-****************************************************************************}
-
-    constructor tabsolutesym.init(const n : string;const tt : ttype);
-      begin
-        inherited init(n,tt);
-        typ:=absolutesym;
-      end;
-
-
-    constructor tabsolutesym.initdef(const n : string;p : pdef);
-      var
-        t : ttype;
-      begin
-        t.setdef(p);
-        tabsolutesym.init(n,t);
-      end;
-
-
-    constructor tabsolutesym.load;
-      begin
-         tvarsym.load;
-         typ:=absolutesym;
-         ref:=nil;
-         address:=0;
-         asmname:=nil;
-         abstyp:=absolutetyp(readbyte);
-         absseg:=false;
-         case abstyp of
-           tovar :
-             begin
-               asmname:=stringdup(readstring);
-               ref:=srsym;
-             end;
-           toasm :
-             asmname:=stringdup(readstring);
-           toaddr :
-             begin
-               address:=readlong;
-               absseg:=boolean(readbyte);
-             end;
-         end;
-      end;
-
-
-    procedure tabsolutesym.write;
-      var
-        hvo : tvaroptions;
-      begin
-         { Note: This needs to write everything of tvarsym.write }
-         tsym.write;
-         writebyte(byte(varspez));
-         if read_member then
-           writelong(address);
-         { write only definition or definitionsym }
-         vartype.write;
-         hvo:=varoptions-[vo_regable];
-         writesmallset(hvo,sizeof(hvo));
-         writebyte(byte(abstyp));
-         case abstyp of
-           tovar :
-             writestring(ref^.name);
-           toasm :
-             writestring(asmname^);
-           toaddr :
-             begin
-               writelong(address);
-               writebyte(byte(absseg));
-             end;
-         end;
-        current_ppu^.writeentry(ibabsolutesym);
-      end;
-
-
-    procedure tabsolutesym.deref;
-      begin
-         tvarsym.deref;
-         if (abstyp=tovar) and (asmname<>nil) then
-           begin
-              { search previous loaded symtables }
-              getsym(asmname^,false);
-              if not(assigned(srsym)) then
-                getsymonlyin(owner,asmname^);
-              if not(assigned(srsym)) then
-                srsym:=generrorsym;
-              ref:=srsym;
-              stringdispose(asmname);
-           end;
-      end;
-
-
-    function tabsolutesym.mangledname : string;
-      begin
-         case abstyp of
-           tovar :
-             mangledname:=ref^.mangledname;
-           toasm :
-             mangledname:=asmname^;
-           toaddr :
-             mangledname:='$'+tostr(address);
-         else
-           internalerror(10002);
-         end;
-      end;
-
-
-    procedure tabsolutesym.insert_in_data;
-      begin
-      end;
-
-
-{$ifdef GDB}
-    procedure tabsolutesym.concatstabto(asmlist : paasmoutput);
-      begin
-      { I don't know how to handle this !! }
-      end;
-{$endif GDB}
-
-
-{****************************************************************************
-                                  TVARSYM
-****************************************************************************}
-
-    constructor tvarsym.init(const n : string;const tt : ttype);
-      begin
-         tsym.init(n);
-         typ:=varsym;
-         vartype:=tt;
-         _mangledname:=nil;
-         varspez:=vs_value;
-         address:=0;
-         localvarsym:=nil;
-         refs:=0;
-         varstate:=vs_used;
-         varoptions:=[];
-         { can we load the value into a register ? }
-         if tt.def^.is_intregable then
-           include(varoptions,vo_regable)
-         else
-           exclude(varoptions,vo_regable);
-
-         if tt.def^.is_fpuregable then
-           include(varoptions,vo_fpuregable)
-         else
-           exclude(varoptions,vo_fpuregable);
-         reg:=R_NO;
-      end;
-
-
-    constructor tvarsym.init_dll(const n : string;const tt : ttype);
-      begin
-         tvarsym.init(n,tt);
-         include(varoptions,vo_is_dll_var);
-      end;
-
-
-    constructor tvarsym.init_C(const n,mangled : string;const tt : ttype);
-      begin
-         tvarsym.init(n,tt);
-         include(varoptions,vo_is_C_var);
-         setmangledname(mangled);
-      end;
-
-
-    constructor tvarsym.initdef(const n : string;p : pdef);
-      var
-        t : ttype;
-      begin
-        t.setdef(p);
-        tvarsym.init(n,t);
-      end;
-
-
-    constructor tvarsym.load;
-      begin
-         tsym.load;
-         typ:=varsym;
-         _mangledname:=nil;
-         reg:=R_NO;
-         refs := 0;
-         varstate:=vs_used;
-         varspez:=tvarspez(readbyte);
-         if read_member then
-           address:=readlong
-         else
-           address:=0;
-         localvarsym:=nil;
-         vartype.load;
-         readsmallset(varoptions,sizeof(varoptions));
-         if (vo_is_C_var in varoptions) then
-           setmangledname(readstring);
-      end;
-
-
-    destructor tvarsym.done;
-      begin
-         strdispose(_mangledname);
-         inherited done;
-      end;
-
-
-    procedure tvarsym.deref;
-      begin
-        vartype.resolve;
-      end;
-
-
-    procedure tvarsym.write;
-      var
-        hvo : tvaroptions;
-      begin
-         tsym.write;
-         writebyte(byte(varspez));
-         if read_member then
-          writelong(address);
-         vartype.write;
-         { symbols which are load are never candidates for a register,
-           turn off the regable }
-         hvo:=varoptions-[vo_regable];
-         writesmallset(hvo,sizeof(hvo));
-         if (vo_is_C_var in varoptions) then
-           writestring(mangledname);
-         current_ppu^.writeentry(ibvarsym);
-      end;
-
-
-    procedure tvarsym.setmangledname(const s : string);
-      begin
-        _mangledname:=strpnew(s);
-      end;
-
-
-    function tvarsym.mangledname : string;
-      var
-        prefix : string;
-      begin
-         if assigned(_mangledname) then
-           begin
-              mangledname:=strpas(_mangledname);
-              exit;
-           end;
-         case owner^.symtabletype of
-           staticsymtable :
-             if (cs_create_smart in aktmoduleswitches) then
-               prefix:='_'+owner^.name^+'$$$_'
-             else
-               prefix:='_';
-           unitsymtable,
-           globalsymtable :
-             prefix:=
-              'U_'+owner^.name^+'_';
-           else
-             Message(sym_e_invalid_call_tvarsymmangledname);
-         end;
-         mangledname:=prefix+name;
-      end;
-
-
-    function tvarsym.getsize : longint;
-      begin
-        if assigned(vartype.def) then
-          getsize:=vartype.def^.size
-        else
-          getsize:=0;
-      end;
-
-
-    function tvarsym.getvaluesize : longint;
-      begin
-        if assigned(vartype.def) and
-           (varspez=vs_value) and
-           ((vartype.def^.deftype<>arraydef) or
-            (Parraydef(vartype.def)^.highrange>=Parraydef(vartype.def)^.lowrange)) then
-          getvaluesize:=vartype.def^.size
-        else
-          getvaluesize:=0;
-      end;
-
-
-    function tvarsym.getpushsize : longint;
-      begin
-         if assigned(vartype.def) then
-           begin
-              case varspez of
-                vs_out,
-                vs_var :
-                  getpushsize:=target_os.size_of_pointer;
-                vs_value,
-                vs_const :
-                  begin
-                      if push_addr_param(vartype.def) then
-                        getpushsize:=target_os.size_of_pointer
-                      else
-                        getpushsize:=vartype.def^.size;
-                  end;
-              end;
-           end
-         else
-           getpushsize:=0;
-      end;
-
-
-    function  data_align(length : longint) : longint;
-      begin
-         (* this is useless under go32v2 at least
-         because the section are only align to dword
-         if length>8 then
-           data_align:=16
-         else if length>4 then
-           data_align:=8
-         else *)
-         if length>2 then
-           data_align:=4
-         else
-          if length>1 then
-           data_align:=2
-         else
-           data_align:=1;
-      end;
-
-
-    procedure tvarsym.insert_in_data;
-      var
-         varalign,
-         l,ali,modulo : longint;
-         storefilepos : tfileposinfo;
-      begin
-        if (vo_is_external in varoptions) then
-          exit;
-        { handle static variables of objects especially }
-        if read_member and (owner^.symtabletype=objectsymtable) and
-           (sp_static in symoptions) then
-         begin
-            { the data filed is generated in parser.pas
-              with a tobject_FIELDNAME variable }
-            { this symbol can't be loaded to a register }
-            exclude(varoptions,vo_regable);
-            exclude(varoptions,vo_fpuregable);
-         end
-        else
-         if not(read_member) then
-          begin
-             { made problems with parameters etc. ! (FK) }
-             {  check for instance of an abstract object or class }
-             {
-             if (pvarsym(sym)^.definition^.deftype=objectdef) and
-               (oo_is_abstract in pobjectdef(pvarsym(sym)^.definition)^.options) then
-               Message(sym_e_no_instance_of_abstract_object);
-             }
-             storefilepos:=aktfilepos;
-             aktfilepos:=tokenpos;
-             if (vo_is_thread_var in varoptions) then
-               l:=4
-             else
-               l:=getvaluesize;
-             case owner^.symtabletype of
-               stt_exceptsymtable:
-                 { can contain only one symbol, address calculated later }
-                 ;
-               localsymtable :
-                 begin
-                   varstate:=vs_declared;
-                   modulo:=owner^.datasize and 3;
-{$ifdef m68k}
-                 { word alignment required for motorola }
-                   if (l=1) then
-                    l:=2
-                   else
-{$endif}
-{
-                   if (cs_optimize in aktglobalswitches) and
-                      (aktoptprocessor in [classp5,classp6]) and
-                      (l>=8) and ((owner^.datasize and 7)<>0) then
-                     inc(owner^.datasize,8-(owner^.datasize and 7))
-                   else
-}
-                     begin
-                        if (l>=4) and (modulo<>0) then
-                          inc(l,4-modulo)
-                        else
-                          if (l>=2) and ((modulo and 1)<>0) then
-                            inc(l,2-(modulo and 1));
-                     end;
-                   inc(owner^.datasize,l);
-                   address:=owner^.datasize;
-                 end;
-               staticsymtable :
-                 begin
-                   { enable unitialized warning for local symbols }
-                   varstate:=vs_declared;
-                   if (cs_create_smart in aktmoduleswitches) then
-                     bsssegment^.concat(new(pai_cut,init));
-                   ali:=data_align(l);
-                   if ali>1 then
-                     begin
-                        modulo:=owner^.datasize mod ali;
-                        if modulo>0 then
-                          inc(owner^.datasize,ali-modulo);
-                     end;
-{$ifdef GDB}
-                   if cs_debuginfo in aktmoduleswitches then
-                      concatstabto(bsssegment);
-{$endif GDB}
-
-                   if (cs_create_smart in aktmoduleswitches) or
-                      DLLSource or
-                      (vo_is_exported in varoptions) or
-                      (vo_is_C_var in varoptions) then
-                     bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
-                   else
-                     bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
-                   { increase datasize }
-                   inc(owner^.datasize,l);
-                   { this symbol can't be loaded to a register }
-                   exclude(varoptions,vo_regable);
-                   exclude(varoptions,vo_fpuregable);
-                 end;
-               globalsymtable :
-                 begin
-                   if (cs_create_smart in aktmoduleswitches) then
-                     bsssegment^.concat(new(pai_cut,init));
-                   ali:=data_align(l);
-                   if ali>1 then
-                     begin
-                        modulo:=owner^.datasize mod ali;
-                        if modulo>0 then
-                          inc(owner^.datasize,ali-modulo);
-                     end;
-{$ifdef GDB}
-                   if cs_debuginfo in aktmoduleswitches then
-                     concatstabto(bsssegment);
-{$endif GDB}
-                   bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)));
-                   inc(owner^.datasize,l);
-                   { this symbol can't be loaded to a register }
-                   exclude(varoptions,vo_regable);
-                   exclude(varoptions,vo_fpuregable);
-                 end;
-               recordsymtable,
-               objectsymtable :
-                 begin
-                 { this symbol can't be loaded to a register }
-                   exclude(varoptions,vo_regable);
-                   exclude(varoptions,vo_fpuregable);
-                 { get the alignment size }
-                   if (aktpackrecords=packrecord_C) then
-                    begin
-                      varalign:=vartype.def^.alignment;
-                      if (varalign>4) and ((varalign mod 4)<>0) and
-                        (vartype.def^.deftype=arraydef) then
-                        begin
-                          Message1(sym_w_wrong_C_pack,vartype.def^.typename);
-                        end;
-                      if varalign=0 then
-                        varalign:=l;
-                      if (owner^.dataalignment<target_os.maxCrecordalignment) then
-                       begin
-                         if (varalign>16) and (owner^.dataalignment<32) then
-                          owner^.dataalignment:=32
-                         else if (varalign>12) and (owner^.dataalignment<16) then
-                          owner^.dataalignment:=16
-                         { 12 is needed for long double }
-                         else if (varalign>8) and (owner^.dataalignment<12) then
-                          owner^.dataalignment:=12
-                         else if (varalign>4) and (owner^.dataalignment<8) then
-                          owner^.dataalignment:=8
-                         else if (varalign>2) and (owner^.dataalignment<4) then
-                          owner^.dataalignment:=4
-                         else if (varalign>1) and (owner^.dataalignment<2) then
-                          owner^.dataalignment:=2;
-                       end;
-                      if owner^.dataalignment>target_os.maxCrecordalignment then
-                        owner^.dataalignment:=target_os.maxCrecordalignment;
-                    end
-                   else
-                    varalign:=vartype.def^.alignment;
-                   if varalign=0 then
-                     varalign:=l;
-                 { align record and object fields }
-                   if (varalign=1) or (owner^.dataalignment=1) then
-                    begin
-                      address:=owner^.datasize;
-                      inc(owner^.datasize,l)
-                    end
-                   else if (varalign=2) or (owner^.dataalignment=2) then
-                     begin
-                       owner^.datasize:=(owner^.datasize+1) and (not 1);
-                       address:=owner^.datasize;
-                       inc(owner^.datasize,l)
-                     end
-                   else if (varalign<=4) or (owner^.dataalignment=4) then
-                     begin
-                       owner^.datasize:=(owner^.datasize+3) and (not 3);
-                       address:=owner^.datasize;
-                       inc(owner^.datasize,l);
-                     end
-                   else if (varalign<=8) or (owner^.dataalignment=8) then
-                     begin
-                       owner^.datasize:=(owner^.datasize+7) and (not 7);
-                       address:=owner^.datasize;
-                       inc(owner^.datasize,l);
-                     end
-                         { 12 is needed for C long double support }
-                   else if (varalign<=12) and (owner^.dataalignment=12) then
-                     begin
-                       owner^.datasize:=((owner^.datasize+11) div 12) * 12;
-                       address:=owner^.datasize;
-                       inc(owner^.datasize,l);
-                     end
-                   else if (varalign<=16) or (owner^.dataalignment=16) then
-                     begin
-                       owner^.datasize:=(owner^.datasize+15) and (not 15);
-                       address:=owner^.datasize;
-                       inc(owner^.datasize,l);
-                     end
-                   else if (varalign<=32) or (owner^.dataalignment=32) then
-                     begin
-                       owner^.datasize:=(owner^.datasize+31) and (not 31);
-                       address:=owner^.datasize;
-                       inc(owner^.datasize,l);
-                     end
-                    else
-                     internalerror(1000022);
-                 end;
-               parasymtable :
-                 begin
-                   { here we need the size of a push instead of the
-                     size of the data }
-                   l:=getpushsize;
-                   varstate:=vs_assigned;
-                   address:=owner^.datasize;
-                   owner^.datasize:=align(owner^.datasize+l,target_os.stackalignment);
-                 end
-               else
-                 begin
-                     modulo:=owner^.datasize and 3;
-                     if (l>=4) and (modulo<>0) then
-                       inc(owner^.datasize,4-modulo)
-                     else
-                       if (l>=2) and ((modulo and 1)<>0) then
-                         inc(owner^.datasize);
-                   address:=owner^.datasize;
-                   inc(owner^.datasize,l);
-                 end;
-               end;
-             aktfilepos:=storefilepos;
-        end;
-      end;
-
-{$ifdef GDB}
-    function tvarsym.stabstring : pchar;
-     var
-       st : string;
-     begin
-       st:=vartype.def^.numberstring;
-       if (owner^.symtabletype = objectsymtable) and
-          (sp_static in symoptions) then
-         begin
-            if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
-{$ifndef Delphi}
-            stabstring := strpnew('"'+owner^.name^+'__'+name+':'+st+
-                     '",'+
-                     tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
-{$endif}
-         end
-       else if (owner^.symtabletype = globalsymtable) or
-          (owner^.symtabletype = unitsymtable) then
-         begin
-            { Here we used S instead of
-              because with G GDB doesn't look at the address field
-              but searches the same name or with a leading underscore
-              but these names don't exist in pascal !}
-            if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
-            stabstring := strpnew('"'+name+':'+st+'",'+
-                     tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
-         end
-       else if owner^.symtabletype = staticsymtable then
-         begin
-            stabstring := strpnew('"'+name+':S'+st+'",'+
-                  tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
-         end
-       else if (owner^.symtabletype in [parasymtable,inlineparasymtable]) then
-         begin
-            case varspez of
-               vs_out,
-               vs_var   : st := 'v'+st;
-               vs_value,
-               vs_const : if push_addr_param(vartype.def) then
-                            st := 'v'+st { should be 'i' but 'i' doesn't work }
-                          else
-                            st := 'p'+st;
-              end;
-            stabstring := strpnew('"'+name+':'+st+'",'+
-                  tostr(N_PSYM)+',0,'+tostr(fileinfo.line)+','+
-                  tostr(address+owner^.address_fixup));
-                  {offset to ebp => will not work if the framepointer is esp
-                  so some optimizing will make things harder to debug }
-         end
-       else if (owner^.symtabletype in [localsymtable,inlinelocalsymtable]) then
-   {$ifdef i386}
-         if reg<>R_NO then
-           begin
-              { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
-              { this is the register order for GDB}
-              stabstring:=strpnew('"'+name+':r'+st+'",'+
-                        tostr(N_RSYM)+',0,'+
-                        tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
-           end
-         else
-   {$endif i386}
-           { I don't know if this will work (PM) }
-           if (vo_is_C_var in varoptions) then
-            stabstring := strpnew('"'+name+':S'+st+'",'+
-                  tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
-           else
-           stabstring := strpnew('"'+name+':'+st+'",'+
-                  tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address-owner^.address_fixup))
-       else
-         stabstring := inherited stabstring;
-  end;
-
-    procedure tvarsym.concatstabto(asmlist : paasmoutput);
-{$ifdef i386}
-      var stab_str : pchar;
-{$endif i386}
-      begin
-         inherited concatstabto(asmlist);
-{$ifdef i386}
-      if (owner^.symtabletype=parasymtable) and
-         (reg<>R_NO) then
-           begin
-           { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
-           { this is the register order for GDB}
-              stab_str:=strpnew('"'+name+':r'
-                     +vartype.def^.numberstring+'",'+
-                     tostr(N_RSYM)+',0,'+
-                     tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
-              asmlist^.concat(new(pai_stabs,init(stab_str)));
-           end;
-{$endif i386}
-      end;
-{$endif GDB}
-
-
-{****************************************************************************
-                             TTYPEDCONSTSYM
-*****************************************************************************}
-
-    constructor ttypedconstsym.init(const n : string;p : pdef;really_const : boolean);
-      begin
-         tsym.init(n);
-         typ:=typedconstsym;
-         typedconsttype.setdef(p);
-         is_really_const:=really_const;
-         prefix:=stringdup(procprefix);
-      end;
-
-
-    constructor ttypedconstsym.inittype(const n : string;const tt : ttype;really_const : boolean);
-      begin
-         ttypedconstsym.init(n,nil,really_const);
-         typedconsttype:=tt;
-      end;
-
-
-    constructor ttypedconstsym.load;
-      begin
-         tsym.load;
-         typ:=typedconstsym;
-         typedconsttype.load;
-         prefix:=stringdup(readstring);
-         is_really_const:=boolean(readbyte);
-      end;
-
-
-    destructor ttypedconstsym.done;
-      begin
-         stringdispose(prefix);
-         tsym.done;
-      end;
-
-
-    function ttypedconstsym.mangledname : string;
-      begin
-         mangledname:='TC_'+prefix^+'_'+name;
-      end;
-
-
-    function ttypedconstsym.getsize : longint;
-      begin
-        if assigned(typedconsttype.def) then
-         getsize:=typedconsttype.def^.size
-        else
-         getsize:=0;
-      end;
-
-
-    procedure ttypedconstsym.deref;
-      begin
-        typedconsttype.resolve;
-      end;
-
-
-    procedure ttypedconstsym.write;
-      begin
-         tsym.write;
-         typedconsttype.write;
-         writestring(prefix^);
-         writebyte(byte(is_really_const));
-         current_ppu^.writeentry(ibtypedconstsym);
-      end;
-
-
-    procedure ttypedconstsym.insert_in_data;
-      var
-        curconstsegment : paasmoutput;
-        l,ali,modulo : longint;
-        storefilepos : tfileposinfo;
-      begin
-        storefilepos:=aktfilepos;
-        aktfilepos:=tokenpos;
-        if is_really_const then
-          curconstsegment:=consts
-        else
-          curconstsegment:=datasegment;
-        if (cs_create_smart in aktmoduleswitches) then
-          curconstsegment^.concat(new(pai_cut,init));
-        l:=getsize;
-        ali:=data_align(l);
-        if ali>1 then
-          begin
-             curconstsegment^.concat(new(pai_align,init(ali)));
-             modulo:=owner^.datasize mod ali;
-             if modulo>0 then
-               inc(owner^.datasize,ali-modulo);
-          end;
-        {  Why was there no owner size update here ??? }
-        inc(owner^.datasize,l);
-{$ifdef GDB}
-              if cs_debuginfo in aktmoduleswitches then
-                concatstabto(curconstsegment);
-{$endif GDB}
-        if owner^.symtabletype=globalsymtable then
-          begin
-             curconstsegment^.concat(new(pai_symbol,initdataname_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)))
-              else
-                curconstsegment^.concat(new(pai_symbol,initdataname(mangledname,getsize)));
-            end;
-        aktfilepos:=storefilepos;
-      end;
-
-{$ifdef GDB}
-    function ttypedconstsym.stabstring : pchar;
-    var
-      st : char;
-    begin
-    if (cs_gdb_gsym in aktglobalswitches) and (owner^.symtabletype in [unitsymtable,globalsymtable]) then
-      st := 'G'
-    else
-      st := 'S';
-    stabstring := strpnew('"'+name+':'+st+
-            typedconsttype.def^.numberstring+'",'+tostr(n_STSYM)+',0,'+
-            tostr(fileinfo.line)+','+mangledname);
-    end;
-{$endif GDB}
-
-
-{****************************************************************************
-                                  TCONSTSYM
-****************************************************************************}
-
-    constructor tconstsym.init(const n : string;t : tconsttyp;v : TConstExprInt);
-      begin
-         inherited init(n);
-         typ:=constsym;
-         consttyp:=t;
-         value:=v;
-         ResStrIndex:=0;
-         consttype.reset;
-         len:=0;
-      end;
-
-
-    constructor tconstsym.init_def(const n : string;t : tconsttyp;v : TConstExprInt;def : pdef);
-      begin
-         inherited init(n);
-         typ:=constsym;
-         consttyp:=t;
-         value:=v;
-         consttype.setdef(def);
-         len:=0;
-      end;
-
-
-    constructor tconstsym.init_string(const n : string;t : tconsttyp;str:pchar;l:longint);
-      begin
-         inherited init(n);
-         typ:=constsym;
-         consttyp:=t;
-         value:=longint(str);
-         consttype.reset;
-         len:=l;
-         if t=constresourcestring then
-           ResStrIndex:=ResourceStrings^.Register(name,
-             pchar(tpointerord(value)),len);
-      end;
-
-    constructor tconstsym.load;
-      var
-         pd : pbestreal;
-         ps : pnormalset;
-         pc : pchar;
-         l1,l2 : longint;
-
-      begin
-         tsym.load;
-         typ:=constsym;
-         consttype.reset;
-         consttyp:=tconsttyp(readbyte);
-         case consttyp of
-           constint:
-             if sizeof(tconstexprint)=8 then
-               begin
-                  l1:=readlong;
-                  l2:=readlong;
-{$ifopt R+}
-  {$define Range_check_on}
-{$endif opt R+}
-{$R- needed here }
-                  value:=qword(l1)+(int64(l2) shl 32);
-{$ifdef Range_check_on}
-  {$R+}
-  {$undef Range_check_on}
-{$endif Range_check_on}
-               end
-             else
-               value:=readlong;
-           constbool,
-           constchar :
-             value:=readlong;
-           constpointer,
-           constord :
-             begin
-               consttype.load;
-               if sizeof(TConstExprInt)=8 then
-                 begin
-                    l1:=readlong;
-                    l2:=readlong;
-{$ifopt R+}
-  {$define Range_check_on}
-{$endif opt R+}
-{$R- needed here }
-                    value:=qword(l1)+(int64(l2) shl 32);
-{$ifdef Range_check_on}
-  {$R+}
-  {$undef Range_check_on}
-{$endif Range_check_on}
-                 end
-               else
-                 value:=readlong;
-             end;
-           conststring,constresourcestring :
-             begin
-               len:=readlong;
-               getmem(pc,len+1);
-               current_ppu^.getdata(pc^,len);
-               if consttyp=constresourcestring then
-                 ResStrIndex:=readlong;
-               value:=tpointerord(pc);
-             end;
-           constreal :
-             begin
-               new(pd);
-               pd^:=readreal;
-               value:=tpointerord(pd);
-             end;
-           constset :
-             begin
-               consttype.load;
-               new(ps);
-               readnormalset(ps^);
-               value:=tpointerord(ps);
-             end;
-           constnil : ;
-           else
-             Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
-         end;
-      end;
-
-
-    destructor tconstsym.done;
-      begin
-        case consttyp of
-          conststring,constresourcestring :
-            freemem(pchar(tpointerord(value)),len+1);
-          constreal :
-            dispose(pbestreal(tpointerord(value)));
-          constset :
-            dispose(pnormalset(tpointerord(value)));
-        end;
-        inherited done;
-      end;
-
-
-    function tconstsym.mangledname : string;
-      begin
-         mangledname:=name;
-      end;
-
-
-    procedure tconstsym.deref;
-      begin
-        if consttyp in [constord,constpointer,constset] then
-         consttype.resolve;
-      end;
-
-
-    procedure tconstsym.write;
-      begin
-         tsym.write;
-         writebyte(byte(consttyp));
-         case consttyp of
-           constnil : ;
-           constint:
-             if sizeof(TConstExprInt)=8 then
-               begin
-                  writelong(lo(value));
-                  writelong(hi(value));
-               end
-             else
-               writelong(value);
-
-           constbool,
-           constchar :
-             writelong(value);
-           constpointer,
-           constord :
-             begin
-               consttype.write;
-               if sizeof(TConstExprInt)=8 then
-                 begin
-                    writelong(lo(value));
-                    writelong(hi(value));
-                 end
-               else
-                 writelong(value);
-             end;
-           conststring,constresourcestring :
-             begin
-               writelong(len);
-               current_ppu^.putdata(pchar(TPointerOrd(value))^,len);
-               if consttyp=constresourcestring then
-                 writelong(ResStrIndex);
-             end;
-           constreal :
-             writereal(pbestreal(TPointerOrd(value))^);
-           constset :
-             begin
-               consttype.write;
-               writenormalset(pointer(TPointerOrd(value))^);
-             end;
-         else
-           internalerror(13);
-         end;
-        current_ppu^.writeentry(ibconstsym);
-      end;
-
-{$ifdef GDB}
-    function tconstsym.stabstring : pchar;
-    var st : string;
-    begin
-         {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
-         case consttyp of
-            conststring : begin
-                          { I had to remove ibm2ascii !! }
-                          st := pstring(TPointerOrd(value))^;
-                          {st := ibm2ascii(pstring(value)^);}
-                          st := 's'''+st+'''';
-                          end;
-            constbool,
-            constint,
-            constpointer,
-            constord,
-            constchar : st := 'i'+tostr(value);
-            constreal : begin
-                        system.str(pbestreal(TPointerOrd(value))^,st);
-                        st := 'r'+st;
-                        end;
-         { if we don't know just put zero !! }
-         else st:='i0';
-            {***SETCONST}
-            {constset:;}    {*** I don't know what to do with a set.}
-         { sets are not recognized by GDB}
-            {***}
-        end;
-    stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
-                    tostr(fileinfo.line)+',0');
-    end;
-
-    procedure tconstsym.concatstabto(asmlist : paasmoutput);
-      begin
-        if consttyp <> conststring then
-          inherited concatstabto(asmlist);
-      end;
-{$endif GDB}
-
-
-{****************************************************************************
-                                  TENUMSYM
-****************************************************************************}
-
-    constructor tenumsym.init(const n : string;def : penumdef;v : longint);
-      begin
-         tsym.init(n);
-         typ:=enumsym;
-         definition:=def;
-         value:=v;
-         if def^.min>v then
-           def^.setmin(v);
-         if def^.max<v then
-           def^.setmax(v);
-         order;
-      end;
-
-
-    constructor tenumsym.load;
-      begin
-         tsym.load;
-         typ:=enumsym;
-         definition:=penumdef(readdefref);
-         value:=readlong;
-         nextenum := Nil;
-      end;
-
-
-    procedure tenumsym.deref;
-      begin
-         resolvedef(pdef(definition));
-         order;
-      end;
-
-
-   procedure tenumsym.order;
-      var
-         sym : penumsym;
-      begin
-         sym := definition^.firstenum;
-         if sym = nil then
-          begin
-            definition^.firstenum := @self;
-            nextenum := nil;
-            exit;
-          end;
-         { reorder the symbols in increasing value }
-         if value < sym^.value then
-          begin
-            nextenum := sym;
-            definition^.firstenum := @self;
-          end
-         else
-          begin
-            while (sym^.value <= value) and assigned(sym^.nextenum) do
-             sym := sym^.nextenum;
-            nextenum := sym^.nextenum;
-            sym^.nextenum := @self;
-          end;
-      end;
-
-
-    procedure tenumsym.write;
-      begin
-         tsym.write;
-         writedefref(definition);
-         writelong(value);
-         current_ppu^.writeentry(ibenumsym);
-      end;
-
-
-{$ifdef GDB}
-    procedure tenumsym.concatstabto(asmlist : paasmoutput);
-    begin
-    {enum elements have no stab !}
-    end;
-{$EndIf GDB}
-
-
-{****************************************************************************
-                                  TTYPESYM
-****************************************************************************}
-
-    constructor ttypesym.init(const n : string;const tt : ttype);
-
-      begin
-         tsym.init(n);
-         typ:=typesym;
-         restype:=tt;
-{$ifdef GDB}
-         isusedinstab := false;
-{$endif GDB}
-{$ifdef SYNONYM}
-         if assigned(restype.def) then
-          begin
-             if not(assigned(restype.def^.typesym)) then
-               begin
-                  restype.def^.typesym:=@self;
-                  synonym:=nil;
-                  include(symoptions,sp_primary_typesym);
-               end
-             else
-               begin
-                  synonym:=restype.def^.typesym^.synonym;
-                  restype.def^.typesym^.synonym:=@self;
-               end;
-          end;
-{$else}
-        { register the typesym for the definition }
-        if assigned(restype.def) and
-           not(assigned(restype.def^.typesym)) then
-         restype.def^.typesym:=@self;
-{$endif}
-      end;
-
-    constructor ttypesym.initdef(const n : string;d : pdef);
-      var
-        t : ttype;
-      begin
-        t.setdef(d);
-        ttypesym.init(n,t);
-      end;
-
-    constructor ttypesym.load;
-      begin
-         tsym.load;
-         typ:=typesym;
-{$ifdef SYNONYM}
-         synonym:=nil;
-{$endif}
-{$ifdef GDB}
-         isusedinstab := false;
-{$endif GDB}
-         restype.load;
-      end;
-
-{$ifdef SYNONYM}
-    destructor ttypesym.done;
-      var
-        prevsym : ptypesym;
-      begin
-         if assigned(restype.def) then
-           begin
-              prevsym:=restype.def^.typesym;
-              if prevsym=@self then
-                restype.def^.typesym:=synonym;
-              while assigned(prevsym) do
-                begin
-                   if (prevsym^.synonym=@self) then
-                     begin
-                        prevsym^.synonym:=synonym;
-                        break;
-                     end;
-                   prevsym:=prevsym^.synonym;
-                end;
-           end;
-         synonym:=nil;
-         inherited done;
-      end;
-{$endif}
-
-
-    procedure ttypesym.prederef;
-      begin
-         restype.resolve;
-{$ifdef SYNONYM}
-         if assigned(restype.def) then
-          begin
-            if (sp_primary_typesym in symoptions) then
-              begin
-                 if restype.def^.typesym<>@self then
-                   synonym:=restype.def^.typesym;
-                 restype.def^.typesym:=@self;
-              end
-            else
-              begin
-                 if assigned(restype.def^.typesym) then
-                   begin
-                      synonym:=restype.def^.typesym^.synonym;
-                      if restype.def^.typesym<>@self then
-                        restype.def^.typesym^.synonym:=@self;
-                   end
-                 else
-                   restype.def^.typesym:=@self;
-              end;
-            if (restype.def^.deftype=recorddef) and assigned(precorddef(restype.def)^.symtable) and
-               (restype.def^.typesym=@self) then
-              precorddef(restype.def)^.symtable^.name:=stringdup('record '+name);
-          end;
-{$endif}
-         {KAZ: another test for system unit: current_module^.used_units.first is nil iif system unit}
-         if not assigned(rec_tguid) and { system unit loaded first and TGUID be defined in system unit }
-            (_name^='TGUID') and { name: TGUID and size=16 bytes that is 128 bits }
-            assigned(restype.def) and (restype.def^.size=16) then
-           rec_tguid:=precorddef(restype.def);
-      end;
-
-
-    procedure ttypesym.write;
-      begin
-         tsym.write;
-         restype.write;
-         current_ppu^.writeentry(ibtypesym);
-      end;
-
-
-    procedure ttypesym.load_references;
-      begin
-         inherited load_references;
-         if (restype.def^.deftype=recorddef) then
-           precorddef(restype.def)^.symtable^.load_browser;
-         if (restype.def^.deftype=objectdef) then
-           pobjectdef(restype.def)^.symtable^.load_browser;
-      end;
-
-
-    function ttypesym.write_references : boolean;
-      begin
-        if not inherited write_references then
-         { write address of this symbol if record or object
-           even if no real refs are there
-           because we need it for the symtable }
-         if (restype.def^.deftype=recorddef) or
-            (restype.def^.deftype=objectdef) then
-          begin
-            writesymref(@self);
-            current_ppu^.writeentry(ibsymref);
-          end;
-         write_references:=true;
-         if (restype.def^.deftype=recorddef) then
-           precorddef(restype.def)^.symtable^.write_browser;
-         if (restype.def^.deftype=objectdef) then
-           pobjectdef(restype.def)^.symtable^.write_browser;
-      end;
-
-
-{$ifdef BrowserLog}
-    procedure ttypesym.add_to_browserlog;
-      begin
-         inherited add_to_browserlog;
-         if (restype.def^.deftype=recorddef) then
-           precorddef(restype.def)^.symtable^.writebrowserlog;
-         if (restype.def^.deftype=objectdef) then
-           pobjectdef(restype.def)^.symtable^.writebrowserlog;
-      end;
-{$endif BrowserLog}
-
-
-{$ifdef GDB}
-    function ttypesym.stabstring : pchar;
-    var
-      stabchar : string[2];
-      short : string;
-    begin
-      if restype.def^.deftype in tagtypes then
-        stabchar := 'Tt'
-      else
-        stabchar := 't';
-      short := '"'+name+':'+stabchar+restype.def^.numberstring
-               +'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
-      stabstring := strpnew(short);
-    end;
-
-    procedure ttypesym.concatstabto(asmlist : paasmoutput);
-      begin
-      {not stabs for forward defs }
-      if assigned(restype.def) then
-        if (restype.def^.typesym = @self) then
-          restype.def^.concatstabto(asmlist)
-        else
-          inherited concatstabto(asmlist);
-      end;
-{$endif GDB}
-
-
-{****************************************************************************
-                                  TSYSSYM
-****************************************************************************}
-
-    constructor tsyssym.init(const n : string;l : longint);
-      begin
-         inherited init(n);
-         typ:=syssym;
-         number:=l;
-      end;
-
-    constructor tsyssym.load;
-      begin
-         tsym.load;
-         typ:=syssym;
-         number:=readlong;
-      end;
-
-    destructor tsyssym.done;
-      begin
-        inherited done;
-      end;
-
-    procedure tsyssym.write;
-      begin
-         tsym.write;
-         writelong(number);
-         current_ppu^.writeentry(ibsyssym);
-      end;
-
-{$ifdef GDB}
-    procedure tsyssym.concatstabto(asmlist : paasmoutput);
-      begin
-      end;
-{$endif GDB}
-
-
-{****************************************************************************
-                                  TMACROSYM
-****************************************************************************}
-
-    constructor tmacrosym.init(const n : string);
-      begin
-         inherited init(n);
-         typ:=macrosym;
-         defined:=true;
-         defined_at_startup:=false;
-         is_used:=false;
-         buftext:=nil;
-         buflen:=0;
-      end;
-
-    destructor tmacrosym.done;
-      begin
-         if assigned(buftext) then
-           freemem(buftext,buflen);
-         inherited done;
-      end;
-
-
-{
-  $Log$
-  Revision 1.14  2000-11-28 00:28:07  pierre
-   * stabs fixing
-
-  Revision 1.13  2000/11/04 14:25:22  florian
-    + merged Attila's changes for interfaces, not tested yet
-
-  Revision 1.12  2000/10/31 22:02:52  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.11  2000/10/21 18:16:12  florian
-    * a lot of changes:
-       - basic dyn. array support
-       - basic C++ support
-       - some work for interfaces done
-       ....
-
-  Revision 1.10  2000/10/15 07:47:53  peter
-    * unit names and procedure names are stored mixed case
-
-  Revision 1.9  2000/09/24 21:19:52  peter
-    * delphi compile fixes
-
-  Revision 1.8  2000/09/19 23:08:03  pierre
-   * fixes for local class debuggging problem (merged)
-
-  Revision 1.7  2000/08/27 20:19:39  peter
-    * store strings with case in ppu, when an internal symbol is created
-      a '$' is prefixed so it's not automatic uppercased
-
-  Revision 1.6  2000/08/21 11:27:44  pierre
-   * fix the stabs problems
-
-  Revision 1.5  2000/08/16 13:06:07  florian
-    + support of 64 bit integer constants
-
-  Revision 1.4  2000/08/13 12:54:56  peter
-    * class member decl wrong then no other error after it
-    * -vb has now also line numbering
-    * -vb is also used for interface/implementation different decls and
-      doesn't list the current function (merged)
-
-  Revision 1.3  2000/07/13 12:08:27  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:49  michael
-  + removed logs
-
-}