fpc/compiler/symdef.inc

{
    $Id$
    Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller

    Symbol table implementation for the defenitions

    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 defenitions)
****************************************************************************}

    constructor tdef.init;
      begin
         deftype:=abstractdef;
         owner := nil;
         next := nil;
         number := 0;
         if registerdef then
           symtablestack^.registerdef(@self);
         has_rtti:=false;
{$ifdef GDB}
         is_def_stab_written := false;
         globalnb := 0;
         if assigned(lastglobaldef) then
           begin
              lastglobaldef^.nextglobal := @self;
              previousglobal:=lastglobaldef;
           end
         else
           begin
              firstglobaldef := @self;
              previousglobal := nil;
           end;
         lastglobaldef := @self;
         nextglobal := nil;
         sym := nil;
{$endif GDB}
      end;

    constructor tdef.load;
      begin
{$ifdef GDB}
         deftype:=abstractdef;
         is_def_stab_written := false;
         number := 0;
         sym := nil;
         owner := nil;
         next := nil;
         has_rtti:=false;
         globalnb := 0;
         if assigned(lastglobaldef) then
           begin
              lastglobaldef^.nextglobal := @self;
              previousglobal:=lastglobaldef;
           end
         else
           begin
              firstglobaldef := @self;
              previousglobal:=nil;
           end;
         lastglobaldef := @self;
         nextglobal := nil;
{$endif GDB}
      end;

    destructor tdef.done;
      begin
{$ifdef GDB}
         { first element  ? }
         if not(assigned(previousglobal)) then
           begin
              firstglobaldef := nextglobal;
              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;
{$endif GDB}
      end;

    procedure tdef.write;
      begin
{$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;

{$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(sym)) or (not sym^.isusedinstab) then
        begin
           {set even if debuglist is not defined}
           if assigned(sym) then
             sym^.isusedinstab := true;
           if assigned(debuglist) and not is_def_stab_written then
             concatstabto(debuglist);
        end;
      if not use_dbx 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(sym) then
             begin
                table := sym^.owner;
                if table^.unitid > 0 then
                  numberstring := '('+tostr(table^.unitid)+','
                  +tostr(sym^.definition^.globalnb)+')'
                else
                  numberstring := tostr(globalnb);
                exit;
             end;
           numberstring := tostr(globalnb);
        end;
      end;

    function tdef.allstabstring : pchar;
    var stabchar : string[2];
        ss,st : pchar;
        name : string;
        sym_line_no : longint;
      begin
      ss := stabstring;
      getmem(st,strlen(ss)+512);
      stabchar := 't';
      if deftype in tagtypes then
        stabchar := 'Tt';
      if assigned(sym) then
        begin
           name := sym^.name;
           sym_line_no:=sym^.line_no;
        end
      else
        begin
           name := ' ';
           sym_line_no:=0;
        end;
      strpcopy(st,'"'+name+':'+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 ((sym = nil) or sym^.isusedinstab or use_dbx)
      and not is_def_stab_written then
      begin
      If use_dbx then
        begin
           { otherwise you get two of each def }
           If assigned(sym) then
             begin
                if sym^.typ=typesym then
                  sym^.isusedinstab:=true;
                if (sym^.owner = nil) or
                  ((sym^.owner^.symtabletype = unitsymtable) and
                 punitsymtable(sym^.owner)^.dbx_count_ok)  then
                begin
                   {with DBX we get the definition from the other objects }
                   is_def_stab_written := true;
                   exit;
                end;
             end;
        end;
      { to avoid infinite loops }
      is_def_stab_written := true;
      stab_str := allstabstring;
      if asmlist = debuglist then do_count_dbx := true;
      { count_dbx(stab_str); moved to GDB.PAS}
      asmlist^.concat(new(pai_stabs,init(stab_str)));
      end;
    end;
{$endif GDB}

    procedure tdef.deref;
      begin
      end;

    function tdef.needs_rtti : boolean;
      begin
         needs_rtti:=false;
      end;

    procedure tdef.generate_rtti;
      begin
         getlabel(rtti_label);
         rttilist^.concat(new(pai_label,init(rtti_label)));
      end;

    function tdef.get_rtti_label : plabel;
      begin
         if not(has_rtti) then
           generate_rtti;
         { I don't know what's the use of rtti_label
           but this was missing  (PM) }
         get_rtti_label:=rtti_label;
      end;

{*************************************************************************************************************************
                               TSTRINGDEF
****************************************************************************}

    constructor tstringdef.init(l : byte);

      begin
         tdef.init;
         string_typ:=shortstring;
         deftype:=stringdef;
         len:=l;
         savesize:=len+1;
      end;

    constructor tstringdef.load;

      begin
         tdef.load;
         string_typ:=shortstring;
         deftype:=stringdef;
         len:=readbyte;
         savesize:=len+1;
      end;

    constructor tstringdef.longinit(l : longint);

      begin
         tdef.init;
         string_typ:=longstring;
         deftype:=stringdef;
         len:=l;
         savesize:=Sizeof(pointer);
      end;

    constructor tstringdef.longload;

      begin
         tdef.load;
         deftype:=stringdef;
         string_typ:=longstring;
         len:=readlong;
         savesize:=Sizeof(pointer);
      end;

    constructor tstringdef.ansiinit(l : longint);

      begin
         tdef.init;
         string_typ:=ansistring;
         deftype:=stringdef;
         len:=l;
         savesize:=sizeof(pointer);
      end;

    constructor tstringdef.ansiload;

      begin
         tdef.load;
         deftype:=stringdef;
         string_typ:=ansistring;
         len:=readlong;
         savesize:=sizeof(pointer);
      end;

    constructor tstringdef.wideinit(l : longint);

      begin
         tdef.init;
         string_typ:=widestring;
         deftype:=stringdef;
         len:=l;
         savesize:=sizeof(pointer);
      end;

    constructor tstringdef.wideload;

      begin
         tdef.load;
         deftype:=stringdef;
         string_typ:=ansistring;
         len:=readlong;
         savesize:=sizeof(pointer);
      end;

    function tstringdef.size : longint;
      begin
        size:=savesize;
      end;

    procedure tstringdef.write;
      begin
{$ifndef NEWPPU}
         case string_typ of
            shortstring:
              writebyte(ibstringdef);
            longstring:
              writebyte(iblongstringdef);
            ansistring:
              writebyte(ibansistringdef);
            widestring:
              writebyte(ibwidestringdef);
         end;
{$endif}
         tdef.write;
         if string_typ=shortstring then
           writebyte(len)
         else
           writelong(len);
{$ifdef NEWPPU}
         case string_typ of
           shortstring : ppufile^.writeentry(ibstringdef);
            longstring : ppufile^.writeentry(iblongstringdef);
            ansistring : ppufile^.writeentry(ibansistringdef);
            widestring : ppufile^.writeentry(ibwidestringdef);
         end;
{$endif}
      end;

{$ifdef GDB}
    function tstringdef.stabstring : pchar;
      var
        bytest,charst,longst : string;
      begin
        case string_typ of
    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;
     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;
     ansistring : begin
                    { an ansi string looks like a pchar easy !! }
                    stabstring:=strpnew('*'+typeglobalnumber('char'));
                  end;
     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_rtti : boolean;
      begin
         needs_rtti:=string_typ in [ansistring,widestring];
      end;

{*************************************************************************************************************************
                                 TENUMDEF
****************************************************************************}

    constructor tenumdef.init;
      begin
         tdef.init;
         deftype:=enumdef;
         max:=0;
         savesize:=Sizeof(longint);
         has_jumps:=false;
{$ifdef GDB}
         first := Nil;
{$endif GDB}
      end;

    constructor tenumdef.load;
      begin
         tdef.load;
         deftype:=enumdef;
         max:=readlong;
         savesize:=Sizeof(longint);
         has_jumps:=false;
         first := Nil;
      end;

    destructor tenumdef.done;
      begin
        inherited done;
      end;

    procedure tenumdef.write;

      begin
{$ifndef NEWPPU}
         writebyte(ibenumdef);
{$endif}
         tdef.write;
         writelong(max);
{$ifdef NEWPPU}
         ppufile^.writeentry(ibenumdef);
{$endif}
      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 := first;
        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^.next;
          end;
        strpcopy(strend(st),';');
        stabstring := strnew(st);
        freemem(st,memsize);
      end;
{$endif GDB}

{*************************************************************************************************************************
                                 TORDDEF
****************************************************************************}

    constructor torddef.init(t : tbasetype;v,b : longint);
      begin
         tdef.init;
         deftype:=orddef;
         low:=v;
         high:=b;
         typ:=t;
         setsize;
      end;

    constructor torddef.load;
      begin
         tdef.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 : savesize:=2;
         s32bit,u32bit,
             bool32bit : savesize:=4;
             else
               savesize:=0;
             end;
           end;
       { there are no entrys for range checking }
         rangenr:=0;
      end;

    procedure torddef.genrangecheck;
      begin
         if rangenr=0 then
           begin
              { generate two constant for bounds }
              getlabelnr(rangenr);
              if (cs_smartlink in aktswitches) then
                datasegment^.concat(new(pai_symbol,init_global('R_'+current_module^.mainsource^+tostr(rangenr))))
              else
                datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr))));
              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)));
                   inc(nextlabelnr);
                   if (cs_smartlink in aktswitches) then
                     datasegment^.concat(new(pai_symbol,init_global('R_'+current_module^.mainsource^+tostr(rangenr+1))))
                   else
                     datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr+1))));
                   datasegment^.concat(new(pai_const,init_32bit($80000000)));
                   datasegment^.concat(new(pai_const,init_32bit(high)));
                end;
           end;
      end;

    procedure torddef.write;
      begin
{$ifndef NEWPPU}
         writebyte(iborddef);
{$endif}
         tdef.write;
         writebyte(byte(typ));
         writelong(low);
         writelong(high);
{$ifdef NEWPPU}
         ppufile^.writeentry(iborddef);
{$endif}
      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 !!!}
         bool8bit,
        bool16bit,
        bool32bit : stabstring := strpnew('r'+numberstring+';0;255;');
         { u32bit : stabstring := strpnew('r'+
              s32bitdef^.numberstring+';0;-1;'); }
        else
          stabstring := strpnew('r'+s32bitdef^.numberstring+';'+tostr(low)+';'+tostr(high)+';');
        end;
      end;
{$endif GDB}

