freepascal.compiler/compiler/symtable.pas

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

    This unit handles the symbol tables

    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.
 ****************************************************************************
}
{$ifdef TP}
  {$N+,E+,F+}
{$endif}
unit symtable;

  interface

    uses
{$ifdef TP}
       objects,
{$endif}
       strings,cobjects,
       globtype,globals,tokens,systems,verbose,
       aasm
{$ifdef i386}
  {$ifdef ag386bin}
       ,i386base
  {$else}
       ,i386
  {$endif}
{$endif}
{$ifdef m68k}
       ,m68k
{$endif}
{$ifdef alpha}
       ,alpha
{$endif}
{$ifdef GDB}
       ,gdb
{$endif}
       ;

{$ifdef OLDPPU}
  {define NOLOCALBROWSER if you have problems with -bl option }
{$endif}

{************************************************
           Some internal constants
************************************************}

   const
       hasharraysize    = 256;
{$ifndef OLDPPU}
  {$ifdef TP}
       indexgrowsize    = 256;
  {$else}
       indexgrowsize    = 1024;
  {$endif}
{$else}
       defhasharraysize = 16000;
{$endif}


{************************************************
                Constants
************************************************}

{$i symconst.inc}


{************************************************
            Needed forward pointers
************************************************}

    type
       { needed for owner (table) of symbol }
       psymtable     = ^tsymtable;
       punitsymtable = ^tunitsymtable;

       { needed for names by the definitions }
       ptypesym = ^ttypesym;
       penumsym = ^tenumsym;

       pref = ^tref;
       tref = object
         nextref     : pref;
         posinfo     : tfileposinfo;
         moduleindex : word;
         is_written  : boolean;
         constructor init(ref:pref;pos:pfileposinfo);
         destructor  done; virtual;
       end;

{************************************************
                    TDef
************************************************}

{$i symdefh.inc}

{************************************************
                   TSym
************************************************}

{$i symsymh.inc}

{************************************************
                 TSymtable
************************************************}

       tsymtabletype = (invalidsymtable,withsymtable,staticsymtable,
                        globalsymtable,unitsymtable,
                        objectsymtable,recordsymtable,
                        macrosymtable,localsymtable,
                        parasymtable,inlineparasymtable,
                        inlinelocalsymtable,stt_exceptsymtable,
                        { only used for PPU reading of static part
                          of a unit }
                        staticppusymtable);

       tcallback = procedure(p : psym);

{$ifdef OLDPPU}
       tnamedindexcallback = procedure(p : psym);
{$endif}

       tsearchhasharray = array[0..hasharraysize-1] of psym;
       psearchhasharray = ^tsearchhasharray;

{$ifdef OLDPPU}
       tdefhasharray = array[0..defhasharraysize-1] of pdef;
       pdefhasharray = ^tdefhasharray;
{$endif}

       tsymtable = object
          symtabletype : tsymtabletype;
          unitid    : word;           { each symtable gets a number }
          name      : pstring;
          datasize  : longint;
{$ifndef OLDPPU}
          symindex,
          defindex  : pindexarray;
          symsearch : pdictionary;
{$else}
          searchroot : psym;
          searchhasharray : psearchhasharray;
          lastsym   : psym;
          rootdef   : pdef;
          defhasharraysize : longint;
          defhasharray : pdefhasharray;
{$endif}
          next      : psymtable;
          defowner  : pdef; { for records and objects }
          { alignment used in this symtable }
          alignment : longint;
          { only used for parameter symtable to determine the offset relative }
          { to the frame pointer and for local inline }
          address_fixup : longint;
          { this saves all definition to allow a proper clean up }
          { separate lexlevel from symtable type }
          symtablelevel : byte;
          constructor init(t : tsymtabletype);
          destructor  done;virtual;
          { access }
{$ifdef OLDPPU}
          { indexes all defs from 0 to num and return num + 1 }
          function  number_defs:longint;
          { indexes all symbols from 1 to num and return num }
          function  number_symbols:longint;
{$endif}
          function getdefnr(l : longint) : pdef;
          function getsymnr(l : longint) : psym;
          { load/write }
          constructor load;
          procedure write;
          constructor loadas(typ : tsymtabletype);
          procedure writeas;
          procedure loaddefs;
          procedure loadsyms;
          procedure writedefs;
          procedure writesyms;
{$ifndef OLDPPU}
          procedure deref;
{$endif}
          procedure clear;
          function  rename(const olds,news : stringid):psym;
          procedure foreach(proc2call : tnamedindexcallback);
          function  insert(sym : psym):psym;
          function  search(const s : stringid) : psym;
          function  speedsearch(const s : stringid;speedvalue : longint) : psym;
          procedure registerdef(p : pdef);
          procedure allsymbolsused;
          procedure allunitsused;
          procedure check_forwards;
          procedure checklabels;
          { change alignment for args  only parasymtable }
          procedure set_alignment(_alignment : byte);
          { find arg having offset  only parasymtable }
          function  find_at_offset(l : longint) : pvarsym;
{$ifdef CHAINPROCSYMS}
          procedure chainprocsyms;
{$endif CHAINPROCSYMS}
          procedure load_browser;
          procedure write_browser;
{$ifdef BrowserLog}
          procedure writebrowserlog;
{$endif BrowserLog}
{$ifdef GDB}
          procedure concatstabto(asmlist : paasmoutput);virtual;
{$endif GDB}
          function getnewtypecount : word; virtual;
       end;

       tunitsymtable = object(tsymtable)
          unittypecount  : word;
          unitsym        : punitsym;
{$ifdef GDB}
          dbx_count : longint;
          prev_dbx_counter : plongint;
          dbx_count_ok : boolean;
          is_stab_written : boolean;
{$endif GDB}
          constructor init(t : tsymtabletype;const n : string);
          constructor loadasunit;
          procedure writeasunit;
{$ifdef GDB}
{$ifdef OLDPPU}
          procedure orderdefs;
{$endif}
          procedure concattypestabto(asmlist : paasmoutput);
{$endif GDB}
          procedure load_symtable_refs;
          function getnewtypecount : word; virtual;
       end;

       pwithsymtable = ^twithsymtable;
       twithsymtable = object(tsymtable)
{$ifndef NODIRECTWITH}
          { used for withsymtable for allowing constructors }
          direct_with : boolean;
          { in fact it is a ptree }
          withnode : pointer;
          { ptree to load of direct with var }
          { already usable before firstwith
            needed for firstpass of function parameters PM }
          withrefnode : pointer;
{$endif def NODIRECTWITH}
          constructor init;
          destructor  done;virtual;
        end;

{****************************************************************************
                              Var / Consts
****************************************************************************}

    const
       systemunit            : punitsymtable = nil; { pointer to the system unit }
       objpasunit            : punitsymtable = nil; { pointer to the objpas unit }
       current_object_option : symprop = sp_public;

    var
       { for STAB debugging }
       globaltypecount  : word;
       pglobaltypecount : pword;

       registerdef : boolean;      { true, when defs should be registered }

       defaultsymtablestack,       { symtablestack after default units
                                     have been loaded }
       symtablestack : psymtable;  { linked list of symtables }

       srsym : psym;               { result of the last search }
       srsymtable : psymtable;
       lastsrsym : psym;           { last sym found in statement }
       lastsrsymtable : psymtable;
       lastsymknown : boolean;

       forwardsallowed : boolean;  { true, wenn forward pointers can be
                                     inserted }

       constsymtable : psymtable;  { symtable were the constants can be
                                     inserted }

       voidpointerdef : ppointerdef; { pointer for Void-Pointerdef      }
       charpointerdef : ppointerdef; { pointer for Char-Pointerdef      }
       voidfarpointerdef : ppointerdef;

       voiddef   : porddef;        { Pointer to Void (procedure)       }
       cchardef  : porddef;        { Pointer to Char                   }
       u8bitdef  : porddef;        { Pointer to 8-Bit unsigned         }
       u16bitdef : porddef;        { Pointer to 16-Bit unsigned        }
       u32bitdef : porddef;        { Pointer to 32-Bit unsigned        }
       s32bitdef : porddef;        { Pointer to 32-Bit signed          }
       booldef   : porddef;        { pointer to boolean type           }
       cformaldef : pformaldef;    { unique formal definition          }

       cu64bitdef : porddef;       { pointer to 64 bit unsigned def }
       cs64bitintdef : porddef;    { pointer to 64 bit signed def, }
                                   { calculated by the int unit on i386 }

       c64floatdef : pfloatdef;    { pointer for realconstn            }
       s80floatdef : pfloatdef;    { pointer to type of temp. floats   }
       s32fixeddef : pfloatdef;    { pointer to type of temp. fixed    }

       cshortstringdef : pstringdef;  { pointer to type of short string const   }
       clongstringdef  : pstringdef;  { pointer to type of long string const   }
       cansistringdef  : pstringdef;  { pointer to type of ansi string const  }
       cwidestringdef  : pstringdef;  { pointer to type of wide string const  }
       openshortstringdef : pstringdef;  { pointer to type of an open shortstring,
                                            needed for readln() }
       openchararraydef : parraydef;     { pointer to type of an open array of char,
                                            needed for readln() }

       cfiledef : pfiledef;       { get the same definition for all file }
                                  { uses for stabs }

       firstglobaldef,         { linked list of all globals defs }
       lastglobaldef : pdef;   { used to reset stabs/ranges }

       class_tobject : pobjectdef; { pointer to the anchestor of all   }
                                   { clases                            }

       aktprocsym : pprocsym;      { pointer to the symbol for the
                                     currently be parsed procedure }

       aktcallprocsym : pprocsym;  { pointer to the symbol for the
                                     currently be called procedure,
                                     only set/unset in firstcall }

       aktvarsym : pvarsym;        { pointer to the symbol for the
                                     currently read var, only used
                                     for variable directives }

       procprefix : string;        { eindeutige Namen bei geschachtel- }
                                   { ten Unterprogrammen erzeugen      }

       lexlevel : longint;         { level of code                     }
                                   { 1 for main procedure              }
                                   { 2 for normal function or proc     }
                                   { higher for locals                 }
    const
       main_program_level = 1;
       unit_init_level = 1;
       normal_function_level = 2;
       in_loading : boolean = false;

    var

       macros : psymtable;         { pointer for die Symboltabelle mit  }
                                   { Makros                            }

       read_member : boolean;      { true, wenn Members aus einer PPU-  }
                                   { Datei gelesen werden, d.h. ein     }
                                   { varsym seine Adresse einlesen soll }

       generrorsym : psym;         { Jokersymbol, wenn das richtige    }
                                   { Symbol nicht gefunden wird        }

       generrordef : pdef;         { Jokersymbol for eine fehlerhafte  }
                                   { Typdefinition                     }

       aktobjectdef : pobjectdef;  { used for private functions check !! }

    const
       { last operator which can be overloaded }
       first_overloaded = PLUS;
       last_overloaded  = ASSIGNMENT;
    var
       overloaded_operators : array[first_overloaded..last_overloaded] of pprocsym;
       { unequal is not equal}
    const
       overloaded_names : array [first_overloaded..last_overloaded] of string[16] =
         ('plus','minus','star','slash','equal',
          'greater','lower','greater_or_equal',
          'lower_or_equal','as','is','in','sym_diff',
          'starstar','assign');


{****************************************************************************
                             Functions
****************************************************************************}

{*** Misc ***}
    function  globaldef(const s : string) : pdef;

{*** Search ***}
    function  search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
    procedure getsym(const s : stringid;notfounderror : boolean);
    procedure getsymonlyin(p : psymtable;const s : stringid);

{*** Forwards ***}
    procedure save_forward(ppd : ppointerdef;typesym : ptypesym);
    procedure resolve_forwards;

{*** PPU Write/Loading ***}
    procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
    procedure closecurrentppu;
    procedure numberunits;
    procedure load_interface;

{*** GDB ***}
{$ifdef GDB}
    function  typeglobalnumber(const s : string) : string;
{$endif}

{*** Definition ***}
   procedure reset_global_defs;

{*** Object Helpers ***}
    function search_class_member(pd : pobjectdef;const n : string) : psym;
    function search_default_property(pd : pobjectdef) : ppropertysym;

{*** Macro ***}
    procedure def_macro(const s : string);
    procedure set_macro(const s : string;value : string);

{*** symtable stack ***}
    procedure dellexlevel;
{$ifdef DEBUG}
    procedure test_symtablestack;
    procedure list_symtablestack;
{$endif DEBUG}

{*** dispose of a pdefcoll (args of a function) ***}
    procedure disposepdefcoll(var para1 : pdefcoll);

{*** Init / Done ***}
    procedure InitSymtable;
    procedure DoneSymtable;


