|
|
@@ -0,0 +1,3873 @@
|
|
|
+{
|
|
|
+ $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;
|
|
|
+
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ {$define NONEXTFIELD}
|
|
|
+{$endif}
|
|
|
+
|
|
|
+ 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}
|
|
|
+ ;
|
|
|
+
|
|
|
+{define NOLOCALBROWSER if you have problems with -bl option }
|
|
|
+
|
|
|
+{************************************************
|
|
|
+ Some internal constants
|
|
|
+************************************************}
|
|
|
+
|
|
|
+ const
|
|
|
+ hasharraysize = 256;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ {$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);
|
|
|
+
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ tnamedindexcallback = procedure(p : psym);
|
|
|
+{$endif}
|
|
|
+
|
|
|
+ tsearchhasharray = array[0..hasharraysize-1] of psym;
|
|
|
+ psearchhasharray = ^tsearchhasharray;
|
|
|
+
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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 }
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ { 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;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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}
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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 : pfarpointerdef;
|
|
|
+
|
|
|
+ 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() }
|
|
|
+
|
|
|
+ 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;
|
|
|
+ object_options : 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
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ procedure writesym(p : psym);
|
|
|
+ begin
|
|
|
+ p^.write;
|
|
|
+ end;
|
|
|
+{$endif}
|
|
|
+
|
|
|
+ procedure derefsym(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});
|
|
|
+ begin
|
|
|
+ psym(p)^.deref;
|
|
|
+ end;
|
|
|
+
|
|
|
+ procedure derefsymsdelayed(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});
|
|
|
+ begin
|
|
|
+ if psym(p)^.typ in [absolutesym,propertysym] then
|
|
|
+ psym(p)^.deref;
|
|
|
+ end;
|
|
|
+
|
|
|
+ procedure check_procsym_forward(sym : {$ifdef STORENUMBER}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 : {$ifdef STORENUMBER}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 : {$ifdef STORENUMBER}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 : {$ifdef STORENUMBER}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 : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});
|
|
|
+ begin
|
|
|
+ if psym(p)^.typ <> procsym then
|
|
|
+ psym(p)^.concatstabto(asmoutput);
|
|
|
+ end;
|
|
|
+
|
|
|
+ procedure concattypestab(p : {$ifdef STORENUMBER}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 : {$ifdef STORENUMBER}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;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ var
|
|
|
+ hp : pdef;
|
|
|
+ {$ifdef GDB}
|
|
|
+ last : pdef;
|
|
|
+ {$endif GDB}
|
|
|
+{$endif}
|
|
|
+ begin
|
|
|
+ stringdispose(name);
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ symsearch:=nil;
|
|
|
+{$endif}
|
|
|
+ inherited done;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{***********************************************
|
|
|
+ Helpers
|
|
|
+***********************************************}
|
|
|
+
|
|
|
+ function tsymtable.getnewtypecount : word;
|
|
|
+ begin
|
|
|
+ getnewtypecount:=pglobaltypecount^;
|
|
|
+ inc(pglobaltypecount^);
|
|
|
+ end;
|
|
|
+
|
|
|
+ procedure tsymtable.registerdef(p : pdef);
|
|
|
+ begin
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ defindex^.insert(p);
|
|
|
+{$else}
|
|
|
+ p^.next:=rootdef;
|
|
|
+ rootdef:=p;
|
|
|
+{$endif}
|
|
|
+ { set def owner and indexnb }
|
|
|
+ p^.owner:=@self;
|
|
|
+ end;
|
|
|
+
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+
|
|
|
+ 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}
|
|
|
+
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+
|
|
|
+ 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
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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);
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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 }
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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);
|
|
|
+ ibstringdef : 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);
|
|
|
+ ibfarpointerdef : hp:=new(pfarpointerdef,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;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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);
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ { 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 }
|
|
|
+{$ifdef Double_checksum}
|
|
|
+ current_ppu^.do_interface_crc:=false;
|
|
|
+{$endif Double_checksum}
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ current_ppu^.putlongint(defindex^.count);
|
|
|
+{$else}
|
|
|
+ current_ppu^.putlongint(number_defs);
|
|
|
+{$endif}
|
|
|
+ current_ppu^.writeentry(ibstartdefs);
|
|
|
+ { now write the definition }
|
|
|
+{$ifdef Double_checksum}
|
|
|
+ current_ppu^.do_interface_crc:=true;
|
|
|
+{$endif Double_checksum}
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ var
|
|
|
+ pd : psym;
|
|
|
+{$endif}
|
|
|
+ begin
|
|
|
+ { each definition get a number, write then the amount of syms and the
|
|
|
+ datasize to the ibsymdef entry }
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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 }
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+
|
|
|
+
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ { solve the references to other definitions for each definition }
|
|
|
+ {$ifdef STORENUMBER}
|
|
|
+ hp:=pdef(defindex^.first);
|
|
|
+ {$else}
|
|
|
+ hp:=rootdef;
|
|
|
+ {$endif}
|
|
|
+ while assigned(hp) do
|
|
|
+ begin
|
|
|
+ hp^.deref;
|
|
|
+ { insert also the owner }
|
|
|
+ hp^.owner:=@self;
|
|
|
+ hp:=pdef(hp^.next);
|
|
|
+ end;
|
|
|
+{$endif}
|
|
|
+
|
|
|
+ { load symbols }
|
|
|
+ loadsyms;
|
|
|
+
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ hp : pdef;
|
|
|
+{$endif}
|
|
|
+ st_loading : boolean;
|
|
|
+ begin
|
|
|
+ st_loading:=in_loading;
|
|
|
+ in_loading:=true;
|
|
|
+ symtabletype:=typ;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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;
|
|
|
+
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ { solve the references of the symbols for each definition }
|
|
|
+ {$ifdef STORENUMBER}
|
|
|
+ hp:=pdef(defindex^.first);
|
|
|
+ {$else}
|
|
|
+ hp:=rootdef;
|
|
|
+ {$endif}
|
|
|
+ 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;
|
|
|
+
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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
|
|
|
+***********************************************}
|
|
|
+
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+
|
|
|
+ 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
|
|
|
+***********************************************}
|
|
|
+
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+
|
|
|
+ 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;
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ lasthfp,hfp : pforwardpointer;
|
|
|
+{$endif}
|
|
|
+ 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);
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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
|
|
|
+{$endif}
|
|
|
+ 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 }
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ symindex^.insert(sym);
|
|
|
+{$endif}
|
|
|
+ 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
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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
|
|
|
+{$else}
|
|
|
+ hp:=inherited speedsearch(s,speedvalue);
|
|
|
+ if assigned(hp) then
|
|
|
+{$endif}
|
|
|
+ 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;
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ speedsearch:=hp;
|
|
|
+ exit;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ if s>hp^.name then
|
|
|
+ hp:=hp^.left
|
|
|
+ else
|
|
|
+ hp:=hp^.right;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ speedsearch:=nil;
|
|
|
+{$else}
|
|
|
+ end;
|
|
|
+ speedsearch:=hp;
|
|
|
+{$endif}
|
|
|
+ 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)
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ or assigned(searchhasharray)
|
|
|
+{$endif}
|
|
|
+ then
|
|
|
+ internalerror(1111);
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ sym:=pvarsym(symindex^.first);
|
|
|
+{$else STORENUMBER}
|
|
|
+ sym:=pvarsym(searchroot);
|
|
|
+{$endif STORENUMBER}
|
|
|
+ datasize:=0;
|
|
|
+ { there can be only varsyms }
|
|
|
+ while assigned(sym) do
|
|
|
+ begin
|
|
|
+ l:=sym^.getpushsize;
|
|
|
+ sym^.address:=datasize;
|
|
|
+ datasize:=align(datasize+l,alignment);
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ sym:=pvarsym(sym^.next);
|
|
|
+{$else STORENUMBER}
|
|
|
+ sym:=pvarsym(sym^.nextsym);
|
|
|
+{$endif STORENUMBER}
|
|
|
+ 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)
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ or assigned(searchhasharray)
|
|
|
+{$endif}
|
|
|
+ then
|
|
|
+ internalerror(1111);
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ sym:=pvarsym(symindex^.first);
|
|
|
+{$else STORENUMBER}
|
|
|
+ sym:=pvarsym(searchroot);
|
|
|
+{$endif STORENUMBER}
|
|
|
+ while assigned(sym) do
|
|
|
+ begin
|
|
|
+ if sym^.address+address_fixup=l then
|
|
|
+ begin
|
|
|
+ find_at_offset:=sym;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ sym:=pvarsym(sym^.next);
|
|
|
+{$else STORENUMBER}
|
|
|
+ sym:=pvarsym(sym^.nextsym);
|
|
|
+{$endif STORENUMBER}
|
|
|
+ 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;
|
|
|
+{$ifdef STORENUMBER}
|
|
|
+ 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
|
|
|
+{$ifndef STORENUMBER}
|
|
|
+ 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}
|
|
|
+ {$ifndef STORENUMBER}
|
|
|
+ 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 : {$ifdef STORENUMBER}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.1 1999-04-26 14:50:13 michael
|
|
|
+ + Added my version again after crash
|
|
|
+
|
|
|
+ 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.
|
|
|
+}
|
michael