{*************************************************************************************************************************
                                TFLOATDEF
****************************************************************************}

    constructor tfloatdef.init(t : tfloattype);
      begin
         tdef.init;
         deftype:=floatdef;
         typ:=t;
         setsize;
      end;

    constructor tfloatdef.load;
      begin
         tdef.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;
            s64bit:
              savesize:=8;
            s80real:
              savesize:=extended_size;
            else savesize:=0;
         end;
      end;

    procedure tfloatdef.write;
      begin
{$ifndef NEWPPU}
         writebyte(ibfloatdef);
{$endif}
         tdef.write;
         writebyte(byte(typ));
{$ifdef NEWPPU}
         ppufile^.writeentry(ibfloatdef);
{$endif}
      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 }
            s64bit : 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}

{*************************************************************************************************************************
                                TFILEDEF
****************************************************************************}

    constructor tfiledef.init(ft : tfiletype;tas : pdef);
      begin
         inherited init;
         deftype:=filedef;
         filetype:=ft;
         typed_as:=tas;
         setsize;
      end;

    constructor tfiledef.load;
      begin
         tdef.load;
         deftype:=filedef;
         filetype:=tfiletype(readbyte);
         if filetype=ft_typed then
           typed_as:=readdefref
         else
           typed_as:=nil;
         setsize;
      end;

    procedure tfiledef.deref;
      begin
         if filetype=ft_typed then
           resolvedef(typed_as);
      end;

    procedure tfiledef.setsize;
      begin
{$ifdef i386}

         case target_info.target of
            target_LINUX:
           begin
              case filetype of
                 ft_text : savesize:=432;
                 ft_typed,ft_untyped : savesize:=304;
              end;
           end;
            target_Win32:
              begin
                 case filetype of
                    ft_text : savesize:=434;
                    ft_typed,ft_untyped : savesize:=306;
                 end;
           end
         else
           begin
              case filetype of
                 ft_text : savesize:=256;
                 ft_typed,ft_untyped : savesize:=128;
              end;
           end;
      end;
{$endif}
{$ifdef m68k}
        case filetype of
          ft_text : savesize:=256;
         ft_typed,
       ft_untyped : savesize:=128;
        end;
{$endif}

      end;



    procedure tfiledef.write;
      begin
{$ifndef NEWPPU}
         writebyte(ibfiledef);
{$endif}
         tdef.write;
         writebyte(byte(filetype));
         if filetype=ft_typed then
           writedefref(typed_as);
{$ifdef NEWPPU}
         ppufile^.writeentry(ibfiledef);
{$endif}
      end;

