fpc/compiler/symsym.inc

{
    $Id$
    Copyright (c) 1993-98 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
         inherited initname(n);
         typ:=abstractsym;
         symoptions:=current_object_option;
{$ifdef GDB}
         isstabwritten := false;
{$endif GDB}
         fileinfo:=tokenpos;
         defref:=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;
      end;


    constructor tsym.load;
      begin
         inherited init;
         indexnr:=readword;
         setname(readstring);
         typ:=abstractsym;
         readsmallset(symoptions);
         readposinfo(fileinfo);
         lastref:=nil;
         defref:=nil;
         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
           dispose(defref,done);
        inherited done;
      end;


    procedure tsym.write;
      begin
         writeword(indexnr);
         writestring(name);
         writesmallset(symoptions);
         writeposinfo(fileinfo);
      end;


    procedure tsym.deref;
      begin
      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;
              if asmlist = debuglist then do_count_dbx := true;
              { 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;
         defined:=false;
      end;

    constructor tlabelsym.load;

      begin
         tsym.load;
         typ:=labelsym;
         { this is all dummy
           it is only used for local browsing }
         lab:=nil;
         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 ! }

    destructor tunitsym.done;
      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;
         unitsymtable:=nil;
         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;
{$ifdef GDB}
         is_global := false;
{$endif GDB}
      end;

    constructor tprocsym.load;

      begin
         tsym.load;
         typ:=procsym;
         definition:=pprocdef(readdefref);
{$ifdef GDB}
         is_global := false;
{$endif GDB}
      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.demangledname:string;
      begin
        demangledname:=name+definition^.demangled_paras;
      end;

    procedure tprocsym.write_parameter_lists;

      var
         p : pprocdef;

      begin
         p:=definition;
         while assigned(p) do
           begin
              { force the error to be printed }
              Verbose.Message1(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^+'.'+demangledname)
                   else
                     MessagePos1(fileinfo,sym_e_forward_not_resolved,demangledname);
                   { Turn futher error messages off }
                   pd^.forwarddef:=false;
                end;

              pd:=pd^.nextoverloaded;
           end;
      end;


    procedure tprocsym.deref;
      var
        t    : ttoken;
        last : pprocdef;
      begin
         resolvedef(pdef(definition));
         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
                     last^.nextoverloaded:=overloaded_operators[t]^.definition;
                   overloaded_operators[t]:=@self;
                end;
           end;
      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 := 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^.retdef^.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);
      if assigned(definition^.localst) then
        definition^.localst^.concatstabto(asmlist);
      definition^.is_def_stab_written := true;
    end;
{$endif GDB}


{****************************************************************************
                                  TPROGRAMSYM
****************************************************************************}

    constructor tprogramsym.init(const n : string);
      begin
        inherited init(n);
        typ:=programsym;
      end;

{****************************************************************************
                                  TERRORSYM
****************************************************************************}

    constructor terrorsym.init;
      begin
        inherited init('');
        typ:=errorsym;
      end;

{****************************************************************************
                                TPROPERTYSYM
****************************************************************************}

    constructor tpropertysym.init(const n : string);
      begin
         inherited init(n);
         typ:=propertysym;
         propoptions:=[];
         proptype:=nil;
         readaccessdef:=nil;
         writeaccessdef:=nil;
         readaccesssym:=nil;
         writeaccesssym:=nil;
         storedsym:=nil;
         storeddef:=nil;

         index:=0;
         default:=0;
      end;

    destructor tpropertysym.done;

        procedure disposepropsymlist(p:ppropsymlist);
        var
          hp : ppropsymlist;
        begin
          while assigned(p) do
           begin
             hp:=p;
             p:=p^.next;
             dispose(hp);
           end;
        end;

      begin
         disposepropsymlist(readaccesssym);
         disposepropsymlist(writeaccesssym);
         disposepropsymlist(storedsym);
         inherited done;
      end;

    constructor tpropertysym.load;

        function readpropsymlist:ppropsymlist;
        var
          root,last,p : ppropsymlist;
          sym : psym;
        begin
          root:=nil;
          last:=nil;
          repeat
            sym:=readsymref;
            if sym=nil then
             break;
            new(p);
            p^.sym:=sym;
            p^.next:=nil;
            if assigned(last) then
             last^.next:=p
            else
             root:=p;
            last:=p;
          until false;
          readpropsymlist:=root;
        end;

      begin
         inherited load;
         typ:=propertysym;
         proptype:=readdefref;
         readsmallset(propoptions);
         index:=readlong;
         default:=readlong;
         { the syms }
         readaccesssym:=readpropsymlist;
         writeaccesssym:=readpropsymlist;
         storedsym:=readpropsymlist;
         { now the defs }
         readaccessdef:=readdefref;
         writeaccessdef:=readdefref;
         storeddef:=readdefref;
      end;

    procedure tpropertysym.deref;

        procedure resolvepropsymlist(p:ppropsymlist);
        begin
          while assigned(p) do
           begin
             resolvesym(p^.sym);
             p:=p^.next;
           end;
        end;

      begin
         resolvedef(proptype);
         resolvedef(readaccessdef);
         resolvedef(writeaccessdef);
         resolvedef(storeddef);
         resolvepropsymlist(readaccesssym);
         resolvepropsymlist(writeaccesssym);
         resolvepropsymlist(storedsym);
      end;

    function tpropertysym.getsize : longint;

      begin
         getsize:=0;
      end;

    procedure tpropertysym.write;

        procedure writepropsymlist(p:ppropsymlist);
        begin
          while assigned(p) do
           begin
             writesymref(p^.sym);
             p:=p^.next;
           end;
          writesymref(nil);
        end;

      begin
         tsym.write;
         writedefref(proptype);
         writesmallset(propoptions);
         writelong(index);
         writelong(default);
         writepropsymlist(readaccesssym);
         writepropsymlist(writeaccesssym);
         writepropsymlist(storedsym);
         writedefref(readaccessdef);
         writedefref(writeaccessdef);
         writedefref(storeddef);
         current_ppu^.writeentry(ibpropertysym);
      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;
         funcretdef:=pprocinfo(approcinfo)^.retdef;
         { address valid for ret in param only }
         { otherwise set by insert             }
         address:=pprocinfo(approcinfo)^.retoffset;
      end;

    constructor tfuncretsym.load;
      begin
         tsym.load;
         funcretdef:=readdefref;
         address:=readlong;
         funcretprocinfo:=nil;
         typ:=funcretsym;
      end;

    procedure tfuncretsym.write;
      begin

         (*
          Normally all references are
          transfered to the function symbol itself !! PM *)
         tsym.write;
         writedefref(funcretdef);
         writelong(address);

         current_ppu^.writeentry(ibfuncretsym);
      end;

    procedure tfuncretsym.deref;
      begin
         resolvedef(funcretdef);
      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
        { allocate space in local if ret in acc or in fpu }
        if ret_in_acc(procinfo.retdef) or (procinfo.retdef^.deftype=floatdef) then
          begin
             l:=funcretdef^.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.retoffset:=-owner^.datasize;
          end;
      end;


