| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699 | {    Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller    Implementation for the symbols types of the symtable    This program is free software; you can redistribute it and/or modify    it under the terms of the GNU General Public License as published by    the Free Software Foundation; either version 2 of the License, or    (at your option) any later version.    This program is distributed in the hope that it will be useful,    but WITHOUT ANY WARRANTY; without even the implied warranty of    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    GNU General Public License for more details.    You should have received a copy of the GNU General Public License    along with this program; if not, write to the Free Software    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ****************************************************************************}unit symsym;{$i fpcdefs.inc}interface    uses       { common }       cutils,       { target }       globtype,globals,widestr,       { symtable }       symconst,symbase,symtype,symdef,defcmp,       { ppu }       ppu,       cclasses,symnot,       { aasm }       aasmbase,aasmtai,       cpuinfo,cpubase,cgbase,cgutils,parabase       ;    type       { this class is the base for all symbol objects }       tstoredsym = class(tsym)       public          constructor create(const n : string);          constructor ppuload(ppufile:tcompilerppufile);          destructor destroy;override;          procedure ppuwrite(ppufile:tcompilerppufile);virtual;{$ifdef GDB}          function  get_var_value(const s:string):string;          function  stabstr_evaluate(const s:string;vars:array of string):Pchar;          procedure concatstabto(asmlist : taasmoutput);{$endif GDB}          function  mangledname : string; virtual;       end;       tlabelsym = class(tstoredsym)          used,          defined : boolean;          { points to the matching node, only valid resulttype pass is run and            the goto<->label relation in the node tree is created, should            be a tnode }          code : pointer;          { when the label is defined in an asm block, this points to the            generated asmlabel }          asmblocklabel : tasmlabel;          constructor create(const n : string);          constructor ppuload(ppufile:tcompilerppufile);          procedure ppuwrite(ppufile:tcompilerppufile);override;{$ifdef GDB}          function  stabstring : pchar;override;{$endif GDB}       end;       tunitsym = class(Tstoredsym)          unitsymtable : tsymtable;          constructor create(const n : string;ref : tsymtable);          constructor ppuload(ppufile:tcompilerppufile);          destructor destroy;override;          procedure ppuwrite(ppufile:tcompilerppufile);override;       end;       terrorsym = class(Tsym)          constructor create;       end;       Tprocdefcallback = procedure(p:Tprocdef;arg:pointer);       tprocsym = class(tstoredsym)       protected          pdlistfirst,          pdlistlast   : pprocdeflist; { linked list of overloaded procdefs }          function getprocdef(nr:cardinal):Tprocdef;       public          procdef_count : byte;{$ifdef GDB}          is_global : boolean;{$endif GDB}          overloadchecked : boolean;          property procdef[nr:cardinal]:Tprocdef read getprocdef;          constructor create(const n : string);          constructor ppuload(ppufile:tcompilerppufile);          destructor destroy;override;          { writes all declarations except the specified one }          procedure write_parameter_lists(skipdef:tprocdef);          { tests, if all procedures definitions are defined and not }          { only forward                                             }          procedure check_forward;          procedure unchain_overload;          procedure ppuwrite(ppufile:tcompilerppufile);override;          procedure buildderef;override;          procedure deref;override;          procedure addprocdef(p:tprocdef);          procedure addprocdef_deref(const d:tderef);          procedure add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);          procedure concat_procdefs_to(s:Tprocsym);          procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);          function first_procdef:Tprocdef;          function last_procdef:Tprocdef;          function search_procdef_nopara_boolret:Tprocdef;          function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;          function search_procdef_bypara(para:tlist;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;          function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;          function search_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;          function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;          { currobjdef is the object def to assume, this is necessary for protected and            private,            context is the object def we're really in, this is for the strict stuff          }          function is_visible_for_object(currobjdef:tdef;context:tdef):boolean;override;{$ifdef GDB}          function stabstring : pchar;override;{$endif GDB}       end;       ttypesym = class(Tstoredsym)          restype    : ttype;          constructor create(const n : string;const tt : ttype);          constructor ppuload(ppufile:tcompilerppufile);          procedure ppuwrite(ppufile:tcompilerppufile);override;          procedure buildderef;override;          procedure deref;override;          function  gettypedef:tdef;override;          procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;          function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;{$ifdef GDB}          function stabstring : pchar;override;{$endif GDB}       end;       tabstractvarsym = class(tstoredsym)          varoptions    : tvaroptions;          varspez       : tvarspez;  { sets the type of access }          varregable    : tvarregable;          varstate      : tvarstate;          notifications : Tlinkedlist;          constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);          constructor ppuload(ppufile:tcompilerppufile);          destructor  destroy;override;          procedure ppuwrite(ppufile:tcompilerppufile);override;          procedure buildderef;override;          procedure deref;override;          function  getsize : longint;          function  is_regvar:boolean;          procedure trigger_notifications(what:Tnotification_flag);          function register_notification(flags:Tnotification_flags;                                         callback:Tnotification_callback):cardinal;          procedure unregister_notification(id:cardinal);         private          procedure setvartype(const newtype: ttype);          _vartype       : ttype;         public          property vartype: ttype read _vartype write setvartype;      end;      tfieldvarsym = class(tabstractvarsym)          fieldoffset   : aint;   { offset in record/object }          constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);          constructor ppuload(ppufile:tcompilerppufile);          procedure ppuwrite(ppufile:tcompilerppufile);override;{$ifdef GDB}          function stabstring : pchar;override;{$endif GDB}      end;      tabstractnormalvarsym = class(tabstractvarsym)          defaultconstsym : tsym;          defaultconstsymderef : tderef;          localloc      : TLocation; { register/reference for local var }          constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);          constructor ppuload(ppufile:tcompilerppufile);          procedure ppuwrite(ppufile:tcompilerppufile);override;          procedure buildderef;override;          procedure deref;override;      end;      tlocalvarsym = class(tabstractnormalvarsym)          constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);          constructor ppuload(ppufile:tcompilerppufile);          procedure ppuwrite(ppufile:tcompilerppufile);override;{$ifdef GDB}          function stabstring : pchar;override;{$endif GDB}      end;      tparavarsym = class(tabstractnormalvarsym)          paraloc       : array[tcallercallee] of TCGPara;          paranr        : word; { position of this parameter }{$ifdef EXTDEBUG}          eqval         : tequaltype;{$endif EXTDEBUG}          constructor create(const n : string;nr:word;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);          constructor ppuload(ppufile:tcompilerppufile);          destructor destroy;override;          procedure ppuwrite(ppufile:tcompilerppufile);override;{$ifdef GDB}          function stabstring : pchar;override;{$endif GDB}      end;      tglobalvarsym = class(tabstractnormalvarsym)      private          _mangledname : pstring;      public          constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);          constructor create_dll(const n : string;vsp:tvarspez;const tt : ttype);          constructor create_C(const n,mangled : string;vsp:tvarspez;const tt : ttype);          constructor ppuload(ppufile:tcompilerppufile);          destructor destroy;override;          procedure ppuwrite(ppufile:tcompilerppufile);override;          function mangledname:string;override;          procedure set_mangledname(const s:string);{$ifdef GDB}          function stabstring : pchar;override;{$endif GDB}      end;      tabsolutevarsym = class(tabstractvarsym)      public         abstyp  : absolutetyp;{$ifdef i386}         absseg  : boolean;{$endif i386}         asmname : pstring;         addroffset : aint;         ref     : tsymlist;         constructor create(const n : string;const tt : ttype);         constructor create_ref(const n : string;const tt : ttype;_ref:tsymlist);         destructor  destroy;override;         constructor ppuload(ppufile:tcompilerppufile);         procedure buildderef;override;         procedure deref;override;         function  mangledname : string;override;         procedure ppuwrite(ppufile:tcompilerppufile);override;{$ifdef gdb}         function stabstring:Pchar;override;{$endif gdb}      end;       tpropertysym = class(Tstoredsym)          propoptions   : tpropertyoptions;          propoverriden : tpropertysym;          propoverridenderef : tderef;          proptype,          indextype     : ttype;          index,          default       : longint;          readaccess,          writeaccess,          storedaccess  : tsymlist;          constructor create(const n : string);          destructor  destroy;override;          constructor ppuload(ppufile:tcompilerppufile);          function  getsize : longint;          procedure ppuwrite(ppufile:tcompilerppufile);override;          function  gettypedef:tdef;override;          procedure buildderef;override;          procedure deref;override;          procedure dooverride(overriden:tpropertysym);       end;       ttypedconstsym = class(tstoredsym)       private          _mangledname : pstring;       public          typedconsttype  : ttype;          is_writable     : boolean;          constructor create(const n : string;p : tdef;writable : boolean);          constructor createtype(const n : string;const tt : ttype;writable : boolean);          constructor ppuload(ppufile:tcompilerppufile);          destructor destroy;override;          function  mangledname : string;override;          procedure ppuwrite(ppufile:tcompilerppufile);override;          procedure buildderef;override;          procedure deref;override;          function  getsize:longint;{$ifdef GDB}          function  stabstring : pchar;override;{$endif GDB}       end;       tconstvalue = record         case integer of         0: (valueord : tconstexprint);         1: (valueordptr : tconstptruint);         2: (valueptr : pointer; len : longint);       end;       tconstsym = class(tstoredsym)          consttype   : ttype;          consttyp    : tconsttyp;          value       : tconstvalue;          resstrindex  : longint;     { needed for resource strings }          constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);          constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);          constructor create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);          constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);          constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);          constructor ppuload(ppufile:tcompilerppufile);          destructor  destroy;override;          procedure buildderef;override;          procedure deref;override;          procedure ppuwrite(ppufile:tcompilerppufile);override;{$ifdef GDB}          function  stabstring : pchar;override;{$endif GDB}       end;       tenumsym = class(Tstoredsym)          value      : longint;          definition : tenumdef;          definitionderef : tderef;          nextenum   : tenumsym;          constructor create(const n : string;def : tenumdef;v : longint);          constructor ppuload(ppufile:tcompilerppufile);          procedure ppuwrite(ppufile:tcompilerppufile);override;          procedure buildderef;override;          procedure deref;override;          procedure order;       end;       tsyssym = class(Tstoredsym)          number : longint;          constructor create(const n : string;l : longint);          constructor ppuload(ppufile:tcompilerppufile);          destructor  destroy;override;          procedure ppuwrite(ppufile:tcompilerppufile);override;       end;    const       maxmacrolen=16*1024;    type       pmacrobuffer = ^tmacrobuffer;       tmacrobuffer = array[0..maxmacrolen-1] of char;       tmacro = class(tstoredsym)          {Normally true, but false when a previously defined macro is undef-ed}          defined : boolean;          {True if this is a mac style compiler variable, in which case no macro           substitutions shall be done.}          is_compiler_var : boolean;          {Whether the macro was used. NOTE: A use of a macro which was never defined}          {e. g. an IFDEF which returns false, will not be registered as used,}          {since there is no place to register its use. }          is_used : boolean;          buftext : pchar;          buflen  : longint;          constructor create(const n : string);          constructor ppuload(ppufile:tcompilerppufile);          procedure ppuwrite(ppufile:tcompilerppufile);override;          destructor  destroy;override;       end;       { compiler generated symbol to point to rtti and init/finalize tables }       trttisym = class(tstoredsym)       private          _mangledname : pstring;       public          lab     : tasmsymbol;          rttityp : trttitype;          constructor create(const n:string;rt:trttitype);          constructor ppuload(ppufile:tcompilerppufile);          destructor destroy;override;          procedure ppuwrite(ppufile:tcompilerppufile);override;          function  mangledname:string;override;          function  get_label:tasmsymbol;       end;    var       generrorsym : tsym;implementation    uses       { global }       verbose,       { target }       systems,       { symtable }       defutil,symtable,       { tree }       node,       { aasm }{$ifdef gdb}       gdb,{$endif gdb}       { codegen }       paramgr,cresstr,       procinfo       ;{****************************************************************************                               Helpers****************************************************************************}{****************************************************************************                          TSYM (base for all symtypes)****************************************************************************}    constructor tstoredsym.create(const n : string);      begin         inherited create(n);      end;    constructor tstoredsym.ppuload(ppufile:tcompilerppufile);      var        nr : word;        s  : string;      begin         nr:=ppufile.getword;         s:=ppufile.getstring;         if s[1]='$' then          inherited createname(copy(s,2,255))         else          inherited createname(upper(s));         _realname:=stringdup(s);         typ:=abstractsym;         { force the correct indexnr. must be after create! }         indexnr:=nr;         ppufile.getposinfo(fileinfo);         ppufile.getsmallset(symoptions);         lastref:=nil;         defref:=nil;         refs:=0;         lastwritten:=nil;         refcount:=0;{$ifdef GDB}         isstabwritten := false;{$endif GDB}      end;    procedure tstoredsym.ppuwrite(ppufile:tcompilerppufile);      begin         ppufile.putword(indexnr);         ppufile.putstring(_realname^);         ppufile.putposinfo(fileinfo);         ppufile.putsmallset(symoptions);      end;    destructor tstoredsym.destroy;      begin        if assigned(defref) then         begin{$ifdef MEMDEBUG}           membrowser.start;{$endif MEMDEBUG}           defref.freechain;           defref.free;{$ifdef MEMDEBUG}           membrowser.stop;{$endif MEMDEBUG}         end;        inherited destroy;      end;{$ifdef GDB}    function Tstoredsym.get_var_value(const s:string):string;    begin      if s='mangledname' then        get_var_value:=mangledname      else        get_var_value:=inherited get_var_value(s);    end;    function Tstoredsym.stabstr_evaluate(const s:string;vars:array of string):Pchar;    begin      stabstr_evaluate:=string_evaluate(s,@get_var_value,vars);    end;    procedure tstoredsym.concatstabto(asmlist : taasmoutput);      var        stabstr : Pchar;      begin        stabstr:=stabstring;        if stabstr<>nil then          asmlist.concat(Tai_stabs.create(stabstr));      end;{$endif GDB}    function tstoredsym.mangledname : string;      begin        internalerror(200204171);      end;{****************************************************************************                                 TLABELSYM****************************************************************************}    constructor tlabelsym.create(const n : string);      begin         inherited create(n);         typ:=labelsym;         used:=false;         defined:=false;         code:=nil;      end;    constructor tlabelsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=labelsym;         code:=nil;         used:=false;         defined:=true;      end;    procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);      begin         if owner.symtabletype=globalsymtable then           Message(sym_e_ill_label_decl)         else           begin              inherited ppuwrite(ppufile);              ppufile.writeentry(iblabelsym);           end;      end;{$ifdef GDB}    function Tlabelsym.stabstring : pchar;      begin        stabstring:=stabstr_evaluate('"${name}",${N_LSYM},0,${line},0',[]);      end;{$endif GDB}{****************************************************************************                                  TUNITSYM****************************************************************************}    constructor tunitsym.create(const n : string;ref : tsymtable);      var        old_make_ref : boolean;      begin         old_make_ref:=make_ref;         make_ref:=false;         inherited create(n);         make_ref:=old_make_ref;         typ:=unitsym;         unitsymtable:=ref;      end;    constructor tunitsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=unitsym;         unitsymtable:=nil;      end;    destructor tunitsym.destroy;      begin         inherited destroy;      end;    procedure tunitsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.writeentry(ibunitsym);      end;{****************************************************************************                                  TPROCSYM****************************************************************************}    constructor tprocsym.create(const n : string);      begin         inherited create(n);         typ:=procsym;         pdlistfirst:=nil;         pdlistlast:=nil;         owner:=nil;{$ifdef GDB}         is_global:=false;{$endif GDB}         { the tprocdef have their own symoptions, make the procsym           always visible }         symoptions:=[sp_public];         overloadchecked:=false;         procdef_count:=0;      end;    constructor tprocsym.ppuload(ppufile:tcompilerppufile);      var         pdderef : tderef;         i,n : longint;      begin         inherited ppuload(ppufile);         typ:=procsym;         pdlistfirst:=nil;         pdlistlast:=nil;         procdef_count:=0;         n:=ppufile.getword;         for i:=1to n do          begin            ppufile.getderef(pdderef);            addprocdef_deref(pdderef);          end;{$ifdef GDB}         is_global:=false;{$endif GDB}         overloadchecked:=false;      end;    destructor tprocsym.destroy;      var         hp,p : pprocdeflist;      begin         p:=pdlistfirst;         while assigned(p) do           begin              hp:=p^.next;              dispose(p);              p:=hp;           end;         inherited destroy;      end;    procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);      var         p : pprocdeflist;         n : word;      begin         inherited ppuwrite(ppufile);         { count procdefs }         n:=0;         p:=pdlistfirst;         while assigned(p) do           begin             { only write the proc definitions that belong               to this procsym and are in the global symtable }             if p^.def.owner=owner then               inc(n);             p:=p^.next;           end;         ppufile.putword(n);         { write procdefs }         p:=pdlistfirst;         while assigned(p) do           begin             { only write the proc definitions that belong               to this procsym and are in the global symtable }             if p^.def.owner=owner then               ppufile.putderef(p^.defderef);             p:=p^.next;           end;         ppufile.writeentry(ibprocsym);      end;    procedure tprocsym.write_parameter_lists(skipdef:tprocdef);      var         p : pprocdeflist;      begin         p:=pdlistfirst;         while assigned(p) do           begin              if p^.def<>skipdef then                MessagePos1(p^.def.fileinfo,sym_h_param_list,p^.def.fullprocname(false));              p:=p^.next;           end;      end;    {Makes implicit externals (procedures declared in the interface     section which do not have a counterpart in the implementation)     to be an imported procedure. For mode macpas.}    procedure import_implict_external(pd:tabstractprocdef);      begin        tprocdef(pd).forwarddef:=false;        tprocdef(pd).setmangledname(target_info.CPrefix+tprocdef(pd).procsym.realname);      end;    procedure tprocsym.check_forward;      var         p : pprocdeflist;      begin         p:=pdlistfirst;         while assigned(p) do           begin              if (p^.def.owner=owner) and (p^.def.forwarddef) then                begin                   if (m_mac in aktmodeswitches) and (p^.def.interfacedef) then                     import_implict_external(p^.def)                   else                     begin                       MessagePos1(p^.def.fileinfo,sym_e_forward_not_resolved,p^.def.fullprocname(false));                       { Turn further error messages off }                       p^.def.forwarddef:=false;                     end                end;              p:=p^.next;           end;      end;    procedure tprocsym.buildderef;      var         p : pprocdeflist;      begin         p:=pdlistfirst;         while assigned(p) do           begin             if p^.def.owner=owner then               p^.defderef.build(p^.def);             p:=p^.next;           end;      end;    procedure tprocsym.deref;      var         p : pprocdeflist;      begin         { We have removed the overloaded entries, because they           are not valid anymore and we can't deref them because           the unit were they come from is not necessary in           our uses clause (PFV) }         unchain_overload;         { Deref our own procdefs }         p:=pdlistfirst;         while assigned(p) do           begin             if not(                    (p^.def=nil) or                    (p^.def.owner=owner)                   ) then               internalerror(200310291);             p^.def:=tprocdef(p^.defderef.resolve);             p:=p^.next;           end;      end;    procedure tprocsym.addprocdef(p:tprocdef);      var        pd : pprocdeflist;      begin        new(pd);        pd^.def:=p;        pd^.defderef.reset;        pd^.next:=nil;        { Add at end of list to keep always          a correct order, also after loading from ppu }        if assigned(pdlistlast) then         begin           pdlistlast^.next:=pd;           pdlistlast:=pd;         end        else         begin           pdlistfirst:=pd;           pdlistlast:=pd;         end;        inc(procdef_count);      end;    procedure tprocsym.addprocdef_deref(const d:tderef);      var        pd : pprocdeflist;      begin        new(pd);        pd^.def:=nil;        pd^.defderef:=d;        pd^.next:=nil;        { Add at end of list to keep always          a correct order, also after loading from ppu }        if assigned(pdlistlast) then         begin           pdlistlast^.next:=pd;           pdlistlast:=pd;         end        else         begin           pdlistfirst:=pd;           pdlistlast:=pd;         end;        inc(procdef_count);      end;    function Tprocsym.getprocdef(nr:cardinal):Tprocdef;      var        i : cardinal;        pd : pprocdeflist;      begin        pd:=pdlistfirst;        for i:=2 to nr do          begin            if not assigned(pd) then              internalerror(200209051);            pd:=pd^.next;          end;        getprocdef:=pd^.def;      end;    procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);      var        pd:pprocdeflist;      begin        pd:=pdlistfirst;        while assigned(pd) do          begin            if Aprocsym.search_procdef_bypara(pd^.def.paras,nil,cpoptions)=nil then              Aprocsym.addprocdef(pd^.def);            pd:=pd^.next;          end;      end;    procedure Tprocsym.concat_procdefs_to(s:Tprocsym);      var        pd : pprocdeflist;      begin        pd:=pdlistfirst;        while assigned(pd) do         begin           s.addprocdef(pd^.def);           pd:=pd^.next;         end;      end;    function Tprocsym.first_procdef:Tprocdef;      begin        if assigned(pdlistfirst) then          first_procdef:=pdlistfirst^.def        else          first_procdef:=nil;      end;    function Tprocsym.last_procdef:Tprocdef;      begin        if assigned(pdlistlast) then          last_procdef:=pdlistlast^.def        else          last_procdef:=nil;      end;    procedure Tprocsym.foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);      var        p : pprocdeflist;      begin        p:=pdlistfirst;        while assigned(p) do         begin           proc2call(p^.def,arg);           p:=p^.next;         end;      end;    function Tprocsym.search_procdef_nopara_boolret:Tprocdef;      var        p : pprocdeflist;      begin        search_procdef_nopara_boolret:=nil;        p:=pdlistfirst;        while p<>nil do         begin           if (p^.def.maxparacount=0) and              is_boolean(p^.def.rettype.def) then            begin              search_procdef_nopara_boolret:=p^.def;              break;            end;           p:=p^.next;         end;      end;    function Tprocsym.search_procdef_bytype(pt:Tproctypeoption):Tprocdef;      var        p : pprocdeflist;      begin        search_procdef_bytype:=nil;        p:=pdlistfirst;        while p<>nil do         begin           if p^.def.proctypeoption=pt then            begin              search_procdef_bytype:=p^.def;              break;            end;           p:=p^.next;         end;      end;    function Tprocsym.search_procdef_bypara(para:tlist;retdef:tdef;                                            cpoptions:tcompare_paras_options):Tprocdef;      var        pd : pprocdeflist;        eq : tequaltype;      begin        search_procdef_bypara:=nil;        pd:=pdlistfirst;        while assigned(pd) do         begin           if assigned(retdef) then             eq:=compare_defs(retdef,pd^.def.rettype.def,nothingn)           else             eq:=te_equal;           if (eq>=te_equal) or              ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then            begin              eq:=compare_paras(para,pd^.def.paras,cp_value_equal_const,cpoptions);              if (eq>=te_equal) or                 ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then                begin                  search_procdef_bypara:=pd^.def;                  break;                end;            end;           pd:=pd^.next;         end;      end;    function Tprocsym.search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;      var        pd : pprocdeflist;        eq,besteq : tequaltype;        bestpd : tprocdef;      begin        { This function will return the pprocdef of pprocsym that          is the best match for procvardef. When there are multiple          matches it returns nil.}        search_procdef_byprocvardef:=nil;        bestpd:=nil;        besteq:=te_incompatible;        pd:=pdlistfirst;        while assigned(pd) do         begin           eq:=proc_to_procvar_equal(pd^.def,d);           if eq>=te_equal then            begin              { multiple procvars with the same equal level }              if assigned(bestpd) and                 (besteq=eq) then                exit;              if eq>besteq then               begin                 besteq:=eq;                 bestpd:=pd^.def;               end;            end;           pd:=pd^.next;         end;        search_procdef_byprocvardef:=bestpd;      end;    function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;      var        convtyp : tconverttype;        pd      : pprocdeflist;        bestpd  : tprocdef;        eq      : tequaltype;        hpd     : tprocdef;        i       : byte;      begin        result:=nil;        bestpd:=nil;        besteq:=te_incompatible;        pd:=pdlistfirst;        while assigned(pd) do          begin            if equal_defs(todef,pd^.def.rettype.def) and              { the result type must be always really equal and not an alias,                if you mess with this code, check tw4093 }              ((todef=pd^.def.rettype.def) or               (                 not(df_unique in todef.defoptions) and                 not(df_unique in pd^.def.rettype.def.defoptions)               )              ) then             begin               i:=0;               { ignore vs_hidden parameters }               while (i<pd^.def.paras.count) and                     assigned(pd^.def.paras[i]) and                     (vo_is_hidden_para in tparavarsym(pd^.def.paras[i]).varoptions) do                 inc(i);               if (i<pd^.def.paras.count) and                  assigned(pd^.def.paras[i]) then                begin                  eq:=compare_defs_ext(fromdef,tparavarsym(pd^.def.paras[i]).vartype.def,nothingn,convtyp,hpd,[]);                  { alias? if yes, only l1 choice,                    if you mess with this code, check tw4093 }                  if (eq=te_exact) and                    (fromdef<>tparavarsym(pd^.def.paras[i]).vartype.def) and                    ((df_unique in fromdef.defoptions) or                    (df_unique in tparavarsym(pd^.def.paras[i]).vartype.def.defoptions)) then                    eq:=te_convert_l1;                  if eq=te_exact then                   begin                     besteq:=eq;                     result:=pd^.def;                     exit;                   end;                  if eq>besteq then                   begin                     bestpd:=pd^.def;                     besteq:=eq;                   end;                end;             end;            pd:=pd^.next;          end;        result:=bestpd;      end;    function tprocsym.write_references(ppufile:tcompilerppufile;locals:boolean) : boolean;      var        p : pprocdeflist;      begin         write_references:=false;         if not inherited write_references(ppufile,locals) then           exit;         write_references:=true;         p:=pdlistfirst;         while assigned(p) do           begin              if p^.def.owner=owner then                p^.def.write_references(ppufile,locals);              p:=p^.next;           end;      end;    procedure tprocsym.unchain_overload;      var         p,hp : pprocdeflist;      begin         { remove all overloaded procdefs from the           procdeflist that are not in the current symtable }         overloadchecked:=false;         p:=pdlistfirst;         { reset new lists }         pdlistfirst:=nil;         pdlistlast:=nil;         while assigned(p) do           begin              hp:=p^.next;             { only keep the proc definitions:                - are not deref'd (def=nil)                - are in the same symtable as the procsym (for example both                  are in the staticsymtable) }             if (p^.def=nil) or                (p^.def.owner=owner) then                begin                  { keep, add to list }                  if assigned(pdlistlast) then                   begin                     pdlistlast^.next:=p;                     pdlistlast:=p;                   end                  else                   begin                     pdlistfirst:=p;                     pdlistlast:=p;                   end;                  p^.next:=nil;                end              else                begin                  { remove }                  dispose(p);                  dec(procdef_count);                end;              p:=hp;           end;      end;    function tprocsym.is_visible_for_object(currobjdef:tdef;context:tdef):boolean;      var        p : pprocdeflist;      begin        { This procsym is visible, when there is at least          one of the procdefs visible }        result:=false;        p:=pdlistfirst;        while assigned(p) do          begin             if (p^.def.owner=owner) and                p^.def.is_visible_for_object(tobjectdef(currobjdef)) then               begin                 result:=true;                 exit;               end;             p:=p^.next;          end;      end;{$ifdef GDB}    function tprocsym.stabstring : pchar;      begin        internalerror(200111171);        result:=nil;      end;{$endif GDB}{****************************************************************************                                  TERRORSYM****************************************************************************}    constructor terrorsym.create;      begin        inherited create('');        typ:=errorsym;      end;{****************************************************************************                                TPROPERTYSYM****************************************************************************}    constructor tpropertysym.create(const n : string);      begin         inherited create(n);         typ:=propertysym;         propoptions:=[];         index:=0;         default:=0;         proptype.reset;         indextype.reset;         readaccess:=tsymlist.create;         writeaccess:=tsymlist.create;         storedaccess:=tsymlist.create;      end;    constructor tpropertysym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=propertysym;         ppufile.getsmallset(propoptions);         if (ppo_is_override in propoptions) then          begin            ppufile.getderef(propoverridenderef);            { we need to have these objects initialized }            readaccess:=tsymlist.create;            writeaccess:=tsymlist.create;            storedaccess:=tsymlist.create;          end         else          begin            ppufile.gettype(proptype);            index:=ppufile.getlongint;            default:=ppufile.getlongint;            ppufile.gettype(indextype);            readaccess:=ppufile.getsymlist;            writeaccess:=ppufile.getsymlist;            storedaccess:=ppufile.getsymlist;          end;      end;    destructor tpropertysym.destroy;      begin         readaccess.free;         writeaccess.free;         storedaccess.free;         inherited destroy;      end;    function tpropertysym.gettypedef:tdef;      begin        gettypedef:=proptype.def;      end;    procedure tpropertysym.buildderef;      begin        if (ppo_is_override in propoptions) then         begin           propoverridenderef.build(propoverriden);         end        else         begin           proptype.buildderef;           indextype.buildderef;           readaccess.buildderef;           writeaccess.buildderef;           storedaccess.buildderef;         end;      end;    procedure tpropertysym.deref;      begin        if (ppo_is_override in propoptions) then         begin           propoverriden:=tpropertysym(propoverridenderef.resolve);           dooverride(propoverriden);         end        else         begin           proptype.resolve;           indextype.resolve;           readaccess.resolve;           writeaccess.resolve;           storedaccess.resolve;         end;      end;    function tpropertysym.getsize : longint;      begin         getsize:=0;      end;    procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);      begin        inherited ppuwrite(ppufile);        ppufile.putsmallset(propoptions);        if (ppo_is_override in propoptions) then         ppufile.putderef(propoverridenderef)        else         begin           ppufile.puttype(proptype);           ppufile.putlongint(index);           ppufile.putlongint(default);           ppufile.puttype(indextype);           ppufile.putsymlist(readaccess);           ppufile.putsymlist(writeaccess);           ppufile.putsymlist(storedaccess);         end;        ppufile.writeentry(ibpropertysym);      end;    procedure tpropertysym.dooverride(overriden:tpropertysym);      begin        propoverriden:=overriden;        proptype:=overriden.proptype;        propoptions:=overriden.propoptions+[ppo_is_override];        index:=overriden.index;        default:=overriden.default;        indextype:=overriden.indextype;        readaccess.free;        readaccess:=overriden.readaccess.getcopy;        writeaccess.free;        writeaccess:=overriden.writeaccess.getcopy;        storedaccess.free;        storedaccess:=overriden.storedaccess.getcopy;      end;{****************************************************************************                            TABSTRACTVARSYM****************************************************************************}    constructor tabstractvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);      begin         inherited create(n);         vartype:=tt;         varspez:=vsp;         varstate:=vs_declared;         varoptions:=vopts;      end;    constructor tabstractvarsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         varstate:=vs_used;         varspez:=tvarspez(ppufile.getbyte);         varregable:=tvarregable(ppufile.getbyte);         ppufile.gettype(_vartype);         ppufile.getsmallset(varoptions);      end;    destructor tabstractvarsym.destroy;      begin        if assigned(notifications) then          notifications.destroy;        inherited destroy;      end;    procedure tabstractvarsym.buildderef;      begin        vartype.buildderef;      end;    procedure tabstractvarsym.deref;      begin        vartype.resolve;      end;    procedure tabstractvarsym.ppuwrite(ppufile:tcompilerppufile);      var        oldintfcrc : boolean;      begin         inherited ppuwrite(ppufile);         ppufile.putbyte(byte(varspez));         oldintfcrc:=ppufile.do_crc;         ppufile.do_crc:=false;         ppufile.putbyte(byte(varregable));         ppufile.do_crc:=oldintfcrc;         ppufile.puttype(vartype);         ppufile.putsmallset(varoptions);      end;    function tabstractvarsym.getsize : longint;      begin        if assigned(vartype.def) and           ((vartype.def.deftype<>arraydef) or            tarraydef(vartype.def).isDynamicArray or            (tarraydef(vartype.def).highrange>=tarraydef(vartype.def).lowrange)) then          result:=vartype.def.size        else          result:=0;      end;    function tabstractvarsym.is_regvar:boolean;      begin        { Register variables are not allowed in the following cases:           - regvars are disabled           - exceptions are used (after an exception is raised the contents of the               registers is not valid anymore)           - it has a local copy           - the value needs to be in memory (i.e. reference counted) }        result:=(cs_regvars in aktglobalswitches) and                not(pi_has_assembler_block in current_procinfo.flags) and                not(pi_uses_exceptions in current_procinfo.flags) and                not(vo_has_local_copy in varoptions) and                (varregable<>vr_none);      end;    procedure tabstractvarsym.trigger_notifications(what:Tnotification_flag);    var n:Tnotification;    begin        if assigned(notifications) then          begin            n:=Tnotification(notifications.first);            while assigned(n) do              begin                if what in n.flags then                  n.callback(what,self);                n:=Tnotification(n.next);              end;          end;    end;    function Tabstractvarsym.register_notification(flags:Tnotification_flags;callback:                                           Tnotification_callback):cardinal;    var n:Tnotification;    begin      if not assigned(notifications) then        notifications:=Tlinkedlist.create;      n:=Tnotification.create(flags,callback);      register_notification:=n.id;      notifications.concat(n);    end;    procedure Tabstractvarsym.unregister_notification(id:cardinal);    var n:Tnotification;    begin      if not assigned(notifications) then        internalerror(200212311)      else        begin            n:=Tnotification(notifications.first);            while assigned(n) do              begin                if n.id=id then                  begin                    notifications.remove(n);                    n.destroy;                    exit;                  end;                n:=Tnotification(n.next);              end;            internalerror(200212311)        end;    end;    procedure tabstractvarsym.setvartype(const newtype: ttype);      begin        _vartype := newtype;         { can we load the value into a register ? }        if not assigned(owner) or           (owner.symtabletype in [localsymtable,parasymtable]) or           (            (owner.symtabletype=staticsymtable) and            not(cs_create_pic in aktmoduleswitches)           ) then          begin            if tstoreddef(vartype.def).is_intregable then              varregable:=vr_intreg            else{$warning TODO: no fpu regvar in staticsymtable yet, need initialization with 0}              if (                  not assigned(owner) or                  (owner.symtabletype<>staticsymtable)                 ) and                 tstoreddef(vartype.def).is_fpuregable then                varregable:=vr_fpureg;          end;      end;{****************************************************************************                               TFIELDVARSYM****************************************************************************}    constructor tfieldvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);      begin         inherited create(n,vsp,tt,vopts);         typ:=fieldvarsym;         fieldoffset:=0;      end;    constructor tfieldvarsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=fieldvarsym;         fieldoffset:=ppufile.getaint;      end;    procedure tfieldvarsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.putaint(fieldoffset);         ppufile.writeentry(ibfieldvarsym);      end;{$ifdef GDB}    function tfieldvarsym.stabstring:Pchar;    var      st : string;    begin      stabstring:=nil;      case owner.symtabletype of        objectsymtable :          begin            if (sp_static in symoptions) then              begin                st:=tstoreddef(vartype.def).numberstring;                if (cs_gdb_gsym in aktglobalswitches) then                  st:='G'+st                else                  st:='S'+st;                stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}',[st]);              end;          end;      end;    end;{$endif GDB}{****************************************************************************                        TABSTRACTNORMALVARSYM****************************************************************************}    constructor tabstractnormalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);      begin         inherited create(n,vsp,tt,vopts);         fillchar(localloc,sizeof(localloc),0);         defaultconstsym:=nil;      end;    constructor tabstractnormalvarsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         fillchar(localloc,sizeof(localloc),0);         ppufile.getderef(defaultconstsymderef);      end;    procedure tabstractnormalvarsym.buildderef;      begin        inherited buildderef;        defaultconstsymderef.build(defaultconstsym);      end;    procedure tabstractnormalvarsym.deref;      begin        inherited deref;        defaultconstsym:=tsym(defaultconstsymderef.resolve);      end;    procedure tabstractnormalvarsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.putderef(defaultconstsymderef);      end;{****************************************************************************                             TGLOBALVARSYM****************************************************************************}    constructor tglobalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);      begin         inherited create(n,vsp,tt,vopts);         typ:=globalvarsym;         _mangledname:=nil;      end;    constructor tglobalvarsym.create_dll(const n : string;vsp:tvarspez;const tt : ttype);      begin         tglobalvarsym(self).create(n,vsp,tt,[vo_is_dll_var]);      end;    constructor tglobalvarsym.create_C(const n,mangled : string;vsp:tvarspez;const tt : ttype);      begin         tglobalvarsym(self).create(n,vsp,tt,[]);         set_mangledname(mangled);      end;    constructor tglobalvarsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=globalvarsym;         if vo_has_mangledname in varoptions then           _mangledname:=stringdup(ppufile.getstring)         else           _mangledname:=nil;      end;    destructor tglobalvarsym.destroy;      begin        if assigned(_mangledname) then          begin{$ifdef MEMDEBUG}            memmanglednames.start;{$endif MEMDEBUG}            stringdispose(_mangledname);{$ifdef MEMDEBUG}            memmanglednames.stop;{$endif MEMDEBUG}          end;        inherited destroy;      end;    procedure tglobalvarsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         if vo_has_mangledname in varoptions then           ppufile.putstring(_mangledname^);         ppufile.writeentry(ibglobalvarsym);      end;    function tglobalvarsym.mangledname:string;      begin        if not assigned(_mangledname) then          begin      {$ifdef compress}            _mangledname:=stringdup(minilzw_encode(make_mangledname('U',owner,name)));      {$else}           _mangledname:=stringdup(make_mangledname('U',owner,name));      {$endif}          end;        result:=_mangledname^;      end;    procedure tglobalvarsym.set_mangledname(const s:string);      begin        stringdispose(_mangledname);      {$ifdef compress}        _mangledname:=stringdup(minilzw_encode(s));      {$else}        _mangledname:=stringdup(s);      {$endif}        include(varoptions,vo_has_mangledname);      end;{$ifdef GDB}    function Tglobalvarsym.stabstring:Pchar;    var st:string;        threadvaroffset:string;        regidx:Tregisterindex;    begin      result:=nil;      st:=tstoreddef(vartype.def).numberstring;      case localloc.loc of        LOC_REGISTER,        LOC_CREGISTER,        LOC_MMREGISTER,        LOC_CMMREGISTER,        LOC_FPUREGISTER,        LOC_CFPUREGISTER :          begin            regidx:=findreg_by_number(localloc.register);            { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }            { this is the register order for GDB}            if regidx<>0 then              stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);          end;        else          begin            if (vo_is_thread_var in varoptions) then              threadvaroffset:='+'+tostr(sizeof(aint))            else              threadvaroffset:='';            { Here we used S instead of              because with G GDB doesn't look at the address field              but searches the same name or with a leading underscore              but these names don't exist in pascal !}            if (cs_gdb_gsym in aktglobalswitches) then              st:='G'+st            else              st:='S'+st;            stabstring:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);          end;      end;    end;{$endif GDB}{****************************************************************************                               TLOCALVARSYM****************************************************************************}    constructor tlocalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);      begin         inherited create(n,vsp,tt,vopts);         typ:=localvarsym;      end;    constructor tlocalvarsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=localvarsym;      end;    procedure tlocalvarsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.writeentry(iblocalvarsym);      end;{$ifdef GDB}    function tlocalvarsym.stabstring:Pchar;    var st:string;        regidx:Tregisterindex;    begin      stabstring:=nil;      { There is no space allocated for not referenced locals }      if (owner.symtabletype=localsymtable) and (refs=0) then        exit;      st:=tstoreddef(vartype.def).numberstring;      case localloc.loc of        LOC_REGISTER,        LOC_CREGISTER,        LOC_MMREGISTER,        LOC_CMMREGISTER,        LOC_FPUREGISTER,        LOC_CFPUREGISTER :          begin            regidx:=findreg_by_number(localloc.register);            { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }            { this is the register order for GDB}            if regidx<>0 then              stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);          end;        LOC_REFERENCE :          { offset to ebp => will not work if the framepointer is esp            so some optimizing will make things harder to debug }          stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])        else          internalerror(2003091814);      end;    end;{$endif GDB}{****************************************************************************                              TPARAVARSYM****************************************************************************}    constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);      begin         inherited create(n,vsp,tt,vopts);         typ:=paravarsym;         paranr:=nr;         paraloc[calleeside].init;         paraloc[callerside].init;      end;    destructor tparavarsym.destroy;      begin        paraloc[calleeside].done;        paraloc[callerside].done;        inherited destroy;      end;    constructor tparavarsym.ppuload(ppufile:tcompilerppufile);      var        b : byte;      begin         inherited ppuload(ppufile);         paranr:=ppufile.getword;         paraloc[calleeside].init;         paraloc[callerside].init;         if vo_has_explicit_paraloc in varoptions then           begin             b:=ppufile.getbyte;             if b<>sizeof(paraloc[callerside].location^) then               internalerror(200411154);             ppufile.getdata(paraloc[callerside].add_location^,sizeof(paraloc[callerside].location^));             paraloc[callerside].size:=paraloc[callerside].location^.size;             paraloc[callerside].intsize:=tcgsize2size[paraloc[callerside].size];           end;         typ:=paravarsym;      end;    procedure tparavarsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.putword(paranr);         if vo_has_explicit_paraloc in varoptions then           begin             paraloc[callerside].check_simple_location;             ppufile.putbyte(sizeof(paraloc[callerside].location^));             ppufile.putdata(paraloc[callerside].location^,sizeof(paraloc[callerside].location^));           end;         ppufile.writeentry(ibparavarsym);      end;{$ifdef GDB}    function tparavarsym.stabstring:Pchar;    var st:string;        regidx:Tregisterindex;        c:char;    begin      result:=nil;      { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }      { while stabs aren't adapted for regvars yet                             }      if (vo_is_self in varoptions) then        begin          case localloc.loc of            LOC_REGISTER,            LOC_CREGISTER:              regidx:=findreg_by_number(localloc.register);            LOC_REFERENCE: ;            else              internalerror(2003091815);          end;          if (po_classmethod in current_procinfo.procdef.procoptions) or             (po_staticmethod in current_procinfo.procdef.procoptions) then            begin              if (localloc.loc=LOC_REFERENCE) then                stabstring:=stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2',                  [Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)]);(*            else                stabstring:=stabstr_evaluate('"pvmt:r$1",${N_RSYM},0,0,$2',                  [Tstoreddef(pvmttype.def).numberstring,tostr(regstabs_table[regidx])]) *)              end          else            begin              if not(is_class(current_procinfo.procdef._class)) then                c:='v'              else                c:='p';              if (localloc.loc=LOC_REFERENCE) then                stabstring:=stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2',                      [c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)]);(*            else                stabstring:=stabstr_evaluate('"$$t:r$1",${N_RSYM},0,0,$2',                      [c+current_procinfo.procdef._class.numberstring,tostr(regstabs_table[regidx])]); *)            end;        end      else        begin          st:=tstoreddef(vartype.def).numberstring;          if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and             not(vo_has_local_copy in varoptions) and             not is_open_string(vartype.def) then            st := 'v'+st { should be 'i' but 'i' doesn't work }          else            st := 'p'+st;          case localloc.loc of            LOC_REGISTER,            LOC_CREGISTER,            LOC_MMREGISTER,            LOC_CMMREGISTER,            LOC_FPUREGISTER,            LOC_CFPUREGISTER :              begin                regidx:=findreg_by_number(localloc.register);                { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }                { this is the register order for GDB}                if regidx<>0 then                  stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(longint(regstabs_table[regidx]))]);              end;            LOC_REFERENCE :              { offset to ebp => will not work if the framepointer is esp                so some optimizing will make things harder to debug }              stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])            else              internalerror(2003091814);          end;        end;    end;{$endif GDB}{****************************************************************************                               TABSOLUTEVARSYM****************************************************************************}    constructor tabsolutevarsym.create(const n : string;const tt : ttype);      begin        inherited create(n,vs_value,tt,[]);        typ:=absolutevarsym;        ref:=nil;      end;    constructor tabsolutevarsym.create_ref(const n : string;const tt : ttype;_ref:tsymlist);      begin        inherited create(n,vs_value,tt,[]);        typ:=absolutevarsym;        ref:=_ref;      end;    destructor tabsolutevarsym.destroy;      begin        if assigned(ref) then          ref.free;        inherited destroy;      end;    constructor tabsolutevarsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=absolutevarsym;         ref:=nil;         asmname:=nil;         abstyp:=absolutetyp(ppufile.getbyte);{$ifdef i386}         absseg:=false;{$endif i386}         case abstyp of           tovar :             ref:=ppufile.getsymlist;           toasm :             asmname:=stringdup(ppufile.getstring);           toaddr :             begin               addroffset:=ppufile.getaint;{$ifdef i386}               absseg:=boolean(ppufile.getbyte);{$endif i386}             end;         end;      end;    procedure tabsolutevarsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.putbyte(byte(abstyp));         case abstyp of           tovar :             ppufile.putsymlist(ref);           toasm :             ppufile.putstring(asmname^);           toaddr :             begin               ppufile.putaint(addroffset);{$ifdef i386}               ppufile.putbyte(byte(absseg));{$endif i386}             end;         end;         ppufile.writeentry(ibabsolutevarsym);      end;    procedure tabsolutevarsym.buildderef;      begin        inherited buildderef;        if (abstyp=tovar) then          ref.buildderef;      end;    procedure tabsolutevarsym.deref;      begin         inherited deref;         { own absolute deref }         if (abstyp=tovar) then           ref.resolve;      end;    function tabsolutevarsym.mangledname : string;      begin         case abstyp of           toasm :             mangledname:=asmname^;           toaddr :             mangledname:='$'+tostr(addroffset);           else             internalerror(200411061);         end;      end;{$ifdef GDB}    function tabsolutevarsym.stabstring:Pchar;      begin        stabstring:=nil;      end;{$endif GDB}{****************************************************************************                             TTYPEDCONSTSYM*****************************************************************************}    constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);      begin         inherited create(n);         typ:=typedconstsym;         typedconsttype.setdef(p);         is_writable:=writable;      end;    constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);      begin         inherited create(n);         typ:=typedconstsym;         typedconsttype:=tt;         is_writable:=writable;      end;    constructor ttypedconstsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=typedconstsym;         ppufile.gettype(typedconsttype);         is_writable:=boolean(ppufile.getbyte);      end;    destructor ttypedconstsym.destroy;      begin        if assigned(_mangledname) then          begin{$ifdef MEMDEBUG}            memmanglednames.start;{$endif MEMDEBUG}            stringdispose(_mangledname);{$ifdef MEMDEBUG}            memmanglednames.stop;{$endif MEMDEBUG}          end;         inherited destroy;      end;    function ttypedconstsym.mangledname:string;      begin        if not assigned(_mangledname) then          begin      {$ifdef compress}            _mangledname:=stringdup(make_mangledname('TC',owner,name));      {$else}            _mangledname:=stringdup(make_mangledname('TC',owner,name));      {$endif}          end;        result:=_mangledname^;      end;    function ttypedconstsym.getsize : longint;      begin        if assigned(typedconsttype.def) then         getsize:=typedconsttype.def.size        else         getsize:=0;      end;    procedure ttypedconstsym.buildderef;      begin        typedconsttype.buildderef;      end;    procedure ttypedconstsym.deref;      begin        typedconsttype.resolve;      end;    procedure ttypedconstsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.puttype(typedconsttype);         ppufile.putbyte(byte(is_writable));         ppufile.writeentry(ibtypedconstsym);      end;{$ifdef GDB}    function ttypedconstsym.stabstring : pchar;    var st:char;    begin      if (cs_gdb_gsym in aktglobalswitches) and (owner.symtabletype=globalsymtable) then        st:='G'      else        st:='S';      stabstring:=stabstr_evaluate('"${name}:$1$2",${N_STSYM},0,${line},${mangledname}',                  [st,Tstoreddef(typedconsttype.def).numberstring]);    end;{$endif GDB}{****************************************************************************                                  TCONSTSYM****************************************************************************}    constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);      begin         inherited create(n);         fillchar(value, sizeof(value), #0);         typ:=constsym;         consttyp:=t;         value.valueord:=v;         ResStrIndex:=0;         consttype:=tt;      end;    constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);      begin         inherited create(n);         fillchar(value, sizeof(value), #0);         typ:=constsym;         consttyp:=t;         value.valueordptr:=v;         ResStrIndex:=0;         consttype:=tt;      end;    constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);      begin         inherited create(n);         fillchar(value, sizeof(value), #0);         typ:=constsym;         consttyp:=t;         value.valueptr:=v;         ResStrIndex:=0;         consttype:=tt;      end;    constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);      begin         inherited create(n);         fillchar(value, sizeof(value), #0);         typ:=constsym;         consttyp:=t;         value.valueptr:=str;         consttype.reset;         value.len:=l;         if t=constresourcestring then           ResStrIndex:=ResourceStrings.Register(name,pchar(value.valueptr),value.len);      end;    constructor tconstsym.create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);      begin         inherited create(n);         fillchar(value, sizeof(value), #0);         typ:=constsym;         consttyp:=t;         pcompilerwidestring(value.valueptr):=pw;         consttype.reset;         value.len:=getlengthwidestring(pw);      end;    constructor tconstsym.ppuload(ppufile:tcompilerppufile);      var         pd : pbestreal;         ps : pnormalset;         pc : pchar;         pw : pcompilerwidestring;      begin         inherited ppuload(ppufile);         typ:=constsym;         consttype.reset;         consttyp:=tconsttyp(ppufile.getbyte);         fillchar(value, sizeof(value), #0);         case consttyp of           constord :             begin               ppufile.gettype(consttype);               value.valueord:=ppufile.getexprint;             end;           constpointer :             begin               ppufile.gettype(consttype);               value.valueordptr:=ppufile.getptruint;             end;           constwstring :             begin               initwidestring(pw);               setlengthwidestring(pw,ppufile.getlongint);               ppufile.getdata(pw^.data,pw^.len*sizeof(tcompilerwidechar));               pcompilerwidestring(value.valueptr):=pw;             end;           conststring,           constresourcestring :             begin               value.len:=ppufile.getlongint;               getmem(pc,value.len+1);               ppufile.getdata(pc^,value.len);               if consttyp=constresourcestring then                 ResStrIndex:=ppufile.getlongint;               value.valueptr:=pc;             end;           constreal :             begin               new(pd);               pd^:=ppufile.getreal;               value.valueptr:=pd;             end;           constset :             begin               ppufile.gettype(consttype);               new(ps);               ppufile.getnormalset(ps^);               value.valueptr:=ps;             end;           constguid :             begin               new(pguid(value.valueptr));               ppufile.getdata(value.valueptr^,sizeof(tguid));             end;           constnil : ;           else             Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));         end;      end;    destructor tconstsym.destroy;      begin        case consttyp of          conststring,          constresourcestring :            freemem(pchar(value.valueptr),value.len+1);          constwstring :            donewidestring(pcompilerwidestring(value.valueptr));          constreal :            dispose(pbestreal(value.valueptr));          constset :            dispose(pnormalset(value.valueptr));          constguid :            dispose(pguid(value.valueptr));        end;        inherited destroy;      end;    procedure tconstsym.buildderef;      begin        if consttyp in [constord,constpointer,constset] then         consttype.buildderef;      end;    procedure tconstsym.deref;      begin        if consttyp in [constord,constpointer,constset] then         consttype.resolve;      end;    procedure tconstsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.putbyte(byte(consttyp));         case consttyp of           constnil : ;           constord :             begin               ppufile.puttype(consttype);               ppufile.putexprint(value.valueord);             end;           constpointer :             begin               ppufile.puttype(consttype);               ppufile.putptruint(value.valueordptr);             end;           constwstring :             begin               ppufile.putlongint(getlengthwidestring(pcompilerwidestring(value.valueptr)));               ppufile.putdata(pcompilerwidestring(value.valueptr)^.data,pcompilerwidestring(value.valueptr)^.len*sizeof(tcompilerwidechar));             end;           conststring,           constresourcestring :             begin               ppufile.putlongint(value.len);               ppufile.putdata(pchar(value.valueptr)^,value.len);               if consttyp=constresourcestring then                 ppufile.putlongint(ResStrIndex);             end;           constreal :             ppufile.putreal(pbestreal(value.valueptr)^);           constset :             begin               ppufile.puttype(consttype);               ppufile.putnormalset(value.valueptr^);             end;           constguid :             ppufile.putdata(value.valueptr^,sizeof(tguid));         else           internalerror(13);         end;        ppufile.writeentry(ibconstsym);      end;{$ifdef GDB}    function Tconstsym.stabstring:Pchar;    var st : string;    begin      {even GDB v4.16 only now 'i' 'r' and 'e' !!!}      case consttyp of        conststring:          st:='s'''+backspace_quote(octal_quote(strpas(pchar(value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+'''';        constord:          st:='i'+tostr(value.valueord);        constpointer:          st:='i'+tostr(value.valueordptr);        constreal:          begin            system.str(pbestreal(value.valueptr)^,st);            st := 'r'+st;          end;        { if we don't know just put zero !! }        else st:='i0';          {***SETCONST}          {constset:;}    {*** I don't know what to do with a set.}          { sets are not recognized by GDB}          {***}      end;      { valgrind does not support constants }      if cs_gdb_valgrind in aktglobalswitches then        stabstring:=nil      else        stabstring:=stabstr_evaluate('"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);    end;{$endif GDB}{****************************************************************************                                  TENUMSYM****************************************************************************}    constructor tenumsym.create(const n : string;def : tenumdef;v : longint);      begin         inherited create(n);         typ:=enumsym;         definition:=def;         value:=v;         { First entry? Then we need to set the minval }         if def.firstenum=nil then           begin             if v>0 then               def.has_jumps:=true;             def.setmin(v);             def.setmax(v);           end         else           begin             { check for jumps }             if v>def.max+1 then              def.has_jumps:=true;             { update low and high }             if def.min>v then               def.setmin(v);             if def.max<v then               def.setmax(v);           end;         order;      end;    constructor tenumsym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=enumsym;         ppufile.getderef(definitionderef);         value:=ppufile.getlongint;         nextenum := Nil;      end;    procedure tenumsym.buildderef;      begin         definitionderef.build(definition);      end;    procedure tenumsym.deref;      begin         definition:=tenumdef(definitionderef.resolve);         order;      end;   procedure tenumsym.order;      var         sym : tenumsym;      begin         sym := tenumsym(definition.firstenum);         if sym = nil then          begin            definition.firstenum := self;            nextenum := nil;            exit;          end;         { reorder the symbols in increasing value }         if value < sym.value then          begin            nextenum := sym;            definition.firstenum := self;          end         else          begin            while (sym.value <= value) and assigned(sym.nextenum) do             sym := sym.nextenum;            nextenum := sym.nextenum;            sym.nextenum := self;          end;      end;    procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.putderef(definitionderef);         ppufile.putlongint(value);         ppufile.writeentry(ibenumsym);      end;{****************************************************************************                                  TTYPESYM****************************************************************************}    constructor ttypesym.create(const n : string;const tt : ttype);      begin         inherited create(n);         typ:=typesym;         restype:=tt;        { register the typesym for the definition }        if assigned(restype.def) and           (restype.def.deftype<>errordef) and           not(assigned(restype.def.typesym)) then         restype.def.typesym:=self;      end;    constructor ttypesym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=typesym;         ppufile.gettype(restype);      end;    function  ttypesym.gettypedef:tdef;      begin        gettypedef:=restype.def;      end;    procedure ttypesym.buildderef;      begin         restype.buildderef;      end;    procedure ttypesym.deref;      begin         restype.resolve;      end;    procedure ttypesym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.puttype(restype);         ppufile.writeentry(ibtypesym);      end;    procedure ttypesym.load_references(ppufile:tcompilerppufile;locals:boolean);      begin         inherited load_references(ppufile,locals);         if (restype.def.deftype=recorddef) then           tstoredsymtable(trecorddef(restype.def).symtable).load_references(ppufile,locals);         if (restype.def.deftype=objectdef) then           tstoredsymtable(tobjectdef(restype.def).symtable).load_references(ppufile,locals);      end;    function ttypesym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;      var        d : tderef;      begin        d.reset;        if not inherited write_references(ppufile,locals) then         begin         { write address of this symbol if record or object           even if no real refs are there           because we need it for the symtable }           if (restype.def.deftype in [recorddef,objectdef]) then            begin              d.build(self);              ppufile.putderef(d);              ppufile.writeentry(ibsymref);            end;         end;        write_references:=true;        if (restype.def.deftype=recorddef) then           tstoredsymtable(trecorddef(restype.def).symtable).write_references(ppufile,locals);        if (restype.def.deftype=objectdef) then           tstoredsymtable(tobjectdef(restype.def).symtable).write_references(ppufile,locals);      end;{$ifdef GDB}    function ttypesym.stabstring : pchar;    var stabchar:string[2];    begin      stabstring:=nil;      if restype.def<>nil then        begin          if restype.def.deftype in tagtypes then            stabchar:='Tt'          else            stabchar:='t';          stabstring:=stabstr_evaluate('"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,tstoreddef(restype.def).numberstring]);        end;    end;{$endif GDB}{****************************************************************************                                  TSYSSYM****************************************************************************}    constructor tsyssym.create(const n : string;l : longint);      begin         inherited create(n);         typ:=syssym;         number:=l;      end;    constructor tsyssym.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=syssym;         number:=ppufile.getlongint;      end;    destructor tsyssym.destroy;      begin        inherited destroy;      end;    procedure tsyssym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.putlongint(number);         ppufile.writeentry(ibsyssym);      end;{*****************************************************************************                                 TMacro*****************************************************************************}    constructor tmacro.create(const n : string);      begin         inherited create(n);         typ:= macrosym;         owner:= nil;         defined:=false;         is_used:=false;         is_compiler_var:= false;         buftext:=nil;         buflen:=0;      end;    constructor tmacro.ppuload(ppufile:tcompilerppufile);      begin         inherited ppuload(ppufile);         typ:=macrosym;         name:=ppufile.getstring;         defined:=boolean(ppufile.getbyte);         is_compiler_var:=boolean(ppufile.getbyte);         is_used:=false;         buflen:= ppufile.getlongint;         if buflen > 0 then           begin             getmem(buftext, buflen);             ppufile.getdata(buftext^, buflen)           end         else           buftext:=nil;      end;    destructor tmacro.destroy;      begin         if assigned(buftext) then           freemem(buftext,buflen);         inherited destroy;      end;    procedure tmacro.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.putstring(name);         ppufile.putbyte(byte(defined));         ppufile.putbyte(byte(is_compiler_var));         ppufile.putlongint(buflen);         if buflen > 0 then           ppufile.putdata(buftext^,buflen);         ppufile.writeentry(ibmacrosym);      end;{****************************************************************************                                  TRTTISYM****************************************************************************}    constructor trttisym.create(const n:string;rt:trttitype);      const        prefix : array[trttitype] of string[5]=('$rtti','$init');      begin        inherited create(prefix[rt]+n);        include(symoptions,sp_internal);        typ:=rttisym;        lab:=nil;        rttityp:=rt;      end;    destructor trttisym.destroy;      begin        if assigned(_mangledname) then          begin{$ifdef MEMDEBUG}            memmanglednames.start;{$endif MEMDEBUG}            stringdispose(_mangledname);{$ifdef MEMDEBUG}            memmanglednames.stop;{$endif MEMDEBUG}          end;        inherited destroy;      end;    constructor trttisym.ppuload(ppufile:tcompilerppufile);      begin        inherited ppuload(ppufile);        typ:=rttisym;        lab:=nil;        rttityp:=trttitype(ppufile.getbyte);      end;    procedure trttisym.ppuwrite(ppufile:tcompilerppufile);      begin         inherited ppuwrite(ppufile);         ppufile.putbyte(byte(rttityp));         ppufile.writeentry(ibrttisym);      end;    function trttisym.mangledname : string;      const        prefix : array[trttitype] of string[5]=('RTTI_','INIT_');      begin        if not assigned(_mangledname) then          _mangledname:=stringdup(make_mangledname(prefix[rttityp],owner,Copy(name,5,255)));        result:=_mangledname^;      end;    function trttisym.get_label:tasmsymbol;      begin        { the label is always a global label }        if not assigned(lab) then         lab:=objectlibrary.newasmsymbol(mangledname,AB_EXTERNAL,AT_DATA);        get_label:=lab;      end;end.
 |