{$ifdef GDB}
    function tfiledef.stabstring : pchar;
      var Handlebitsize,namesize : longint;
          Handledef :string;
      begin
      {$IfDef GDBknowsfiles}
      case filetyp of
        ft_typed : stabstring := strpnew('d'+typed_as^.numberstring{+';'});
        ft_untyped : stabstring := strpnew('d'+voiddef^.numberstring{+';'});
        ft_text : stabstring := strpnew('d'+cchardef^.numberstring{+';'});
        end;
      {$Else }
      {based on
       filerec = record
          handle : word;
          mode : word;
          recsize : word;
          _private : array[1..26] of byte;
          userdata : array[1..16] of byte;
          name : string[79 or 255 for linux]; }
{$ifdef i386}   

      if (target_info.target=target_GO32V1) or
         (target_info.target=target_GO32V2) then
        namesize:=79
      else
        namesize:=255;

      if (target_info.target=target_Win32) then
        begin
          Handledef:='longint';
          Handlebitsize:=32;
        end
      else
        begin
           Handledef:='word';
           HandleBitSize:=16;
        end;
{$endif}
{$ifdef m68k}
      namesize:=79;
      Handledef:='word';
      HandleBitSize:=16;
{$endif}

      { the buffer part is still missing !! (PM) }
      { but the string could become too long !! }
      stabstring := strpnew('s'+tostr(savesize)+
                     'HANDLE:'+typeglobalnumber(Handledef)+',0,'+tostr(HandleBitSize)+';'+
                      'MODE:'+typeglobalnumber('word')+','+tostr(HandleBitSize)+',16;'+
                      'RECSIZE:'+typeglobalnumber('word')+','+tostr(HandleBitSize+16)+',16;'+
                      '_PRIVATE:ar'+typeglobalnumber('word')+';1;26;'+typeglobalnumber('byte')
                        +','+tostr(HandleBitSize+32)+',208;'+
                      'USERDATA:ar'+typeglobalnumber('word')+';1;16;'+typeglobalnumber('byte')
                        +','+tostr(HandleBitSize+240)+',128;'+
                     { 'NAME:s'+tostr(namesize+1)+
                        'length:'+typeglobalnumber('byte')+',0,8;'+
                        'st:ar'+typeglobalnumber('word')+';1;'
                        +tostr(namesize)+';'+typeglobalnumber('char')+',8,'+tostr(8*namesize)+';;'+}
                      'NAME:ar'+typeglobalnumber('word')+';0;'
                        +tostr(namesize)+';'+typeglobalnumber('char')+
                      ','+tostr(HandleBitSize+368)+','+tostr(8*(namesize+1))+';;');
      {$EndIf}
      end;

    procedure tfiledef.concatstabto(asmlist : paasmoutput);
      begin
      { most file defs are unnamed !!! }
      if ((sym = nil) or sym^.isusedinstab or use_dbx) and not is_def_stab_written then
        begin
        if assigned(typed_as) then forcestabto(asmlist,typed_as);
        inherited concatstabto(asmlist);
        end;
      end;
{$endif GDB}

{*************************************************************************************************************************
                               TPOINTERDEF
****************************************************************************}

    constructor tpointerdef.init(def : pdef);
      begin
         inherited init;
         deftype:=pointerdef;
         definition:=def;
         savesize:=Sizeof(pointer);
      end;

    constructor tpointerdef.load;
      begin
         tdef.load;
         deftype:=pointerdef;
         { the real address in memory is calculated later (deref) }
         definition:=readdefref;
         savesize:=Sizeof(pointer);
      end;

    procedure tpointerdef.deref;
      begin
         resolvedef(definition);
      end;

    procedure tpointerdef.write;
      begin
{$ifndef NEWPPU}
         writebyte(ibpointerdef);
{$endif}
         tdef.write;
         writedefref(definition);
{$ifdef NEWPPU}
         ppufile^.writeentry(ibpointerdef);
{$endif}
      end;

{$ifdef GDB}
    function tpointerdef.stabstring : pchar;
      begin
        stabstring := strpnew('*'+definition^.numberstring);
      end;

    procedure tpointerdef.concatstabto(asmlist : paasmoutput);
      var st,nb : string;
          sym_line_no : longint;
      begin
      if ( (sym=nil) or sym^.isusedinstab or use_dbx) and not is_def_stab_written then
        begin
        if assigned(definition) then
          if definition^.deftype in [recorddef,objectdef] then
            begin
            is_def_stab_written := true;
            {to avoid infinite recursion in record with next-like fields }
            nb := definition^.numberstring;
            is_def_stab_written := false;
            if not definition^.is_def_stab_written then
              begin
              if assigned(definition^.sym) then
                begin
                if assigned(sym) then
                  begin
                     st := sym^.name;
                     sym_line_no:=sym^.line_no;
                  end
                else
                  begin
                     st := ' ';
                     sym_line_no:=0;
                  end;
                st := '"'+st+':t'+numberstring+'=*'+definition^.numberstring
                      +'=xs'+definition^.sym^.name+':",'+tostr(N_LSYM)+',0,'+tostr(sym_line_no)+',0';
                if asmlist = debuglist then do_count_dbx := true;
                asmlist^.concat(new(pai_stabs,init(strpnew(st))));
                end;
              end else inherited concatstabto(asmlist);
            is_def_stab_written := true;
            end else
            begin
            forcestabto(asmlist,definition);
            inherited concatstabto(asmlist);
            end;
        end;
      end;
{$endif GDB}

{*************************************************************************************************************************
                              TCLASSREFDEF
****************************************************************************}

    constructor tclassrefdef.init(def : pdef);
      begin
         inherited init(def);
         deftype:=classrefdef;
         definition:=def;
         savesize:=Sizeof(pointer);
      end;

    constructor tclassrefdef.load;
      begin
         inherited load;
         deftype:=classrefdef;
      end;

    procedure tclassrefdef.write;
      begin
{$ifndef NEWPPU}
         writebyte(ibclassrefdef);
{$endif}
         tdef.write;
         writedefref(definition);
{$ifdef NEWPPU}
         ppufile^.writeentry(ibclassrefdef);
{$endif}
      end;

{$ifdef GDB}
    function tclassrefdef.stabstring : pchar;
      begin
         stabstring:=strpnew('');
      end;

    procedure tclassrefdef.concatstabto(asmlist : paasmoutput);
      begin
      end;
{$endif GDB}