{****************************************************************************
                                  TABSOLUTESYM
****************************************************************************}

    constructor tabsolutesym.init(const n : string;p : pdef);
      begin
        inherited init(n,p);
        typ:=absolutesym;
      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 }
         if assigned(definitionsym) then
          begin
            writedefref(nil);
            writesymref(definitionsym);
          end
         else
          begin
            writedefref(definition);
            writesymref(nil);
          end;
         hvo:=varoptions-[vo_regable];
         writesmallset(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;p : pdef);
      begin
         tsym.init(n);
         typ:=varsym;
         definition:=p;
         definitionsym:=nil;
         _mangledname:=nil;
         varspez:=vs_value;
         address:=0;
         islocalcopy:=false;
         localvarsym:=nil;
         refs:=0;
         varstate:=vs_used;
         varoptions:=[];
         { can we load the value into a register ? }
         if p^.is_intregable then

{$ifdef INCLUDEOK}
           include(varoptions,vo_regable)
{$else}
           varoptions:=varoptions+[vo_regable]
{$endif}
         else
{$ifdef INCLUDEOK}
           exclude(varoptions,vo_regable);
{$else}
           varoptions:=varoptions-[vo_regable];
{$endif}

         if p^.is_fpuregable then
{$ifdef INCLUDEOK}
           include(varoptions,vo_fpuregable)
{$else}
           varoptions:=varoptions+[vo_fpuregable]
{$endif}
         else
{$ifdef INCLUDEOK}
           exclude(varoptions,vo_regable);
{$else}
           varoptions:=varoptions-[vo_fpuregable];
{$endif}
         reg:=R_NO;
      end;


    constructor tvarsym.init_dll(const n : string;p : pdef);
      begin
      { The tvarsym is necessary for 0.99.5 (PFV) }
         tvarsym.init(n,p);
{$ifdef INCLUDEOK}
         include(varoptions,vo_is_dll_var);
{$else}
         varoptions:=varoptions+[vo_is_dll_var];
{$endif}
      end;


    constructor tvarsym.init_C(const n,mangled : string;p : pdef);
      begin
      { The tvarsym is necessary for 0.99.5 (PFV) }
         tvarsym.init(n,p);
{$ifdef INCLUDEOK}
         include(varoptions,vo_is_C_var);
{$else}
         varoptions:=varoptions+[vo_is_C_var];
{$endif}
         setmangledname(mangled);
      end;


    constructor tvarsym.initsym(const n : string;p : ptypesym);
      begin
        tvarsym.init(n,p^.definition);
        definitionsym:=p;
      end;


    constructor tvarsym.initsym_dll(const n : string;p : ptypesym);
      begin
        tvarsym.init_dll(n,p^.definition);
        definitionsym:=p;
      end;


    constructor tvarsym.initsym_C(const n,mangled : string;p : ptypesym);
      begin
        tvarsym.init_C(n,mangled,p^.definition);
        definitionsym:=p;
      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;
         islocalcopy:=false;
         localvarsym:=nil;
         definition:=readdefref;
         definitionsym:=ptypesym(readsymref);
         readsmallset(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
         if assigned(definitionsym) then
          begin
            resolvesym(psym(definitionsym));
            definition:=definitionsym^.definition;
          end
         else
          resolvedef(definition);
      end;


    procedure tvarsym.write;
      var
        hvo : tvaroptions;
      begin
         tsym.write;
         writebyte(byte(varspez));
         if read_member then
          writelong(address);
         { write only definition or definitionsym }
         if assigned(definitionsym) then
          begin
            writedefref(nil);
            writesymref(definitionsym);
          end
         else
          begin
            writedefref(definition);
            writesymref(nil);
          end;
         { symbols which are load are never candidates for a register,
           turn off the regable }
         hvo:=varoptions-[vo_regable];
         writesmallset(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_smartlink 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(definition) and (varspez=vs_value) and
          ((definition^.deftype<>arraydef) or (Parraydef(definition)^.highrange>=
          Parraydef(definition)^.lowrange)) then
              getsize:=definition^.size
          else
              getsize:=0;
      end;


    function tvarsym.getpushsize : longint;
      begin
         if assigned(definition) then
           begin
              case varspez of
                vs_var :
                  getpushsize:=target_os.size_of_pointer;
                vs_value,
                vs_const :
                  begin
                      if push_addr_param(definition) then
                        getpushsize:=target_os.size_of_pointer
                      else
                        getpushsize:=definition^.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 }
{$ifdef INCLUDEOK}
            exclude(varoptions,vo_regable);
            exclude(varoptions,vo_fpuregable);
{$else}
            varoptions:=varoptions-[vo_regable,vo_fpuregable];
{$endif}
         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
               ((pobjectdef(pvarsym(sym)^.definition)^.options and oo_is_abstract)<>0) 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:=getsize;
             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 (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));
                   inc(owner^.datasize,l);
                   address:=owner^.datasize;
                 end;
               staticsymtable :
                 begin
                   { enable unitialized warning for local symbols }
                   varstate:=vs_declared;
                   if (cs_smartlink 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_smartlink in aktmoduleswitches) or
                      DLLSource 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 }
{$ifdef INCLUDEOK}
                   exclude(varoptions,vo_regable);
                   exclude(varoptions,vo_fpuregable);
{$else}
                   varoptions:=varoptions-[vo_regable,vo_fpuregable];
{$endif}
                 end;
               globalsymtable :
                 begin
                   if (cs_smartlink 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 }
{$ifdef INCLUDEOK}
                   exclude(varoptions,vo_regable);
                   exclude(varoptions,vo_fpuregable);
{$else}
                   varoptions:=varoptions-[vo_regable,vo_fpuregable];
{$endif}
                 end;
               recordsymtable,
               objectsymtable :
                 begin
                 { this symbol can't be loaded to a register }
{$ifdef INCLUDEOK}
                   exclude(varoptions,vo_regable);
                   exclude(varoptions,vo_fpuregable);
{$else}
                   varoptions:=varoptions-[vo_regable,vo_fpuregable];
{$endif}
                 { get the alignment size }
                   if (aktpackrecords=packrecord_C) then
                    begin
                      varalign:=definition^.alignment;
                      if varalign=0 then
                       begin
                         if (owner^.dataalignment<4) then
                          begin
                            if (l>=4) then
                             owner^.dataalignment:=4
                            else
                             if (owner^.dataalignment<2) and (l>=2) then
                              owner^.dataalignment:=2;
                          end;
                       end;
                    end
                   else
                    varalign:=0;
                 { align record and object fields }
                   if (l=1) or (varalign=1) or (owner^.dataalignment=1) then
                    begin
                      address:=owner^.datasize;
                      inc(owner^.datasize,l)
                    end
                   else
                    if (l=2) or (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 (l<=4) or (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 (l<=8) or (owner^.dataalignment=8) then
                     begin
                       owner^.datasize:=(owner^.datasize+7) and (not 7);
                       address:=owner^.datasize;
                       inc(owner^.datasize,l);
                     end
                   else
                    if (l<=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 (l<=32) or (owner^.dataalignment=32) then
                     begin
                       owner^.datasize:=(owner^.datasize+31) and (not 31);
                       address:=owner^.datasize;
                       inc(owner^.datasize,l);
                     end;
                 end;
               parasymtable :
                 begin
                   { here we need the size of a push instead of the
                     size of the data }
                   l:=getpushsize;
                   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[2];
     begin
       if (definition^.deftype=objectdef) and
          pobjectdef(definition)^.is_class then
         st:='*'
       else
         st:='';
       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+
                     +definition^.numberstring+'",'+
                     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
                     +definition^.numberstring+'",'+
                     tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
         end
       else if owner^.symtabletype = staticsymtable then
         begin
            stabstring := strpnew('"'+name+':S'+st
                  +definition^.numberstring+'",'+
                  tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
         end
       else if (owner^.symtabletype=parasymtable) then
         begin
            case varspez of
               vs_var   : st := 'v'+st;
               vs_value,
               vs_const : if push_addr_param(definition) then
                            st := 'v'+st { should be 'i' but 'i' doesn't work }
                          else
                            st := 'p'+st;
              end;
            stabstring := strpnew('"'+name+':'+st
                  +definition^.numberstring+'",'+
                  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=localsymtable) 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
                        +definition^.numberstring+'",'+
                        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
                  +definition^.numberstring+'",'+
                  tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
           else
           stabstring := strpnew('"'+name+':'+st
                  +definition^.numberstring+'",'+
                  tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address))
       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'
                     +definition^.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;
         definition:=p;
         definitionsym:=nil;
         is_really_const:=really_const;
         prefix:=stringdup(procprefix);
      end;


    constructor ttypedconstsym.initsym(const n : string;p : ptypesym;really_const : boolean);
      begin
         ttypedconstsym.init(n,p^.definition,really_const);
         definitionsym:=p;
      end;


    constructor ttypedconstsym.load;
      begin
         tsym.load;
         typ:=typedconstsym;
         definition:=readdefref;
         definitionsym:=ptypesym(readsymref);
         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(definition) then
         getsize:=definition^.size
        else
         getsize:=0;
      end;


    procedure ttypedconstsym.deref;
      begin
         if assigned(definitionsym) then
          begin
            resolvesym(psym(definitionsym));
            definition:=definitionsym^.definition;
          end
         else
          resolvedef(definition);
      end;


    procedure ttypedconstsym.write;
      begin
         tsym.write;
         { write only definition or definitionsym }
         if assigned(definitionsym) then
          begin
            writedefref(nil);
            writesymref(definitionsym);
          end
         else
          begin
            writedefref(definition);
            writesymref(nil);
          end;
         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_smartlink 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,initname_global(mangledname,getsize)));
          end
        else
          if owner^.symtabletype<>unitsymtable then
            begin
              if (cs_smartlink in aktmoduleswitches) or
                 DLLSource then
                curconstsegment^.concat(new(pai_symbol,initname_global(mangledname,getsize)))
              else
                curconstsegment^.concat(new(pai_symbol,initname(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+
            definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+
            tostr(fileinfo.line)+','+mangledname);
    end;
{$endif GDB}

{****************************************************************************
                                  TCONSTSYM
****************************************************************************}

    constructor tconstsym.init(const n : string;t : tconsttype;v : longint);
      begin
         inherited init(n);
         typ:=constsym;
         consttype:=t;
         value:=v;
         ResStrIndex:=0;
         definition:=nil;
         len:=0;
      end;


    constructor tconstsym.init_def(const n : string;t : tconsttype;v : longint;def : pdef);
      begin
         inherited init(n);
         typ:=constsym;
         consttype:=t;
         value:=v;
         definition:=def;
         len:=0;
      end;


    constructor tconstsym.init_string(const n : string;t : tconsttype;str:pchar;l:longint);
      begin
         inherited init(n);
         typ:=constsym;
         consttype:=t;
         value:=longint(str);
         definition:=nil;
         len:=l;
         if t=constresourcestring then
           ResStrIndex:=registerresourcestring(name,pchar(value),len);
      end;

    constructor tconstsym.load;
      var
         pd : pbestreal;
         ps : pnormalset;
      begin
         tsym.load;
         typ:=constsym;
         consttype:=tconsttype(readbyte);
         case consttype of
           constint,
           constbool,
           constchar : value:=readlong;
           constord :
             begin
               definition:=readdefref;
               value:=readlong;
             end;
           conststring,constresourcestring :
             begin
               len:=readlong;
               getmem(pchar(value),len+1);
               current_ppu^.getdata(pchar(value)^,len);
               if consttype=constresourcestring then
                 ResStrIndex:=readlong;
             end;
           constreal :
             begin
               new(pd);
               pd^:=readreal;
               value:=longint(pd);
             end;
           constset :
             begin
               definition:=readdefref;
               new(ps);
               readnormalset(ps^);
               value:=longint(ps);
             end;
           constnil : ;
           else
             Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
         end;
      end;


    destructor tconstsym.done;
      begin
        case consttype of
          conststring :
            freemem(pchar(value),len+1);
          constreal :
            dispose(pbestreal(value));
          constset :
            dispose(pnormalset(value));
        end;
        inherited done;
      end;


    function tconstsym.mangledname : string;
      begin
         mangledname:=name;
      end;


    procedure tconstsym.deref;
      begin
        if consttype in [constord,constset] then
         resolvedef(pdef(definition));
      end;


    procedure tconstsym.write;
      begin
         tsym.write;
         writebyte(byte(consttype));
         case consttype of
           constnil : ;
           constint,
           constbool,
           constchar :
             writelong(value);
           constord :
             begin
               writedefref(definition);
               writelong(value);
             end;
           conststring,constresourcestring :
             begin
               writelong(len);
               current_ppu^.putdata(pchar(value)^,len);
               writelong(ResStrIndex);
             end;
           constreal :
             writereal(pbestreal(value)^);
           constset :
             begin
               writedefref(definition);
               writenormalset(pointer(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 consttype of
            conststring : begin
                          { I had to remove ibm2ascii !! }
                          st := pstring(value)^;
                          {st := ibm2ascii(pstring(value)^);}
                          st := 's'''+st+'''';
                          end;
            constbool, constint, constord, constchar : st := 'i'+tostr(value);
            constreal : begin
                        system.str(pbestreal(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 consttype <> 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;d : pdef);

      begin
         tsym.init(n);
         typ:=typesym;
         definition:=d;
{$ifdef GDB}
         isusedinstab := false;
{$endif GDB}
         forwardpointer:=nil;
         if assigned(definition) then
          begin
             if not(assigned(definition^.sym)) then
               begin
                  definition^.sym:=@self;
                  synonym:=nil;
{$ifdef INCLUDEOK}
                  include(symoptions,sp_primary_typesym);
{$else}
                  symoptions:=symoptions+[sp_primary_typesym];
{$endif}
               end
             else
               begin
                  synonym:=definition^.sym^.synonym;
                  definition^.sym^.synonym:=@self;
               end;
          end;
      end;

    constructor ttypesym.load;

      begin
         tsym.load;
         typ:=typesym;
         forwardpointer:=nil;
         synonym:=nil;
{$ifdef GDB}
         isusedinstab := false;
{$endif GDB}
         definition:=readdefref;
      end;

    destructor ttypesym.done;
      var prevsym : ptypesym;

      begin
         if assigned(definition) then
           begin
              prevsym:=definition^.sym;
              if prevsym=@self then
                definition^.sym:=synonym;
              while assigned(prevsym) do
                begin
                   if (prevsym^.synonym=@self) then
                     begin
                        prevsym^.synonym:=synonym;
                        break;
                     end;
                   prevsym:=prevsym^.synonym;
                end;
           end;
         synonym:=nil;
         definition:=nil;
         inherited done;
      end;


    procedure ttypesym.deref;

      begin
         resolvedef(definition);
         if assigned(definition) then
          begin
            if (sp_primary_typesym in symoptions) then
              begin
                 if definition^.sym<>@self then
                   synonym:=definition^.sym;
                 definition^.sym:=@self;
              end
            else
              begin
                 if assigned(definition^.sym) then
                   begin
                      synonym:=definition^.sym^.synonym;
                      if definition^.sym<>@self then
                        definition^.sym^.synonym:=@self;
                   end
                 else
                   definition^.sym:=@self;
              end;
            if (definition^.deftype=recorddef) and assigned(precorddef(definition)^.symtable) and
               (definition^.sym=@self) then
              precorddef(definition)^.symtable^.name:=stringdup('record '+name);
          end;
      end;


    procedure ttypesym.write;

      begin
         tsym.write;
         writedefref(definition);
         current_ppu^.writeentry(ibtypesym);
      end;


    procedure ttypesym.load_references;
      begin
         inherited load_references;
         if (definition^.deftype=recorddef) then
           precorddef(definition)^.symtable^.load_browser;
         if (definition^.deftype=objectdef) then
           pobjectdef(definition)^.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 (definition^.deftype=recorddef) or
            (definition^.deftype=objectdef) then
          begin
             writesymref(@self);
             current_ppu^.writeentry(ibsymref);
          end;
         write_references:=true;
         if (definition^.deftype=recorddef) then
           precorddef(definition)^.symtable^.write_browser;
         if (definition^.deftype=objectdef) then
           pobjectdef(definition)^.symtable^.write_browser;
      end;


    procedure ttypesym.addforwardpointer(p:ppointerdef);
      var
        hfp : pforwardpointer;
      begin
        new(hfp);
        hfp^.next:=forwardpointer;
        hfp^.def:=p;
        forwardpointer:=hfp;
      end;


    procedure ttypesym.updateforwarddef(p:pdef);
      var
        lasthfp,hfp : pforwardpointer;
      begin
        definition:=p;
        symoptions:=current_object_option;
        fileinfo:=tokenpos;
        if assigned(definition) and not(assigned(definition^.sym)) then
          definition^.sym:=@self;
        { update all forwardpointers to this definition }
        hfp:=forwardpointer;
        while assigned(hfp) do
         begin
           lasthfp:=hfp;
           hfp^.def^.definition:=definition;
           hfp:=hfp^.next;
           dispose(lasthfp);
         end;
      end;


{$ifdef BrowserLog}
    procedure ttypesym.add_to_browserlog;
      begin
         inherited add_to_browserlog;
         if (definition^.deftype=recorddef) then
            precorddef(definition)^.symtable^.writebrowserlog;
         if (definition^.deftype=objectdef) then
             pobjectdef(definition)^.symtable^.writebrowserlog;
      end;
{$endif BrowserLog}


{$ifdef GDB}
    function ttypesym.stabstring : pchar;
    var stabchar : string[2];
        short : string;
    begin
      if definition^.deftype in tagtypes then
        stabchar := 'Tt'
      else
        stabchar := 't';
      short := '"'+name+':'+stabchar+definition^.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(definition) then
        if (definition^.sym = @self) then
          definition^.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;
         buftext:=nil;
         buflen:=0;
      end;

    destructor tmacrosym.done;
      begin
         if assigned(buftext) then
           freemem(buftext,buflen);
         inherited done;
      end;


{
  $Log$
  Revision 1.115  1999-08-23 11:45:42  michael
  * Hopefully final attempt at resourcestrings

  Revision 1.114  1999/08/15 21:57:58  michael
  Changes for resource strings

  Revision 1.113  1999/08/14 00:39:00  peter
    * hack to support property with record fields

  Revision 1.112  1999/08/13 14:24:20  pierre
    + stabs for classes and classref working,
      a class still needs an ^ to get that content of it,
      but the class fields inside a class don't result into an
      infinite loop anymore!

  Revision 1.111  1999/08/10 12:36:31  pierre
   * use of procsym field for correct gdb info in local procedures
   * exported DLL vars made global to be able to use DLLTOOL with themz

  Revision 1.110  1999/08/07 14:21:03  florian
    * some small problems fixed

  Revision 1.109  1999/08/07 13:24:34  daniel
  * Fixed open arrays

  Revision 1.108  1999/08/05 16:53:17  peter
    * V_Fatal=1, all other V_ are also increased
    * Check for local procedure when assigning procvar
    * fixed comment parsing because directives
    * oldtp mode directives better supported
    * added some messages to errore.msg

  Revision 1.107  1999/08/04 13:45:30  florian
    + floating point register variables !!
    * pairegalloc is now generated for register variables

  Revision 1.106  1999/08/03 22:03:19  peter
    * moved bitmask constants to sets
    * some other type/const renamings

  Revision 1.105  1999/07/29 20:54:10  peter
    * write .size also

  Revision 1.104  1999/07/27 23:42:21  peter
    * indirect type referencing is now allowed

  Revision 1.103  1999/07/24 15:12:59  michael
  changes for resourcestrings

  Revision 1.102  1999/07/24 13:36:23  michael
  * Fixed resourcestring writing to units

  Revision 1.101  1999/07/23 20:59:23  peter
    * more C packing fixes

  Revision 1.100  1999/07/23 16:05:32  peter
    * alignment is now saved in the symtable
    * C alignment added for records
    * PPU version increased to solve .12 <-> .13 probs

  Revision 1.99  1999/07/23 11:33:23  peter
    * removed oldppu from propertysym

  Revision 1.98  1999/07/22 09:37:55  florian
    + resourcestring implemented
    + start of longstring support

  Revision 1.97  1999/07/05 12:13:25  florian
    * property reading from PPU fixed (new PPU format), it uses now writesym...

  Revision 1.96  1999/06/28 10:49:48  pierre
   merged from 0-99-12 branch

  Revision 1.94.2.2  1999/06/28 10:32:29  pierre
   * fixes bug453

  Revision 1.94.2.1  1999/06/22 16:26:45  pierre
   * local browser stuff corrected

  Revision 1.94  1999/06/03 16:25:05  pierre
   * local Cvar stabs corrected

  Revision 1.93  1999/05/27 19:45:06  peter
    * removed oldasm
    * plabel -> pasmlabel
    * -a switches to source writing automaticly
    * assembler readers OOPed
    * asmsymbol automaticly external
    * jumptables and other label fixes for asm readers

  Revision 1.92  1999/05/21 13:55:21  peter
    * NEWLAB for label as symbol

  Revision 1.91  1999/05/20 22:22:44  pierre
    + added synonym filed for ttypesym
      allows a clean disposal of tdefs and related ttypesyms

  Revision 1.90  1999/05/17 13:11:40  pierre
   * unitsym security stuff

  Revision 1.89  1999/05/13 21:59:45  peter
    * removed oldppu code
    * warning if objpas is loaded from uses
    * first things for new deref writing

  Revision 1.88  1999/05/10 09:01:43  peter
    * small message fixes

  Revision 1.87  1999/05/08 19:52:38  peter
    + MessagePos() which is enhanced Message() function but also gets the
      position info
    * Removed comp warnings

  Revision 1.86  1999/05/07 00:06:22  pierre
    + added aligmnent of data for typed consts
      for var it is done by AS or LD or in ag386bin for direct object output

  Revision 1.85  1999/05/04 21:45:07  florian
    * changes to compile it with Delphi 4.0

  Revision 1.84  1999/05/04 16:05:13  pierre
   * fix for unitsym problem

  Revision 1.83  1999/04/28 06:02:13  florian
    * changes of Bruessel:
       + message handler can now take an explicit self
       * typinfo fixed: sometimes the type names weren't written
       * the type checking for pointer comparisations and subtraction
         and are now more strict (was also buggy)
       * small bug fix to link.pas to support compiling on another
         drive
       * probable bug in popt386 fixed: call/jmp => push/jmp
         transformation didn't count correctly the jmp references
       + threadvar support
       * warning if ln/sqrt gets an invalid constant argument

  Revision 1.82  1999/04/26 13:31:52  peter
    * release storenumber,double_checksum

  Revision 1.81  1999/04/25 22:38:39  pierre
    + added is_really_const booleanfield for typedconstsym
      for Delphi in $J- mode (not yet implemented !)

  Revision 1.80  1999/04/21 09:43:54  peter
    * storenumber works
    * fixed some typos in double_checksum
    + incompatible types type1 and type2 message (with storenumber)

  Revision 1.79  1999/04/17 13:16:21  peter
    * fixes for storenumber

  Revision 1.78  1999/04/14 09:15:02  peter
    * first things to store the symbol/def number in the ppu

  Revision 1.77  1999/04/08 10:11:32  pierre
   + enable uninitilized warnings for static symbols

  Revision 1.76  1999/03/31 13:55:21  peter
    * assembler inlining working for ag386bin

  Revision 1.75  1999/03/24 23:17:27  peter
    * fixed bugs 212,222,225,227,229,231,233

  Revision 1.74  1999/02/23 18:29:27  pierre
    * win32 compilation error fix
    + some work for local browser (not cl=omplete yet)

  Revision 1.73  1999/02/22 13:07:09  pierre
    + -b and -bl options work !
    + cs_local_browser ($L+) is disabled if cs_browser ($Y+)
      is not enabled when quitting global section
    * local vars and procedures are not yet stored into PPU

  Revision 1.72  1999/02/08 09:51:22  pierre
   * gdb info for local functions was wrong

  Revision 1.71  1999/01/23 23:29:41  florian
    * first running version of the new code generator
    * when compiling exceptions under Linux fixed

  Revision 1.70  1999/01/21 22:10:48  peter
    * fixed array of const
    * generic platform independent high() support

  Revision 1.69  1999/01/20 10:20:20  peter
    * don't make localvar copies for assembler procedures

  Revision 1.68  1999/01/12 14:25:36  peter
    + BrowserLog for browser.log generation
    + BrowserCol for browser info in TCollections
    * released all other UseBrowser

  Revision 1.67  1998/12/30 22:15:54  peter
    + farpointer type
    * absolutesym now also stores if its far

  Revision 1.66  1998/12/30 13:41:14  peter
    * released valuepara

  Revision 1.65  1998/12/26 15:35:44  peter
    + read/write of constnil

  Revision 1.64  1998/12/08 10:18:15  peter
    + -gh for heaptrc unit

  Revision 1.63  1998/11/28 16:20:56  peter
    + support for dll variables

  Revision 1.62  1998/11/27 14:50:48  peter
    + open strings, $P switch support

  Revision 1.61  1998/11/18 15:44:18  peter
    * VALUEPARA for tp7 compatible value parameters

  Revision 1.60  1998/11/16 10:13:51  peter
    * label defines are checked at the end of the proc

  Revision 1.59  1998/11/13 12:09:11  peter
    * unused label is now a warning

  Revision 1.58  1998/11/10 10:50:57  pierre
   * temporary fix for long mangled procsym names

  Revision 1.57  1998/11/05 23:39:31  peter
    + typedconst.getsize

  Revision 1.56  1998/10/28 18:26:18  pierre
   * removed some erros after other errors (introduced by useexcept)
   * stabs works again correctly (for how long !)

  Revision 1.55  1998/10/20 08:07:00  pierre
    * several memory corruptions due to double freemem solved
      => never use p^.loc.location:=p^.left^.loc.location;
    + finally I added now by default
      that ra386dir translates global and unit symbols
    + added a first field in tsymtable and
      a nextsym field in tsym
      (this allows to obtain ordered type info for
      records and objects in gdb !)

  Revision 1.54  1998/10/19 08:55:07  pierre
    * wrong stabs info corrected once again !!
    + variable vmt offset with vmt field only if required
      implemented now !!!

  Revision 1.53  1998/10/16 08:51:53  peter
    + target_os.stackalignment
    + stack can be aligned at 2 or 4 byte boundaries

  Revision 1.52  1998/10/08 17:17:32  pierre
    * current_module old scanner tagged as invalid if unit is recompiled
    + added ppheap for better info on tracegetmem of heaptrc
      (adds line column and file index)
    * several memory leaks removed ith help of heaptrc !!

  Revision 1.51  1998/10/08 13:48:50  peter
    * fixed memory leaks for do nothing source
    * fixed unit interdependency

  Revision 1.50  1998/10/06 17:16:56  pierre
    * some memory leaks fixed (thanks to Peter for heaptrc !)

  Revision 1.49  1998/10/01 09:22:55  peter
    * fixed value openarray
    * ungettemp of arrayconstruct

  Revision 1.48  1998/09/26 17:45:44  peter
    + idtoken and only one token table

  Revision 1.47  1998/09/24 15:11:17  peter
    * fixed enum for not GDB

  Revision 1.46  1998/09/23 15:39:13  pierre
    * browser bugfixes
      was adding a reference when looking for the symbol
      if -bSYM_NAME was used

  Revision 1.45  1998/09/21 08:45:24  pierre
    + added vmt_offset in tobjectdef.write for fututre use
      (first steps to have objects without vmt if no virtual !!)
    + added fpu_used field for tabstractprocdef  :
      sets this level to 2 if the functions return with value in FPU
      (is then set to correct value at parsing of implementation)
      THIS MIGHT refuse some code with FPU expression too complex
      that were accepted before and even in some cases
      that don't overflow in fact
      ( like if f : float; is a forward that finally in implementation
       only uses one fpu register !!)
      Nevertheless I think that it will improve security on
      FPU operations !!
    * most other changes only for UseBrowser code
      (added symtable references for record and objects)
      local switch for refs to args and local of each function
      (static symtable still missing)
      UseBrowser still not stable and probably broken by
      the definition hash array !!

  Revision 1.44  1998/09/18 16:03:47  florian
    * some changes to compile with Delphi

  Revision 1.43  1998/09/18 08:01:38  pierre
    + improvement on the usebrowser part
      (does not work correctly for now)

  Revision 1.42  1998/09/07 19:33:25  florian
    + some stuff for property rtti added:
       - NameIndex of the TPropInfo record is now written correctly
       - the DEFAULT/NODEFAULT keyword is supported now
       - the default value and the storedsym/def are now written to
         the PPU fiel

  Revision 1.41  1998/09/07 18:46:12  peter
    * update smartlinking, uses getdatalabel
    * renamed ptree.value vars to value_str,value_real,value_set

  Revision 1.40  1998/09/07 17:37:04  florian
    * first fixes for published properties

  Revision 1.39  1998/09/05 22:11:02  florian
    + switch -vb
    * while/repeat loops accept now also word/longbool conditions
    * makebooltojump did an invalid ungetregister32, fixed

  Revision 1.38  1998/09/01 12:53:26  peter
    + aktpackenum

  Revision 1.37  1998/09/01 07:54:25  pierre
    * UseBrowser a little updated (might still be buggy !!)
    * bug in psub.pas in function specifier removed
    * stdcall allowed in interface and in implementation
      (FPC will not yet complain if it is missing in either part
      because stdcall is only a dummy !!)

  Revision 1.36  1998/08/25 13:09:26  pierre
    * corrected mangling sheme :
      cvar add Cprefix to the mixed case name whereas
      export or public use direct name

  Revision 1.35  1998/08/25 12:42:46  pierre
    * CDECL changed to CVAR for variables
      specifications are read in structures also
    + started adding GPC compatibility mode ( option  -Sp)
    * names changed to lowercase

  Revision 1.34  1998/08/21 14:08:53  pierre
    + TEST_FUNCRET now default (old code removed)
      works also for m68k (at least compiles)

  Revision 1.33  1998/08/20 12:53:27  peter
    * object_options are always written for object syms

  Revision 1.32  1998/08/20 09:26:46  pierre
    + funcret setting in underproc testing
      compile with _dTEST_FUNCRET

  Revision 1.31  1998/08/17 10:10:12  peter
    - removed OLDPPU

  Revision 1.30  1998/08/13 10:57:29  peter
    * constant sets are now written correctly to the ppufile

  Revision 1.29  1998/08/11 15:31:42  peter
    * write extended to ppu file
    * new version 0.99.7

  Revision 1.28  1998/08/11 14:07:27  peter
    * fixed pushing of high value for openarray

  Revision 1.27  1998/08/10 14:50:31  peter
    + localswitches, moduleswitches, globalswitches splitting

  Revision 1.26  1998/08/10 10:18:35  peter
    + Compiler,Comphook unit which are the new interface units to the
      compiler

  Revision 1.25  1998/07/30 11:18:19  florian
    + first implementation of try ... except on .. do end;
    * limitiation of 65535 bytes parameters for cdecl removed

  Revision 1.24  1998/07/20 18:40:16  florian
    * handling of ansi string constants should now work

  Revision 1.23  1998/07/14 21:37:24  peter
    * fixed packrecords as discussed at the alias

  Revision 1.22  1998/07/14 14:47:08  peter
    * released NEWINPUT

  Revision 1.21  1998/07/13 21:17:38  florian
    * changed to compile with TP

  Revision 1.20  1998/07/10 00:00:05  peter
    * fixed ttypesym bug finally
    * fileinfo in the symtable and better using for unused vars

  Revision 1.19  1998/07/07 17:40:39  peter
    * packrecords 4 works
    * word aligning of parameters

  Revision 1.18  1998/07/07 11:20:15  peter
    + NEWINPUT for a better inputfile and scanner object

  Revision 1.17  1998/06/24 14:48:40  peter
    * ifdef newppu -> ifndef oldppu

  Revision 1.16  1998/06/19 15:40:42  peter
    * removed cosntructor/constructor warning and 0.99.5 recompiles it again

  Revision 1.15  1998/06/17 14:10:18  peter
    * small os2 fixes
    * fixed interdependent units with newppu (remake3 under linux works now)

  Revision 1.14  1998/06/16 08:56:34  peter
    + targetcpu
    * cleaner pmodules for newppu

  Revision 1.13  1998/06/15 15:38:10  pierre
    * small bug in systems.pas corrected
    + operators in different units better hanlded

  Revision 1.12  1998/06/15 14:23:44  daniel

  * Reverted my changes.

  Revision 1.10  1998/06/13 00:10:18  peter
    * working browser and newppu
    * some small fixes against crashes which occured in bp7 (but not in
      fpc?!)

  Revision 1.9  1998/06/12 16:15:35  pierre
    * external name 'C_var';
      export name 'intern_C_var';
      cdecl;
      cdecl;external;
      are now supported only with -Sv switch

  Revision 1.8  1998/06/11 10:11:59  peter
    * -gb works again

  Revision 1.7  1998/06/09 16:01:51  pierre
    + added procedure directive parsing for procvars
      (accepted are popstack cdecl and pascal)
    + added C vars with the following syntax
      var C calias 'true_c_name';(can be followed by external)
      reason is that you must add the Cprefix

      which is target dependent

  Revision 1.6  1998/06/08 22:59:53  peter
    * smartlinking works for win32
    * some defines to exclude some compiler parts

  Revision 1.5  1998/06/04 23:52:02  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:46  pierre
    * demangled name of procsym reworked to become independant of the mangling scheme

  Revision 1.3  1998/06/03 22:14:20  florian
    * problem with sizes of classes fixed (if the anchestor was declared
      forward, the compiler doesn't update the child classes size)

  Revision 1.2  1998/05/28 14:40:29  peter
    * fixes for newppu, remake3 works now with it

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

}