implementation

  uses
     version,
     types,ppu,
     gendef,files
     ,tree
{$ifdef newcg}
     ,cgbase
{$else}
     ,hcodegen
{$endif}
{$ifdef BrowserLog}
     ,browlog
{$endif BrowserLog}
     ;

  var
     aktrecordsymtable : psymtable; { current record read from ppu symtable }
     aktstaticsymtable : psymtable; { current static for local ppu symtable }
{$ifdef GDB}
     asmoutput : paasmoutput;
{$endif GDB}
{$ifdef TP}
   {$ifndef dpmi}
       symbolstream : temsstream;  { stream which is used to store some info }
   {$else}
       symbolstream : tmemorystream;
   {$endif}
{$endif}

   {to dispose the global symtable of a unit }
  const
     dispose_global : boolean = false;
     memsizeinc = 2048; { for long stabstrings }
     tagtypes : Set of tdeftype =
       [recorddef,enumdef,
       {$IfNDef GDBKnowsStrings}
       stringdef,
       {$EndIf not GDBKnowsStrings}
       {$IfNDef GDBKnowsFiles}
       filedef,
       {$EndIf not GDBKnowsFiles}
       objectdef];

{*****************************************************************************
                             Helper Routines
*****************************************************************************}

    function demangledparas(s : string) : string;
      var
         r : string;
         l : longint;
      begin
         demangledparas:='';
         r:=',';
         { delete leading $$'s }
         l:=pos('$$',s);
         while l<>0 do
           begin
              delete(s,1,l+1);
              l:=pos('$$',s);
           end;
         l:=pos('$',s);
         if l=0 then
           exit;
         delete(s,1,l);
         l:=pos('$',s);
         if l=0 then
           l:=length(s)+1;
         while s<>'' do
           begin
              r:=r+copy(s,1,l-1)+',';
              delete(s,1,l);
           end;
         delete(r,1,1);
         delete(r,length(r),1);
         demangledparas:=r;
      end;


    procedure numberunits;
      var
        counter : longint;
        hp      : pused_unit;
      begin
        counter:=1;
        psymtable(current_module^.globalsymtable)^.unitid:=0;
        hp:=pused_unit(current_module^.used_units.first);
        while assigned(hp) do
         begin
           psymtable(hp^.u^.globalsymtable)^.unitid:=counter;
           inc(counter);
           hp:=pused_unit(hp^.next);
         end;
      end;


   procedure setstring(var p : pchar;const s : string);
     begin
{$ifdef TP}
       if use_big then
        begin
          p:=pchar(symbolstream.getsize);
          symbolstream.seek(longint(p));
          symbolstream.writestr(@s);
        end
       else
{$endif TP}
        p:=strpnew(s);
     end;


{****************************************************************************
                               TRef
****************************************************************************}

    constructor tref.init(ref :pref;pos : pfileposinfo);
      begin
        nextref:=nil;
        if pos<>nil then
          posinfo:=pos^;
        if assigned(current_module) then
          moduleindex:=current_module^.unit_index;
        if assigned(ref) then
          ref^.nextref:=@self;
        is_written:=false;
      end;


    destructor tref.done;
      var
         inputfile : pinputfile;
      begin
         inputfile:=get_source_file(moduleindex,posinfo.fileindex);
         if inputfile<>nil then
           dec(inputfile^.ref_count);
         if assigned(nextref) then
          dispose(nextref,done);
         nextref:=nil;
      end;


{*****************************************************************************
                           PPU Reading Writing
*****************************************************************************}

{$I symppu.inc}


{*****************************************************************************
                            Definition Helpers
*****************************************************************************}

    function globaldef(const s : string) : pdef;

      var st : string;
          symt : psymtable;
      begin
         srsym := nil;
         if pos('.',s) > 0 then
           begin
           st := copy(s,1,pos('.',s)-1);
           getsym(st,false);
           st := copy(s,pos('.',s)+1,255);
           if assigned(srsym) then
             begin
             if srsym^.typ = unitsym then
               begin
               symt := punitsym(srsym)^.unitsymtable;
               srsym := symt^.search(st);
               end else srsym := nil;
             end;
           end else st := s;
         if srsym = nil then getsym(st,false);
         if srsym = nil then
           getsymonlyin(systemunit,st);
         if srsym^.typ<>typesym then
           begin
             Message(type_e_type_id_expected);
             exit;
           end;
         globaldef := ptypesym(srsym)^.definition;
      end;

{*****************************************************************************
                        Symbol / Definition Resolving
*****************************************************************************}

const localsymtablestack : psymtable = nil;

    function find_local_symtable(index : word) : psymtable;
    var
       p : psymtable;
      begin
         p:=localsymtablestack;
         while assigned(p) do
           begin
              if p^.unitid=index then break
              else
                p:=p^.next;
           end;
         if (p=nil) then
           comment(v_fatal,'Error in local browser');
         find_local_symtable:=p;
      end;

    procedure resolvesym(var d : psym);
      begin
        if longint(d)=$ffffffff then
          d:=nil
        else
          begin
            if (longint(d) and $ffff)=$ffff then
              d:=aktrecordsymtable^.getsymnr(longint(d) shr 16)
            else
            if (longint(d) and $ffff)=$fffe then
              d:=aktstaticsymtable^.getsymnr(longint(d) shr 16)
            else if (longint(d) and $ffff)>$8000 then
              d:=find_local_symtable(longint(d) and $ffff)^.getsymnr(longint(d) shr 16)
            else
{$ifdef NEWMAP}
              d:=psymtable(current_module^.map^[longint(d) and $ffff]^.globalsymtable)^.getsymnr(longint(d) shr 16);
{$else NEWMAP}
              d:=psymtable(current_module^.map^[longint(d) and $ffff])^.getsymnr(longint(d) shr 16);
{$endif NEWMAP}
          end;
      end;

    procedure resolvedef(var d : pdef);
      begin
        if longint(d)=$ffffffff then
          d:=nil
        else
          begin
            if (longint(d) and $ffff)=$ffff then
              d:=aktrecordsymtable^.getdefnr(longint(d) shr 16)
            else
            if (longint(d) and $ffff)=$fffe then
              d:=aktstaticsymtable^.getdefnr(longint(d) shr 16)
            else if (longint(d) and $ffff)>$8000 then
              d:=find_local_symtable(longint(d) and $ffff)^.getdefnr(longint(d) shr 16)
            else
{$ifdef NEWMAP}
              d:=psymtable(current_module^.map^[longint(d) and $ffff]^.globalsymtable)^.getdefnr(longint(d) shr 16);
{$else NEWMAP}
              d:=psymtable(current_module^.map^[longint(d) and $ffff])^.getdefnr(longint(d) shr 16);
{$endif NEWMAP}
           end;
      end;


{*****************************************************************************
                        Symbol Call Back Functions
*****************************************************************************}

{$ifdef OLDPPU}
    procedure writesym(p : psym);
      begin
         p^.write;
      end;
{$endif}

    procedure derefsym(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
      begin
         psym(p)^.deref;
      end;

    procedure derefsymsdelayed(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
      begin
         if psym(p)^.typ in [absolutesym,propertysym] then
           psym(p)^.deref;
      end;

    procedure check_procsym_forward(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
      begin
         if psym(sym)^.typ=procsym then
           pprocsym(sym)^.check_forward
         { check also object method table             }
         { we needn't to test the def list            }
         { because each object has to have a type sym }
         else
          if (psym(sym)^.typ=typesym) and
             assigned(ptypesym(sym)^.definition) and
             (ptypesym(sym)^.definition^.deftype=objectdef) then
           pobjectdef(ptypesym(sym)^.definition)^.check_forwards;
      end;

    procedure labeldefined(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
      begin
        if (psym(p)^.typ=labelsym) and
           not(plabelsym(p)^.defined) then
          Message1(sym_w_label_not_defined,p^.name);
      end;

    procedure unitsymbolused(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
      begin
         if (psym(p)^.typ=unitsym) and
            (punitsym(p)^.refs=0) then
           comment(V_info,'Unit '+p^.name+' is not used');
      end;

    procedure varsymbolused(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
      var
        oldaktfilepos : tfileposinfo;
      begin
         if (psym(p)^.typ=varsym) and
            ((psym(p)^.owner^.symtabletype in [parasymtable,localsymtable,staticsymtable])) then
           { unused symbol should be reported only if no }
           { error is reported                           }
           { if the symbol is in a register it is used   }
           { also don't count the value parameters which have local copies }
           { also don't claim for high param of open parameters (PM) }
           if (pvarsym(p)^.refs=0) and
              (copy(p^.name,1,3)<>'val') and
              (copy(p^.name,1,4)<>'high') and
              (Errorcount=0) then
             begin
                oldaktfilepos:=aktfilepos;
                aktfilepos:=psym(p)^.fileinfo;
                if (psym(p)^.owner^.symtabletype=parasymtable) or pvarsym(p)^.islocalcopy then
                  Message1(sym_h_para_identifier_not_used,p^.name)
                else
                  Message1(sym_n_local_identifier_not_used,p^.name);
                aktfilepos:=oldaktfilepos;
             end;
      end;

{$ifdef GDB}
    procedure concatstab(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
      begin
        if psym(p)^.typ <> procsym then
          psym(p)^.concatstabto(asmoutput);
      end;

    procedure concattypestab(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
      begin
        if psym(p)^.typ = typesym then
         begin
           psym(p)^.isstabwritten:=false;
           psym(p)^.concatstabto(asmoutput);
         end;
      end;

    procedure forcestabto(asmlist : paasmoutput; pd : pdef);
      begin
        if not pd^.is_def_stab_written then
         begin
           if assigned(pd^.sym) then
            pd^.sym^.isusedinstab := true;
           pd^.concatstabto(asmlist);
         end;
      end;
{$endif}

{$ifdef CHAINPROCSYMS}
    procedure chainprocsym(p : psym);
      var
         storesymtablestack : psymtable;
      begin
         if p^.typ=procsym then
           begin
              storesymtablestack:=symtablestack;
              symtablestack:=p^.owner^.next;
              while assigned(symtablestack) do
                begin
                  { search for same procsym in other units }
                  getsym(p^.name,false);
                  if assigned(srsym) and (srsym^.typ=procsym) then
                    begin
                       pprocsym(p)^.nextprocsym:=pprocsym(srsym);
                       symtablestack:=storesymtablestack;
                       exit;
                    end
                  else if srsym=nil then
                    symtablestack:=nil
                  else
                    symtablestack:=srsymtable^.next;
                end;
              symtablestack:=storesymtablestack;
           end;
      end;
{$endif}

    procedure write_refs(sym : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
      begin
         psym(sym)^.write_references;
      end;

{$ifdef BrowserLog}
    procedure add_to_browserlog(p : psym);
      begin
         p^.add_to_browserlog;
      end;
{$endif UseBrowser}


{****************************************************************************
                             Forward Resolving
****************************************************************************}

    type
       presolvelist = ^tresolvelist;
       tresolvelist = record
          p : ppointerdef;
          typ : ptypesym;
          next : presolvelist;
       end;

    var
       sroot : presolvelist;
    procedure save_forward(ppd : ppointerdef;typesym : ptypesym);
      var
         p : presolvelist;
      begin
         new(p);
         p^.next:=sroot;
         p^.p:=ppd;
         ppd^.defsym := typesym;
         p^.typ:=typesym;
         sroot:=p;
      end;


    procedure resolve_forwards;
      var
         p : presolvelist;
      begin
         p:=sroot;
         while p<>nil do
           begin
              sroot:=sroot^.next;
              p^.p^.definition:=p^.typ^.definition;
              dispose(p);
              p:=sroot;
           end;
      end;


{*****************************************************************************
                          Search Symtables for Syms
*****************************************************************************}

    procedure getsym(const s : stringid;notfounderror : boolean);
      var
        speedvalue : longint;
      begin
         speedvalue:=getspeedvalue(s);
         lastsrsym:=nil;
         srsymtable:=symtablestack;
         while assigned(srsymtable) do
           begin
              srsym:=srsymtable^.speedsearch(s,speedvalue);
              if assigned(srsym) then
                exit
              else
                srsymtable:=srsymtable^.next;
           end;
         if forwardsallowed then
           begin
              srsymtable:=symtablestack;
              while (srsymtable^.symtabletype in [objectsymtable,recordsymtable]) do
                   srsymtable:=srsymtable^.next;
              srsym:=new(ptypesym,init(s,nil));
              srsym^.properties:=sp_forwarddef;
              srsymtable^.insert(srsym);
           end
         else if notfounderror then
           begin
              Message1(sym_e_id_not_found,s);
              srsym:=generrorsym;
           end
         else srsym:=nil;
      end;


    procedure getsymonlyin(p : psymtable;const s : stringid);
      begin
         { the caller have to take care if srsym=nil (FK) }
         srsym:=nil;
         if assigned(p) then
           begin
              srsymtable:=p;
              srsym:=srsymtable^.search(s);
              if assigned(srsym) then
                exit
              else
               begin
                  if (punitsymtable(srsymtable)=punitsymtable(current_module^.globalsymtable)) then
                    begin
                       getsymonlyin(psymtable(current_module^.localsymtable),s);
                       if assigned(srsym) then
                         srsymtable:=psymtable(current_module^.localsymtable)
                       else
                         Message1(sym_e_id_not_found,s);
                    end
                  else
                    Message1(sym_e_id_not_found,s);
               end;
           end;
      end;


    function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
    {Search for a symbol in a specified symbol table. Returns nil if
     the symtable is not found, and also if the symbol cannot be found
     in the desired symtable }
    var hsymtab:Psymtable;
        res:Psym;
    begin
        res:=nil;
        hsymtab:=symtablestack;
        while (hsymtab<>nil) and (hsymtab^.symtabletype<>symtabletype) do
            hsymtab:=hsymtab^.next;
        if hsymtab<>nil then
            {We found the desired symtable. Now check if the symbol we
             search for is defined in it }
            res:=hsymtab^.search(symbol);
        search_a_symtable:=res;
    end;


{****************************************************************************
                                TSYMTABLE
****************************************************************************}

    constructor tsymtable.init(t : tsymtabletype);
      begin
         symtabletype:=t;
         symtablelevel:=0;
         defowner:=nil;
         unitid:=0;
         next:=nil;
         name:=nil;
         address_fixup:=0;
         datasize:=0;
{$ifndef OLDPPU}
         new(symindex,init(indexgrowsize));
         new(defindex,init(indexgrowsize));
         new(symsearch,init);
         symsearch^.noclear:=true;
{$else}
         lastsym:=nil;
         rootdef:=nil;
         defhasharray:=nil;
         defhasharraysize:=0;
         searchroot:=nil;
         searchhasharray:=nil;
{$endif}
         alignment:=def_alignment;
      end;


    destructor tsymtable.done;
{$ifdef OLDPPU}
      var
         hp : pdef;
  {$ifdef GDB}
         last : pdef;
  {$endif GDB}
{$endif}
      begin
        stringdispose(name);
{$ifndef OLDPPU}
        dispose(symindex,done);
        dispose(defindex,done);
        { symsearch can already be disposed or set to nil for withsymtable }
        if assigned(symsearch) then
         begin
           dispose(symsearch,done);
           symsearch:=nil;
         end;
{$else}
        if assigned(defhasharray) then
          begin
             freemem(defhasharray,sizeof(pdef)*defhasharraysize);
             defhasharray:=nil;
          end;
      { clear all entries, pprocsyms have still the definitions left }
        clear;
  {$ifdef GDB}
        last := Nil;
  {$endif GDB}
         hp:=rootdef;
         while assigned(hp) do
           begin
  {$ifdef GDB}
              if hp^.owner=@self then
               begin
                 if assigned(last) then
                  last^.next := hp^.next;
  {$endif GDB}
                 rootdef:=hp^.next;
                 dispose(hp,done);
  {$ifdef GDB}
                end
              else
                begin
                  last := hp;
                  rootdef:=hp^.next;
                end;
  {$endif GDB}
              hp:=rootdef;
           end;
{$endif}
      end;


    constructor twithsymtable.init;
      begin
         inherited init(withsymtable);
{$ifndef NODIRECTWITH}
         direct_with:=false;
         withnode:=nil;
         withrefnode:=nil;
{$endif def NODIRECTWITH}
      end;


    destructor twithsymtable.done;
      begin
{$ifndef OLDPPU}
        symsearch:=nil;
{$endif}
        inherited done;
      end;


{***********************************************
                Helpers
***********************************************}

   function tsymtable.getnewtypecount : word;
      begin
         getnewtypecount:=pglobaltypecount^;
         inc(pglobaltypecount^);
      end;

    procedure tsymtable.registerdef(p : pdef);
      begin
{$ifndef OLDPPU}
         defindex^.insert(p);
{$else}
         p^.next:=rootdef;
         rootdef:=p;
{$endif}
         { set def owner and indexnb }
         p^.owner:=@self;
      end;

{$ifndef OLDPPU}

    procedure tsymtable.foreach(proc2call : tnamedindexcallback);
      begin
        symindex^.foreach(proc2call);
      end;

{$else}

    procedure tsymtable.foreach(proc2call : tnamedindexcallback);

        procedure a(p : psym);
        { must be preorder, because it's used by reading in }
        { a PPU file                                        }
        { what does this mean ? I need to index
          so proc2call must be after left and before right !! PM }
        begin
          proc2call(p);
          if assigned(p^.left) then
            a(p^.left);
          if assigned(p^.right) then
            a(p^.right);
        end;

      var
         i : longint;
      begin
        if assigned(searchhasharray) then
         begin
           for i:=0 to hasharraysize-1 do
            if assigned(searchhasharray^[i]) then
             a(searchhasharray^[i]);
         end
        else
         if assigned(searchroot) then
          a(searchroot);
      end;

{$endif}

{$ifdef OLDPPU}

    function tsymtable.number_defs:longint;
      var
         pd : pdef;
         counter : longint;
      begin
         counter:=0;
         pd:=rootdef;
         while assigned(pd) do
           begin
              pd^.indexnb:=counter;
              inc(counter);
              pd:=pd^.next;
           end;
         number_defs:=counter;
      end;


   var symtable_index : longint;

    procedure numbersym(p : psym);

      begin
          p^.indexnb:=symtable_index;
          inc(symtable_index);
      end;


    function tsymtable.number_symbols:longint;
      var old_nr : longint;
      begin
        old_nr:=symtable_index;
        symtable_index:=1;
        {$ifdef tp}
        foreach(numbersym);
        {$else}
        foreach(@numbersym);
        {$endif}
        number_symbols:=symtable_index-1;
        symtable_index:=old_nr;
      end;
{$endif}


{***********************************************
       LOAD / WRITE SYMTABLE FROM PPU
***********************************************}

    procedure tsymtable.loaddefs;
      var
{$ifdef OLDPPU}
        counter : longint;
        last : pdef;
{$endif}
        hp : pdef;
        b  : byte;
      begin
      { load start of definition section, which holds the amount of defs }
         if current_ppu^.readentry<>ibstartdefs then
          Message(unit_f_ppu_read_error);
{$ifdef OLDPPU}
         if symtabletype=unitsymtable then
          begin
            defhasharraysize:=current_ppu^.getlongint;
            getmem(defhasharray,sizeof(pdef)*defhasharraysize);
            fillchar(defhasharray^,sizeof(pdef)*defhasharraysize,0);
          end
         else
{$endif}
           current_ppu^.getlongint;
      { read definitions }
{$ifdef OLDPPU}
         counter:=0;
         rootdef:=nil;
{$endif}
         repeat
           b:=current_ppu^.readentry;
           case b of
              ibpointerdef : hp:=new(ppointerdef,load);
                ibarraydef : hp:=new(parraydef,load);
                  iborddef : hp:=new(porddef,load);
                ibfloatdef : hp:=new(pfloatdef,load);
                 ibprocdef : hp:=new(pprocdef,load);
          ibshortstringdef : hp:=new(pstringdef,shortload);
           iblongstringdef : hp:=new(pstringdef,longload);
           ibansistringdef : hp:=new(pstringdef,ansiload);
           ibwidestringdef : hp:=new(pstringdef,wideload);
               ibrecorddef : hp:=new(precdef,load);
               ibobjectdef : hp:=new(pobjectdef,load);
                 ibenumdef : hp:=new(penumdef,load);
                  ibsetdef : hp:=new(psetdef,load);
              ibprocvardef : hp:=new(pprocvardef,load);
                 ibfiledef : hp:=new(pfiledef,load);
             ibclassrefdef : hp:=new(pclassrefdef,load);
               ibformaldef : hp:=new(pformaldef,load);
                 ibenddefs : break;
                     ibend : Message(unit_f_ppu_read_error);
           else
             Message1(unit_f_ppu_invalid_entry,tostr(b));
           end;
{$ifndef OLDPPU}
           hp^.owner:=@self;
           defindex^.insert(hp);
{$else}
         { each def gets a number }
           hp^.indexnb:=counter;
           if counter=0 then
             begin
                rootdef:=hp;
                last:=hp;
             end
           else
             begin
                last^.next:=hp;
                last:=hp;
             end;
           if assigned(defhasharray) then
             begin
               if counter<defhasharraysize then
                 defhasharray^[counter]:=hp
               else
                 internalerror(10997);
             end;
           inc(counter);
{$endif}
         until false;
{$ifdef OLDPPU}
         number_defs;
{$endif}
      end;


    procedure tsymtable.loadsyms;
      var
        b   : byte;
        sym : psym;
      begin
      { load start of definition section, which holds the amount of defs }
         if current_ppu^.readentry<>ibstartsyms then
          Message(unit_f_ppu_read_error);
         { skip amount of symbols, not used currently }
         current_ppu^.getlongint;
         { load datasize of this symboltable }
         datasize:=current_ppu^.getlongint;
      { now read the symbols }
         repeat
           b:=current_ppu^.readentry;
           case b of
                ibtypesym : sym:=new(ptypesym,load);
                ibprocsym : sym:=new(pprocsym,load);
               ibconstsym : sym:=new(pconstsym,load);
                 ibvarsym : sym:=new(pvarsym,load);
             ibfuncretsym : sym:=new(pfuncretsym,load);
            ibabsolutesym : sym:=new(pabsolutesym,load);
                ibenumsym : sym:=new(penumsym,load);
          ibtypedconstsym : sym:=new(ptypedconstsym,load);
            ibpropertysym : sym:=new(ppropertysym,load);
                ibunitsym : sym:=new(punitsym,load);
               iblabelsym : sym:=new(plabelsym,load);
{$ifndef OLDPPU}
                 ibsyssym : sym:=new(psyssym,load);
{$endif}
                ibendsyms : break;
                    ibend : Message(unit_f_ppu_read_error);
           else
             Message1(unit_f_ppu_invalid_entry,tostr(b));
           end;
{$ifndef OLDPPU}
           sym^.owner:=@self;
           symindex^.insert(sym);
           symsearch^.insert(sym);
{$else}
           if not (symtabletype in [recordsymtable,objectsymtable]) then
            begin
              { don't deref absolute symbols there, because it's possible   }
              { that the var sym which the absolute sym refers, isn't       }
              { loaded                                                      }
              { but syms must be derefered to determine the definition      }
              { because must know the varsym size when inserting the symbol }
              if not(b in [ibabsolutesym,ibpropertysym]) then
                sym^.deref;
            end;
           insert(sym);
{$endif}
         until false;

{$ifdef OLDPPU}
       { symbol numbering for references }
         number_symbols;

         if not (symtabletype in [recordsymtable,objectsymtable]) then
          begin
            {$ifdef tp}
             foreach(derefsymsdelayed);
            {$else}
             foreach(@derefsymsdelayed);
            {$endif}
          end;
{$endif}
      end;


    procedure tsymtable.writedefs;
      var
         pd : pdef;
      begin
      { each definition get a number, write then the amount of defs to the
         ibstartdef entry }
{$ifndef OLDPPU}
         current_ppu^.putlongint(defindex^.count);
{$else}
         current_ppu^.putlongint(number_defs);
{$endif}
         current_ppu^.writeentry(ibstartdefs);
      { now write the definition }
{$ifndef OLDPPU}
         pd:=pdef(defindex^.first);
{$else}
         pd:=rootdef;
{$endif}
         while assigned(pd) do
           begin
              pd^.write;
              pd:=pdef(pd^.next);
           end;
      { write end of definitions }
         current_ppu^.writeentry(ibenddefs);
      end;


    procedure tsymtable.writesyms;
{$ifndef OLDPPU}
      var
        pd : psym;
{$endif}
      begin
       { each definition get a number, write then the amount of syms and the
         datasize to the ibsymdef entry }
{$ifndef OLDPPU}
         current_ppu^.putlongint(symindex^.count);
{$else}
         current_ppu^.putlongint(number_symbols);
{$endif}
         current_ppu^.putlongint(datasize);
         current_ppu^.writeentry(ibstartsyms);
       { foreach is used to write all symbols }
{$ifndef OLDPPU}
         pd:=psym(symindex^.first);
         while assigned(pd) do
           begin
              pd^.write;
              pd:=psym(pd^.next);
           end;
{$else}
         {$ifdef tp}
           foreach(writesym);
         {$else}
           foreach(@writesym);
         {$endif}
{$endif}
       { end of symbols }
         current_ppu^.writeentry(ibendsyms);
      end;


{$ifndef OLDPPU}
    procedure tsymtable.deref;
      var
        hp : pdef;
        hs : psym;
      begin
        hp:=pdef(defindex^.first);
        while assigned(hp) do
         begin
           hp^.deref;
           hp^.symderef;
           hp:=pdef(hp^.next);
         end;

        hs:=psym(symindex^.first);
        while assigned(hs) do
         begin
           hs^.deref;
           hs:=psym(hs^.next);
         end;
      end;
{$endif}


    constructor tsymtable.load;
      var
{$ifdef OLDPPU}
         hp : pdef;
{$endif}
         st_loading : boolean;
      begin
        st_loading:=in_loading;
        in_loading:=true;
{$ifndef NEWMAP}
        current_module^.map^[0]:=@self;
{$else NEWMAP}
        current_module^.globalsymtable:=@self;
{$endif NEWMAP}

        symtabletype:=unitsymtable;
        symtablelevel:=0;

        { unused for units }
        address_fixup:=0;

        datasize:=0;
        defowner:=nil;
        name:=nil;
        unitid:=0;
        defowner:=nil;
{$ifndef OLDPPU}
        new(symindex,init(indexgrowsize));
        new(defindex,init(indexgrowsize));
        new(symsearch,init);
        symsearch^.usehash;
        symsearch^.noclear:=true;
{$else}
        lastsym:=nil;
        next:=nil;
        rootdef:=nil;
        defhasharray:=nil;
        defhasharraysize:=0;
        { reset search arrays }
        searchroot:=nil;
        new(searchhasharray);
        fillchar(searchhasharray^,sizeof(searchhasharray^),0);
{$endif}
        alignment:=def_alignment;

      { load definitions }
        loaddefs;
{$ifdef OLDPPU}
      { solve the references to other definitions for each definition }
        hp:=rootdef;
        while assigned(hp) do
         begin
           hp^.deref;
           { insert also the owner }
           hp^.owner:=@self;
           hp:=pdef(hp^.next);
         end;
{$endif}

      { load symbols }
        loadsyms;

{$ifndef OLDPPU}
        if not(symtabletype in [objectsymtable,recordsymtable]) then
          deref;
{$endif}

{$ifdef NEWMAP}
        { necessary for dependencies }
        current_module^.globalsymtable:=nil;
{$endif NEWMAP}
        in_loading:=st_loading;
      end;


    procedure tsymtable.write;
      begin
      { write definitions }
         writedefs;
      { write symbols }
         writesyms;
      end;


    constructor tsymtable.loadas(typ : tsymtabletype);
      var
         storesymtable : psymtable;
{$ifdef OLDPPU}
         hp : pdef;
{$endif}
         st_loading : boolean;
      begin
         st_loading:=in_loading;
         in_loading:=true;
         symtabletype:=typ;
{$ifndef OLDPPU}
         new(symindex,init(indexgrowsize));
         new(defindex,init(indexgrowsize));
         new(symsearch,init);
         symsearch^.noclear:=true;
{$else}
         lastsym:=nil;
         next:=nil;
         rootdef:=nil;
         defhasharray:=nil;
         defhasharraysize:=0;
         searchroot:=nil;
         searchhasharray:=nil;
{$endif}
         defowner:=nil;
         storesymtable:=aktrecordsymtable;
         if typ in [recordsymtable,objectsymtable,
                    parasymtable,localsymtable] then
           aktrecordsymtable:=@self;
         { used for local browser }
         if typ=staticppusymtable then
           begin
              aktstaticsymtable:=@self;
{$ifndef OLDPPU}
              symsearch^.usehash;
{$else}
              new(searchhasharray);
              fillchar(searchhasharray^,sizeof(searchhasharray^),0);
{$endif}
           end;
         name:=nil;
         alignment:=def_alignment;
         { isn't used there }
         datasize:=0;
         address_fixup:= 0;
         { also unused }
         unitid:=0;

      { load definitions }
      { we need the correct symtable for registering }
         if not (typ in [recordsymtable,objectsymtable]) then
           begin
             next:=symtablestack;
             symtablestack:=@self;
           end;

         loaddefs;

{$ifdef OLDPPU}
       { solve the references of the symbols for each definition }
         hp:=rootdef;
         if not (typ in [recordsymtable,objectsymtable]) then
          while assigned(hp) do
           begin
              hp^.deref;
              { insert also the owner }
              hp^.owner:=@self;
              hp:=pdef(hp^.next);
           end;
{$endif}

      { load symbols }
         loadsyms;

{$ifndef OLDPPU}
         if not (typ in [recordsymtable,objectsymtable]) then
           deref;
{$endif}

         aktrecordsymtable:=storesymtable;
         if not (typ in [recordsymtable,objectsymtable]) then
           begin
             symtablestack:=next;
           end;
        in_loading:=st_loading;
      end;


    procedure tsymtable.writeas;
      var
         oldtyp : byte;
         storesymtable : psymtable;
      begin
         oldtyp:=current_ppu^.entrytyp;
         storesymtable:=aktrecordsymtable;
         if symtabletype in [recordsymtable,objectsymtable,
                    parasymtable,localsymtable] then
           aktrecordsymtable:=@self;
         if (symtabletype in [recordsymtable,objectsymtable]) then
         current_ppu^.entrytyp:=subentryid;
         { write definitions }
         writedefs;
         { write symbols }
         writesyms;
         current_ppu^.entrytyp:=oldtyp;
         aktrecordsymtable:=storesymtable;
      end;


{***********************************************
          Get Symbol / Def by Number
***********************************************}

{$ifndef OLDPPU}

    function tsymtable.getsymnr(l : longint) : psym;
      var
        hp : psym;
      begin
        hp:=psym(symindex^.search(l));
        if hp=nil then
         internalerror(10999);
        getsymnr:=hp;
      end;

    function tsymtable.getdefnr(l : longint) : pdef;
      var
        hp : pdef;
      begin
        hp:=pdef(defindex^.search(l));
        if hp=nil then
         internalerror(10998);
        getdefnr:=hp;
      end;

{$else}

    function tsymtable.getsymnr(l : longint) : psym;
      var
         hp : psym;
         i  : longint;
      begin
          getsymnr:=nil;
          if assigned(searchhasharray) then
            begin
               hp:=nil;
               for i:=0 to hasharraysize-1 do
                 if assigned(searchhasharray^[i]) then
                   if (searchhasharray^[i]^.indexnb>l) then
                     break
                   else
                     hp:=searchhasharray^[i];
            end
          else
            hp:=searchroot;
          { hp has an index that is <= l               }
          { if hp's index = l we found                 }
          { if hp^.right exists and is also <= l       }
          { the sym is in the right branch             }
          { else in the left                           }
          while assigned(hp) do
            begin
               if hp^.indexnb=l then
                 begin
                    getsymnr:=hp;
                    exit;
                 end
               else if assigned(hp^.right) and (hp^.right^.indexnb<=l) then
                 hp:=hp^.right
               else
                 hp:=hp^.left;
            end;
        InternalError(10999);
      end;


    function tsymtable.getdefnr(l : longint) : pdef;
      var
         hp : pdef;
      begin
         if assigned(defhasharray) and
            (l<defhasharraysize) and
            assigned(defhasharray^[l]) and
            (defhasharray^[l]^.indexnb=l) then
           begin
              getdefnr:=defhasharray^[l];
              exit;
           end;
         hp:=rootdef;
         while (assigned(hp)) and (hp^.indexnb<>l) do
           hp:=hp^.next;
         if assigned(defhasharray) and
            (l<defhasharraysize) then
           if not assigned(defhasharray^[l]) then
             defhasharray^[l]:=hp
           else
             begin
{$ifdef debug}
                if (l<defhasharraysize) and
                   (hp<>defhasharray^[l]) then
                  InternalError(10998);
{$endif debug}
             end;
         if assigned(hp) then
           getdefnr:=hp
         else
           InternalError(10998);
      end;

{$endif}

{***********************************************
                Table Access
***********************************************}

{$ifndef OLDPPU}

    procedure tsymtable.clear;
      begin
         { remove no entry from a withsymtable as it is only a pointer to the
         recorddef  or objectdef symtable }
         if symtabletype=withsymtable then
           exit;
         symindex^.clear;
         defindex^.clear;
      end;


    function tsymtable.insert(sym:psym):psym;
      var
         hp : psymtable;
         hsym : psym;
      begin
         { set owner and sym indexnb }
         sym^.owner:=@self;
{$ifdef CHAINPROCSYMS}
         { set the nextprocsym field }
         if sym^.typ=procsym then
           chainprocsym(sym);
{$endif CHAINPROCSYMS}
         { writes the symbol in data segment if required }
         { also sets the datasize of owner               }
         if not in_loading then
           sym^.insert_in_data;
         if (symtabletype in [staticsymtable,globalsymtable]) then
           begin
              hp:=symtablestack;
              while assigned(hp) do
                begin
                   if hp^.symtabletype in [staticsymtable,globalsymtable] then
                    begin
                       hsym:=hp^.search(sym^.name);
                       if (assigned(hsym)) and
                          (hsym^.properties and sp_forwarddef=0) then
                             Message1(sym_e_duplicate_id,sym^.name);
                    end;
                  hp:=hp^.next;
                end;
           end;

         { check for duplicate id in local and parsymtable symtable }
         if (symtabletype=localsymtable) then
           { to be on the sure side: }
           begin
              if assigned(next) and
                (next^.symtabletype=parasymtable) then
                begin
                   hsym:=next^.search(sym^.name);
                   if assigned(hsym) then
                     Message1(sym_e_duplicate_id,sym^.name);
                end
              else if (current_module^.flags and uf_local_browser)=0 then
                internalerror(43789);
           end;

         { check for duplicate id in local symtable of methods }
         if (symtabletype=localsymtable) and
           assigned(next) and
           assigned(next^.next) and
          { funcretsym is allowed !! }
           (sym^.typ <> funcretsym) and
           (next^.next^.symtabletype=objectsymtable) then
           begin
              hsym:=search_class_member(pobjectdef(next^.next^.defowner),sym^.name);
              { but private ids can be reused }
              if assigned(hsym) and
                ((hsym^.properties<>sp_private) or
                 (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
                Message1(sym_e_duplicate_id,sym^.name);
           end;
         { check for duplicate field id in inherited classes }
         if (sym^.typ=varsym) and
            (symtabletype=objectsymtable) and
            assigned(defowner) then
           begin
              hsym:=search_class_member(pobjectdef(defowner),sym^.name);
              { but private ids can be reused }
              if assigned(hsym) and
                ((hsym^.properties<>sp_private) or
                 (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
                Message1(sym_e_duplicate_id,sym^.name);
           end;

         if sym^.typ = typesym then
           if assigned(ptypesym(sym)^.definition) then
             begin
             if not assigned(ptypesym(sym)^.definition^.owner) then
              registerdef(ptypesym(sym)^.definition);
{$ifdef GDB}
             if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist)
                and (symtabletype in [globalsymtable,staticsymtable]) then
                   begin
                   ptypesym(sym)^.isusedinstab := true;
                   sym^.concatstabto(debuglist);
                   end;
{$endif GDB}
             end;
         { insert in index and search hash }
         symindex^.insert(sym);
         symsearch^.insert(sym);
         insert:=sym;
      end;


    function tsymtable.search(const s : stringid) : psym;
      begin
        search:=psym(symsearch^.search(s));
      end;


    function tsymtable.speedsearch(const s : stringid;speedvalue : longint) : psym;
      var
        hp : psym;
      begin
        hp:=psym(symsearch^.speedsearch(s,speedvalue));
        if assigned(hp) then
         begin
           { reject non static members in static procedures,
             be carefull aktprocsym^.definition is not allways
             loaded already (PFV) }
           if (symtabletype=objectsymtable) and
              ((hp^.properties and sp_static)=0) and
              allow_only_static
              {assigned(aktprocsym) and
              assigned(aktprocsym^.definition) and
              ((aktprocsym^.definition^.options and postaticmethod)<>0)} then
                  Message(sym_e_only_static_in_static);
           if (symtabletype=unitsymtable) and
              assigned(punitsymtable(@self)^.unitsym) then
             inc(punitsymtable(@self)^.unitsym^.refs);
           { unitsym are only loaded for browsing PM    }
           { this was buggy anyway because we could use }
           { unitsyms from other units in _USES !!      }
           if (symtabletype=unitsymtable) and (hp^.typ=unitsym) and
              assigned(current_module) and (current_module^.globalsymtable<>@self) then
             hp:=nil;
           if assigned(hp) and
              (cs_browser in aktmoduleswitches) and make_ref then
             begin
                hp^.lastref:=new(pref,init(hp^.lastref,@tokenpos));
                { for symbols that are in tables without
                browser info or syssyms (PM) }
                if hp^.refcount=0 then
                  hp^.defref:=hp^.lastref;
                inc(hp^.refcount);
             end;
         end;
        speedsearch:=hp;
      end;


    function tsymtable.rename(const olds,news : stringid):psym;
      begin
        rename:=psym(symsearch^.rename(olds,news));
      end;

{$else}


    procedure tsymtable.clear;
      var
         w : longint;
      begin
         { remove no entry from a withsymtable as it is only a pointer to the
         recorddef  or objectdef symtable }
         if symtabletype=withsymtable then
           exit;
         { remove all entry from a symbol table }
         if assigned(searchroot) then
           begin
             dispose(searchroot,done);
             searchroot:=nil;
           end;
         if assigned(searchhasharray) then
           begin
              for w:=0 to hasharraysize-1 do
                if assigned(searchhasharray^[w]) then
                  begin
                    dispose(searchhasharray^[w],done);
                    searchhasharray^[w]:=nil;
                  end;
              dispose(searchhasharray);
              searchhasharray:=nil;
           end;
      end;


    function tsymtable.insert(sym:psym):psym;
      var
        ref : pref;

      function _insert(var osym : psym):psym;
      {To prevent TP from allocating temp space for temp strings, we allocate
       some temp strings manually. We can use two temp strings, plus a third
       one that TP adds, where TP alone needs five temp strings!. Storing
       these on the heap saves even more, totally 1016 bytes per recursion!}
        var
          s1,s2:^string;
          lasthfp,hfp : pforwardpointer;
        begin
           if osym=nil then
             begin
               osym:=sym;
               _insert:=osym;
{$ifndef nonextfield}
               if assigned(lastsym) then
                 lastsym^.nextsym:=sym;
               lastsym:=sym;
{$endif}
             end

         { first check speedvalue, to allow a fast insert }
           else
             if osym^.speedvalue>sym^.speedvalue then
               _insert:=_insert(psym(osym^.right))
           else
             if osym^.speedvalue<sym^.speedvalue then
               _insert:=_insert(psym(osym^.left))
           else
             begin
                new(s1);
                new(s2);
                s1^:=osym^.name;
                s2^:=sym^.name;
                if s1^>s2^ then
                  begin
                    dispose(s2);
                    dispose(s1);
                    _insert:=_insert(psym(osym^.right));
                  end
                else
                  if s1^<s2^ then
                    begin
                      dispose(s2);
                      dispose(s1);
                      _insert:=_insert(psym(osym^.left));
                    end
                else
                  begin
                     dispose(s2);
                     dispose(s1);
                     if (osym^.typ=typesym) and (osym^.properties=sp_forwarddef) then
                       begin
                          if (sym^.typ<>typesym) then
                           Message(sym_f_id_already_typed);
                          {
                          if (ptypesym(sym)^.definition^.deftype<>recorddef) and
                             (ptypesym(sym)^.definition^.deftype<>objectdef) then
                             Message(sym_f_type_must_be_rec_or_class);
                          }
                          ptypesym(osym)^.definition:=ptypesym(sym)^.definition;
                          osym^.properties:=sp_public;
                          { resolve the definition right now !! }
                          {forward types have two defref chained
                          the first corresponding to the location
                          of  the
                             ptype = ^ttype;
                          and the second
                          to the line
                             ttype = record }
                          if cs_browser in aktmoduleswitches then
                           begin
                             new(ref,init(nil,@sym^.fileinfo));
                             ref^.nextref:=osym^.defref;
                             osym^.defref:=ref;
                           end;

                          { update all forwardpointers to this definition }
                          hfp:=ptypesym(osym)^.forwardpointer;
                          while assigned(hfp) do
                           begin
                             lasthfp:=hfp;
                             hfp^.def^.definition:=ptypesym(osym)^.definition;
                             hfp:=hfp^.next;
                             dispose(lasthfp);
                           end;

                          if ptypesym(osym)^.definition^.sym = ptypesym(sym) then
                            ptypesym(osym)^.definition^.sym := ptypesym(osym);
{$ifdef GDB}
                         ptypesym(osym)^.isusedinstab := true;
                         if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) then
                            osym^.concatstabto(debuglist);
{$endif GDB}
                          { don't do a done on sym
                          because it also disposes left and right !!
                           sym is new so it has no left nor right }
                          dispose(sym,done);
                          _insert:=osym;
                       end
                     else
                       begin
                         Message1(sym_e_duplicate_id,sym^.name);
                         _insert:=osym;
                       end;
                  end;
             end;
        end;

      var
         hp : psymtable;
         hsym : psym;
      begin
         { set owner and sym indexnb }
         sym^.owner:=@self;
{$ifdef CHAINPROCSYMS}
         { set the nextprocsym field }
         if sym^.typ=procsym then
           chainprocsym(sym);
{$endif CHAINPROCSYMS}
         { writes the symbol in data segment if required }
         { also sets the datasize of owner               }
         if not in_loading then
           sym^.insert_in_data;
         if (symtabletype in [staticsymtable,globalsymtable]) then
           begin
              hp:=symtablestack;
              while assigned(hp) do
                begin
                   if hp^.symtabletype in [staticsymtable,globalsymtable] then
                    begin
                       hsym:=hp^.search(sym^.name);
                       if (assigned(hsym)) and
                          (hsym^.properties and sp_forwarddef=0) then
                             Message1(sym_e_duplicate_id,sym^.name);
                    end;
                  hp:=hp^.next;
                end;
           end;

         { check for duplicate id in local and parsymtable symtable }
         if (symtabletype=localsymtable) then
           { to be on the sure side: }
           begin
              if assigned(next) and
                (next^.symtabletype=parasymtable) then
                begin
                   hsym:=next^.search(sym^.name);
                   if assigned(hsym) then
                     Message1(sym_e_duplicate_id,sym^.name);
                end
              else if (current_module^.flags and uf_local_browser)=0 then
                internalerror(43789);
           end;

         { check for duplicate id in local symtable of methods }
         if (symtabletype=localsymtable) and
           assigned(next) and
           assigned(next^.next) and
          { funcretsym is allowed !! }
           (sym^.typ <> funcretsym) and
           (next^.next^.symtabletype=objectsymtable) then
           begin
              hsym:=search_class_member(pobjectdef(next^.next^.defowner),sym^.name);
              { but private ids can be reused }
              if assigned(hsym) and
                ((hsym^.properties<>sp_private) or
                 (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
                Message1(sym_e_duplicate_id,sym^.name);
           end;
         { check for duplicate field id in inherited classes }
         if (sym^.typ=varsym) and
            (symtabletype=objectsymtable) and
            assigned(defowner) then
           begin
              hsym:=search_class_member(pobjectdef(defowner),sym^.name);
              { but private ids can be reused }
              if assigned(hsym) and
                ((hsym^.properties<>sp_private) or
                 (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
                Message1(sym_e_duplicate_id,sym^.name);
           end;

         if sym^.typ = typesym then
           if assigned(ptypesym(sym)^.definition) then
             begin
             if not assigned(ptypesym(sym)^.definition^.owner) then
              registerdef(ptypesym(sym)^.definition);
{$ifdef GDB}
             if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist)
                and (symtabletype in [globalsymtable,staticsymtable]) then
                   begin
                   ptypesym(sym)^.isusedinstab := true;
                   sym^.concatstabto(debuglist);
                   end;
{$endif GDB}
             end;
         sym^.speedvalue:=getspeedvalue(sym^.name);
         if assigned(searchhasharray) then
           insert:=_insert(searchhasharray^[sym^.speedvalue mod hasharraysize])
         else
           insert:=_insert(searchroot);
         { store the sym also in the index, must be after the insert the table
           because }
      end;


    function tsymtable.search(const s : stringid) : psym;
      begin
        search:=speedsearch(s,getspeedvalue(s));
      end;


    function tsymtable.speedsearch(const s : stringid;speedvalue : longint) : psym;
      var
         hp : psym;
      begin
         if assigned(searchhasharray) then
           hp:=searchhasharray^[speedvalue mod hasharraysize]
         else
           hp:=searchroot;
         while assigned(hp) do
           begin
              if speedvalue>hp^.speedvalue then
                hp:=hp^.left
              else
                if speedvalue<hp^.speedvalue then
                  hp:=hp^.right
              else
                begin
                   if (hp^.name=s) then
                     begin
                        { reject non static members in static procedures,
                          be carefull aktprocsym^.definition is not allways
                          loaded already (PFV) }
                        if (symtabletype=objectsymtable) and
                           ((hp^.properties and sp_static)=0) and
                           allow_only_static
                           {assigned(aktprocsym) and
                           assigned(aktprocsym^.definition) and
                           ((aktprocsym^.definition^.options and postaticmethod)<>0)} then
                               Message(sym_e_only_static_in_static);
                        if (symtabletype=unitsymtable) and
                           assigned(punitsymtable(@self)^.unitsym) then
                          inc(punitsymtable(@self)^.unitsym^.refs);
                        { unitsym are only loaded for browsing PM    }
                        { this was buggy anyway because we could use }
                        { unitsyms from other units in _USES !!      }
                        if (symtabletype=unitsymtable) and (hp^.typ=unitsym) and
                           assigned(current_module) and (current_module^.globalsymtable<>@self) then
                          hp:=nil;
                        if assigned(hp) and
                           (cs_browser in aktmoduleswitches) and make_ref then
                          begin
                             hp^.lastref:=new(pref,init(hp^.lastref,@tokenpos));
                             { for symbols that are in tables without
                             browser info or syssyms (PM) }
                             if hp^.refcount=0 then
                               hp^.defref:=hp^.lastref;
                             inc(hp^.refcount);
                          end;
                        speedsearch:=hp;
                        exit;
                     end
                   else
                     if s>hp^.name then
                       hp:=hp^.left
                   else
                     hp:=hp^.right;
                end;
           end;
         speedsearch:=nil;
      end;


    function tsymtable.rename(const olds,news : stringid):psym;
      var
        spdval : longint;
        lasthp,
        hp,hp2,hp3 : psym;

        function _insert(var osym:psym):psym;
        var
          s1,s2:^string;
        begin
          if osym=nil then
           begin
             osym:=hp;
             _insert:=osym;
           end
          { first check speedvalue, to allow a fast insert }
          else
           if osym^.speedvalue>hp^.speedvalue then
            _insert:=_insert(osym^.right)
           else
            if osym^.speedvalue<hp^.speedvalue then
             _insert:=_insert(osym^.left)
           else
            begin
              new(s1);
              new(s2);
              s1^:=osym^._name^;
              s2^:=hp^._name^;
              if s1^>s2^ then
               begin
                 dispose(s2);
                 dispose(s1);
                 _insert:=_insert(osym^.right);
               end
              else
               if s1^<s2^ then
                begin
                  dispose(s2);
                  dispose(s1);
                  _insert:=_insert(osym^.left);
                end
               else
                begin
                  dispose(s2);
                  dispose(s1);
                  _insert:=osym;
                end;
            end;
        end;

        procedure inserttree(p:psym);
        begin
          if assigned(p) then
           begin
             inserttree(p^.left);
             inserttree(p^.right);
             _insert(p);
           end;
        end;

      begin
        spdval:=getspeedvalue(olds);
        if assigned(searchhasharray) then
         hp:=searchhasharray^[spdval mod hasharraysize]
        else
         hp:=searchroot;
        lasthp:=nil;
        while assigned(hp) do
          begin
            if spdval>hp^.speedvalue then
             begin
               lasthp:=hp;
               hp:=hp^.left
             end
            else
             if spdval<hp^.speedvalue then
              begin
                lasthp:=hp;
                hp:=hp^.right
              end
            else
             begin
               if (hp^.name=olds) then
                begin
                  { get in hp2 the replacer for the root or hasharr }
                  hp2:=hp^.left;
                  hp3:=hp^.right;
                  if not assigned(hp2) then
                   begin
                     hp2:=hp^.right;
                     hp3:=hp^.left;
                   end;
                  { remove entry from the tree }
                  if assigned(lasthp) then
                   begin
                     if lasthp^.left=hp then
                      lasthp^.left:=hp2
                     else
                      lasthp^.right:=hp2;
                   end
                  else
                   begin
                     if assigned(searchhasharray) then
                      searchhasharray^[spdval mod hasharraysize]:=hp2
                     else
                      searchroot:=hp2;
                   end;
                  { reinsert the hp3 }
                  inserttree(hp3);
                  { reinsert }
                  hp^.setname(news);
                  hp^.speedvalue:=getspeedvalue(news);
                  if assigned(searchhasharray) then
                   rename:=_insert(searchhasharray^[hp^.speedvalue mod hasharraysize])
                  else
                   rename:=_insert(searchroot);
                  exit;
                end
               else
                if olds>hp^.name then
                 begin
                   lasthp:=hp;
                   hp:=hp^.left
                 end
                else
                 begin
                   lasthp:=hp;
                   hp:=hp^.right;
                 end;
             end;
          end;
      end;

{$endif}


{***********************************************
                Browser
***********************************************}

    procedure tsymtable.load_browser;
      var
        b     : byte;
        sym   : psym;
        prdef : pdef;
        oldrecsyms : psymtable;
      begin
         if symtabletype in [recordsymtable,objectsymtable,
                    parasymtable,localsymtable] then
           begin
              oldrecsyms:=aktrecordsymtable;
              aktrecordsymtable:=@self;
           end;
         if symtabletype=staticppusymtable then
           aktstaticsymtable:=@self;
         b:=current_ppu^.readentry;
         if b <> ibbeginsymtablebrowser then
           Message1(unit_f_ppu_invalid_entry,tostr(b));
         repeat
           b:=current_ppu^.readentry;
           case b of
           ibsymref : begin
                        sym:=readsymref;
                        resolvesym(sym);
                        if assigned(sym) then
                          sym^.load_references;
                      end;
           ibdefref : begin
                        prdef:=readdefref;
                        resolvedef(prdef);
                        if assigned(prdef) then
                         begin
                           if prdef^.deftype<>procdef then
                            Message(unit_f_ppu_read_error);
                           pprocdef(prdef)^.load_references;
                         end;
                      end;
            ibendsymtablebrowser : break;
           else
             Message1(unit_f_ppu_invalid_entry,tostr(b));
           end;
         until false;
         if symtabletype in [recordsymtable,objectsymtable,
                    parasymtable,localsymtable] then
           aktrecordsymtable:=oldrecsyms;
      end;


    procedure tsymtable.write_browser;
      var
         oldrecsyms : psymtable;
      begin
         { symbol numbering for references
           should have been done in write PM
         number_symbols;
         number_defs;   }

         if symtabletype in [recordsymtable,objectsymtable,
                    parasymtable,localsymtable] then
           begin
              oldrecsyms:=aktrecordsymtable;
              aktrecordsymtable:=@self;
           end;
         current_ppu^.writeentry(ibbeginsymtablebrowser);
      {$ifdef tp}
         foreach(write_refs);
      {$else}
         foreach(@write_refs);
      {$endif}
         current_ppu^.writeentry(ibendsymtablebrowser);
         if symtabletype in [recordsymtable,objectsymtable,
                    parasymtable,localsymtable] then
           aktrecordsymtable:=oldrecsyms;
      end;


{$ifdef BrowserLog}
    procedure tsymtable.writebrowserlog;
      begin
        if cs_browser in aktmoduleswitches then
         begin
           if assigned(name) then
             Browserlog.AddLog('---Symtable '+name^)
           else
             begin
                if (symtabletype=recordsymtable) and
                  assigned(defowner^.sym) then
                  Browserlog.AddLog('---Symtable '+defowner^.sym^.name)
                else
                  Browserlog.AddLog('---Symtable with no name');
             end;
           Browserlog.Ident;
         {$ifdef tp}
           foreach(add_to_browserlog);
         {$else}
           foreach(@add_to_browserlog);
         {$endif}
           browserlog.Unident;
         end;
      end;
{$endif BrowserLog}


{***********************************************
           Process all entries
***********************************************}

    { checks, if all procsyms and methods are defined }
    procedure tsymtable.check_forwards;
      begin
      {$ifdef tp}
         foreach(check_procsym_forward);
      {$else}
         foreach(@check_procsym_forward);
      {$endif}
      end;

    procedure tsymtable.checklabels;
      begin
      {$ifdef tp}
         foreach(labeldefined);
      {$else}
         foreach(@labeldefined);
      {$endif}
      end;

    procedure tsymtable.set_alignment(_alignment : byte);
      var
         sym : pvarsym;
         l : longint;
      begin
        { this can not be done if there is an
          hasharray ! }
        alignment:=_alignment;
        if (symtabletype<>parasymtable)
{$ifdef OLDPPU}
           or assigned(searchhasharray)
{$endif}
           then
          internalerror(1111);
{$ifndef OLDPPU}
        sym:=pvarsym(symindex^.first);
{$else}
        sym:=pvarsym(searchroot);
{$endif}
        datasize:=0;
        { there can be only varsyms }
        while assigned(sym) do
          begin
             l:=sym^.getpushsize;
             sym^.address:=datasize;
             datasize:=align(datasize+l,alignment);
{$ifndef OLDPPU}
             sym:=pvarsym(sym^.next);
{$else}
             sym:=pvarsym(sym^.nextsym);
{$endif}
          end;
      end;

    function tsymtable.find_at_offset(l : longint) : pvarsym;
      var
         sym : pvarsym;
      begin
        find_at_offset:=nil;
        { this can not be done if there is an
          hasharray ! }
        if (symtabletype<>parasymtable)
{$ifdef OLDPPU}
           or assigned(searchhasharray)
{$endif}
           then
          internalerror(1111);
{$ifndef OLDPPU}
        sym:=pvarsym(symindex^.first);
{$else}
        sym:=pvarsym(searchroot);
{$endif}
        while assigned(sym) do
          begin
             if sym^.address+address_fixup=l then
               begin
                 find_at_offset:=sym;
                 exit;
               end;
{$ifndef OLDPPU}
             sym:=pvarsym(sym^.next);
{$else}
             sym:=pvarsym(sym^.nextsym);
{$endif}
          end;
      end;

    procedure tsymtable.allunitsused;
      begin
      {$ifdef tp}
         foreach(unitsymbolused);
      {$else}
         foreach(@unitsymbolused);
      {$endif}
      end;

    procedure tsymtable.allsymbolsused;
      begin
      {$ifdef tp}
         foreach(varsymbolused);
      {$else}
         foreach(@varsymbolused);
      {$endif}
      end;

{$ifdef CHAINPROCSYMS}
    procedure tsymtable.chainprocsyms;
      begin
      {$ifdef tp}
         foreach(chainprocsym);
      {$else}
         foreach(@chainprocsym);
      {$endif}
      end;
{$endif CHAINPROCSYMS}

{$ifdef GDB}
      procedure tsymtable.concatstabto(asmlist : paasmoutput);
      begin
        asmoutput:=asmlist;
      {$ifdef tp}
        foreach(concatstab);
      {$else}
        foreach(@concatstab);
      {$endif}
      end;
{$endif}


{****************************************************************************
                              TUNITSYMTABLE
****************************************************************************}

    constructor tunitsymtable.init(t : tsymtabletype; const n : string);
      begin
         inherited init(t);
         name:=stringdup(upper(n));
         unitid:=0;
         unitsym:=nil;
{$ifndef OLDPPU}
         symsearch^.usehash;
{$else}
       { create a hasharray }
         new(searchhasharray);
         fillchar(searchhasharray^,sizeof(searchhasharray^),0);
{$endif}
       { reset GDB things }
{$ifdef GDB}
         if t = globalsymtable then
           begin
              prev_dbx_counter := dbx_counter;
              dbx_counter := @dbx_count;
           end;
         is_stab_written:=false;
         if cs_gdb_dbx in aktglobalswitches then
           begin
             dbx_count := 0;
             if (symtabletype=globalsymtable) then
               pglobaltypecount := @unittypecount;
             debuglist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0'))));
             unitid:=current_module^.unitcount;
             inc(current_module^.unitcount);
             debuglist^.concat(new(pai_asm_comment,init(strpnew('Global '+name^+' has index '+tostr(unitid)))));
           end;
{$endif GDB}
      end;


    constructor tunitsymtable.loadasunit;
      var
        storeGlobalTypeCount : pword;
        b : byte;
      begin
         unitsym:=nil;
         unitid:=0;
         if (current_module^.flags and uf_has_dbx)<>0 then
           begin
              storeGlobalTypeCount:=PGlobalTypeCount;
              PglobalTypeCount:=@UnitTypeCount;
           end;

       { load symtables }
         inherited load;
       { set the name after because it is set to nil in tsymtable.load !! }
         name:=stringdup(current_module^.modulename^);

       { dbx count }
{$ifdef GDB}
         if (current_module^.flags and uf_has_dbx)<>0 then
           begin
              b := current_ppu^.readentry;
              if b <> ibdbxcount then
               Message(unit_f_ppu_dbx_count_problem)
              else
               dbx_count := readlong;
              dbx_count_ok := true;
              PGlobalTypeCount:=storeGlobalTypeCount;
           end
         else
           dbx_count := 0;
         is_stab_written:=false;
{$endif GDB}

         b:=current_ppu^.readentry;
         if b<>ibendimplementation then
           Message1(unit_f_ppu_invalid_entry,tostr(b));
      end;


       procedure tunitsymtable.load_symtable_refs;
         var
            b : byte;
            unitindex : word;
         begin
{$ifdef OLDPPU}
         number_defs;
         number_symbols;
{$endif}
         if ((current_module^.flags and uf_local_browser)<>0) then
           begin
              current_module^.localsymtable:=new(psymtable,loadas(staticppusymtable));
              psymtable(current_module^.localsymtable)^.name:=
                stringdup('implementation of '+psymtable(current_module^.globalsymtable)^.name^);
           end;
         { load browser }
         if (current_module^.flags and uf_has_browser)<>0 then
           begin
              {if not (cs_browser in aktmoduleswitches) then
                current_ppu^.skipuntilentry(ibendbrowser)
              else }
                begin
                   load_browser;
                   unitindex:=1;
                   while assigned(current_module^.map^[unitindex]) do
                     begin
                        {each unit wrote one browser entry }
                        load_browser;
                        inc(unitindex);
                     end;
                   b:=current_ppu^.readentry;
                   if b<>ibendbrowser then
                     Message1(unit_f_ppu_invalid_entry,tostr(b));
                end;
           end;
         if ((current_module^.flags and uf_local_browser)<>0) then
           psymtable(current_module^.localsymtable)^.load_browser;
         end;


    procedure tunitsymtable.writeasunit;
      var
         pu           : pused_unit;
      begin
      { first the unitname }
        current_ppu^.putstring(name^);
        current_ppu^.writeentry(ibmodulename);

        writesourcefiles;

        writeusedunit;

      { write the objectfiles and libraries that come for this unit,
        preserve the containers becuase they are still needed to load
        the link.res. All doesn't depend on the crc! It doesn't matter
        if a unit is in a .o or .a file }
        current_ppu^.do_crc:=false;
        writecontainer(current_module^.linkunitfiles,iblinkunitfiles,true,true);
        writecontainer(current_module^.linkofiles,iblinkofiles,true,false);
        writecontainer(current_module^.linksharedlibs,iblinksharedlibs,true,true);
        writecontainer(current_module^.linkstaticlibs,iblinkstaticlibs,true,true);
        current_ppu^.do_crc:=true;

        current_ppu^.writeentry(ibendinterface);

      { write the symtable entries }
        inherited write;

      { write dbx count }
{$ifdef GDB}
        if cs_gdb_dbx in aktglobalswitches then
         begin
{$IfDef EXTDEBUG}
           writeln('Writing dbx_count ',dbx_count,' in unit ',name^,'.ppu');
{$ENDIF EXTDEBUG}
           current_ppu^.putlongint(dbx_count);
           current_ppu^.writeentry(ibdbxcount);
         end;
{$endif GDB}

        current_ppu^.writeentry(ibendimplementation);

         { write static symtable
           needed for local debugging of unit functions }
        if (current_module^.flags and uf_local_browser)<>0 then
          psymtable(current_module^.localsymtable)^.write;
      { write all browser section }
        if (current_module^.flags and uf_has_browser)<>0 then
         begin
           current_ppu^.do_crc:=false; { doesn't affect crc }
           write_browser;
           pu:=pused_unit(current_module^.used_units.first);
           while assigned(pu) do
            begin
              psymtable(pu^.u^.globalsymtable)^.write_browser;
              pu:=pused_unit(pu^.next);
            end;
           current_ppu^.writeentry(ibendbrowser);
           current_ppu^.do_crc:=true;
         end;
        if (current_module^.flags and uf_local_browser)<>0 then
          psymtable(current_module^.localsymtable)^.write_browser;

      { the last entry ibend is written automaticly }
      end;


   function tunitsymtable.getnewtypecount : word;

      begin
{$ifdef GDB}
         if not (cs_gdb_dbx in aktglobalswitches) then
           getnewtypecount:=tsymtable.getnewtypecount
         else
{$endif GDB}
           if symtabletype = staticsymtable then
           getnewtypecount:=tsymtable.getnewtypecount
         else
           begin
              getnewtypecount:=unittypecount;
              inc(unittypecount);
           end;
      end;


{$ifdef GDB}
  {$ifdef OLDPPU}
    procedure tunitsymtable.orderdefs;
      var
         firstd, last, nonum, pd, cur, prev, lnext : pdef;

      begin
         pd:=rootdef;
         firstd:=nil;
         last:=nil;
         nonum:=nil;
         while assigned(pd) do
           begin
              lnext:=pd^.next;
              if pd^.globalnb > 0 then
                if firstd = nil then
                  begin
                     firstd:=pd;
                     last:=pd;
                     last^.next:=nil;
                  end
                else
                  begin
                     cur:=firstd;
                     prev:=nil;
                     while assigned(cur) and
                           (prev <> last) and
                           (cur^.globalnb>0) and
                           (cur^.globalnb<pd^.globalnb) do
                       begin
                          prev:=cur;
                          cur:=cur^.next;
                       end;
                     if cur = firstd then
                       begin
                          pd^.next:=firstd;
                          firstd:=pd;
                       end
                     else
                     if prev = last then
                       begin
                          pd^.next:=nil;
                          last^.next:=pd;
                          last:=pd;
                       end
                     else
                       begin
                          pd^.next:=cur;
                          prev^.next:=pd;
                       end;
                  end
                else  { without number }
                  begin
                     pd^.next:=nonum;
                     nonum:=pd;
                  end;
              pd:=lnext;
           end;
         if assigned(firstd) then
           begin
              rootdef:=firstd;
              last^.next:=nonum;
           end else
           rootdef:=nonum;
      end;
  {$endif}

      procedure tunitsymtable.concattypestabto(asmlist : paasmoutput);
        var prev_dbx_count : plongint;
        begin
           if is_stab_written then exit;
           if not assigned(name) then name := stringdup('Main_program');
           if symtabletype = unitsymtable then
             begin
                unitid:=current_module^.unitcount;
                inc(current_module^.unitcount);
             end;
           asmlist^.concat(new(pai_asm_comment,init(strpnew('Begin unit '+name^
                  +' has index '+tostr(unitid)))));
           if cs_gdb_dbx in aktglobalswitches then
             begin
                if dbx_count_ok then
                  begin
                     asmlist^.insert(new(pai_asm_comment,init(strpnew('"repeated" unit '+name^
                              +' has index '+tostr(unitid)))));
                     do_count_dbx:=true;
                     asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
                       +tostr(N_EXCL)+',0,0,'+tostr(dbx_count)))));
                     exit;
                  end;
                prev_dbx_count := dbx_counter;
                dbx_counter := nil;
                if symtabletype = unitsymtable then
                  asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
                    +tostr(N_BINCL)+',0,0,0'))));
                dbx_counter := @dbx_count;
             end;
           asmoutput:=asmlist;
           {$ifdef tp}
             foreach(concattypestab);
           {$else}
             foreach(@concattypestab);
           {$endif}
           if cs_gdb_dbx in aktglobalswitches then
             begin
                dbx_counter := prev_dbx_count;
                do_count_dbx:=true;
                asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
                  +tostr(N_EINCL)+',0,0,0'))));
                dbx_count_ok := true;
             end;
           asmlist^.concat(new(pai_asm_comment,init(strpnew('End unit '+name^
                  +' has index '+tostr(unitid)))));
           is_stab_written:=true;
        end;
{$endif}

{****************************************************************************
                              Definitions
****************************************************************************}

{$I symdef.inc}

{****************************************************************************
                                Symbols
****************************************************************************}

{$I symsym.inc}

{****************************************************************************
                               GDB Helpers
****************************************************************************}

{$ifdef GDB}
    function typeglobalnumber(const s : string) : string;

      var st : string;
          symt : psymtable;
          old_make_ref : boolean;
      begin
         old_make_ref:=make_ref;
         make_ref:=false;
         typeglobalnumber := '0';
         srsym := nil;
         if pos('.',s) > 0 then
           begin
           st := copy(s,1,pos('.',s)-1);
           getsym(st,false);
           st := copy(s,pos('.',s)+1,255);
           if assigned(srsym) then
             begin
             if srsym^.typ = unitsym then
               begin
               symt := punitsym(srsym)^.unitsymtable;
               srsym := symt^.search(st);
               end else srsym := nil;
             end;
           end else st := s;
         if srsym = nil then getsym(st,true);
         if srsym^.typ<>typesym then
           begin
             Message(type_e_type_id_expected);
             exit;
           end;
         typeglobalnumber := ptypesym(srsym)^.definition^.numberstring;
         make_ref:=old_make_ref;
      end;
{$endif GDB}


{****************************************************************************
                           Definition Helpers
****************************************************************************}

   procedure reset_global_defs;
     var
       def     : pdef;
{$ifdef debug}
       prevdef : pdef;
{$endif debug}
     begin
{$ifdef debug}
        prevdef:=nil;
{$endif debug}
{$ifdef GDB}
        pglobaltypecount:=@globaltypecount;
{$endif GDB}
        def:=firstglobaldef;
        while assigned(def) do
          begin
{$ifdef GDB}
            if assigned(def^.sym) then
              def^.sym^.isusedinstab:=false;
            def^.is_def_stab_written:=false;
{$endif GDB}
            {if not current_module^.in_implementation then}
              begin
                { reset rangenr's }
                case def^.deftype of
                  orddef   : porddef(def)^.rangenr:=0;
                  enumdef  : penumdef(def)^.rangenr:=0;
                  arraydef : parraydef(def)^.rangenr:=0;
                end;
                if def^.deftype<>objectdef then
                  def^.has_rtti:=false;
                def^.has_inittable:=false;
              end;
{$ifdef debug}
            prevdef:=def;
{$endif debug}
            def:=def^.nextglobal;
          end;
     end;


{****************************************************************************
                              Object Helpers
****************************************************************************}

    function search_class_member(pd : pobjectdef;const n : string) : psym;
    { searches n in symtable of pd and all anchestors }
      var
         sym : psym;
      begin
         sym:=nil;
         while assigned(pd) do
           begin
              sym:=pd^.publicsyms^.search(n);
              if assigned(sym) then
                break;
              pd:=pd^.childof;
           end;
         { this is needed for static methods in do_member_read pexpr unit PM
           caused bug0214 }
         if assigned(sym) then
           begin
             srsymtable:=pd^.publicsyms;
           end;
         search_class_member:=sym;
      end;

   var
      _defaultprop : ppropertysym;

   procedure testfordefaultproperty(p : {$ifndef OLDPPU}pnamedindexobject{$else}psym{$endif});
     begin
        if (psym(p)^.typ=propertysym) and ((ppropertysym(p)^.options and ppo_defaultproperty)<>0) then
          _defaultprop:=ppropertysym(p);
     end;


   function search_default_property(pd : pobjectdef) : ppropertysym;
   { returns the default property of a class, searches also anchestors }
     begin
        _defaultprop:=nil;
        while assigned(pd) do
          begin
           {$ifdef tp}
             pd^.publicsyms^.foreach(testfordefaultproperty);
           {$else}
             pd^.publicsyms^.foreach(@testfordefaultproperty);
           {$endif}
             if assigned(_defaultprop) then
               break;
             pd:=pd^.childof;
          end;
        search_default_property:=_defaultprop;
     end;

{****************************************************************************
                               Macro's
****************************************************************************}

      procedure def_macro(const s : string);
        var
          mac : pmacrosym;
        begin
           mac:=pmacrosym(macros^.search(s));
           if mac=nil then
             begin
               mac:=new(pmacrosym,init(s));
               Message1(parser_m_macro_defined,mac^.name);
               macros^.insert(mac);
             end;
           mac^.defined:=true;
        end;


      procedure set_macro(const s : string;value : string);
        var
          mac : pmacrosym;
        begin
           mac:=pmacrosym(macros^.search(s));
           if mac=nil then
             begin
               mac:=new(pmacrosym,init(s));
               macros^.insert(mac);
             end
           else
             begin
                if assigned(mac^.buftext) then
                  freemem(mac^.buftext,mac^.buflen);
             end;
           Message2(parser_m_macro_set_to,mac^.name,value);
           mac^.buflen:=length(value);
           getmem(mac^.buftext,mac^.buflen);
           move(value[1],mac^.buftext^,mac^.buflen);
           mac^.defined:=true;
        end;


{****************************************************************************
                            Symtable Stack
****************************************************************************}

    procedure dellexlevel;
      var
         p : psymtable;
      begin
         p:=symtablestack;
         symtablestack:=p^.next;
         { symbol tables of unit interfaces are never disposed }
         { this is handle by the unit unitm                    }
         if not(p^.symtabletype in [unitsymtable,globalsymtable,stt_exceptsymtable]) or dispose_global then
          dispose(p,done);
      end;

{$ifdef DEBUG}
    procedure test_symtablestack;
      var
         p : psymtable;
         i : longint;
      begin
         p:=symtablestack;
         i:=0;
         while assigned(p) do
           begin
              inc(i);
              p:=p^.next;
              if i>500 then
               Message(sym_f_internal_error_in_symtablestack);
           end;
      end;

    procedure list_symtablestack;
      var
         p : psymtable;
         i : longint;
      begin
         p:=symtablestack;
         i:=0;
         while assigned(p) do
           begin
              inc(i);
              writeln(i,' ',p^.name^);
              p:=p^.next;
              if i>500 then
               Message(sym_f_internal_error_in_symtablestack);
           end;
      end;
{$endif DEBUG}


{****************************************************************************
                           Init/Done Symtable
****************************************************************************}

{$ifdef tp}
   procedure do_streamerror;
     begin
       if symbolstream.status=-2 then
        WriteLn('Error: Not enough EMS memory')
       else
        WriteLn('Error: EMS Error ',symbolstream.status);
       halt(1);
     end;
{$endif TP}

   procedure InitSymtable;
     begin
{$ifdef TP}
     { Allocate stream }
        if use_big then
         begin
           streamerror:=@do_streamerror;
         { symbolstream.init('TMPFILE',stcreate,16000); }
         {$ifndef dpmi}
           symbolstream.init(10000,4000000); {using ems streams}
         {$else}
           symbolstream.init(1000000,16000); {using memory streams}
         {$endif}
           if symbolstream.errorinfo=stiniterror then
            do_streamerror;
         { write something, because pos 0 means nil pointer }
           symbolstream.writestr(@inputfile);
         end;
{$endif tp}
      { Reset symbolstack }
        registerdef:=false;
        read_member:=false;
        symtablestack:=nil;
        systemunit:=nil;
        objpasunit:=nil;
        sroot:=nil;
{$ifdef GDB}
        firstglobaldef:=nil;
        lastglobaldef:=nil;
{$endif GDB}
        globaltypecount:=1;
        pglobaltypecount:=@globaltypecount;
     { create error syms and def }
        generrorsym:=new(perrorsym,init);
        generrordef:=new(perrordef,init);
     end;


   procedure DoneSymtable;
      begin
        dispose(generrorsym,done);
        dispose(generrordef,done);
      { unload all symtables
         done with loaded_units
        dispose_global:=true;
        while assigned(symtablestack) do
          dellexlevel;  }
{$ifdef TP}
      { close the stream }
        if use_big then
         symbolstream.done;
{$endif}
     end;

end.
{
  $Log$
  Revision 1.4  1999-04-29 17:25:37  peter
    * small fix for deref

  Revision 1.3  1999/04/26 18:30:03  peter
    * farpointerdef moved into pointerdef.is_far

  Revision 1.151  1999/04/26 13:31:54  peter
    * release storenumber,double_checksum

  Revision 1.150  1999/04/25 17:36:13  peter
    * typo fix for storenumber

  Revision 1.149  1999/04/21 22:05:28  pierre
    + tsymtable.find_at_offset function
      used by ra386att to give arg name from ebp offset with -vz option

  Revision 1.148  1999/04/21 16:31:44  pierre
  ra386att.pas : commit problem !

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

  Revision 1.146  1999/04/19 09:33:14  pierre
    + added tsymtable.set_alignment(longint) function
      to change the offsets of all function args
      if declared as cdecl or stdcall
      (this must be done after because the cdecl is parsed after
      insertion of the function parameterss into parast symboltable)

  Revision 1.145  1999/04/17 13:16:24  peter
    * fixes for storenumber

  Revision 1.144  1999/04/15 10:01:45  peter
    * small update for storenumber

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

  Revision 1.142  1999/04/08 14:54:10  pierre
   * suppression of val para unused warnings

  Revision 1.141  1999/04/07 15:31:09  pierre
    * all formaldefs are now a sinlge definition
      cformaldef (this was necessary for double_checksum)
    + small part of double_checksum code

  Revision 1.140  1999/03/31 13:55:24  peter
    * assembler inlining working for ag386bin

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

  Revision 1.138  1999/03/21 22:49:11  florian
    * private ids of objects can be reused in child classes
      if they are in another unit

  Revision 1.137  1999/03/17 22:23:20  florian
    * a FPC compiled compiler checks now also in debug mode in assigned
      if a pointer points to the heap
    * when a symtable is loaded, there is no need to check for duplicate
      symbols. This leads to crashes because defowner isn't assigned
      in this case

  Revision 1.136  1999/03/01 13:45:07  pierre
   + added staticppusymtable symtable type for local browsing

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

  Revision 1.134  1999/02/22 15:09:42  florian
    * behaviaor of PROTECTED and PRIVATE fixed, works now like TP/Delphi

  Revision 1.133  1999/02/22 13:07:12  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.132  1999/02/22 02:15:40  peter
    * updates for ag386bin

  Revision 1.131  1999/02/16 00:44:34  peter
    * tp7 fix, assigned() can only be used on vars, not on functions

  Revision 1.130  1999/02/15 13:13:16  pierre
   * fix for bug0216

  Revision 1.129  1999/02/11 09:46:29  pierre
    * fix for normal method calls inside static methods :
      WARNING there were both parser and codegen errors !!
      added static_call boolean to calln tree

  Revision 1.128  1999/02/09 23:03:05  florian
    * check for duplicate field names in inherited classes/objects
    * bug with self from the mailing list solved (the problem
      was that classes were sometimes pushed wrong)

  Revision 1.127  1999/02/08 11:29:06  pierre
   * fix for bug0214
     several problems where combined
     search_class_member did not set srsymtable
     => in do_member_read the call node got a wrong symtable
     in cg386cal the vmt was pushed twice without chacking if it exists
     now %esi is set to zero and pushed if not vmt
     (not very efficient but should work !)

  Revision 1.126  1999/02/05 08:54:31  pierre
    + linkofiles splitted inot linkofiles and linkunitfiles
      because linkofiles must be stored with directory
      to enabled linking of different objects with same name
      in a different directory

  Revision 1.125  1999/02/03 09:44:33  pierre
    * symbol nubering begins with 1 in number_symbols
    * program tmodule has globalsymtable for its staticsymtable
      (to get it displayed in IDE globals list)
    + list of symbol (browcol) greatly improved for IDE

  Revision 1.124  1999/01/27 12:58:33  pierre
   * unused var warning suppressed for high of open arrays

  Revision 1.123  1999/01/21 16:41:03  pierre
   * fix for constructor inside with statements

  Revision 1.122  1999/01/20 10:16:44  peter
    * don't update crc when writing objs,libs and sources

  Revision 1.121  1999/01/14 21:50:00  peter
    * fixed forwardpointer problem with multiple forwards for the same
      typesym. It now uses a linkedlist instead of a single pointer

  Revision 1.120  1999/01/13 14:29:22  daniel
  * nonextfield repaired

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

  Revision 1.118  1999/01/05 08:20:10  florian
    * mainly problem with invalid case ranges fixed (reported by Jonas)

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

  Revision 1.116  1998/12/30 13:41:16  peter
    * released valuepara

  Revision 1.115  1998/12/11 00:03:48  peter
    + globtype,tokens,version unit splitted from globals

  Revision 1.114  1998/12/10 09:47:29  florian
    + basic operations with int64/qord (compiler with -dint64)
    + rtti of enumerations extended: names are now written

  Revision 1.113  1998/12/08 10:18:17  peter
    + -gh for heaptrc unit

  Revision 1.112  1998/12/04 10:18:10  florian
    * some stuff for procedures of object added
    * bug with overridden virtual constructors fixed (reported by Italo Gomes)

  Revision 1.111  1998/11/30 16:34:46  pierre
    * corrected problems with rangecheck
    + added needed code for no rangecheck  in CRC32 functions in ppu unit
    * enumdef lso need its rangenr reset to zero
      when calling reset_global_defs

  Revision 1.110  1998/11/28 16:20:58  peter
    + support for dll variables

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

  Revision 1.108  1998/11/24 23:00:32  peter
    * small crash prevention

  Revision 1.107  1998/11/20 15:36:01  florian
    * problems with rtti fixed, hope it works

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

  Revision 1.105  1998/11/17 10:39:18  peter
    * has_rtti,has_inittable reset

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

  Revision 1.103  1998/11/13 15:40:32  pierre
    + added -Se in Makefile cvstest target
    + lexlevel cleanup
      normal_function_level main_program_level and unit_init_level defined
    * tins_cache grown to A_EMMS (gave range check error in asm readers)
      (test added in code !)
    * -Un option was wrong
    * _FAIL and _SELF only keyword inside
      constructors and methods respectively

  Revision 1.102  1998/11/12 16:43:34  florian
    * functions with ansi strings as result didn't work, solved

  Revision 1.101  1998/11/12 12:55:18  pierre
   * fix for bug0176 and bug0177

  Revision 1.100  1998/11/10 10:09:15  peter
    * va_list -> array of const

  Revision 1.99  1998/11/09 11:44:38  peter
    + va_list for printf support

  Revision 1.98  1998/11/05 23:33:35  peter
    * symtable.done sets vars to nil

  Revision 1.97  1998/11/05 12:03:00  peter
    * released useansistring
    * removed -Sv, its now available in fpc modes

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

  Revision 1.95  1998/10/21 08:40:01  florian
    + ansistring operator +
    + $h and string[n] for n>255 added
    * small problem with TP fixed

  Revision 1.94  1998/10/20 08:07:03  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.93  1998/10/19 08:55:08  pierre
    * wrong stabs info corrected once again !!
    + variable vmt offset with vmt field only if required
      implemented now !!!

  Revision 1.92  1998/10/16 13:12:56  pierre
    * added vmt_offsets in destructors code also !!!
    * vmt_offset code for m68k

  Revision 1.91  1998/10/16 08:48:38  peter
    * fixed some misplaced $endif GDB

  Revision 1.90  1998/10/15 15:13:32  pierre
    + added oo_hasconstructor and oo_hasdestructor
      for objects options

  Revision 1.89  1998/10/14 13:38:25  peter
    * fixed path with staticlib/objects in ppufiles

  Revision 1.88  1998/10/09 16:36:07  pierre
    * some memory leaks specific to usebrowser define fixed
    * removed tmodule.implsymtable (was like tmodule.localsymtable)

  Revision 1.87  1998/10/09 11:47:57  pierre
    * still more memory leaks fixes !!

  Revision 1.86  1998/10/08 17:17:35  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.85  1998/10/08 13:48:51  peter
    * fixed memory leaks for do nothing source
    * fixed unit interdependency

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

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

  Revision 1.82  1998/09/25 09:52:57  peter
    + store also datasize and # of symbols in ppu
    * # of defs is now also stored in structs

  Revision 1.81  1998/09/24 23:49:21  peter
    + aktmodeswitches

  Revision 1.80  1998/09/23 12:20:51  pierre
    * main program tmodule had no symtable (crashed browser)
    * unit symbols problem fixed !!

  Revision 1.79  1998/09/23 12:03:57  peter
    * overloading fix for array of const

  Revision 1.78  1998/09/22 17:13:54  pierre
    + browsing updated and developed
      records and objects fields are also stored

  Revision 1.77  1998/09/22 15:37:24  peter
    + array of const start

  Revision 1.76  1998/09/21 10:00:08  peter
    * store number of defs in ppu file

  Revision 1.75  1998/09/21 08:58:31  peter
    + speedsearch, which also needs speedvalue as parameter

  Revision 1.74  1998/09/21 08:45:25  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.73  1998/09/20 09:38:47  florian
    * hasharray for defs fixed
    * ansistring code generation corrected (init/final, assignement)

  Revision 1.72  1998/09/19 22:56:18  florian
    + hash table for getdefnr added

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

  Revision 1.70  1998/09/09 11:50:57  pierre
    * forward def are not put in record or objects
    + added check for forwards also in record and objects
    * dummy parasymtable for unit initialization removed from
    symtable stack

  Revision 1.69  1998/09/07 23:10:25  florian
    * a lot of stuff fixed regarding rtti and publishing of properties,
      basics should now work

  Revision 1.68  1998/09/07 19:33:26  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.67  1998/09/07 18:46:14  peter
    * update smartlinking, uses getdatalabel
    * renamed ptree.value vars to value_str,value_real,value_set

  Revision 1.66  1998/09/07 17:37:05  florian
    * first fixes for published properties

  Revision 1.65  1998/09/06 22:42:03  florian
    + rtti genreation for properties added

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

  Revision 1.63  1998/09/04 17:34:23  pierre
    * bug with datalabel corrected
    + assembler errors better commented
    * one nested record crash removed

  Revision 1.62  1998/09/04 08:42:10  peter
    * updated some error messages

  Revision 1.61  1998/09/03 16:03:21  florian
    + rtti generation
    * init table generation changed

  Revision 1.60  1998/09/01 17:39:52  peter
    + internal constant functions

  Revision 1.59  1998/09/01 12:53:27  peter
    + aktpackenum

  Revision 1.58  1998/09/01 07:54:26  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.57  1998/08/31 12:26:33  peter
    * m68k and palmos updates from surebugfixes

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

  Revision 1.55  1998/08/21 08:43:32  pierre
    * pocdecl and poclearstack are now different
      external must but written as last specification

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

  Revision 1.53  1998/08/19 18:04:56  peter
    * fixed current_module^.in_implementation flag

  Revision 1.51  1998/08/18 14:17:12  pierre
    * bug about assigning the return value of a function to
      a procvar fixed : warning
      assigning a proc to a procvar need @ in FPC mode !!
    * missing file/line info restored

  Revision 1.50  1998/08/17 10:10:13  peter
    - removed OLDPPU

  Revision 1.49  1998/08/12 19:39:31  peter
    * fixed some crashes

  Revision 1.48  1998/08/10 14:50:32  peter
    + localswitches, moduleswitches, globalswitches splitting

  Revision 1.47  1998/08/10 10:00:19  peter
    * Moved symbolstream to symtable.pas

  Revision 1.46  1998/08/08 10:19:19  florian
    * small fixes to write the extended type correct

  Revision 1.45  1998/08/02 16:42:00  florian
    * on o : tobject do should also work now, the exceptsymtable shouldn't be
      disposed by dellexlevel

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

  Revision 1.43  1998/07/28 21:52:56  florian
    + implementation of raise and try..finally
    + some misc. exception stuff

  Revision 1.42  1998/07/20 10:23:03  florian
    * better ansi string assignement

  Revision 1.41  1998/07/18 22:54:31  florian
    * some ansi/wide/longstring support fixed:
       o parameter passing
       o returning as result from functions

  Revision 1.40  1998/07/14 14:47:09  peter
    * released NEWINPUT

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

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

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

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

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

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

  Revision 1.33  1998/06/15 14:10:53  daniel
  * File was ruined, fixed.

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

  Revision 1.30  1998/06/09 16:01:53  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.29  1998/06/07 15:30:26  florian
    + first working rtti
    + data init/final. for local variables

  Revision 1.28  1998/06/06 09:27:39  peter
    * new depend file generated

  Revision 1.27  1998/06/05 14:37:38  pierre
    * fixes for inline for operators
    * inline procedure more correctly restricted

  Revision 1.26  1998/06/04 23:52:03  peter
    * m68k compiles
    + .def file creation moved to gendef.pas so it could also be used
      for win32

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

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

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

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

  Revision 1.21  1998/05/23 01:21:31  peter
    + aktasmmode, aktoptprocessor, aktoutputformat
    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
    + $LIBNAME to set the library name where the unit will be put in
    * splitted cgi386 a bit (codeseg to large for bp7)
    * nasm, tasm works again. nasm moved to ag386nsm.pas

  Revision 1.20  1998/05/21 19:33:37  peter
    + better procedure directive handling and only one table

  Revision 1.19  1998/05/20 09:42:37  pierre
    + UseTokenInfo now default
    * unit in interface uses and implementation uses gives error now
    * only one error for unknown symbol (uses lastsymknown boolean)
      the problem came from the label code !
    + first inlined procedures and function work
      (warning there might be allowed cases were the result is still wrong !!)
    * UseBrower updated gives a global list of all position of all used symbols
      with switch -gb

  Revision 1.18  1998/05/11 13:07:57  peter
    + $ifndef OLDPPU for the new ppuformat
    + $define GDB not longer required
    * removed all warnings and stripped some log comments
    * no findfirst/findnext anymore to remove smartlink *.o files

  Revision 1.17  1998/05/06 08:38:48  pierre
    * better position info with UseTokenInfo
      UseTokenInfo greatly simplified
    + added check for changed tree after first time firstpass
      (if we could remove all the cases were it happen
      we could skip all firstpass if firstpasscount > 1)
      Only with ExtDebug

  Revision 1.16  1998/05/05 15:24:20  michael
  * Fix to save units with classes.

  Revision 1.15  1998/05/04 17:54:29  peter
    + smartlinking works (only case jumptable left todo)
    * redesign of systems.pas to support assemblers and linkers
    + Unitname is now also in the PPU-file, increased version to 14

  Revision 1.14  1998/05/01 16:38:46  florian
    * handling of private and protected fixed
    + change_keywords_to_tp implemented to remove
      keywords which aren't supported by tp
    * break and continue are now symbols of the system unit
    + widestring, longstring and ansistring type released

  Revision 1.13  1998/05/01 09:01:25  florian
    + correct semantics of private and protected
    * small fix in variable scope:
       a id can be used in a parameter list of a method, even it is used in
       an anchestor class as field id

  Revision 1.12  1998/05/01 07:43:57  florian
    + basics for rtti implemented
    + switch $m (generate rtti for published sections)

  Revision 1.11  1998/04/30 15:59:42  pierre
    * GDB works again better :
      correct type info in one pass
    + UseTokenInfo for better source position
    * fixed one remaining bug in scanner for line counts
    * several little fixes

  Revision 1.10  1998/04/29 10:34:05  pierre
    + added some code for ansistring (not complete nor working yet)
    * corrected operator overloading
    * corrected nasm output
    + started inline procedures
    + added starstarn : use ** for exponentiation (^ gave problems)
    + started UseTokenInfo cond to get accurate positions

  Revision 1.9  1998/04/27 23:10:29  peter
    + new scanner
    * $makelib -> if smartlink
    * small filename fixes pmodule.setfilename
    * moved import from files.pas -> import.pas

  Revision 1.8  1998/04/21 10:16:48  peter
    * patches from strasbourg
    * objects is not used anymore in the fpc compiled version

  Revision 1.7  1998/04/13 22:20:36  florian
    + stricter checking for duplicate id, solves also bug0097

  Revision 1.6  1998/04/13 17:20:43  florian
    * tdef.done much faster implemented

  Revision 1.5  1998/04/10 21:36:56  florian
    + some stuff to support method pointers (procedure of object) added
      (declaration, parameter handling)

  Revision 1.4  1998/04/08 16:58:08  pierre
    * several bugfixes
      ADD ADC and AND are also sign extended
      nasm output OK (program still crashes at end
      and creates wrong assembler files !!)
      procsym types sym in tdef removed !!

  Revision 1.3  1998/04/07 13:19:52  pierre
    * bugfixes for reset_gdb_info
      in MEM parsing for go32v2
      better external symbol creation
      support for rhgdb.exe (lowercase file names)

  Revision 1.2  1998/04/06 13:09:04  daniel
  * Emergency solution for bug in reset_gdb_info.
}