{***********************************************************************************
                                   TSETDEF
***************************************************************************}

    constructor tsetdef.init(s : pdef;high : longint);
      begin
         inherited init;
         deftype:=setdef;
         setof:=s;
         if high<32 then
           begin
              settype:=smallset;
              savesize:=Sizeof(longint);
           end
         else
         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
         tdef.load;
         deftype:=setdef;
         setof:=readdefref;
         settype:=tsettype(readbyte);
         case settype of
            normset : savesize:=32;
            varset : savesize:=readlong;
            smallset : savesize:=Sizeof(longint);
         end;
      end;

    procedure tsetdef.write;
      begin
{$ifndef NEWPPU}
         writebyte(ibsetdef);
{$endif}
         tdef.write;
         writedefref(setof);
         writebyte(byte(settype));
         if settype=varset then
           writelong(savesize);
{$ifdef NEWPPU}
         ppufile^.writeentry(ibsetdef);
{$endif}
      end;

{$ifdef GDB}
    function tsetdef.stabstring : pchar;
      begin
         stabstring := strpnew('S'+setof^.numberstring);
      end;

    procedure tsetdef.concatstabto(asmlist : paasmoutput);

      begin
      if ( not assigned(sym) or sym^.isusedinstab or use_dbx) and
          not is_def_stab_written then
        begin
          if assigned(setof) then
            forcestabto(asmlist,setof);
          inherited concatstabto(asmlist);
        end;
      end;
{$endif GDB}

    procedure tsetdef.deref;
      begin
         resolvedef(setof);
      end;

{***********************************************************************************
                                 TFORMALDEF
***************************************************************************}

    constructor tformaldef.init;

      begin
         inherited init;
         deftype:=formaldef;
         savesize:=Sizeof(pointer);
      end;

    constructor tformaldef.load;

      begin
         tdef.load;
         deftype:=formaldef;
         savesize:=Sizeof(pointer);
      end;

    procedure tformaldef.write;

      begin
{$ifndef NEWPPU}
         writebyte(ibformaldef);
{$endif}
         tdef.write;
{$ifdef NEWPPU}
         ppufile^.writeentry(ibformaldef);
{$endif}
      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}

{***********************************************************************************
               TARRAYDEF
***************************************************************************}

    constructor tarraydef.init(l,h : longint;rd : pdef);

      begin
         tdef.init;
         deftype:=arraydef;
         lowrange:=l;
         highrange:=h;
         rangedef:=rd;
         rangenr:=0;
         definition:=nil;
      end;

    constructor tarraydef.load;

      begin
         tdef.load;
         deftype:=arraydef;
         { the addresses are calculated later }
         definition:=readdefref;
         rangedef:=readdefref;
         lowrange:=readlong;
         highrange:=readlong;
         rangenr:=0;
      end;

    procedure tarraydef.genrangecheck;

      begin
         if rangenr=0 then
           begin
              { generates the data for range checking }
              getlabelnr(rangenr);
              datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr))));
              datasegment^.concat(new(pai_const,init_32bit(lowrange)));
              datasegment^.concat(new(pai_const,init_32bit(highrange)));
           end;
      end;

    procedure tarraydef.deref;

      begin
         resolvedef(definition);
         resolvedef(rangedef);
      end;

    procedure tarraydef.write;

      begin
{$ifndef NEWPPU}
         writebyte(ibarraydef);
{$endif}
         tdef.write;
         writedefref(definition);
         writedefref(rangedef);
         writelong(lowrange);
         writelong(highrange);
{$ifdef NEWPPU}
         ppufile^.writeentry(ibarraydef);
{$endif}
      end;

{$ifdef GDB}
    function tarraydef.stabstring : pchar;
      begin
      stabstring := strpnew('ar'+rangedef^.numberstring+';'
                    +tostr(lowrange)+';'+tostr(highrange)+';'+definition^.numberstring);
      end;

    procedure tarraydef.concatstabto(asmlist : paasmoutput);

      begin
      if (not assigned(sym) or sym^.isusedinstab or use_dbx)
        and not is_def_stab_written then
        begin
        {when array are inserted they have no definition yet !!}
        if assigned(definition) then
          inherited concatstabto(asmlist);
        end;
      end;
{$endif GDB}

    function tarraydef.elesize : longint;
      begin
         elesize:=definition^.size;
      end;

    function tarraydef.size : longint;
      begin
         size:=(highrange-lowrange+1)*elesize;
      end;

    function tarraydef.needs_rtti : boolean;

      begin
         needs_rtti:=definition^.needs_rtti;
      end;

{***********************************************************************************
                                  TRECDEF
***************************************************************************}

    constructor trecdef.init(p : psymtable);

      begin
         tdef.init;
         deftype:=recorddef;
         symtable:=p;
         savesize:=symtable^.datasize;
         symtable^.defowner := @self;
      end;

    constructor trecdef.load;
      var
         oldread_member : boolean;
      begin
         tdef.load;
         deftype:=recorddef;
         savesize:=readlong;
         oldread_member:=read_member;
         read_member:=true;
         symtable:=new(psymtable,loadasstruct(recordsymtable));
         read_member:=oldread_member;
         symtable^.defowner := @self;
      end;

    destructor trecdef.done;

      begin
         if assigned(symtable) then dispose(symtable,done);
         inherited done;
      end;

    var
       brtti : boolean;

    procedure check_rec_rtti(s : psym);

      begin
         if (s^.typ=varsym) and (pvarsym(s)^.definition^.needs_rtti) then
           brtti:=true;
      end;

    function trecdef.needs_rtti : 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:=brtti;
         brtti:=false;
         symtable^.foreach(check_rec_rtti);
         needs_rtti:=brtti;
         brtti:=oldb;
      end;

    procedure trecdef.deref;
      var
         hp : pdef;
         oldrecsyms : psymtable;
      begin
         oldrecsyms:=aktrecordsymtable;
         aktrecordsymtable:=symtable;
         { now dereference the definitions }
         hp:=symtable^.rootdef;
         while assigned(hp) do
           begin
              hp^.deref;

              { set owner }
              hp^.owner:=symtable;

              hp:=hp^.next;
           end;
         {$ifdef tp}
           symtable^.foreach(derefsym);
         {$else}
           symtable^.foreach(@derefsym);
         {$endif}
         aktrecordsymtable:=oldrecsyms;
      end;

    procedure trecdef.write;
      var
         oldread_member : boolean;
      begin
         oldread_member:=read_member;
         read_member:=true;
{$ifndef NEWPPU}
         writebyte(ibrecorddef);
{$endif}
         tdef.write;
         writelong(savesize);
{$ifdef NEWPPU}
         ppufile^.writeentry(ibrecorddef);
{$endif}
         self.symtable^.writeasstruct;
         read_member:=oldread_member;
      end;

