{ $Id$ Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller Implementation for the symbols types of the symtable This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. **************************************************************************** } {**************************************************************************** TSYM (base for all symtypes) ****************************************************************************} constructor tsym.init(const n : string); begin left:=nil; right:=nil; setname(n); typ:=abstractsym; properties:=current_object_option; {$ifdef GDB} isstabwritten := false; {$endif GDB} fileinfo:=tokenpos; {$ifdef UseBrowser} defref:=nil; lastwritten:=nil; refcount:=0; if (cs_browser in aktmoduleswitches) and make_ref then begin defref:=new(pref,init(defref,@tokenpos)); inc(refcount); end; lastref:=defref; {$endif UseBrowser} end; constructor tsym.load; begin left:=nil; right:=nil; setname(readstring); typ:=abstractsym; fillchar(fileinfo,sizeof(fileinfo),0); if object_options then properties:=symprop(readbyte) else properties:=sp_public; {$ifdef UseBrowser} lastref:=nil; defref:=nil; lastwritten:=nil; refcount:=0; {$endif UseBrowser} {$ifdef GDB} isstabwritten := false; {$endif GDB} end; {$ifdef UseBrowser} procedure tsym.load_references; var pos : tfileposinfo; move_last : boolean; begin move_last:=lastwritten=lastref; while (not current_ppu^.endofentry) do begin readposinfo(pos); inc(refcount); lastref:=new(pref,init(lastref,@pos)); lastref^.is_written:=true; if refcount=1 then defref:=lastref; end; if move_last then lastwritten:=lastref; end; { big problem here : wrong refs were written because of interface parsing of other units PM moduleindex must be checked !! } function tsym.write_references : boolean; var ref : pref; symref_written,move_last : boolean; begin write_references:=false; if lastwritten=lastref then exit; { should we update lastref } move_last:=true; symref_written:=false; { write symbol refs } if assigned(lastwritten) then ref:=lastwritten else ref:=defref; while assigned(ref) do begin if ref^.moduleindex=current_module^.unit_index then begin { write address to this symbol } if not symref_written then begin writesymref(@self); symref_written:=true; end; writeposinfo(ref^.posinfo); ref^.is_written:=true; if move_last then lastwritten:=ref; end else if not ref^.is_written then move_last:=false else if move_last then lastwritten:=ref; ref:=ref^.nextref; end; if symref_written then current_ppu^.writeentry(ibsymref); write_references:=symref_written; end; procedure tsym.add_to_browserlog; begin if assigned(defref) then begin Browse.AddLog('***'+name+'***'); Browse.AddLogRefs(defref); end; end; {$endif UseBrowser} destructor tsym.done; begin {$ifdef tp} if not(use_big) then {$endif tp} strdispose(_name); {$ifdef UseBrowser} if assigned(defref) then dispose(defref,done); {$endif UseBrowser} if assigned(left) then dispose(left,done); if assigned(right) then dispose(right,done); end; procedure tsym.write; begin writestring(name); if object_options then writebyte(byte(properties)); end; procedure tsym.deref; begin end; function tsym.name : string; {$ifdef tp} var s : string; b : byte; {$endif} begin {$ifdef tp} if use_big then begin symbolstream.seek(longint(_name)); symbolstream.read(b,1); symbolstream.read(s[1],b); s[0]:=chr(b); name:=s; end else {$endif} if assigned(_name) then name:=strpas(_name) else name:=''; end; function tsym.mangledname : string; begin mangledname:=name; end; procedure tsym.setname(const s : string); begin setstring(_name,s); end; { for most symbol types ther is nothing to do at all } procedure tsym.insert_in_data; begin end; {$ifdef GDB} function tsym.stabstring : pchar; begin stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+ tostr(fileinfo.line)+',0'); end; procedure tsym.concatstabto(asmlist : paasmoutput); var stab_str : pchar; begin if not isstabwritten then begin stab_str := stabstring; if asmlist = debuglist then do_count_dbx := true; { count_dbx(stab_str); moved to GDB.PAS } asmlist^.concat(new(pai_stabs,init(stab_str))); isstabwritten:=true; end; end; {$endif GDB} {**************************************************************************** TLABELSYM ****************************************************************************} constructor tlabelsym.init(const n : string; l : plabel); begin inherited init(n); typ:=labelsym; number:=l; number^.is_used:=false; number^.is_set:=true; number^.refcount:=0; defined:=false; end; constructor tlabelsym.load; begin tsym.load; typ:=labelsym; { this is all dummy it is only used for local browsing } number:=nil; defined:=true; end; destructor tlabelsym.done; begin if not(defined) then Message1(sym_e_label_not_defined,name); inherited done; end; function tlabelsym.mangledname : string; begin { this also sets the is_used field } mangledname:=lab2str(number); end; procedure tlabelsym.write; begin if owner^.symtabletype in [unitsymtable,globalsymtable] then Message(sym_e_ill_label_decl) else begin tsym.write; current_ppu^.writeentry(iblabelsym); end; end; {**************************************************************************** TUNITSYM ****************************************************************************} constructor tunitsym.init(const n : string;ref : punitsymtable); var old_make_ref : boolean; begin old_make_ref:=make_ref; make_ref:=false; inherited init(n); make_ref:=old_make_ref; typ:=unitsym; unitsymtable:=ref; prevsym:=ref^.unitsym; ref^.unitsym:=@self; refs:=0; end; constructor tunitsym.load; begin tsym.load; typ:=unitsym; unitsymtable:=punitsymtable(current_module^.globalsymtable); prevsym:=nil; end; destructor tunitsym.done; begin if assigned(unitsymtable) and (unitsymtable^.unitsym=@self) then unitsymtable^.unitsym:=prevsym; inherited done; end; procedure tunitsym.write; begin tsym.write; current_ppu^.writeentry(ibunitsym); end; {$ifdef GDB} procedure tunitsym.concatstabto(asmlist : paasmoutput); begin {Nothing to write to stabs !} end; {$endif GDB} {**************************************************************************** TPROCSYM ****************************************************************************} constructor tprocsym.init(const n : string); begin tsym.init(n); typ:=procsym; definition:=nil; owner:=nil; {$ifdef GDB} is_global := false; {$endif GDB} end; constructor tprocsym.load; begin tsym.load; typ:=procsym; definition:=pprocdef(readdefref); {$ifdef GDB} is_global := false; {$endif GDB} end; destructor tprocsym.done; begin check_forward; tsym.done; end; function tprocsym.mangledname : string; begin mangledname:=definition^.mangledname; end; function tprocsym.demangledname:string; begin demangledname:=name+definition^.demangled_paras; end; procedure tprocsym.write_parameter_lists; var p : pprocdef; begin p:=definition; while assigned(p) do begin { force the error to be printed } Verbose.Message1(sym_b_param_list,name+p^.demangled_paras); p:=p^.nextoverloaded; end; end; procedure tprocsym.check_forward; var pd : pprocdef; oldaktfilepos : tfileposinfo; begin pd:=definition; while assigned(pd) do begin if pd^.forwarddef then begin oldaktfilepos:=aktfilepos; aktfilepos:=fileinfo; if assigned(pd^._class) then Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+demangledparas(pd^.demangled_paras)) else Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras); aktfilepos:=oldaktfilepos; end; pd:=pd^.nextoverloaded; end; end; procedure tprocsym.deref; var t : ttoken; last : pprocdef; begin resolvedef(pdef(definition)); if (definition^.options and pooperator) <> 0 then begin last:=definition; while assigned(last^.nextoverloaded) do last:=last^.nextoverloaded; for t:=first_overloaded to last_overloaded do if (name=overloaded_names[t]) then begin if assigned(overloaded_operators[t]) then last^.nextoverloaded:=overloaded_operators[t]^.definition; overloaded_operators[t]:=@self; end; end; end; procedure tprocsym.write; begin tsym.write; writedefref(pdef(definition)); current_ppu^.writeentry(ibprocsym); end; {$ifdef UseBrowser} procedure tprocsym.load_references; var prdef : pprocdef; begin inherited load_references; prdef:=definition; { take care about operators !! } while assigned(prdef) and (prdef^.owner=definition^.owner) do begin prdef^.load_references; prdef:=prdef^.nextoverloaded; end; end; function tprocsym.write_references : boolean; var prdef : pprocdef; begin write_references:=false; if not inherited write_references then exit; write_references:=true; prdef:=definition; while assigned(prdef) and (prdef^.owner=definition^.owner) do begin prdef^.write_references; prdef:=prdef^.nextoverloaded; end; end; procedure tprocsym.add_to_browserlog; var prdef : pprocdef; begin inherited add_to_browserlog; prdef:=definition; while assigned(prdef) do begin pprocdef(prdef)^.add_to_browserlog; prdef:=pprocdef(prdef)^.nextoverloaded; end; end; {$endif UseBrowser} {$ifdef GDB} function tprocsym.stabstring : pchar; Var RetType : Char; Obj,Info : String; begin obj := name; info := ''; if is_global then RetType := 'F' else RetType := 'f'; if assigned(owner) then begin if (owner^.symtabletype = objectsymtable) then obj := owner^.name^+'__'+name; if (owner^.symtabletype=localsymtable) and assigned(owner^.name) then info := ','+name+','+owner^.name^; end; stabstring :=strpnew('"'+obj+':'+RetType +definition^.retdef^.numberstring+info+'",'+tostr(n_function) +',0,'+ tostr(aktfilepos.line) +','+definition^.mangledname); end; procedure tprocsym.concatstabto(asmlist : paasmoutput); begin if (definition^.options and pointernproc) <> 0 then exit; if not isstabwritten then asmlist^.concat(new(pai_stabs,init(stabstring))); isstabwritten := true; if assigned(definition^.parast) then definition^.parast^.concatstabto(asmlist); if assigned(definition^.localst) then definition^.localst^.concatstabto(asmlist); definition^.is_def_stab_written := true; end; {$endif GDB} {**************************************************************************** TPROGRAMSYM ****************************************************************************} constructor tprogramsym.init(const n : string); begin inherited init(n); typ:=programsym; end; {**************************************************************************** TERRORSYM ****************************************************************************} constructor terrorsym.init; begin inherited init(''); typ:=errorsym; end; {**************************************************************************** TPROPERTYSYM ****************************************************************************} constructor tpropertysym.init(const n : string); begin inherited init(n); typ:=propertysym; options:=0; proptype:=nil; readaccessdef:=nil; writeaccessdef:=nil; readaccesssym:=nil; writeaccesssym:=nil; storedsym:=nil; storeddef:=nil; index:=0; default:=0; end; destructor tpropertysym.done; begin inherited done; end; constructor tpropertysym.load; begin inherited load; typ:=propertysym; proptype:=readdefref; options:=readlong; index:=readlong; default:=readlong; { it's hack ... } readaccesssym:=psym(stringdup(readstring)); writeaccesssym:=psym(stringdup(readstring)); storedsym:=psym(stringdup(readstring)); { now the defs: } readaccessdef:=readdefref; writeaccessdef:=readdefref; storeddef:=readdefref; end; procedure tpropertysym.deref; begin resolvedef(proptype); resolvedef(readaccessdef); resolvedef(writeaccessdef); resolvedef(storeddef); { solve the hack we did in load: } if pstring(readaccesssym)^<>'' then begin srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(readaccesssym)^); if not(assigned(srsym)) then srsym:=generrorsym; end else srsym:=nil; stringdispose(pstring(readaccesssym)); readaccesssym:=srsym; if pstring(writeaccesssym)^<>'' then begin srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(writeaccesssym)^); if not(assigned(srsym)) then srsym:=generrorsym; end else srsym:=nil; stringdispose(pstring(writeaccesssym)); writeaccesssym:=srsym; if pstring(storedsym)^<>'' then begin srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(storedsym)^); if not(assigned(srsym)) then srsym:=generrorsym; end else srsym:=nil; stringdispose(pstring(storedsym)); storedsym:=srsym; end; function tpropertysym.getsize : longint; begin getsize:=0; end; procedure tpropertysym.write; begin tsym.write; writedefref(proptype); writelong(options); writelong(index); writelong(default); if assigned(readaccesssym) then writestring(readaccesssym^.name) else writestring(''); if assigned(writeaccesssym) then writestring(writeaccesssym^.name) else writestring(''); if assigned(storedsym) then writestring(storedsym^.name) else writestring(''); writedefref(readaccessdef); writedefref(writeaccessdef); writedefref(storeddef); current_ppu^.writeentry(ibpropertysym); end; {$ifdef GDB} function tpropertysym.stabstring : pchar; begin { !!!! don't know how to handle } stabstring:=strpnew(''); end; procedure tpropertysym.concatstabto(asmlist : paasmoutput); begin { !!!! don't know how to handle } end; {$endif GDB} {**************************************************************************** TFUNCRETSYM ****************************************************************************} constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo}); begin tsym.init(n); typ:=funcretsym; funcretprocinfo:=approcinfo; funcretdef:=pprocinfo(approcinfo)^.retdef; { address valid for ret in param only } { otherwise set by insert } address:=pprocinfo(approcinfo)^.retoffset; end; {$ifdef GDB} procedure tfuncretsym.concatstabto(asmlist : paasmoutput); begin { Nothing to do here, it is done in genexitcode } end; {$endif GDB} {**************************************************************************** TABSOLUTESYM ****************************************************************************} { constructor tabsolutesym.init(const s : string;p : pdef;newref : psym); begin inherited init(s,p); ref:=newref; typ:=absolutesym; end; } constructor tabsolutesym.load; begin tvarsym.load; typ:=absolutesym; ref:=nil; address:=0; asmname:=nil; abstyp:=absolutetyp(readbyte); absseg:=false; case abstyp of tovar : begin asmname:=stringdup(readstring); ref:=srsym; end; toasm : asmname:=stringdup(readstring); toaddr : address:=readlong; end; end; procedure tabsolutesym.write; begin tsym.write; writebyte(byte(varspez)); if read_member then writelong(address); writedefref(definition); writebyte(byte(abstyp)); case abstyp of tovar : writestring(ref^.name); toasm : writestring(asmname^); toaddr : writelong(address); end; current_ppu^.writeentry(ibabsolutesym); end; procedure tabsolutesym.deref; begin resolvedef(definition); if (abstyp=tovar) and (asmname<>nil) then begin { search previous loaded symtables } getsym(asmname^,false); if not(assigned(srsym)) then getsymonlyin(owner,asmname^); if not(assigned(srsym)) then srsym:=generrorsym; ref:=srsym; stringdispose(asmname); end; end; function tabsolutesym.mangledname : string; begin case abstyp of tovar : mangledname:=ref^.mangledname; toasm : mangledname:=asmname^; toaddr : mangledname:='$'+tostr(address); else internalerror(10002); end; end; procedure tabsolutesym.insert_in_data; begin end; {$ifdef GDB} procedure tabsolutesym.concatstabto(asmlist : paasmoutput); begin { I don't know how to handle this !! } end; {$endif GDB} {**************************************************************************** TVARSYM ****************************************************************************} constructor tvarsym.init(const n : string;p : pdef); begin tsym.init(n); typ:=varsym; definition:=p; _mangledname:=nil; varspez:=vs_value; address:=0; refs:=0; is_valid := 1; var_options:=0; { can we load the value into a register ? } case p^.deftype of pointerdef, enumdef, procvardef : var_options:=var_options or vo_regable; orddef : case porddef(p)^.typ of u8bit,u16bit,u32bit, bool8bit,bool16bit,bool32bit, s8bit,s16bit,s32bit : var_options:=var_options or vo_regable; else var_options:=var_options and not vo_regable; end; else var_options:=var_options and not vo_regable; end; reg:=R_NO; end; constructor tvarsym.load; begin tsym.load; typ:=varsym; _mangledname:=nil; varspez:=tvarspez(readbyte); if read_member then address:=readlong else address:=0; definition:=readdefref; refs := 0; is_valid := 1; { symbols which are load are never candidates for a register } var_options:=0; { was regable:=false; } reg:=R_NO; end; constructor tvarsym.init_C(const n,mangled : string;p : pdef); begin { The tvarsym is necessary for 0.99.5 (PFV) } tvarsym.init(n,p); var_options:=var_options or vo_is_C_var; { C prefix not allways added moved to pdecl PM } _mangledname:=strpnew(mangled); end; constructor tvarsym.load_C; begin { Adding tvarsym removes the warning } tvarsym.load; typ:=varsym; var_options:=readbyte; _mangledname:=strpnew(readstring); end; procedure tvarsym.deref; begin resolvedef(definition); end; procedure tvarsym.write; begin tsym.write; writebyte(byte(varspez)); if read_member then writelong(address); writedefref(definition); if (var_options and vo_is_C_var)<>0 then begin writebyte(var_options); writestring(mangledname); end; if (var_options and vo_is_C_var)<>0 then current_ppu^.writeentry(ibvarsym_C) else current_ppu^.writeentry(ibvarsym); end; function tvarsym.mangledname : string; var prefix : string; begin if assigned(_mangledname) then begin mangledname:=strpas(_mangledname); exit; end; case owner^.symtabletype of staticsymtable : if (cs_smartlink in aktmoduleswitches) then prefix:='_'+owner^.name^+'$$$_' else prefix:='_'; unitsymtable, globalsymtable : prefix:='U_'+owner^.name^+'_'; else Message(sym_e_invalid_call_tvarsymmangledname); end; mangledname:=prefix+name; end; function tvarsym.getsize : longint; begin { only if the definition is set, we could determine the } { size, this is if an error occurs while reading the type } { also used for operator, this allows not to allocate the } { return size twice } if assigned(definition) then begin case varspez of vs_value : begin if is_open_array(definition) then getsize:=sizeof(pointer)+4 else getsize:=definition^.size; end; vs_var : begin { open arrays push also the high valye } if is_open_array(definition) then getsize:=sizeof(pointer)+4 else getsize:=sizeof(pointer); end; vs_const : begin case definition^.deftype of stringdef, recorddef, objectdef, setdef : getsize:=sizeof(pointer); arraydef : begin { open arrays push also the high valye } if (parraydef(definition)^.lowrange=0) and (parraydef(definition)^.highrange=-1) then getsize:=sizeof(pointer)+4 else getsize:=sizeof(pointer); end; else getsize:=definition^.size; end; end; end; end else getsize:=0; end; procedure tvarsym.insert_in_data; var l,modulo : longint; begin if (var_options and vo_is_external)<>0 then exit; { handle static variables of objects especially } if read_member and (owner^.symtabletype=objectsymtable) and ((properties and sp_static)<>0) then begin { the data filed is generated in parser.pas with a tobject_FIELDNAME variable } { this symbol can't be loaded to a register } var_options:=var_options and not vo_regable; end else if not(read_member) then begin { made problems with parameters etc. ! (FK) } { check for instance of an abstract object or class } { if (pvarsym(sym)^.definition^.deftype=objectdef) and ((pobjectdef(pvarsym(sym)^.definition)^.options and oois_abstract)<>0) then Message(sym_e_no_instance_of_abstract_object); } l:=getsize; case owner^.symtabletype of stt_exceptsymtable: { can contain only one symbol, address calculated later } ; localsymtable : begin is_valid := 0; modulo:=owner^.datasize and 3; {$ifdef m68k} { word alignment required for motorola } if (l=1) then l:=2 else {$endif} if (l>=4) and (modulo<>0) then inc(l,4-modulo) else if (l>=2) and ((modulo and 1)<>0) then inc(l,2-(modulo and 1)); inc(owner^.datasize,l); address:=owner^.datasize; end; staticsymtable : begin if (cs_smartlink in aktmoduleswitches) then bsssegment^.concat(new(pai_cut,init)); {$ifdef GDB} if cs_debuginfo in aktmoduleswitches then concatstabto(bsssegment); {$endif GDB} if (cs_smartlink in aktmoduleswitches) or ((var_options and vo_is_c_var)<>0) then bsssegment^.concat(new(pai_datablock,init_global(mangledname,l))) else bsssegment^.concat(new(pai_datablock,init(mangledname,l))); { increase datasize } inc(owner^.datasize,l); { this symbol can't be loaded to a register } var_options:=var_options and not vo_regable; end; globalsymtable : begin if (cs_smartlink in aktmoduleswitches) then bsssegment^.concat(new(pai_cut,init)); {$ifdef GDB} if cs_debuginfo in aktmoduleswitches then concatstabto(bsssegment); {$endif GDB} bsssegment^.concat(new(pai_datablock,init_global(mangledname,l))); inc(owner^.datasize,l); { this symbol can't be loaded to a register } var_options:=var_options and not vo_regable; end; recordsymtable, objectsymtable : begin { this symbol can't be loaded to a register } var_options:=var_options and not vo_regable; { align record and object fields } if (l=1) or (aktpackrecords=1) then begin address:=owner^.datasize; inc(owner^.datasize,l) end else if (l=2) or (aktpackrecords=2) then begin owner^.datasize:=(owner^.datasize+1) and (not 1); address:=owner^.datasize; inc(owner^.datasize,l) end else if (l<=4) or (aktpackrecords=4) then begin owner^.datasize:=(owner^.datasize+3) and (not 3); address:=owner^.datasize; inc(owner^.datasize,l); end else if (l<=8) or (aktpackrecords=8) then begin owner^.datasize:=(owner^.datasize+7) and (not 7); address:=owner^.datasize; inc(owner^.datasize,l); end else if (l<=16) or (aktpackrecords=16) then begin owner^.datasize:=(owner^.datasize+15) and (not 15); address:=owner^.datasize; inc(owner^.datasize,l); end else if (l<=32) or (aktpackrecords=32) then begin owner^.datasize:=(owner^.datasize+31) and (not 31); address:=owner^.datasize; inc(owner^.datasize,l); end; end; parasymtable : begin address:=owner^.datasize; { needs word alignment } if odd(l) then inc(owner^.datasize,l+1) else inc(owner^.datasize,l); end else begin modulo:=owner^.datasize and 3 ; if (l>=4) and (modulo<>0) then inc(owner^.datasize,4-modulo) else if (l>=2) and ((modulo and 1)<>0) then { nice piece of code !! inc(owner^.datasize,2-(datasize and 1)); 2 - (datasize and 1) is allways 1 in this case Florian when will your global stream analyser find this out ?? } inc(owner^.datasize); address:=owner^.datasize; inc(owner^.datasize,l); end; end; end; end; {$ifdef GDB} function tvarsym.stabstring : pchar; var st : char; begin if (owner^.symtabletype = objectsymtable) and ((properties and sp_static)<>0) then begin if use_gsym then st := 'G' else st := 'S'; stabstring := strpnew('"'+owner^.name^+'__'+name+':'+ +definition^.numberstring+'",'+ tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname); end else if (owner^.symtabletype = globalsymtable) or (owner^.symtabletype = unitsymtable) then begin { Here we used S instead of because with G GDB doesn't look at the address field but searches the same name or with a leading underscore but these names don't exist in pascal !} if use_gsym then st := 'G' else st := 'S'; stabstring := strpnew('"'+name+':'+st +definition^.numberstring+'",'+ tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname); end else if owner^.symtabletype = staticsymtable then begin stabstring := strpnew('"'+name+':S' +definition^.numberstring+'",'+ tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname); end else if (owner^.symtabletype=parasymtable) then begin case varspez of vs_value : st := 'p'; vs_var : st := 'v'; vs_const : if dont_copy_const_param(definition) then st := 'v'{ should be 'i' but 'i' doesn't work } else st := 'p'; end; stabstring := strpnew('"'+name+':'+st +definition^.numberstring+'",'+ tostr(N_PSYM)+',0,'+tostr(fileinfo.line)+','+ tostr(address+owner^.call_offset)); {offset to ebp => will not work if the framepointer is esp so some optimizing will make things harder to debug } end else if (owner^.symtabletype=localsymtable) then {$ifdef i386} if reg<>R_NO then begin { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", } { this is the register order for GDB} stabstring:=strpnew('"'+name+':r' +definition^.numberstring+'",'+ tostr(N_RSYM)+',0,'+ tostr(fileinfo.line)+','+tostr(GDB_i386index[reg])); end else {$endif i386} stabstring := strpnew('"'+name+':' +definition^.numberstring+'",'+ tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address)) else stabstring := inherited stabstring; end; procedure tvarsym.concatstabto(asmlist : paasmoutput); {$ifdef i386} var stab_str : pchar; {$endif i386} begin inherited concatstabto(asmlist); {$ifdef i386} if (owner^.symtabletype=parasymtable) and (reg<>R_NO) then begin { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", } { this is the register order for GDB} stab_str:=strpnew('"'+name+':r' +definition^.numberstring+'",'+ tostr(N_RSYM)+',0,'+ tostr(fileinfo.line)+','+tostr(GDB_i386index[reg])); asmlist^.concat(new(pai_stabs,init(stab_str))); end; {$endif i386} end; {$endif GDB} destructor tvarsym.done; begin strdispose(_mangledname); inherited done; end; {**************************************************************************** TTYPEDCONSTSYM *****************************************************************************} constructor ttypedconstsym.init(const n : string;p : pdef); begin tsym.init(n); typ:=typedconstsym; definition:=p; prefix:=stringdup(procprefix); end; constructor ttypedconstsym.load; begin tsym.load; typ:=typedconstsym; definition:=readdefref; prefix:=stringdup(readstring); end; destructor ttypedconstsym.done; begin stringdispose(prefix); tsym.done; end; function ttypedconstsym.mangledname : string; begin mangledname:='TC_'+prefix^+'_'+name; end; procedure ttypedconstsym.deref; begin resolvedef(definition); end; procedure ttypedconstsym.write; begin tsym.write; writedefref(definition); writestring(prefix^); current_ppu^.writeentry(ibtypedconstsym); end; { for most symbol types ther is nothing to do at all } procedure ttypedconstsym.insert_in_data; begin { here there is a problem for ansistrings !! } { we must write the label only after the 12 header bytes (PM) if not is_ansistring(definition) then } { solved, the ansis string is moved to consts (FK) } really_insert_in_data; end; procedure ttypedconstsym.really_insert_in_data; begin if owner^.symtabletype=globalsymtable then begin if (cs_smartlink in aktmoduleswitches) then datasegment^.concat(new(pai_cut,init)); {$ifdef GDB} if cs_debuginfo in aktmoduleswitches then concatstabto(datasegment); {$endif GDB} datasegment^.concat(new(pai_symbol,init_global(mangledname))); end else if owner^.symtabletype<>unitsymtable then begin if (cs_smartlink in aktmoduleswitches) then datasegment^.concat(new(pai_cut,init)); {$ifdef GDB} if cs_debuginfo in aktmoduleswitches then concatstabto(datasegment); {$endif GDB} if (cs_smartlink in aktmoduleswitches) then datasegment^.concat(new(pai_symbol,init_global(mangledname))) else datasegment^.concat(new(pai_symbol,init(mangledname))); end; end; {$ifdef GDB} function ttypedconstsym.stabstring : pchar; var st : char; begin if use_gsym and (owner^.symtabletype in [unitsymtable,globalsymtable]) then st := 'G' else st := 'S'; stabstring := strpnew('"'+name+':'+st+ definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+ tostr(fileinfo.line)+','+mangledname); end; {$endif GDB} {**************************************************************************** TCONSTSYM ****************************************************************************} constructor tconstsym.init(const n : string;t : tconsttype;v : longint;def : pdef); begin tsym.init(n); typ:=constsym; definition:=def; consttype:=t; value:=v; end; constructor tconstsym.load; var pd : pbestreal; ps : pnormalset; begin tsym.load; typ:=constsym; consttype:=tconsttype(readbyte); case consttype of constint, constbool, constchar : value:=readlong; constord : begin definition:=readdefref; value:=readlong; end; conststring : value:=longint(stringdup(readstring)); constreal : begin new(pd); pd^:=readreal; value:=longint(pd); end; constset : begin definition:=readdefref; new(ps); readnormalset(ps^); value:=longint(ps); end; else Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype))); end; end; destructor tconstsym.done; begin case consttype of conststring : stringdispose(pstring(value)); constreal : dispose(pbestreal(value)); constset : dispose(pnormalset(value)); end; inherited done; end; function tconstsym.mangledname : string; begin mangledname:=name; end; procedure tconstsym.deref; begin if consttype in [constord,constset] then resolvedef(pdef(definition)); end; procedure tconstsym.write; begin tsym.write; writebyte(byte(consttype)); case consttype of constint, constbool, constchar : writelong(value); constord : begin writedefref(definition); writelong(value); end; conststring : writestring(pstring(value)^); constreal : writereal(pbestreal(value)^); constset : begin writedefref(definition); writenormalset(pointer(value)^); end; else internalerror(13); end; current_ppu^.writeentry(ibconstsym); end; {$ifdef GDB} function tconstsym.stabstring : pchar; var st : string; begin {even GDB v4.16 only now 'i' 'r' and 'e' !!!} case consttype of conststring : begin { I had to remove ibm2ascii !! } st := pstring(value)^; {st := ibm2ascii(pstring(value)^);} st := 's'''+st+''''; end; constbool, constint, constord, constchar : st := 'i'+tostr(value); constreal : begin system.str(pbestreal(value)^,st); st := 'r'+st; end; { if we don't know just put zero !! } else st:='i0'; {***SETCONST} {constset:;} {*** I don't know what to do with a set.} { sets are not recognized by GDB} {***} end; stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+ tostr(fileinfo.line)+',0'); end; procedure tconstsym.concatstabto(asmlist : paasmoutput); begin if consttype <> conststring then inherited concatstabto(asmlist); end; {$endif GDB} {**************************************************************************** TENUMSYM ****************************************************************************} constructor tenumsym.init(const n : string;def : penumdef;v : longint); begin tsym.init(n); typ:=enumsym; definition:=def; value:=v; if def^.min>v then def^.setmin(v); if def^.max ifndef oldppu Revision 1.16 1998/06/19 15:40:42 peter * removed cosntructor/constructor warning and 0.99.5 recompiles it again Revision 1.15 1998/06/17 14:10:18 peter * small os2 fixes * fixed interdependent units with newppu (remake3 under linux works now) Revision 1.14 1998/06/16 08:56:34 peter + targetcpu * cleaner pmodules for newppu Revision 1.13 1998/06/15 15:38:10 pierre * small bug in systems.pas corrected + operators in different units better hanlded Revision 1.12 1998/06/15 14:23:44 daniel * Reverted my changes. Revision 1.10 1998/06/13 00:10:18 peter * working browser and newppu * some small fixes against crashes which occured in bp7 (but not in fpc?!) Revision 1.9 1998/06/12 16:15:35 pierre * external name 'C_var'; export name 'intern_C_var'; cdecl; cdecl;external; are now supported only with -Sv switch Revision 1.8 1998/06/11 10:11:59 peter * -gb works again Revision 1.7 1998/06/09 16:01:51 pierre + added procedure directive parsing for procvars (accepted are popstack cdecl and pascal) + added C vars with the following syntax var C calias 'true_c_name';(can be followed by external) reason is that you must add the Cprefix which is target dependent Revision 1.6 1998/06/08 22:59:53 peter * smartlinking works for win32 * some defines to exclude some compiler parts Revision 1.5 1998/06/04 23:52:02 peter * m68k compiles + .def file creation moved to gendef.pas so it could also be used for win32 Revision 1.4 1998/06/04 09:55:46 pierre * demangled name of procsym reworked to become independant of the mangling scheme Revision 1.3 1998/06/03 22:14:20 florian * problem with sizes of classes fixed (if the anchestor was declared forward, the compiler doesn't update the child classes size) Revision 1.2 1998/05/28 14:40:29 peter * fixes for newppu, remake3 works now with it Revision 1.1 1998/05/27 19:45:09 peter * symtable.pas splitted into includefiles * symtable adapted for $ifndef OLDPPU }