{$ifdef GDB}
    Const StabRecString : pchar = Nil;
          StabRecSize : longint = 0;
          RecOffset : Longint = 0;

    procedure addname(p : psym);
    var
      news, newrec : pchar;
    begin
    { static variables from objects are like global objects }
    if ((p^.properties and sp_static)<>0) then
      exit;
    If p^.typ = varsym then
       begin
       newrec := strpnew(p^.name+':'+pvarsym(p)^.definition^.numberstring
                     +','+tostr(pvarsym(p)^.address*8)+','
                     +tostr(pvarsym(p)^.definition^.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)^.definition^.size;
       end;
    end;

    function trecdef.stabstring : pchar;
      Var oldrec : pchar;
          oldsize : longint;
      begin
        oldrec := stabrecstring;
        oldsize:=stabrecsize;
        GetMem(stabrecstring,memsizeinc);
        stabrecsize:=memsizeinc;
        strpcopy(stabRecString,'s'+tostr(savesize));
        RecOffset := 0;
        {$ifdef tp}
          symtable^.foreach(addname);
        {$else}
          symtable^.foreach(@addname);
        {$endif}
        { 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 trecdef.concatstabto(asmlist : paasmoutput);

      begin
        if (not assigned(sym) or sym^.isusedinstab or use_dbx) and
           (not is_def_stab_written) then
          inherited concatstabto(asmlist);
      end;

{$endif GDB}

{***********************************************************************************
               TABSTRACTPROCDEF
***************************************************************************}

    constructor tabstractprocdef.init;

      begin
         inherited init;
         para1:=nil;
{$ifdef StoreFPULevel}
        fpu_used:=255;
{$endif StoreFPULevel}
         options:=0;
         retdef:=voiddef;
         savesize:=Sizeof(pointer);
      end;

    destructor tabstractprocdef.done;

      var
         hp : pdefcoll;

      begin
         hp:=para1;
         while assigned(hp) do
           begin
              para1:=hp^.next;
              dispose(hp);
              hp:=para1;
           end;
         inherited done;
      end;

    procedure tabstractprocdef.concatdef(p : pdef;vsp : tvarspez);

      var
         hp : pdefcoll;

      begin
         new(hp);
         hp^.paratyp:=vsp;
         hp^.data:=p;
         hp^.next:=para1;
         para1:=hp;
      end;

    procedure tabstractprocdef.deref;
      var
         hp : pdefcoll;
      begin
         inherited deref;
         resolvedef(retdef);
         hp:=para1;
         while assigned(hp) do
           begin
              resolvedef(hp^.data);
              hp:=hp^.next;
           end;
      end;

    constructor tabstractprocdef.load;
      var
         last,hp : pdefcoll;
         count,i : word;
      begin
         tdef.load;
         retdef:=readdefref;
{$ifdef StoreFPULevel}
         fpu_used:=readbyte;
{$endif StoreFPULevel}
         options:=readlong;
         count:=readword;
         para1:=nil;
         savesize:=Sizeof(pointer);
         for i:=1 to count do
           begin
              new(hp);
              hp^.paratyp:=tvarspez(readbyte);
              hp^.data:=readdefref;
              hp^.next:=nil;
              if para1=nil then
                para1:=hp
              else
                last^.next:=hp;
              last:=hp;
           end;
      end;

    function tabstractprocdef.para_size : longint;
      var
         pdc : pdefcoll;
         l : longint;
      begin
         l:=0;
         pdc:=para1;
         while assigned(pdc) do
           begin
              case pdc^.paratyp of
                vs_value : l:=l+pdc^.data^.size+(pdc^.data^.size mod 2);
                  vs_var : l:=l+sizeof(pointer);
                vs_const : if dont_copy_const_param(pdc^.data) then
                             l:=l+sizeof(pointer)
                           else
                             l:=l+pdc^.data^.size+(pdc^.data^.size mod 2);
                end;
              pdc:=pdc^.next;
           end;
         para_size:=l;
      end;

    procedure tabstractprocdef.write;

      var
         count : word;
         hp : pdefcoll;

      begin
         tdef.write;
         writedefref(retdef);
{$ifdef StoreFPULevel}
         writebyte(FPU_used);
{$endif StoreFPULevel}
         writelong(options);
         hp:=para1;
         count:=0;
         while assigned(hp) do
           begin
              inc(count);
              hp:=hp^.next;
           end;
         writeword(count);
         hp:=para1;
         while assigned(hp) do
           begin
              writebyte(byte(hp^.paratyp));
              writedefref(hp^.data);
              hp:=hp^.next;
           end;
      end;

    function tabstractprocdef.demangled_paras : string;
      var s : string;
          p : pdefcoll;
      begin
        s:='';
        p:=para1;
        if assigned(p) then
          begin
             s:=s+'(';
             while assigned(p) do
               begin
                  if assigned(p^.data^.sym) then
                    s:=s+p^.data^.sym^.name
                  else if p^.paratyp=vs_var then
                    s:=s+'var'
                  else if p^.paratyp=vs_const then
                    s:=s+'const';
                  p:=p^.next;
                  if assigned(p) then
                    s:=s+','
                  else
                    s:=s+')';
               end;
          end;
        demangled_paras:=s;
      end;

{$ifdef GDB}
    function tabstractprocdef.stabstring : pchar;
      begin
        stabstring := strpnew('abstractproc'+numberstring+';');
      end;

    procedure tabstractprocdef.concatstabto(asmlist : paasmoutput);

      begin
         if (not assigned(sym) or sym^.isusedinstab or use_dbx)
            and not is_def_stab_written then
           begin
              if assigned(retdef) then forcestabto(asmlist,retdef);
              inherited concatstabto(asmlist);
           end;
      end;
{$endif GDB}

{***********************************************************************************
                                  TPROCDEF
***************************************************************************}

    constructor tprocdef.init;

      begin
         inherited init;
         deftype:=procdef;
         _mangledname:=nil;
         nextoverloaded:=nil;
         extnumber:=-1;
         localst:=new(psymtable,init(localsymtable));
         parast:=new(psymtable,init(parasymtable));
         { this is used by insert
          to check same names in parast and localst }
         localst^.next:=parast;
{$ifdef UseBrowser}
         defref:=nil;
         if make_ref then
           add_new_ref(defref,@tokenpos);
         lastref:=defref;
         lastwritten:=nil;
         refcount:=1;
{$endif UseBrowser}

         { first, we assume, that all registers are used }
{$ifdef i386}
         usedregisters:=$ff;
{$endif i386}
{$ifdef m68k}
         usedregisters:=$FFFF;
{$endif}
{$ifdef alpha}
         usedregisters_int:=$ffffffff;
         usedregisters_fpu:=$ffffffff;
{$endif alpha}
         forwarddef:=true;
         _class := nil;
      end;

    constructor tprocdef.load;

      var
         s : string;

      begin
         { deftype:=procdef; this is at the wrong place !! }
         inherited load;
         deftype:=procdef;
{$ifdef i386}
         usedregisters:=readbyte;
{$endif i386}
{$ifdef m68k}
         usedregisters:=readword;
{$endif}
{$ifdef alpha}
         usedregisters_int:=readlong;
         usedregisters_fpu:=readlong;
{$endif alpha}

         s:=readstring;
         setstring(_mangledname,s);

         extnumber:=readlong;
         nextoverloaded:=pprocdef(readdefref);
         _class := pobjectdef(readdefref);

         if gendeffile and ((options and poexports)<>0) then
           deffile.AddExport(mangledname);

         parast:=nil;
         localst:=nil;
         forwarddef:=false;
{$ifdef UseBrowser}
         if (current_module^.flags and uf_uses_browser)<>0 then
           load_references
         else
           begin
              lastref:=nil;
              lastwritten:=nil;
              defref:=nil;
              refcount:=0;
           end;
{$endif UseBrowser}
      end;

{$ifdef UseBrowser}
    procedure tprocdef.load_references;

      var fileindex : word;
          b : byte;
          l,c : longint;

      begin
         b:=readbyte;
         refcount:=0;
         lastref:=nil;
         lastwritten:=nil;
         defref:=nil;
         while b=ibref do
           begin
              fileindex:=readword;
              l:=readlong;
              c:=readword;
              inc(refcount);
              lastref:=new(pref,load(lastref,fileindex,l,c));
              if refcount=1 then defref:=lastref;
              b:=readbyte;
           end;
          if b <> ibend then
         { Message(unit_f_ppu_read);
          message disappeared ?? }
            Comment(V_fatal,'error in load_reference');
      end;

    procedure tprocdef.write_references;

      var ref : pref;

      begin
      { references do not change the ppu caracteristics      }
      { this only save the references to variables/functions }
      { defined in the unit what about the others            }
         ppufile^.do_crc:=false;
         if assigned(lastwritten) then
           ref:=lastwritten
         else
           ref:=defref;
         while assigned(ref) do
           begin
              writebyte(ibref);
              writeword(ref^.posinfo.fileindex);
              writelong(ref^.posinfo.line);
              writeword(ref^.posinfo.column);
              ref:=ref^.nextref;
           end;
         lastwritten:=lastref;
         writebyte(ibend);
         ppufile^.do_crc:=true;
      end;

    procedure tprocdef.write_external_references;

      var ref : pref;

      begin
         ppufile^.do_crc:=false;
         if lastwritten=lastref then exit;
         writebyte(ibextdefref);
         writedefref(@self);
         if assigned(lastwritten) then
           ref:=lastwritten
         else
           ref:=defref;
         while assigned(ref) do
           begin
              writebyte(ibref);
              writeword(ref^.posinfo.fileindex);
              writelong(ref^.posinfo.line);
              writeword(ref^.posinfo.column);
              ref:=ref^.nextref;
           end;
         lastwritten:=lastref;
         writebyte(ibend);
         ppufile^.do_crc:=true;
      end;

    procedure tprocdef.write_ref_to_file(var f : text);

      var ref : pref;
         i : longint;

      begin
         ref:=defref;
         if assigned(ref) then
           begin
              for i:=1 to reffile_indent do
                system.write(f,' ');
              writeln(f,'***',mangledname);
           end;
         inc(reffile_indent,2);
         while assigned(ref) do
           begin
              for i:=1 to reffile_indent do
                system.write(f,' ');
              writeln(f,ref^.get_file_line);
              ref:=ref^.nextref;
           end;
         dec(reffile_indent,2);
      end;
{$endif UseBrowser}

    destructor tprocdef.done;

      begin
         if assigned(parast) then
           dispose(parast,done);
         if assigned(localst) then
           dispose(localst,done);
         if
{$ifdef tp}
         not(use_big) and
{$endif}
         assigned(_mangledname) then
           strdispose(_mangledname);
         inherited done;
      end;

    procedure tprocdef.write;

      begin
{$ifndef NEWPPU}
         writebyte(ibprocdef);
{$endif}
         inherited write;
{$ifdef i386}
         writebyte(usedregisters);
{$endif i386}
{$ifdef m68k}
         writeword(usedregisters);
{$endif}
{$ifdef alpha}
         writelong(usedregisters_int);
         writelong(usedregisters_fpu);
{$endif alpha}
         writestring(mangledname);
         writelong(extnumber);
         writedefref(nextoverloaded);
         writedefref(_class);
{$ifdef NEWPPU}
         ppufile^.writeentry(ibprocdef);
{$endif}
{$ifdef UseBrowser}
         if (current_module^.flags and uf_uses_browser)<>0 then
           write_references;
{$endif UseBrowser}
      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)^.definition^.numberstring+','+vs+';');
      end;

    function tprocdef.stabstring : pchar;
      var param : pdefcoll;
          i : word;
          vartyp : char;
          oldrec : pchar;
      begin
      oldrec := stabrecstring;
      getmem(StabRecString,1024);
      param := para1;
      i := 0;
      while assigned(param) do
        begin
           inc(i);
           param := param^.next;
        end;
      strpcopy(StabRecString,'f'+retdef^.numberstring);
      if i>0 then
        begin
        strpcopy(strend(StabRecString),','+tostr(i)+';');
        if assigned(parast) then
          {$IfDef TP}
          parast^.foreach(addparaname)
          {$Else}
          parast^.foreach(@addparaname)
          {$EndIf}
          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^.data^.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;
      begin
         inherited deref;
         resolvedef(pdef(nextoverloaded));
         resolvedef(pdef(_class));
      end;

    function tprocdef.mangledname : string;
{$ifdef tp}
      var
         oldpos : longint;
         s : string;
         b : byte;
{$endif tp}
      begin
{$ifdef tp}
         if use_big then
           begin
              symbolstream.seek(longint(_mangledname));
              symbolstream.read(b,1);
              symbolstream.read(s[1],b);
              s[0]:=chr(b);
              mangledname:=s;
           end
         else
{$endif}
          mangledname:=strpas(_mangledname);
      end;

{$IfDef GDB}
    function tprocdef.cplusplusmangledname : string;
      var
         s,s2 : string;
         param : pdefcoll;
      begin
      s := sym^.name;
      if _class <> nil then
        begin
        s2 := _class^.name^;
        s := s+'__'+tostr(length(s2))+s2;
        end else s := s + '_';
      param := para1;
      while assigned(param) do
        begin
        s2 := param^.data^.sym^.name;
        s := s+tostr(length(s2))+s2;
        param := param^.next;
        end;
      cplusplusmangledname:=s;
      end;
{$EndIf GDB}


    procedure tprocdef.setmangledname(const s : string);
      begin
         if {$ifdef tp}not(use_big) and{$endif} (assigned(_mangledname)) then
           strdispose(_mangledname);
         setstring(_mangledname,s);
{$ifdef UseBrowser}
         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 UseBrowser}
      end;

{***********************************************************************************
                                 TPROCVARDEF
***************************************************************************}

    constructor tprocvardef.init;
      begin
         inherited init;
         deftype:=procvardef;
      end;

    constructor tprocvardef.load;
      begin
         inherited load;
         deftype:=procvardef;
      end;

    procedure tprocvardef.write;
      begin
{$ifndef NEWPPU}
         writebyte(ibprocvardef);
{$endif}
         { here we cannot get a real good value so just give something }
         { plausible (PM) }
{$ifdef StoreFPULevel}
         if is_fpu(retdef) then
           fpu_used:=3
         else
           fpu_used:=0;
{$endif StoreFPULevel}
         inherited write;
{$ifdef NEWPPU}
         ppufile^.writeentry(ibprocvardef);
{$endif}
      end;

    function tprocvardef.size : longint;

      begin
         if (options and pomethodpointer)=0 then
           size:=sizeof(pointer)
         else
           size:=2*sizeof(pointer);
      end;

{$ifdef GDB}
    function tprocvardef.stabstring : pchar;
      var
         nss : pchar;
         i : word;
         vartyp : char;
         pst : pchar;
         param : pdefcoll;
      begin
        i := 0;
        param := para1;
        while assigned(param) do
          begin
          inc(i);
          param := param^.next;
          end;
        getmem(nss,1024);
        strpcopy(nss,'f'+retdef^.numberstring+','+tostr(i)+';');
        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 !!}
          pst := strpnew('p'+tostr(i)+':'+param^.data^.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(sym) or sym^.isusedinstab or use_dbx)
           and not is_def_stab_written then
           inherited concatstabto(asmlist);
         is_def_stab_written:=true;
      end;
{$endif GDB}

{***************************************************************************
                              TOBJECTDEF
***************************************************************************}

{$ifdef GDB}
    const
       vtabletype : word = 0;
       vtableassigned : boolean = false;
{$endif GDB}

   constructor tobjectdef.init(const n : string;c : pobjectdef);

     begin
        tdef.init;
        deftype:=objectdef;
        childof:=c;
        options:=0;
        { privatesyms:=new(psymtable,init(objectsymtable));
      protectedsyms:=new(psymtable,init(objectsymtable)); }
        publicsyms:=new(psymtable,init(objectsymtable));
        publicsyms^.name := stringdup(n);
        { add the data of the anchestor class }
        if assigned(childof) then
          begin
             publicsyms^.datasize:=
               publicsyms^.datasize-4+childof^.publicsyms^.datasize;
          end;
        name:=stringdup(n);
        savesize := publicsyms^.datasize;
        publicsyms^.defowner:=@self;
     end;

    constructor tobjectdef.load;
      var
         oldread_member : boolean;
      begin
         tdef.load;
         deftype:=objectdef;
         savesize:=readlong;
         name:=stringdup(readstring);
         childof:=pobjectdef(readdefref);
         options:=readlong;
         oldread_member:=read_member;
         read_member:=true;
         if (options and (oo_hasprivate or oo_hasprotected))<>0 then
           object_options:=true;
         publicsyms:=new(psymtable,loadasstruct(objectsymtable));
         object_options:=false;
         publicsyms^.defowner:=@self;
         publicsyms^.datasize:=savesize;
         publicsyms^.name := stringdup(name^);
         read_member:=oldread_member;

         { handles the predefined class tobject  }
         { the last TOBJECT which is loaded gets }
         { it !                                  }
         if (name^='TOBJECT') and not(cs_compilesystem in aktswitches) and
           isclass and (childof=pointer($ffffffff)) then
           class_tobject:=@self;
      end;

   procedure tobjectdef.check_forwards;

     begin
        publicsyms^.check_forwards;
        if (options and oo_isforward)<>0 then
          begin
             { ok, in future, the forward can be resolved }
             Message1(sym_e_class_forward_not_resolved,name^);
             options:=options and not(oo_isforward);
          end;
     end;

   destructor tobjectdef.done;

     begin
{!!!!
        if assigned(privatesyms) then
          dispose(privatesyms,done);
        if assigned(protectedsyms) then
          dispose(protectedsyms,done); }
        if assigned(publicsyms) then
          dispose(publicsyms,done);
        if (options and oo_isforward)<>0 then
         Message1(sym_e_class_forward_not_resolved,name^);
        stringdispose(name);
        tdef.done;
     end;

   { true, if self inherits from d (or if they are equal) }
   function tobjectdef.isrelated(d : pobjectdef) : boolean;

     var
        hp : pobjectdef;

     begin
        hp:=@self;
        while assigned(hp) do
          begin
             if hp=d then
               begin
                  isrelated:=true;
                  exit;
               end;
             hp:=hp^.childof;
          end;
        isrelated:=false;
     end;

   function tobjectdef.size : longint;

     begin
        if (options and oois_class)<>0 then
          size:=sizeof(pointer)

        else
          size:=publicsyms^.datasize;
     end;

    procedure tobjectdef.deref;

      var
         hp : pdef;
         oldrecsyms : psymtable;

      begin
         resolvedef(pdef(childof));
         oldrecsyms:=aktrecordsymtable;
         aktrecordsymtable:=publicsyms;
         { nun die Definitionen dereferenzieren }
         hp:=publicsyms^.rootdef;
         while assigned(hp) do
           begin
              hp^.deref;

              {Besitzer setzen }
              hp^.owner:=publicsyms;

              hp:=hp^.next;
           end;
{$ifdef tp}
         publicsyms^.foreach(derefsym);
{$else}
         publicsyms^.foreach(@derefsym);
{$endif}
         aktrecordsymtable:=oldrecsyms;
      end;

    function tobjectdef.vmt_mangledname : string;

    {DM: I get a nil pointer on the owner name. I don't know if this
     mayhappen, and I have therefore fixed the problem by doing nil pointer
     checks.}

    var s1,s2:string;

    begin
        if owner^.name=nil then
            s1:=''
        else
            s1:=owner^.name^;
        if name=nil then
            s2:=''
        else
            s2:=name^;
        vmt_mangledname:='VMT_'+s1+'$_'+s2;
    end;

    function tobjectdef.isclass : boolean;
      begin
         isclass:=(options and oois_class)<>0;
      end;

    procedure tobjectdef.write;
      var
         oldread_member : boolean;
      begin
         oldread_member:=read_member;
         read_member:=true;
{$ifndef NEWPPU}
         writebyte(ibobjectdef);
{$endif}
         tdef.write;
         writelong(size);
         writestring(name^);
         writedefref(childof);
         writelong(options);
{$ifdef NEWPPU}
         ppufile^.writeentry(ibobjectdef);
{$endif}
         if (options and (oo_hasprivate or oo_hasprotected))<>0 then
           object_options:=true;
         publicsyms^.writeasstruct;
         object_options:=false;
         read_member:=oldread_member;
      end;

{$ifdef GDB}
    procedure addprocname(p :psym);
    var virtualind,argnames : string;
        news, newrec : pchar;
        pd,ipd : pprocdef;
        lindex : longint;
        para : pdefcoll;
        arglength : byte;
        sp : char;

    begin
    If 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 (pd^.options and povirtualmethod) <> 0 then
                   begin
                   lindex := pd^.extnumber;
                   {doesnt seem to be necessary
                   lindex := lindex or $80000000;}
                   virtualind := '*'+tostr(lindex)+';'+ipd^._class^.numberstring+';'
                   end else virtualind := '.';
                { arguments are not listed here }
                {we don't need another definition}
                 para := pd^.para1;
                 argnames := '';
                 while assigned(para) do
                   begin
                   if para^.data^.deftype = formaldef then
                     begin
                        if para^.paratyp=vs_var then
                          argnames := argnames+'3var'
                        else if para^.paratyp=vs_const then
                          argnames:=argnames+'5const';
                     end
                   else
                     begin
                     { if the arg definition is like (v: ^byte;..
                     there is no sym attached to data !!! }
                     if assigned(para^.data^.sym) then
                       begin
                          arglength := length(para^.data^.sym^.name);
                          argnames := argnames + tostr(arglength)+para^.data^.sym^.name;
                       end
                     else
                       begin
                          argnames:=argnames+'11unnamedtype';
                       end;
                     end;
                   para := para^.next;
                   end;
                ipd^.is_def_stab_written := true;
                { here 2A must be changed for private and protected }
                { 0 is private 1 protected and 2 public }
                if (p^.properties and sp_private)<>0 then sp:='0'
                else if (p^.properties and sp_protected)<>0 then sp:='1'
                else sp:='2';
                newrec := strpnew(p^.name+'::'+ipd^.numberstring
                     +'=##'+pd^.retdef^.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;
          oldrecsize : longint;
          str_end : string;
      begin
        oldrec := stabrecstring;
        oldrecsize:=stabrecsize;
        stabrecsize:=memsizeinc;
        GetMem(stabrecstring,stabrecsize);
        strpcopy(stabRecString,'s'+tostr(size));
        if assigned(childof) then
          {only one ancestor not virtual, public, at base offset 0 }
          {       !1           ,    0       2         0    ,       }
          strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';');
        {virtual table to implement yet}
        RecOffset := 0;
      {$ifdef tp}
         publicsyms^.foreach(addname);
      {$else}
         publicsyms^.foreach(@addname);
      {$endif tp}
      if (options and oo_hasvirtual) <> 0 then
        if not assigned(childof) or ((childof^.options and oo_hasvirtual) = 0) then
           begin
              str_end:='$vf'+numberstring+':'+typeglobalnumber('vtblarray')+',0;';
              strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')+',0;');
           end;
        {$ifdef tp}
          publicsyms^.foreach(addprocname);
        {$else}
          publicsyms^.foreach(@addprocname);
        {$endif tp }
        if (options and oo_hasvirtual) <> 0  then
          begin
             anc := @self;
             while assigned(anc^.childof) and ((anc^.childof^.options and oo_hasvirtual) <> 0) do
               anc := anc^.childof;
             str_end:=';~%'+anc^.numberstring+';';
          end
        else
          str_end:=';';
        strpcopy(strend(stabrecstring),str_end);
        stabstring := strnew(StabRecString);
        freemem(stabrecstring,stabrecsize);
        stabrecstring := oldrec;
        stabrecsize:=oldrecsize;
      end;
{$endif GDB}

{****************************************************************************
                                  TERRORDEF
****************************************************************************}

   constructor terrordef.init;
     begin
        tdef.init;
        deftype:=errordef;
     end;

{$ifdef GDB}
    function terrordef.stabstring : pchar;
      begin
         stabstring:=strpnew('error'+numberstring);
      end;
{$endif GDB}

{
  $Log$
  Revision 1.5  1998-06-04 23:52:01  peter
    * m68k compiles
    + .def file creation moved to gendef.pas so it could also be used
      for win32

  Revision 1.4  1998/06/04 09:55:45  pierre
    * demangled name of procsym reworked to become independant of the mangling scheme

  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------

  Revision 1.3  1998/06/03 22:49:03  peter
    + wordbool,longbool
    * rename bis,von -> high,low
    * moved some systemunit loading/creating to psystem.pas

  Revision 1.2  1998/05/31 14:13:37  peter
    * fixed call bugs with assembler readers
    + OPR_SYMBOL to hold a symbol in the asm parser
    * fixed staticsymtable vars which were acessed through %ebp instead of
      name

  Revision 1.1  1998/05/27 19:45:09  peter
    * symtable.pas splitted into includefiles
    * symtable adapted for $ifdef NEWPPU

}