mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-27 08:13:42 +02:00
0dd2b51943
reading ordinal fields of objects futher the register allocation
didn't take care of the extra register when reading ordinal values
* enumerations can now be used in constant indexes of properties
2645 lines
77 KiB
PHP
2645 lines
77 KiB
PHP
{
|
|
$Id$
|
|
Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
|
|
|
|
Implementation for the symbols types of the symtable
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
****************************************************************************
|
|
}
|
|
|
|
{****************************************************************************
|
|
TSYM (base for all symtypes)
|
|
****************************************************************************}
|
|
|
|
constructor tsym.init(const n : string);
|
|
begin
|
|
inherited initname(n);
|
|
typ:=abstractsym;
|
|
symoptions:=current_object_option;
|
|
{$ifdef GDB}
|
|
isstabwritten := false;
|
|
{$endif GDB}
|
|
fileinfo:=tokenpos;
|
|
defref:=nil;
|
|
lastwritten:=nil;
|
|
refcount:=0;
|
|
if (cs_browser in aktmoduleswitches) and make_ref then
|
|
begin
|
|
defref:=new(pref,init(defref,@tokenpos));
|
|
inc(refcount);
|
|
end;
|
|
lastref:=defref;
|
|
end;
|
|
|
|
|
|
constructor tsym.load;
|
|
begin
|
|
inherited init;
|
|
indexnr:=readword;
|
|
setname(readstring);
|
|
typ:=abstractsym;
|
|
readsmallset(symoptions);
|
|
readposinfo(fileinfo);
|
|
lastref:=nil;
|
|
defref:=nil;
|
|
lastwritten:=nil;
|
|
refcount:=0;
|
|
{$ifdef GDB}
|
|
isstabwritten := false;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
|
|
procedure tsym.load_references;
|
|
var
|
|
pos : tfileposinfo;
|
|
move_last : boolean;
|
|
begin
|
|
move_last:=lastwritten=lastref;
|
|
while (not current_ppu^.endofentry) do
|
|
begin
|
|
readposinfo(pos);
|
|
inc(refcount);
|
|
lastref:=new(pref,init(lastref,@pos));
|
|
lastref^.is_written:=true;
|
|
if refcount=1 then
|
|
defref:=lastref;
|
|
end;
|
|
if move_last then
|
|
lastwritten:=lastref;
|
|
end;
|
|
|
|
{ big problem here :
|
|
wrong refs were written because of
|
|
interface parsing of other units PM
|
|
moduleindex must be checked !! }
|
|
|
|
function tsym.write_references : boolean;
|
|
var
|
|
ref : pref;
|
|
symref_written,move_last : boolean;
|
|
begin
|
|
write_references:=false;
|
|
if lastwritten=lastref then
|
|
exit;
|
|
{ should we update lastref }
|
|
move_last:=true;
|
|
symref_written:=false;
|
|
{ write symbol refs }
|
|
if assigned(lastwritten) then
|
|
ref:=lastwritten
|
|
else
|
|
ref:=defref;
|
|
while assigned(ref) do
|
|
begin
|
|
if ref^.moduleindex=current_module^.unit_index then
|
|
begin
|
|
{ write address to this symbol }
|
|
if not symref_written then
|
|
begin
|
|
writesymref(@self);
|
|
symref_written:=true;
|
|
end;
|
|
writeposinfo(ref^.posinfo);
|
|
ref^.is_written:=true;
|
|
if move_last then
|
|
lastwritten:=ref;
|
|
end
|
|
else if not ref^.is_written then
|
|
move_last:=false
|
|
else if move_last then
|
|
lastwritten:=ref;
|
|
ref:=ref^.nextref;
|
|
end;
|
|
if symref_written then
|
|
current_ppu^.writeentry(ibsymref);
|
|
write_references:=symref_written;
|
|
end;
|
|
|
|
|
|
{$ifdef BrowserLog}
|
|
procedure tsym.add_to_browserlog;
|
|
begin
|
|
if assigned(defref) then
|
|
begin
|
|
browserlog.AddLog('***'+name+'***');
|
|
browserlog.AddLogRefs(defref);
|
|
end;
|
|
end;
|
|
{$endif BrowserLog}
|
|
|
|
|
|
destructor tsym.done;
|
|
begin
|
|
if assigned(defref) then
|
|
dispose(defref,done);
|
|
inherited done;
|
|
end;
|
|
|
|
|
|
procedure tsym.write;
|
|
begin
|
|
writeword(indexnr);
|
|
writestring(name);
|
|
writesmallset(symoptions);
|
|
writeposinfo(fileinfo);
|
|
end;
|
|
|
|
|
|
procedure tsym.deref;
|
|
begin
|
|
end;
|
|
|
|
|
|
function tsym.mangledname : string;
|
|
begin
|
|
mangledname:=name;
|
|
end;
|
|
|
|
|
|
{ for most symbol types there is nothing to do at all }
|
|
procedure tsym.insert_in_data;
|
|
begin
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
function tsym.stabstring : pchar;
|
|
|
|
begin
|
|
stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
|
|
tostr(fileinfo.line)+',0');
|
|
end;
|
|
|
|
procedure tsym.concatstabto(asmlist : paasmoutput);
|
|
|
|
var stab_str : pchar;
|
|
begin
|
|
if not isstabwritten then
|
|
begin
|
|
stab_str := stabstring;
|
|
if asmlist = debuglist then do_count_dbx := true;
|
|
{ count_dbx(stab_str); moved to GDB.PAS }
|
|
asmlist^.concat(new(pai_stabs,init(stab_str)));
|
|
isstabwritten:=true;
|
|
end;
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TLABELSYM
|
|
****************************************************************************}
|
|
|
|
constructor tlabelsym.init(const n : string; l : pasmlabel);
|
|
|
|
begin
|
|
inherited init(n);
|
|
typ:=labelsym;
|
|
lab:=l;
|
|
defined:=false;
|
|
end;
|
|
|
|
constructor tlabelsym.load;
|
|
|
|
begin
|
|
tsym.load;
|
|
typ:=labelsym;
|
|
{ this is all dummy
|
|
it is only used for local browsing }
|
|
lab:=nil;
|
|
defined:=true;
|
|
end;
|
|
|
|
destructor tlabelsym.done;
|
|
|
|
begin
|
|
inherited done;
|
|
end;
|
|
|
|
|
|
function tlabelsym.mangledname : string;
|
|
begin
|
|
mangledname:=lab^.name;
|
|
end;
|
|
|
|
|
|
procedure tlabelsym.write;
|
|
begin
|
|
if owner^.symtabletype in [unitsymtable,globalsymtable] then
|
|
Message(sym_e_ill_label_decl)
|
|
else
|
|
begin
|
|
tsym.write;
|
|
current_ppu^.writeentry(iblabelsym);
|
|
end;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TUNITSYM
|
|
****************************************************************************}
|
|
|
|
constructor tunitsym.init(const n : string;ref : punitsymtable);
|
|
var
|
|
old_make_ref : boolean;
|
|
begin
|
|
old_make_ref:=make_ref;
|
|
make_ref:=false;
|
|
inherited init(n);
|
|
make_ref:=old_make_ref;
|
|
typ:=unitsym;
|
|
unitsymtable:=ref;
|
|
prevsym:=ref^.unitsym;
|
|
ref^.unitsym:=@self;
|
|
refs:=0;
|
|
end;
|
|
|
|
constructor tunitsym.load;
|
|
|
|
begin
|
|
tsym.load;
|
|
typ:=unitsym;
|
|
unitsymtable:=punitsymtable(current_module^.globalsymtable);
|
|
prevsym:=nil;
|
|
end;
|
|
|
|
{ we need to remove it from the prevsym chain ! }
|
|
|
|
destructor tunitsym.done;
|
|
var pus,ppus : punitsym;
|
|
begin
|
|
if assigned(unitsymtable) then
|
|
begin
|
|
ppus:=nil;
|
|
pus:=unitsymtable^.unitsym;
|
|
if pus=@self then
|
|
unitsymtable^.unitsym:=prevsym
|
|
else while assigned(pus) do
|
|
begin
|
|
if pus=@self then
|
|
begin
|
|
ppus^.prevsym:=prevsym;
|
|
break;
|
|
end
|
|
else
|
|
begin
|
|
ppus:=pus;
|
|
pus:=ppus^.prevsym;
|
|
end;
|
|
end;
|
|
end;
|
|
prevsym:=nil;
|
|
unitsymtable:=nil;
|
|
inherited done;
|
|
end;
|
|
|
|
procedure tunitsym.write;
|
|
begin
|
|
tsym.write;
|
|
current_ppu^.writeentry(ibunitsym);
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
procedure tunitsym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
{Nothing to write to stabs !}
|
|
end;
|
|
{$endif GDB}
|
|
|
|
{****************************************************************************
|
|
TPROCSYM
|
|
****************************************************************************}
|
|
|
|
constructor tprocsym.init(const n : string);
|
|
|
|
begin
|
|
tsym.init(n);
|
|
typ:=procsym;
|
|
definition:=nil;
|
|
owner:=nil;
|
|
{$ifdef GDB}
|
|
is_global := false;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
constructor tprocsym.load;
|
|
|
|
begin
|
|
tsym.load;
|
|
typ:=procsym;
|
|
definition:=pprocdef(readdefref);
|
|
{$ifdef GDB}
|
|
is_global := false;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
destructor tprocsym.done;
|
|
|
|
begin
|
|
{ don't check if errors !! }
|
|
if Errorcount=0 then
|
|
check_forward;
|
|
tsym.done;
|
|
end;
|
|
|
|
function tprocsym.mangledname : string;
|
|
|
|
begin
|
|
mangledname:=definition^.mangledname;
|
|
end;
|
|
|
|
|
|
function tprocsym.demangledname:string;
|
|
begin
|
|
demangledname:=name+definition^.demangled_paras;
|
|
end;
|
|
|
|
procedure tprocsym.write_parameter_lists;
|
|
|
|
var
|
|
p : pprocdef;
|
|
|
|
begin
|
|
p:=definition;
|
|
while assigned(p) do
|
|
begin
|
|
{ force the error to be printed }
|
|
Verbose.Message1(sym_b_param_list,name+p^.demangled_paras);
|
|
p:=p^.nextoverloaded;
|
|
end;
|
|
end;
|
|
|
|
procedure tprocsym.check_forward;
|
|
var
|
|
pd : pprocdef;
|
|
begin
|
|
pd:=definition;
|
|
while assigned(pd) do
|
|
begin
|
|
if pd^.forwarddef then
|
|
begin
|
|
if assigned(pd^._class) then
|
|
MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^._class^.objname^+'.'+demangledname)
|
|
else
|
|
MessagePos1(fileinfo,sym_e_forward_not_resolved,demangledname);
|
|
{ Turn futher error messages off }
|
|
pd^.forwarddef:=false;
|
|
end;
|
|
pd:=pd^.nextoverloaded;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tprocsym.deref;
|
|
var
|
|
t : ttoken;
|
|
last : pprocdef;
|
|
begin
|
|
resolvedef(pdef(definition));
|
|
if (definition^.proctypeoption=potype_operator) then
|
|
begin
|
|
last:=definition;
|
|
while assigned(last^.nextoverloaded) do
|
|
last:=last^.nextoverloaded;
|
|
for t:=first_overloaded to last_overloaded do
|
|
if (name=overloaded_names[t]) then
|
|
begin
|
|
if assigned(overloaded_operators[t]) then
|
|
last^.nextoverloaded:=overloaded_operators[t]^.definition;
|
|
overloaded_operators[t]:=@self;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure tprocsym.write;
|
|
begin
|
|
tsym.write;
|
|
writedefref(pdef(definition));
|
|
current_ppu^.writeentry(ibprocsym);
|
|
end;
|
|
|
|
|
|
procedure tprocsym.load_references;
|
|
(*var
|
|
prdef,prdef2 : pprocdef;
|
|
b : byte; *)
|
|
begin
|
|
inherited load_references;
|
|
(*prdef:=definition;
|
|
done in tsymtable.load_browser (PM)
|
|
{ take care about operators !! }
|
|
if (current_module^.flags and uf_has_browser) <>0 then
|
|
while assigned(prdef) and (prdef^.owner=definition^.owner) do
|
|
begin
|
|
b:=current_ppu^.readentry;
|
|
if b<>ibdefref then
|
|
Message(unit_f_ppu_read_error);
|
|
prdef2:=pprocdef(readdefref);
|
|
resolvedef(prdef2);
|
|
if prdef<>prdef2 then
|
|
Message(unit_f_ppu_read_error);
|
|
prdef^.load_references;
|
|
prdef:=prdef^.nextoverloaded;
|
|
end; *)
|
|
end;
|
|
|
|
function tprocsym.write_references : boolean;
|
|
var
|
|
prdef : pprocdef;
|
|
begin
|
|
write_references:=false;
|
|
if not inherited write_references then
|
|
exit;
|
|
write_references:=true;
|
|
prdef:=definition;
|
|
while assigned(prdef) and (prdef^.owner=definition^.owner) do
|
|
begin
|
|
prdef^.write_references;
|
|
prdef:=prdef^.nextoverloaded;
|
|
end;
|
|
end;
|
|
|
|
|
|
{$ifdef BrowserLog}
|
|
procedure tprocsym.add_to_browserlog;
|
|
var
|
|
prdef : pprocdef;
|
|
begin
|
|
inherited add_to_browserlog;
|
|
prdef:=definition;
|
|
while assigned(prdef) do
|
|
begin
|
|
pprocdef(prdef)^.add_to_browserlog;
|
|
prdef:=pprocdef(prdef)^.nextoverloaded;
|
|
end;
|
|
end;
|
|
{$endif BrowserLog}
|
|
|
|
|
|
{$ifdef GDB}
|
|
function tprocsym.stabstring : pchar;
|
|
Var RetType : Char;
|
|
Obj,Info : String;
|
|
stabsstr : string;
|
|
p : pchar;
|
|
begin
|
|
obj := name;
|
|
info := '';
|
|
if is_global then
|
|
RetType := 'F'
|
|
else
|
|
RetType := 'f';
|
|
if assigned(owner) then
|
|
begin
|
|
if (owner^.symtabletype = objectsymtable) then
|
|
obj := owner^.name^+'__'+name;
|
|
{ this code was correct only as long as the local symboltable
|
|
of the parent had the same name as the function
|
|
but this is no true anymore !! PM
|
|
if (owner^.symtabletype=localsymtable) and assigned(owner^.name) then
|
|
info := ','+name+','+owner^.name^; }
|
|
if (owner^.symtabletype=localsymtable) and assigned(owner^.defowner) and
|
|
assigned(pprocdef(owner^.defowner)^.procsym) then
|
|
info := ','+name+','+pprocdef(owner^.defowner)^.procsym^.name;
|
|
end;
|
|
stabsstr:=definition^.mangledname;
|
|
getmem(p,length(stabsstr)+255);
|
|
strpcopy(p,'"'+obj+':'+RetType
|
|
+definition^.retdef^.numberstring+info+'",'+tostr(n_function)
|
|
+',0,'+
|
|
tostr(aktfilepos.line)
|
|
+',');
|
|
strpcopy(strend(p),stabsstr);
|
|
stabstring:=strnew(p);
|
|
freemem(p,length(stabsstr)+255);
|
|
end;
|
|
|
|
procedure tprocsym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
if (pocall_internproc in definition^.proccalloptions) then exit;
|
|
if not isstabwritten then
|
|
asmlist^.concat(new(pai_stabs,init(stabstring)));
|
|
isstabwritten := true;
|
|
if assigned(definition^.parast) then
|
|
definition^.parast^.concatstabto(asmlist);
|
|
if assigned(definition^.localst) then
|
|
definition^.localst^.concatstabto(asmlist);
|
|
definition^.is_def_stab_written := true;
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TPROGRAMSYM
|
|
****************************************************************************}
|
|
|
|
constructor tprogramsym.init(const n : string);
|
|
begin
|
|
inherited init(n);
|
|
typ:=programsym;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TERRORSYM
|
|
****************************************************************************}
|
|
|
|
constructor terrorsym.init;
|
|
begin
|
|
inherited init('');
|
|
typ:=errorsym;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TPROPERTYSYM
|
|
****************************************************************************}
|
|
|
|
constructor tpropertysym.init(const n : string);
|
|
begin
|
|
inherited init(n);
|
|
typ:=propertysym;
|
|
propoptions:=[];
|
|
proptype:=nil;
|
|
readaccessdef:=nil;
|
|
writeaccessdef:=nil;
|
|
readaccesssym:=nil;
|
|
writeaccesssym:=nil;
|
|
storedsym:=nil;
|
|
storeddef:=nil;
|
|
|
|
index:=0;
|
|
default:=0;
|
|
end;
|
|
|
|
destructor tpropertysym.done;
|
|
|
|
procedure disposepropsymlist(p:ppropsymlist);
|
|
var
|
|
hp : ppropsymlist;
|
|
begin
|
|
while assigned(p) do
|
|
begin
|
|
hp:=p;
|
|
p:=p^.next;
|
|
dispose(hp);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
disposepropsymlist(readaccesssym);
|
|
disposepropsymlist(writeaccesssym);
|
|
disposepropsymlist(storedsym);
|
|
inherited done;
|
|
end;
|
|
|
|
constructor tpropertysym.load;
|
|
|
|
function readpropsymlist:ppropsymlist;
|
|
var
|
|
root,last,p : ppropsymlist;
|
|
sym : psym;
|
|
begin
|
|
root:=nil;
|
|
last:=nil;
|
|
repeat
|
|
sym:=readsymref;
|
|
if sym=nil then
|
|
break;
|
|
new(p);
|
|
p^.sym:=sym;
|
|
p^.next:=nil;
|
|
if assigned(last) then
|
|
last^.next:=p
|
|
else
|
|
root:=p;
|
|
last:=p;
|
|
until false;
|
|
readpropsymlist:=root;
|
|
end;
|
|
|
|
begin
|
|
inherited load;
|
|
typ:=propertysym;
|
|
proptype:=readdefref;
|
|
readsmallset(propoptions);
|
|
index:=readlong;
|
|
default:=readlong;
|
|
{ the syms }
|
|
readaccesssym:=readpropsymlist;
|
|
writeaccesssym:=readpropsymlist;
|
|
storedsym:=readpropsymlist;
|
|
{ now the defs }
|
|
readaccessdef:=readdefref;
|
|
writeaccessdef:=readdefref;
|
|
storeddef:=readdefref;
|
|
end;
|
|
|
|
procedure tpropertysym.deref;
|
|
|
|
procedure resolvepropsymlist(p:ppropsymlist);
|
|
begin
|
|
while assigned(p) do
|
|
begin
|
|
resolvesym(p^.sym);
|
|
p:=p^.next;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
resolvedef(proptype);
|
|
resolvedef(readaccessdef);
|
|
resolvedef(writeaccessdef);
|
|
resolvedef(storeddef);
|
|
resolvepropsymlist(readaccesssym);
|
|
resolvepropsymlist(writeaccesssym);
|
|
resolvepropsymlist(storedsym);
|
|
end;
|
|
|
|
function tpropertysym.getsize : longint;
|
|
|
|
begin
|
|
getsize:=0;
|
|
end;
|
|
|
|
procedure tpropertysym.write;
|
|
|
|
procedure writepropsymlist(p:ppropsymlist);
|
|
begin
|
|
while assigned(p) do
|
|
begin
|
|
writesymref(p^.sym);
|
|
p:=p^.next;
|
|
end;
|
|
writesymref(nil);
|
|
end;
|
|
|
|
begin
|
|
tsym.write;
|
|
writedefref(proptype);
|
|
writesmallset(propoptions);
|
|
writelong(index);
|
|
writelong(default);
|
|
writepropsymlist(readaccesssym);
|
|
writepropsymlist(writeaccesssym);
|
|
writepropsymlist(storedsym);
|
|
writedefref(readaccessdef);
|
|
writedefref(writeaccessdef);
|
|
writedefref(storeddef);
|
|
current_ppu^.writeentry(ibpropertysym);
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
function tpropertysym.stabstring : pchar;
|
|
begin
|
|
{ !!!! don't know how to handle }
|
|
stabstring:=strpnew('');
|
|
end;
|
|
|
|
procedure tpropertysym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
{ !!!! don't know how to handle }
|
|
end;
|
|
{$endif GDB}
|
|
|
|
{****************************************************************************
|
|
TFUNCRETSYM
|
|
****************************************************************************}
|
|
|
|
constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
|
|
|
|
begin
|
|
tsym.init(n);
|
|
typ:=funcretsym;
|
|
funcretprocinfo:=approcinfo;
|
|
funcretdef:=pprocinfo(approcinfo)^.retdef;
|
|
{ address valid for ret in param only }
|
|
{ otherwise set by insert }
|
|
address:=pprocinfo(approcinfo)^.retoffset;
|
|
end;
|
|
|
|
constructor tfuncretsym.load;
|
|
begin
|
|
tsym.load;
|
|
funcretdef:=readdefref;
|
|
address:=readlong;
|
|
funcretprocinfo:=nil;
|
|
typ:=funcretsym;
|
|
end;
|
|
|
|
procedure tfuncretsym.write;
|
|
begin
|
|
tsym.write;
|
|
writedefref(funcretdef);
|
|
writelong(address);
|
|
current_ppu^.writeentry(ibfuncretsym);
|
|
end;
|
|
|
|
procedure tfuncretsym.deref;
|
|
begin
|
|
resolvedef(funcretdef);
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
procedure tfuncretsym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
{ Nothing to do here, it is done in genexitcode }
|
|
end;
|
|
{$endif GDB}
|
|
|
|
procedure tfuncretsym.insert_in_data;
|
|
var
|
|
l : longint;
|
|
begin
|
|
{ if retoffset is already set then reuse it, this is needed
|
|
when inserting the result variable }
|
|
if procinfo^.retoffset<>0 then
|
|
address:=procinfo^.retoffset
|
|
else
|
|
begin
|
|
{ allocate space in local if ret in acc or in fpu }
|
|
if ret_in_acc(procinfo^.retdef) or (procinfo^.retdef^.deftype=floatdef) then
|
|
begin
|
|
l:=funcretdef^.size;
|
|
inc(owner^.datasize,l);
|
|
{$ifdef m68k}
|
|
{ word alignment required for motorola }
|
|
if (l=1) then
|
|
inc(owner^.datasize,1)
|
|
else
|
|
{$endif}
|
|
if (l>=4) and ((owner^.datasize and 3)<>0) then
|
|
inc(owner^.datasize,4-(owner^.datasize and 3))
|
|
else if (l>=2) and ((owner^.datasize and 1)<>0) then
|
|
inc(owner^.datasize,2-(owner^.datasize and 1));
|
|
address:=owner^.datasize;
|
|
procinfo^.retoffset:=-owner^.datasize;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TABSOLUTESYM
|
|
****************************************************************************}
|
|
|
|
constructor tabsolutesym.init(const n : string;p : pdef);
|
|
begin
|
|
inherited init(n,p);
|
|
typ:=absolutesym;
|
|
end;
|
|
|
|
|
|
constructor tabsolutesym.load;
|
|
begin
|
|
tvarsym.load;
|
|
typ:=absolutesym;
|
|
ref:=nil;
|
|
address:=0;
|
|
asmname:=nil;
|
|
abstyp:=absolutetyp(readbyte);
|
|
absseg:=false;
|
|
case abstyp of
|
|
tovar :
|
|
begin
|
|
asmname:=stringdup(readstring);
|
|
ref:=srsym;
|
|
end;
|
|
toasm :
|
|
asmname:=stringdup(readstring);
|
|
toaddr :
|
|
begin
|
|
address:=readlong;
|
|
absseg:=boolean(readbyte);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tabsolutesym.write;
|
|
var
|
|
hvo : tvaroptions;
|
|
begin
|
|
{ Note: This needs to write everything of tvarsym.write }
|
|
tsym.write;
|
|
writebyte(byte(varspez));
|
|
if read_member then
|
|
writelong(address);
|
|
{ write only definition or definitionsym }
|
|
if assigned(definitionsym) then
|
|
begin
|
|
writedefref(nil);
|
|
writesymref(definitionsym);
|
|
end
|
|
else
|
|
begin
|
|
writedefref(definition);
|
|
writesymref(nil);
|
|
end;
|
|
hvo:=varoptions-[vo_regable];
|
|
writesmallset(hvo);
|
|
writebyte(byte(abstyp));
|
|
case abstyp of
|
|
tovar :
|
|
writestring(ref^.name);
|
|
toasm :
|
|
writestring(asmname^);
|
|
toaddr :
|
|
begin
|
|
writelong(address);
|
|
writebyte(byte(absseg));
|
|
end;
|
|
end;
|
|
current_ppu^.writeentry(ibabsolutesym);
|
|
end;
|
|
|
|
|
|
procedure tabsolutesym.deref;
|
|
begin
|
|
tvarsym.deref;
|
|
if (abstyp=tovar) and (asmname<>nil) then
|
|
begin
|
|
{ search previous loaded symtables }
|
|
getsym(asmname^,false);
|
|
if not(assigned(srsym)) then
|
|
getsymonlyin(owner,asmname^);
|
|
if not(assigned(srsym)) then
|
|
srsym:=generrorsym;
|
|
ref:=srsym;
|
|
stringdispose(asmname);
|
|
end;
|
|
end;
|
|
|
|
|
|
function tabsolutesym.mangledname : string;
|
|
begin
|
|
case abstyp of
|
|
tovar :
|
|
mangledname:=ref^.mangledname;
|
|
toasm :
|
|
mangledname:=asmname^;
|
|
toaddr :
|
|
mangledname:='$'+tostr(address);
|
|
else
|
|
internalerror(10002);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tabsolutesym.insert_in_data;
|
|
begin
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
procedure tabsolutesym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
{ I don't know how to handle this !! }
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TVARSYM
|
|
****************************************************************************}
|
|
|
|
constructor tvarsym.init(const n : string;p : pdef);
|
|
begin
|
|
tsym.init(n);
|
|
typ:=varsym;
|
|
definition:=p;
|
|
definitionsym:=nil;
|
|
_mangledname:=nil;
|
|
varspez:=vs_value;
|
|
address:=0;
|
|
islocalcopy:=false;
|
|
localvarsym:=nil;
|
|
refs:=0;
|
|
varstate:=vs_used;
|
|
varoptions:=[];
|
|
{ can we load the value into a register ? }
|
|
if p^.is_intregable then
|
|
|
|
{$ifdef INCLUDEOK}
|
|
include(varoptions,vo_regable)
|
|
{$else}
|
|
varoptions:=varoptions+[vo_regable]
|
|
{$endif}
|
|
else
|
|
{$ifdef INCLUDEOK}
|
|
exclude(varoptions,vo_regable);
|
|
{$else}
|
|
varoptions:=varoptions-[vo_regable];
|
|
{$endif}
|
|
|
|
if p^.is_fpuregable then
|
|
{$ifdef INCLUDEOK}
|
|
include(varoptions,vo_fpuregable)
|
|
{$else}
|
|
varoptions:=varoptions+[vo_fpuregable]
|
|
{$endif}
|
|
else
|
|
{$ifdef INCLUDEOK}
|
|
exclude(varoptions,vo_regable);
|
|
{$else}
|
|
varoptions:=varoptions-[vo_fpuregable];
|
|
{$endif}
|
|
reg:=R_NO;
|
|
end;
|
|
|
|
|
|
constructor tvarsym.init_dll(const n : string;p : pdef);
|
|
begin
|
|
{ The tvarsym is necessary for 0.99.5 (PFV) }
|
|
tvarsym.init(n,p);
|
|
{$ifdef INCLUDEOK}
|
|
include(varoptions,vo_is_dll_var);
|
|
{$else}
|
|
varoptions:=varoptions+[vo_is_dll_var];
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
constructor tvarsym.init_C(const n,mangled : string;p : pdef);
|
|
begin
|
|
{ The tvarsym is necessary for 0.99.5 (PFV) }
|
|
tvarsym.init(n,p);
|
|
{$ifdef INCLUDEOK}
|
|
include(varoptions,vo_is_C_var);
|
|
{$else}
|
|
varoptions:=varoptions+[vo_is_C_var];
|
|
{$endif}
|
|
setmangledname(mangled);
|
|
end;
|
|
|
|
|
|
constructor tvarsym.initsym(const n : string;p : ptypesym);
|
|
begin
|
|
tvarsym.init(n,p^.definition);
|
|
definitionsym:=p;
|
|
end;
|
|
|
|
|
|
constructor tvarsym.initsym_dll(const n : string;p : ptypesym);
|
|
begin
|
|
tvarsym.init_dll(n,p^.definition);
|
|
definitionsym:=p;
|
|
end;
|
|
|
|
|
|
constructor tvarsym.initsym_C(const n,mangled : string;p : ptypesym);
|
|
begin
|
|
tvarsym.init_C(n,mangled,p^.definition);
|
|
definitionsym:=p;
|
|
end;
|
|
|
|
|
|
constructor tvarsym.load;
|
|
begin
|
|
tsym.load;
|
|
typ:=varsym;
|
|
_mangledname:=nil;
|
|
reg:=R_NO;
|
|
refs := 0;
|
|
varstate:=vs_used;
|
|
varspez:=tvarspez(readbyte);
|
|
if read_member then
|
|
address:=readlong
|
|
else
|
|
address:=0;
|
|
islocalcopy:=false;
|
|
localvarsym:=nil;
|
|
definition:=readdefref;
|
|
definitionsym:=ptypesym(readsymref);
|
|
readsmallset(varoptions);
|
|
if (vo_is_C_var in varoptions) then
|
|
setmangledname(readstring);
|
|
end;
|
|
|
|
|
|
destructor tvarsym.done;
|
|
begin
|
|
strdispose(_mangledname);
|
|
inherited done;
|
|
end;
|
|
|
|
|
|
procedure tvarsym.deref;
|
|
begin
|
|
if assigned(definitionsym) then
|
|
begin
|
|
resolvesym(psym(definitionsym));
|
|
definition:=definitionsym^.definition;
|
|
end
|
|
else
|
|
resolvedef(definition);
|
|
end;
|
|
|
|
|
|
procedure tvarsym.write;
|
|
var
|
|
hvo : tvaroptions;
|
|
begin
|
|
tsym.write;
|
|
writebyte(byte(varspez));
|
|
if read_member then
|
|
writelong(address);
|
|
{ write only definition or definitionsym }
|
|
if assigned(definitionsym) then
|
|
begin
|
|
writedefref(nil);
|
|
writesymref(definitionsym);
|
|
end
|
|
else
|
|
begin
|
|
writedefref(definition);
|
|
writesymref(nil);
|
|
end;
|
|
{ symbols which are load are never candidates for a register,
|
|
turn off the regable }
|
|
hvo:=varoptions-[vo_regable];
|
|
writesmallset(hvo);
|
|
if (vo_is_C_var in varoptions) then
|
|
writestring(mangledname);
|
|
current_ppu^.writeentry(ibvarsym);
|
|
end;
|
|
|
|
|
|
procedure tvarsym.setmangledname(const s : string);
|
|
begin
|
|
_mangledname:=strpnew(s);
|
|
end;
|
|
|
|
|
|
function tvarsym.mangledname : string;
|
|
var
|
|
prefix : string;
|
|
begin
|
|
if assigned(_mangledname) then
|
|
begin
|
|
mangledname:=strpas(_mangledname);
|
|
exit;
|
|
end;
|
|
case owner^.symtabletype of
|
|
staticsymtable :
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
prefix:='_'+owner^.name^+'$$$_'
|
|
else
|
|
prefix:='_';
|
|
unitsymtable,
|
|
globalsymtable :
|
|
prefix:='U_'+owner^.name^+'_';
|
|
else
|
|
Message(sym_e_invalid_call_tvarsymmangledname);
|
|
end;
|
|
mangledname:=prefix+name;
|
|
end;
|
|
|
|
|
|
function tvarsym.getsize : longint;
|
|
begin
|
|
if assigned(definition) and (varspez=vs_value) and
|
|
((definition^.deftype<>arraydef) or (Parraydef(definition)^.highrange>=
|
|
Parraydef(definition)^.lowrange)) then
|
|
getsize:=definition^.size
|
|
else
|
|
getsize:=0;
|
|
end;
|
|
|
|
|
|
function tvarsym.getpushsize : longint;
|
|
begin
|
|
if assigned(definition) then
|
|
begin
|
|
case varspez of
|
|
vs_var :
|
|
getpushsize:=target_os.size_of_pointer;
|
|
vs_value,
|
|
vs_const :
|
|
begin
|
|
if push_addr_param(definition) then
|
|
getpushsize:=target_os.size_of_pointer
|
|
else
|
|
getpushsize:=definition^.size;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
getpushsize:=0;
|
|
end;
|
|
|
|
|
|
function data_align(length : longint) : longint;
|
|
begin
|
|
(* this is useless under go32v2 at least
|
|
because the section are only align to dword
|
|
if length>8 then
|
|
data_align:=16
|
|
else if length>4 then
|
|
data_align:=8
|
|
else *)
|
|
if length>2 then
|
|
data_align:=4
|
|
else
|
|
if length>1 then
|
|
data_align:=2
|
|
else
|
|
data_align:=1;
|
|
end;
|
|
|
|
|
|
procedure tvarsym.insert_in_data;
|
|
var
|
|
varalign,
|
|
l,ali,modulo : longint;
|
|
storefilepos : tfileposinfo;
|
|
begin
|
|
if (vo_is_external in varoptions) then
|
|
exit;
|
|
{ handle static variables of objects especially }
|
|
if read_member and (owner^.symtabletype=objectsymtable) and
|
|
(sp_static in symoptions) then
|
|
begin
|
|
{ the data filed is generated in parser.pas
|
|
with a tobject_FIELDNAME variable }
|
|
{ this symbol can't be loaded to a register }
|
|
{$ifdef INCLUDEOK}
|
|
exclude(varoptions,vo_regable);
|
|
exclude(varoptions,vo_fpuregable);
|
|
{$else}
|
|
varoptions:=varoptions-[vo_regable,vo_fpuregable];
|
|
{$endif}
|
|
end
|
|
else
|
|
if not(read_member) then
|
|
begin
|
|
{ made problems with parameters etc. ! (FK) }
|
|
{ check for instance of an abstract object or class }
|
|
{
|
|
if (pvarsym(sym)^.definition^.deftype=objectdef) and
|
|
((pobjectdef(pvarsym(sym)^.definition)^.options and oo_is_abstract)<>0) then
|
|
Message(sym_e_no_instance_of_abstract_object);
|
|
}
|
|
storefilepos:=aktfilepos;
|
|
aktfilepos:=tokenpos;
|
|
if (vo_is_thread_var in varoptions) then
|
|
l:=4
|
|
else
|
|
l:=getsize;
|
|
case owner^.symtabletype of
|
|
stt_exceptsymtable:
|
|
{ can contain only one symbol, address calculated later }
|
|
;
|
|
localsymtable :
|
|
begin
|
|
varstate:=vs_declared;
|
|
modulo:=owner^.datasize and 3;
|
|
{$ifdef m68k}
|
|
{ word alignment required for motorola }
|
|
if (l=1) then
|
|
l:=2
|
|
else
|
|
{$endif}
|
|
{
|
|
if (cs_optimize in aktglobalswitches) and
|
|
(aktoptprocessor in [classp5,classp6]) and
|
|
(l>=8) and ((owner^.datasize and 7)<>0) then
|
|
inc(owner^.datasize,8-(owner^.datasize and 7))
|
|
else
|
|
}
|
|
begin
|
|
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));
|
|
end;
|
|
inc(owner^.datasize,l);
|
|
address:=owner^.datasize;
|
|
end;
|
|
staticsymtable :
|
|
begin
|
|
{ enable unitialized warning for local symbols }
|
|
varstate:=vs_declared;
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
bsssegment^.concat(new(pai_cut,init));
|
|
ali:=data_align(l);
|
|
if ali>1 then
|
|
begin
|
|
modulo:=owner^.datasize mod ali;
|
|
if modulo>0 then
|
|
inc(owner^.datasize,ali-modulo);
|
|
end;
|
|
{$ifdef GDB}
|
|
if cs_debuginfo in aktmoduleswitches then
|
|
concatstabto(bsssegment);
|
|
{$endif GDB}
|
|
|
|
if (cs_create_smart in aktmoduleswitches) or
|
|
DLLSource or
|
|
(vo_is_C_var in varoptions) then
|
|
bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
|
|
else
|
|
bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
|
|
{ increase datasize }
|
|
inc(owner^.datasize,l);
|
|
{ this symbol can't be loaded to a register }
|
|
{$ifdef INCLUDEOK}
|
|
exclude(varoptions,vo_regable);
|
|
exclude(varoptions,vo_fpuregable);
|
|
{$else}
|
|
varoptions:=varoptions-[vo_regable,vo_fpuregable];
|
|
{$endif}
|
|
end;
|
|
globalsymtable :
|
|
begin
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
bsssegment^.concat(new(pai_cut,init));
|
|
ali:=data_align(l);
|
|
if ali>1 then
|
|
begin
|
|
modulo:=owner^.datasize mod ali;
|
|
if modulo>0 then
|
|
inc(owner^.datasize,ali-modulo);
|
|
end;
|
|
{$ifdef GDB}
|
|
if cs_debuginfo in aktmoduleswitches then
|
|
concatstabto(bsssegment);
|
|
{$endif GDB}
|
|
bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)));
|
|
inc(owner^.datasize,l);
|
|
{ this symbol can't be loaded to a register }
|
|
{$ifdef INCLUDEOK}
|
|
exclude(varoptions,vo_regable);
|
|
exclude(varoptions,vo_fpuregable);
|
|
{$else}
|
|
varoptions:=varoptions-[vo_regable,vo_fpuregable];
|
|
{$endif}
|
|
end;
|
|
recordsymtable,
|
|
objectsymtable :
|
|
begin
|
|
{ this symbol can't be loaded to a register }
|
|
{$ifdef INCLUDEOK}
|
|
exclude(varoptions,vo_regable);
|
|
exclude(varoptions,vo_fpuregable);
|
|
{$else}
|
|
varoptions:=varoptions-[vo_regable,vo_fpuregable];
|
|
{$endif}
|
|
{ get the alignment size }
|
|
if (aktpackrecords=packrecord_C) then
|
|
begin
|
|
varalign:=definition^.alignment;
|
|
if varalign=0 then
|
|
begin
|
|
if (owner^.dataalignment<4) then
|
|
begin
|
|
if (l>=4) then
|
|
owner^.dataalignment:=4
|
|
else
|
|
if (owner^.dataalignment<2) and (l>=2) then
|
|
owner^.dataalignment:=2;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
varalign:=0;
|
|
{ align record and object fields }
|
|
if (l=1) or (varalign=1) or (owner^.dataalignment=1) then
|
|
begin
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l)
|
|
end
|
|
else
|
|
if (l=2) or (varalign=2) or (owner^.dataalignment=2) then
|
|
begin
|
|
owner^.datasize:=(owner^.datasize+1) and (not 1);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l)
|
|
end
|
|
else
|
|
if (l<=4) or (varalign=4) or (owner^.dataalignment=4) then
|
|
begin
|
|
owner^.datasize:=(owner^.datasize+3) and (not 3);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l);
|
|
end
|
|
else
|
|
if (l<=8) or (owner^.dataalignment=8) then
|
|
begin
|
|
owner^.datasize:=(owner^.datasize+7) and (not 7);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l);
|
|
end
|
|
else
|
|
if (l<=16) or (owner^.dataalignment=16) then
|
|
begin
|
|
owner^.datasize:=(owner^.datasize+15) and (not 15);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l);
|
|
end
|
|
else
|
|
if (l<=32) or (owner^.dataalignment=32) then
|
|
begin
|
|
owner^.datasize:=(owner^.datasize+31) and (not 31);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l);
|
|
end;
|
|
end;
|
|
parasymtable :
|
|
begin
|
|
{ here we need the size of a push instead of the
|
|
size of the data }
|
|
l:=getpushsize;
|
|
address:=owner^.datasize;
|
|
owner^.datasize:=align(owner^.datasize+l,target_os.stackalignment);
|
|
end
|
|
else
|
|
begin
|
|
modulo:=owner^.datasize and 3;
|
|
if (l>=4) and (modulo<>0) then
|
|
inc(owner^.datasize,4-modulo)
|
|
else
|
|
if (l>=2) and ((modulo and 1)<>0) then
|
|
inc(owner^.datasize);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l);
|
|
end;
|
|
end;
|
|
aktfilepos:=storefilepos;
|
|
end;
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
function tvarsym.stabstring : pchar;
|
|
var
|
|
st : string[2];
|
|
begin
|
|
if (definition^.deftype=objectdef) and
|
|
pobjectdef(definition)^.is_class then
|
|
st:='*'
|
|
else
|
|
st:='';
|
|
if (owner^.symtabletype = objectsymtable) and
|
|
(sp_static in symoptions) then
|
|
begin
|
|
if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
|
|
{$ifndef Delphi}
|
|
stabstring := strpnew('"'+owner^.name^+'__'+name+':'+st+
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
|
{$endif}
|
|
end
|
|
else if (owner^.symtabletype = globalsymtable) or
|
|
(owner^.symtabletype = unitsymtable) then
|
|
begin
|
|
{ Here we used S instead of
|
|
because with G GDB doesn't look at the address field
|
|
but searches the same name or with a leading underscore
|
|
but these names don't exist in pascal !}
|
|
if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
|
|
stabstring := strpnew('"'+name+':'+st
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
|
end
|
|
else if owner^.symtabletype = staticsymtable then
|
|
begin
|
|
stabstring := strpnew('"'+name+':S'+st
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
|
end
|
|
else if (owner^.symtabletype=parasymtable) then
|
|
begin
|
|
case varspez of
|
|
vs_var : st := 'v'+st;
|
|
vs_value,
|
|
vs_const : if push_addr_param(definition) then
|
|
st := 'v'+st { should be 'i' but 'i' doesn't work }
|
|
else
|
|
st := 'p'+st;
|
|
end;
|
|
stabstring := strpnew('"'+name+':'+st
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_PSYM)+',0,'+tostr(fileinfo.line)+','+
|
|
tostr(address+owner^.address_fixup));
|
|
{offset to ebp => will not work if the framepointer is esp
|
|
so some optimizing will make things harder to debug }
|
|
end
|
|
else if (owner^.symtabletype=localsymtable) then
|
|
{$ifdef i386}
|
|
if reg<>R_NO then
|
|
begin
|
|
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
|
|
{ this is the register order for GDB}
|
|
stabstring:=strpnew('"'+name+':r'+st
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_RSYM)+',0,'+
|
|
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
|
|
end
|
|
else
|
|
{$endif i386}
|
|
{ I don't know if this will work (PM) }
|
|
if (vo_is_C_var in varoptions) then
|
|
stabstring := strpnew('"'+name+':S'+st
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
|
|
else
|
|
stabstring := strpnew('"'+name+':'+st
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address))
|
|
else
|
|
stabstring := inherited stabstring;
|
|
end;
|
|
|
|
procedure tvarsym.concatstabto(asmlist : paasmoutput);
|
|
{$ifdef i386}
|
|
var stab_str : pchar;
|
|
{$endif i386}
|
|
begin
|
|
inherited concatstabto(asmlist);
|
|
{$ifdef i386}
|
|
if (owner^.symtabletype=parasymtable) and
|
|
(reg<>R_NO) then
|
|
begin
|
|
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
|
|
{ this is the register order for GDB}
|
|
stab_str:=strpnew('"'+name+':r'
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_RSYM)+',0,'+
|
|
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
|
|
asmlist^.concat(new(pai_stabs,init(stab_str)));
|
|
end;
|
|
{$endif i386}
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TTYPEDCONSTSYM
|
|
*****************************************************************************}
|
|
|
|
constructor ttypedconstsym.init(const n : string;p : pdef;really_const : boolean);
|
|
begin
|
|
tsym.init(n);
|
|
typ:=typedconstsym;
|
|
definition:=p;
|
|
definitionsym:=nil;
|
|
is_really_const:=really_const;
|
|
prefix:=stringdup(procprefix);
|
|
end;
|
|
|
|
|
|
constructor ttypedconstsym.initsym(const n : string;p : ptypesym;really_const : boolean);
|
|
begin
|
|
ttypedconstsym.init(n,p^.definition,really_const);
|
|
definitionsym:=p;
|
|
end;
|
|
|
|
|
|
constructor ttypedconstsym.load;
|
|
begin
|
|
tsym.load;
|
|
typ:=typedconstsym;
|
|
definition:=readdefref;
|
|
definitionsym:=ptypesym(readsymref);
|
|
prefix:=stringdup(readstring);
|
|
is_really_const:=boolean(readbyte);
|
|
end;
|
|
|
|
|
|
destructor ttypedconstsym.done;
|
|
begin
|
|
stringdispose(prefix);
|
|
tsym.done;
|
|
end;
|
|
|
|
|
|
function ttypedconstsym.mangledname : string;
|
|
begin
|
|
mangledname:='TC_'+prefix^+'_'+name;
|
|
end;
|
|
|
|
|
|
function ttypedconstsym.getsize : longint;
|
|
begin
|
|
if assigned(definition) then
|
|
getsize:=definition^.size
|
|
else
|
|
getsize:=0;
|
|
end;
|
|
|
|
|
|
procedure ttypedconstsym.deref;
|
|
begin
|
|
if assigned(definitionsym) then
|
|
begin
|
|
resolvesym(psym(definitionsym));
|
|
definition:=definitionsym^.definition;
|
|
end
|
|
else
|
|
resolvedef(definition);
|
|
end;
|
|
|
|
|
|
procedure ttypedconstsym.write;
|
|
begin
|
|
tsym.write;
|
|
{ write only definition or definitionsym }
|
|
if assigned(definitionsym) then
|
|
begin
|
|
writedefref(nil);
|
|
writesymref(definitionsym);
|
|
end
|
|
else
|
|
begin
|
|
writedefref(definition);
|
|
writesymref(nil);
|
|
end;
|
|
writestring(prefix^);
|
|
writebyte(byte(is_really_const));
|
|
current_ppu^.writeentry(ibtypedconstsym);
|
|
end;
|
|
|
|
|
|
procedure ttypedconstsym.insert_in_data;
|
|
var
|
|
curconstsegment : paasmoutput;
|
|
l,ali,modulo : longint;
|
|
storefilepos : tfileposinfo;
|
|
begin
|
|
storefilepos:=aktfilepos;
|
|
aktfilepos:=tokenpos;
|
|
if is_really_const then
|
|
curconstsegment:=consts
|
|
else
|
|
curconstsegment:=datasegment;
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
curconstsegment^.concat(new(pai_cut,init));
|
|
l:=getsize;
|
|
ali:=data_align(l);
|
|
if ali>1 then
|
|
begin
|
|
curconstsegment^.concat(new(pai_align,init(ali)));
|
|
modulo:=owner^.datasize mod ali;
|
|
if modulo>0 then
|
|
inc(owner^.datasize,ali-modulo);
|
|
end;
|
|
{ Why was there no owner size update here ??? }
|
|
inc(owner^.datasize,l);
|
|
{$ifdef GDB}
|
|
if cs_debuginfo in aktmoduleswitches then
|
|
concatstabto(curconstsegment);
|
|
{$endif GDB}
|
|
if owner^.symtabletype=globalsymtable then
|
|
begin
|
|
curconstsegment^.concat(new(pai_symbol,initname_global(mangledname,getsize)));
|
|
end
|
|
else
|
|
if owner^.symtabletype<>unitsymtable then
|
|
begin
|
|
if (cs_create_smart in aktmoduleswitches) or
|
|
DLLSource then
|
|
curconstsegment^.concat(new(pai_symbol,initname_global(mangledname,getsize)))
|
|
else
|
|
curconstsegment^.concat(new(pai_symbol,initname(mangledname,getsize)));
|
|
end;
|
|
aktfilepos:=storefilepos;
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
function ttypedconstsym.stabstring : pchar;
|
|
var
|
|
st : char;
|
|
begin
|
|
if (cs_gdb_gsym in aktglobalswitches) and (owner^.symtabletype in [unitsymtable,globalsymtable]) then
|
|
st := 'G'
|
|
else
|
|
st := 'S';
|
|
stabstring := strpnew('"'+name+':'+st+
|
|
definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+
|
|
tostr(fileinfo.line)+','+mangledname);
|
|
end;
|
|
{$endif GDB}
|
|
|
|
{****************************************************************************
|
|
TCONSTSYM
|
|
****************************************************************************}
|
|
|
|
constructor tconstsym.init(const n : string;t : tconsttype;v : longint);
|
|
begin
|
|
inherited init(n);
|
|
typ:=constsym;
|
|
consttype:=t;
|
|
value:=v;
|
|
ResStrIndex:=0;
|
|
definition:=nil;
|
|
len:=0;
|
|
end;
|
|
|
|
|
|
constructor tconstsym.init_def(const n : string;t : tconsttype;v : longint;def : pdef);
|
|
begin
|
|
inherited init(n);
|
|
typ:=constsym;
|
|
consttype:=t;
|
|
value:=v;
|
|
definition:=def;
|
|
len:=0;
|
|
end;
|
|
|
|
|
|
constructor tconstsym.init_string(const n : string;t : tconsttype;str:pchar;l:longint);
|
|
begin
|
|
inherited init(n);
|
|
typ:=constsym;
|
|
consttype:=t;
|
|
value:=longint(str);
|
|
definition:=nil;
|
|
len:=l;
|
|
if t=constresourcestring then
|
|
ResStrIndex:=registerresourcestring(name,pchar(value),len);
|
|
end;
|
|
|
|
constructor tconstsym.load;
|
|
var
|
|
pd : pbestreal;
|
|
ps : pnormalset;
|
|
begin
|
|
tsym.load;
|
|
typ:=constsym;
|
|
consttype:=tconsttype(readbyte);
|
|
case consttype of
|
|
constint,
|
|
constbool,
|
|
constchar :
|
|
value:=readlong;
|
|
constpointer,
|
|
constord :
|
|
begin
|
|
definition:=readdefref;
|
|
value:=readlong;
|
|
end;
|
|
conststring,constresourcestring :
|
|
begin
|
|
len:=readlong;
|
|
getmem(pchar(value),len+1);
|
|
current_ppu^.getdata(pchar(value)^,len);
|
|
if consttype=constresourcestring then
|
|
ResStrIndex:=readlong;
|
|
end;
|
|
constreal :
|
|
begin
|
|
new(pd);
|
|
pd^:=readreal;
|
|
value:=longint(pd);
|
|
end;
|
|
constset :
|
|
begin
|
|
definition:=readdefref;
|
|
new(ps);
|
|
readnormalset(ps^);
|
|
value:=longint(ps);
|
|
end;
|
|
constnil : ;
|
|
else
|
|
Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor tconstsym.done;
|
|
begin
|
|
case consttype of
|
|
conststring :
|
|
freemem(pchar(value),len+1);
|
|
constreal :
|
|
dispose(pbestreal(value));
|
|
constset :
|
|
dispose(pnormalset(value));
|
|
end;
|
|
inherited done;
|
|
end;
|
|
|
|
|
|
function tconstsym.mangledname : string;
|
|
begin
|
|
mangledname:=name;
|
|
end;
|
|
|
|
|
|
procedure tconstsym.deref;
|
|
begin
|
|
if consttype in [constord,constpointer,constset] then
|
|
resolvedef(pdef(definition));
|
|
end;
|
|
|
|
|
|
procedure tconstsym.write;
|
|
begin
|
|
tsym.write;
|
|
writebyte(byte(consttype));
|
|
case consttype of
|
|
constnil : ;
|
|
constint,
|
|
constbool,
|
|
constchar :
|
|
writelong(value);
|
|
constpointer,
|
|
constord :
|
|
begin
|
|
writedefref(definition);
|
|
writelong(value);
|
|
end;
|
|
conststring,constresourcestring :
|
|
begin
|
|
writelong(len);
|
|
current_ppu^.putdata(pchar(value)^,len);
|
|
if consttype=constresourcestring then
|
|
writelong(ResStrIndex);
|
|
end;
|
|
constreal :
|
|
writereal(pbestreal(value)^);
|
|
constset :
|
|
begin
|
|
writedefref(definition);
|
|
writenormalset(pointer(value)^);
|
|
end;
|
|
else
|
|
internalerror(13);
|
|
end;
|
|
current_ppu^.writeentry(ibconstsym);
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
function tconstsym.stabstring : pchar;
|
|
var st : string;
|
|
begin
|
|
{even GDB v4.16 only now 'i' 'r' and 'e' !!!}
|
|
case consttype of
|
|
conststring : begin
|
|
{ I had to remove ibm2ascii !! }
|
|
st := pstring(value)^;
|
|
{st := ibm2ascii(pstring(value)^);}
|
|
st := 's'''+st+'''';
|
|
end;
|
|
constbool,
|
|
constint,
|
|
constpointer,
|
|
constord,
|
|
constchar : st := 'i'+tostr(value);
|
|
constreal : begin
|
|
system.str(pbestreal(value)^,st);
|
|
st := 'r'+st;
|
|
end;
|
|
{ if we don't know just put zero !! }
|
|
else st:='i0';
|
|
{***SETCONST}
|
|
{constset:;} {*** I don't know what to do with a set.}
|
|
{ sets are not recognized by GDB}
|
|
{***}
|
|
end;
|
|
stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
|
|
tostr(fileinfo.line)+',0');
|
|
end;
|
|
|
|
procedure tconstsym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
if consttype <> conststring then
|
|
inherited concatstabto(asmlist);
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TENUMSYM
|
|
****************************************************************************}
|
|
|
|
constructor tenumsym.init(const n : string;def : penumdef;v : longint);
|
|
begin
|
|
tsym.init(n);
|
|
typ:=enumsym;
|
|
definition:=def;
|
|
value:=v;
|
|
if def^.min>v then
|
|
def^.setmin(v);
|
|
if def^.max<v then
|
|
def^.setmax(v);
|
|
order;
|
|
end;
|
|
|
|
|
|
constructor tenumsym.load;
|
|
begin
|
|
tsym.load;
|
|
typ:=enumsym;
|
|
definition:=penumdef(readdefref);
|
|
value:=readlong;
|
|
nextenum := Nil;
|
|
end;
|
|
|
|
|
|
procedure tenumsym.deref;
|
|
begin
|
|
resolvedef(pdef(definition));
|
|
order;
|
|
end;
|
|
|
|
|
|
procedure tenumsym.order;
|
|
var
|
|
sym : penumsym;
|
|
begin
|
|
sym := definition^.firstenum;
|
|
if sym = nil then
|
|
begin
|
|
definition^.firstenum := @self;
|
|
nextenum := nil;
|
|
exit;
|
|
end;
|
|
{ reorder the symbols in increasing value }
|
|
if value < sym^.value then
|
|
begin
|
|
nextenum := sym;
|
|
definition^.firstenum := @self;
|
|
end
|
|
else
|
|
begin
|
|
while (sym^.value <= value) and assigned(sym^.nextenum) do
|
|
sym := sym^.nextenum;
|
|
nextenum := sym^.nextenum;
|
|
sym^.nextenum := @self;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tenumsym.write;
|
|
begin
|
|
tsym.write;
|
|
writedefref(definition);
|
|
writelong(value);
|
|
current_ppu^.writeentry(ibenumsym);
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
procedure tenumsym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
{enum elements have no stab !}
|
|
end;
|
|
{$EndIf GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TTYPESYM
|
|
****************************************************************************}
|
|
|
|
constructor ttypesym.init(const n : string;d : pdef);
|
|
|
|
begin
|
|
tsym.init(n);
|
|
typ:=typesym;
|
|
definition:=d;
|
|
{$ifdef GDB}
|
|
isusedinstab := false;
|
|
{$endif GDB}
|
|
if assigned(definition) then
|
|
begin
|
|
if not(assigned(definition^.sym)) then
|
|
begin
|
|
definition^.sym:=@self;
|
|
synonym:=nil;
|
|
{$ifdef INCLUDEOK}
|
|
include(symoptions,sp_primary_typesym);
|
|
{$else}
|
|
symoptions:=symoptions+[sp_primary_typesym];
|
|
{$endif}
|
|
end
|
|
else
|
|
begin
|
|
synonym:=definition^.sym^.synonym;
|
|
definition^.sym^.synonym:=@self;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
constructor ttypesym.load;
|
|
begin
|
|
tsym.load;
|
|
typ:=typesym;
|
|
synonym:=nil;
|
|
{$ifdef GDB}
|
|
isusedinstab := false;
|
|
{$endif GDB}
|
|
definition:=readdefref;
|
|
end;
|
|
|
|
destructor ttypesym.done;
|
|
var prevsym : ptypesym;
|
|
|
|
begin
|
|
if assigned(definition) then
|
|
begin
|
|
prevsym:=definition^.sym;
|
|
if prevsym=@self then
|
|
definition^.sym:=synonym;
|
|
while assigned(prevsym) do
|
|
begin
|
|
if (prevsym^.synonym=@self) then
|
|
begin
|
|
prevsym^.synonym:=synonym;
|
|
break;
|
|
end;
|
|
prevsym:=prevsym^.synonym;
|
|
end;
|
|
end;
|
|
synonym:=nil;
|
|
definition:=nil;
|
|
inherited done;
|
|
end;
|
|
|
|
|
|
procedure ttypesym.deref;
|
|
|
|
begin
|
|
resolvedef(definition);
|
|
if assigned(definition) then
|
|
begin
|
|
if (sp_primary_typesym in symoptions) then
|
|
begin
|
|
if definition^.sym<>@self then
|
|
synonym:=definition^.sym;
|
|
definition^.sym:=@self;
|
|
end
|
|
else
|
|
begin
|
|
if assigned(definition^.sym) then
|
|
begin
|
|
synonym:=definition^.sym^.synonym;
|
|
if definition^.sym<>@self then
|
|
definition^.sym^.synonym:=@self;
|
|
end
|
|
else
|
|
definition^.sym:=@self;
|
|
end;
|
|
if (definition^.deftype=recorddef) and assigned(precorddef(definition)^.symtable) and
|
|
(definition^.sym=@self) then
|
|
precorddef(definition)^.symtable^.name:=stringdup('record '+name);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure ttypesym.write;
|
|
|
|
begin
|
|
tsym.write;
|
|
writedefref(definition);
|
|
current_ppu^.writeentry(ibtypesym);
|
|
end;
|
|
|
|
|
|
procedure ttypesym.load_references;
|
|
begin
|
|
inherited load_references;
|
|
if (definition^.deftype=recorddef) then
|
|
precorddef(definition)^.symtable^.load_browser;
|
|
if (definition^.deftype=objectdef) then
|
|
pobjectdef(definition)^.symtable^.load_browser;
|
|
end;
|
|
|
|
|
|
function ttypesym.write_references : boolean;
|
|
begin
|
|
if not inherited write_references then
|
|
{ write address of this symbol if record or object
|
|
even if no real refs are there
|
|
because we need it for the symtable }
|
|
if (definition^.deftype=recorddef) or
|
|
(definition^.deftype=objectdef) then
|
|
begin
|
|
writesymref(@self);
|
|
current_ppu^.writeentry(ibsymref);
|
|
end;
|
|
write_references:=true;
|
|
if (definition^.deftype=recorddef) then
|
|
precorddef(definition)^.symtable^.write_browser;
|
|
if (definition^.deftype=objectdef) then
|
|
pobjectdef(definition)^.symtable^.write_browser;
|
|
end;
|
|
|
|
|
|
{$ifdef BrowserLog}
|
|
procedure ttypesym.add_to_browserlog;
|
|
begin
|
|
inherited add_to_browserlog;
|
|
if (definition^.deftype=recorddef) then
|
|
precorddef(definition)^.symtable^.writebrowserlog;
|
|
if (definition^.deftype=objectdef) then
|
|
pobjectdef(definition)^.symtable^.writebrowserlog;
|
|
end;
|
|
{$endif BrowserLog}
|
|
|
|
|
|
{$ifdef GDB}
|
|
function ttypesym.stabstring : pchar;
|
|
var stabchar : string[2];
|
|
short : string;
|
|
begin
|
|
if definition^.deftype in tagtypes then
|
|
stabchar := 'Tt'
|
|
else
|
|
stabchar := 't';
|
|
short := '"'+name+':'+stabchar+definition^.numberstring
|
|
+'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
|
|
stabstring := strpnew(short);
|
|
end;
|
|
|
|
procedure ttypesym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
{not stabs for forward defs }
|
|
if assigned(definition) then
|
|
if (definition^.sym = @self) then
|
|
definition^.concatstabto(asmlist)
|
|
else
|
|
inherited concatstabto(asmlist);
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TSYSSYM
|
|
****************************************************************************}
|
|
|
|
constructor tsyssym.init(const n : string;l : longint);
|
|
begin
|
|
inherited init(n);
|
|
typ:=syssym;
|
|
number:=l;
|
|
end;
|
|
|
|
constructor tsyssym.load;
|
|
begin
|
|
tsym.load;
|
|
typ:=syssym;
|
|
number:=readlong;
|
|
end;
|
|
|
|
destructor tsyssym.done;
|
|
begin
|
|
inherited done;
|
|
end;
|
|
|
|
procedure tsyssym.write;
|
|
begin
|
|
tsym.write;
|
|
writelong(number);
|
|
current_ppu^.writeentry(ibsyssym);
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
procedure tsyssym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TMACROSYM
|
|
****************************************************************************}
|
|
|
|
constructor tmacrosym.init(const n : string);
|
|
begin
|
|
inherited init(n);
|
|
typ:=macrosym;
|
|
defined:=true;
|
|
defined_at_startup:=false;
|
|
is_used:=false;
|
|
buftext:=nil;
|
|
buflen:=0;
|
|
end;
|
|
|
|
destructor tmacrosym.done;
|
|
begin
|
|
if assigned(buftext) then
|
|
freemem(buftext,buflen);
|
|
inherited done;
|
|
end;
|
|
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.122 1999-10-21 16:41:41 florian
|
|
* problems with readln fixed: esi wasn't restored correctly when
|
|
reading ordinal fields of objects futher the register allocation
|
|
didn't take care of the extra register when reading ordinal values
|
|
* enumerations can now be used in constant indexes of properties
|
|
|
|
Revision 1.121 1999/10/01 08:02:48 peter
|
|
* forward type declaration rewritten
|
|
|
|
Revision 1.120 1999/09/27 23:44:58 peter
|
|
* procinfo is now a pointer
|
|
* support for result setting in sub procedure
|
|
|
|
Revision 1.119 1999/09/26 21:30:22 peter
|
|
+ constant pointer support which can happend with typecasting like
|
|
const p=pointer(1)
|
|
* better procvar parsing in typed consts
|
|
|
|
Revision 1.118 1999/09/20 16:39:03 peter
|
|
* cs_create_smart instead of cs_smartlink
|
|
* -CX is create smartlink
|
|
* -CD is create dynamic, but does nothing atm.
|
|
|
|
Revision 1.117 1999/08/31 15:42:24 pierre
|
|
+ tmacrosym is_used and defined_at_startup boolean fields added
|
|
|
|
Revision 1.116 1999/08/24 22:38:55 michael
|
|
* more resourcestring changes
|
|
|
|
Revision 1.115 1999/08/23 11:45:42 michael
|
|
* Hopefully final attempt at resourcestrings
|
|
|
|
Revision 1.114 1999/08/15 21:57:58 michael
|
|
Changes for resource strings
|
|
|
|
Revision 1.113 1999/08/14 00:39:00 peter
|
|
* hack to support property with record fields
|
|
|
|
Revision 1.112 1999/08/13 14:24:20 pierre
|
|
+ stabs for classes and classref working,
|
|
a class still needs an ^ to get that content of it,
|
|
but the class fields inside a class don't result into an
|
|
infinite loop anymore!
|
|
|
|
Revision 1.111 1999/08/10 12:36:31 pierre
|
|
* use of procsym field for correct gdb info in local procedures
|
|
* exported DLL vars made global to be able to use DLLTOOL with themz
|
|
|
|
Revision 1.110 1999/08/07 14:21:03 florian
|
|
* some small problems fixed
|
|
|
|
Revision 1.109 1999/08/07 13:24:34 daniel
|
|
* Fixed open arrays
|
|
|
|
Revision 1.108 1999/08/05 16:53:17 peter
|
|
* V_Fatal=1, all other V_ are also increased
|
|
* Check for local procedure when assigning procvar
|
|
* fixed comment parsing because directives
|
|
* oldtp mode directives better supported
|
|
* added some messages to errore.msg
|
|
|
|
Revision 1.107 1999/08/04 13:45:30 florian
|
|
+ floating point register variables !!
|
|
* pairegalloc is now generated for register variables
|
|
|
|
Revision 1.106 1999/08/03 22:03:19 peter
|
|
* moved bitmask constants to sets
|
|
* some other type/const renamings
|
|
|
|
Revision 1.105 1999/07/29 20:54:10 peter
|
|
* write .size also
|
|
|
|
Revision 1.104 1999/07/27 23:42:21 peter
|
|
* indirect type referencing is now allowed
|
|
|
|
Revision 1.103 1999/07/24 15:12:59 michael
|
|
changes for resourcestrings
|
|
|
|
Revision 1.102 1999/07/24 13:36:23 michael
|
|
* Fixed resourcestring writing to units
|
|
|
|
Revision 1.101 1999/07/23 20:59:23 peter
|
|
* more C packing fixes
|
|
|
|
Revision 1.100 1999/07/23 16:05:32 peter
|
|
* alignment is now saved in the symtable
|
|
* C alignment added for records
|
|
* PPU version increased to solve .12 <-> .13 probs
|
|
|
|
Revision 1.99 1999/07/23 11:33:23 peter
|
|
* removed oldppu from propertysym
|
|
|
|
Revision 1.98 1999/07/22 09:37:55 florian
|
|
+ resourcestring implemented
|
|
+ start of longstring support
|
|
|
|
Revision 1.97 1999/07/05 12:13:25 florian
|
|
* property reading from PPU fixed (new PPU format), it uses now writesym...
|
|
|
|
Revision 1.96 1999/06/28 10:49:48 pierre
|
|
merged from 0-99-12 branch
|
|
|
|
Revision 1.94.2.2 1999/06/28 10:32:29 pierre
|
|
* fixes bug453
|
|
|
|
Revision 1.94.2.1 1999/06/22 16:26:45 pierre
|
|
* local browser stuff corrected
|
|
|
|
Revision 1.94 1999/06/03 16:25:05 pierre
|
|
* local Cvar stabs corrected
|
|
|
|
Revision 1.93 1999/05/27 19:45:06 peter
|
|
* removed oldasm
|
|
* plabel -> pasmlabel
|
|
* -a switches to source writing automaticly
|
|
* assembler readers OOPed
|
|
* asmsymbol automaticly external
|
|
* jumptables and other label fixes for asm readers
|
|
|
|
Revision 1.92 1999/05/21 13:55:21 peter
|
|
* NEWLAB for label as symbol
|
|
|
|
Revision 1.91 1999/05/20 22:22:44 pierre
|
|
+ added synonym filed for ttypesym
|
|
allows a clean disposal of tdefs and related ttypesyms
|
|
|
|
Revision 1.90 1999/05/17 13:11:40 pierre
|
|
* unitsym security stuff
|
|
|
|
Revision 1.89 1999/05/13 21:59:45 peter
|
|
* removed oldppu code
|
|
* warning if objpas is loaded from uses
|
|
* first things for new deref writing
|
|
|
|
Revision 1.88 1999/05/10 09:01:43 peter
|
|
* small message fixes
|
|
|
|
Revision 1.87 1999/05/08 19:52:38 peter
|
|
+ MessagePos() which is enhanced Message() function but also gets the
|
|
position info
|
|
* Removed comp warnings
|
|
|
|
Revision 1.86 1999/05/07 00:06:22 pierre
|
|
+ added aligmnent of data for typed consts
|
|
for var it is done by AS or LD or in ag386bin for direct object output
|
|
|
|
Revision 1.85 1999/05/04 21:45:07 florian
|
|
* changes to compile it with Delphi 4.0
|
|
|
|
Revision 1.84 1999/05/04 16:05:13 pierre
|
|
* fix for unitsym problem
|
|
|
|
Revision 1.83 1999/04/28 06:02:13 florian
|
|
* changes of Bruessel:
|
|
+ message handler can now take an explicit self
|
|
* typinfo fixed: sometimes the type names weren't written
|
|
* the type checking for pointer comparisations and subtraction
|
|
and are now more strict (was also buggy)
|
|
* small bug fix to link.pas to support compiling on another
|
|
drive
|
|
* probable bug in popt386 fixed: call/jmp => push/jmp
|
|
transformation didn't count correctly the jmp references
|
|
+ threadvar support
|
|
* warning if ln/sqrt gets an invalid constant argument
|
|
|
|
Revision 1.82 1999/04/26 13:31:52 peter
|
|
* release storenumber,double_checksum
|
|
|
|
Revision 1.81 1999/04/25 22:38:39 pierre
|
|
+ added is_really_const booleanfield for typedconstsym
|
|
for Delphi in $J- mode (not yet implemented !)
|
|
|
|
Revision 1.80 1999/04/21 09:43:54 peter
|
|
* storenumber works
|
|
* fixed some typos in double_checksum
|
|
+ incompatible types type1 and type2 message (with storenumber)
|
|
|
|
Revision 1.79 1999/04/17 13:16:21 peter
|
|
* fixes for storenumber
|
|
|
|
Revision 1.78 1999/04/14 09:15:02 peter
|
|
* first things to store the symbol/def number in the ppu
|
|
|
|
Revision 1.77 1999/04/08 10:11:32 pierre
|
|
+ enable uninitilized warnings for static symbols
|
|
|
|
Revision 1.76 1999/03/31 13:55:21 peter
|
|
* assembler inlining working for ag386bin
|
|
|
|
Revision 1.75 1999/03/24 23:17:27 peter
|
|
* fixed bugs 212,222,225,227,229,231,233
|
|
|
|
Revision 1.74 1999/02/23 18:29:27 pierre
|
|
* win32 compilation error fix
|
|
+ some work for local browser (not cl=omplete yet)
|
|
|
|
Revision 1.73 1999/02/22 13:07:09 pierre
|
|
+ -b and -bl options work !
|
|
+ cs_local_browser ($L+) is disabled if cs_browser ($Y+)
|
|
is not enabled when quitting global section
|
|
* local vars and procedures are not yet stored into PPU
|
|
|
|
Revision 1.72 1999/02/08 09:51:22 pierre
|
|
* gdb info for local functions was wrong
|
|
|
|
Revision 1.71 1999/01/23 23:29:41 florian
|
|
* first running version of the new code generator
|
|
* when compiling exceptions under Linux fixed
|
|
|
|
Revision 1.70 1999/01/21 22:10:48 peter
|
|
* fixed array of const
|
|
* generic platform independent high() support
|
|
|
|
Revision 1.69 1999/01/20 10:20:20 peter
|
|
* don't make localvar copies for assembler procedures
|
|
|
|
Revision 1.68 1999/01/12 14:25:36 peter
|
|
+ BrowserLog for browser.log generation
|
|
+ BrowserCol for browser info in TCollections
|
|
* released all other UseBrowser
|
|
|
|
Revision 1.67 1998/12/30 22:15:54 peter
|
|
+ farpointer type
|
|
* absolutesym now also stores if its far
|
|
|
|
Revision 1.66 1998/12/30 13:41:14 peter
|
|
* released valuepara
|
|
|
|
Revision 1.65 1998/12/26 15:35:44 peter
|
|
+ read/write of constnil
|
|
|
|
Revision 1.64 1998/12/08 10:18:15 peter
|
|
+ -gh for heaptrc unit
|
|
|
|
Revision 1.63 1998/11/28 16:20:56 peter
|
|
+ support for dll variables
|
|
|
|
Revision 1.62 1998/11/27 14:50:48 peter
|
|
+ open strings, $P switch support
|
|
|
|
Revision 1.61 1998/11/18 15:44:18 peter
|
|
* VALUEPARA for tp7 compatible value parameters
|
|
|
|
Revision 1.60 1998/11/16 10:13:51 peter
|
|
* label defines are checked at the end of the proc
|
|
|
|
Revision 1.59 1998/11/13 12:09:11 peter
|
|
* unused label is now a warning
|
|
|
|
Revision 1.58 1998/11/10 10:50:57 pierre
|
|
* temporary fix for long mangled procsym names
|
|
|
|
Revision 1.57 1998/11/05 23:39:31 peter
|
|
+ typedconst.getsize
|
|
|
|
Revision 1.56 1998/10/28 18:26:18 pierre
|
|
* removed some erros after other errors (introduced by useexcept)
|
|
* stabs works again correctly (for how long !)
|
|
|
|
Revision 1.55 1998/10/20 08:07:00 pierre
|
|
* several memory corruptions due to double freemem solved
|
|
=> never use p^.loc.location:=p^.left^.loc.location;
|
|
+ finally I added now by default
|
|
that ra386dir translates global and unit symbols
|
|
+ added a first field in tsymtable and
|
|
a nextsym field in tsym
|
|
(this allows to obtain ordered type info for
|
|
records and objects in gdb !)
|
|
|
|
Revision 1.54 1998/10/19 08:55:07 pierre
|
|
* wrong stabs info corrected once again !!
|
|
+ variable vmt offset with vmt field only if required
|
|
implemented now !!!
|
|
|
|
Revision 1.53 1998/10/16 08:51:53 peter
|
|
+ target_os.stackalignment
|
|
+ stack can be aligned at 2 or 4 byte boundaries
|
|
|
|
Revision 1.52 1998/10/08 17:17:32 pierre
|
|
* current_module old scanner tagged as invalid if unit is recompiled
|
|
+ added ppheap for better info on tracegetmem of heaptrc
|
|
(adds line column and file index)
|
|
* several memory leaks removed ith help of heaptrc !!
|
|
|
|
Revision 1.51 1998/10/08 13:48:50 peter
|
|
* fixed memory leaks for do nothing source
|
|
* fixed unit interdependency
|
|
|
|
Revision 1.50 1998/10/06 17:16:56 pierre
|
|
* some memory leaks fixed (thanks to Peter for heaptrc !)
|
|
|
|
Revision 1.49 1998/10/01 09:22:55 peter
|
|
* fixed value openarray
|
|
* ungettemp of arrayconstruct
|
|
|
|
Revision 1.48 1998/09/26 17:45:44 peter
|
|
+ idtoken and only one token table
|
|
|
|
Revision 1.47 1998/09/24 15:11:17 peter
|
|
* fixed enum for not GDB
|
|
|
|
Revision 1.46 1998/09/23 15:39:13 pierre
|
|
* browser bugfixes
|
|
was adding a reference when looking for the symbol
|
|
if -bSYM_NAME was used
|
|
|
|
Revision 1.45 1998/09/21 08:45:24 pierre
|
|
+ added vmt_offset in tobjectdef.write for fututre use
|
|
(first steps to have objects without vmt if no virtual !!)
|
|
+ added fpu_used field for tabstractprocdef :
|
|
sets this level to 2 if the functions return with value in FPU
|
|
(is then set to correct value at parsing of implementation)
|
|
THIS MIGHT refuse some code with FPU expression too complex
|
|
that were accepted before and even in some cases
|
|
that don't overflow in fact
|
|
( like if f : float; is a forward that finally in implementation
|
|
only uses one fpu register !!)
|
|
Nevertheless I think that it will improve security on
|
|
FPU operations !!
|
|
* most other changes only for UseBrowser code
|
|
(added symtable references for record and objects)
|
|
local switch for refs to args and local of each function
|
|
(static symtable still missing)
|
|
UseBrowser still not stable and probably broken by
|
|
the definition hash array !!
|
|
|
|
Revision 1.44 1998/09/18 16:03:47 florian
|
|
* some changes to compile with Delphi
|
|
|
|
Revision 1.43 1998/09/18 08:01:38 pierre
|
|
+ improvement on the usebrowser part
|
|
(does not work correctly for now)
|
|
|
|
Revision 1.42 1998/09/07 19:33:25 florian
|
|
+ some stuff for property rtti added:
|
|
- NameIndex of the TPropInfo record is now written correctly
|
|
- the DEFAULT/NODEFAULT keyword is supported now
|
|
- the default value and the storedsym/def are now written to
|
|
the PPU fiel
|
|
|
|
Revision 1.41 1998/09/07 18:46:12 peter
|
|
* update smartlinking, uses getdatalabel
|
|
* renamed ptree.value vars to value_str,value_real,value_set
|
|
|
|
Revision 1.40 1998/09/07 17:37:04 florian
|
|
* first fixes for published properties
|
|
|
|
Revision 1.39 1998/09/05 22:11:02 florian
|
|
+ switch -vb
|
|
* while/repeat loops accept now also word/longbool conditions
|
|
* makebooltojump did an invalid ungetregister32, fixed
|
|
|
|
Revision 1.38 1998/09/01 12:53:26 peter
|
|
+ aktpackenum
|
|
|
|
Revision 1.37 1998/09/01 07:54:25 pierre
|
|
* UseBrowser a little updated (might still be buggy !!)
|
|
* bug in psub.pas in function specifier removed
|
|
* stdcall allowed in interface and in implementation
|
|
(FPC will not yet complain if it is missing in either part
|
|
because stdcall is only a dummy !!)
|
|
|
|
Revision 1.36 1998/08/25 13:09:26 pierre
|
|
* corrected mangling sheme :
|
|
cvar add Cprefix to the mixed case name whereas
|
|
export or public use direct name
|
|
|
|
Revision 1.35 1998/08/25 12:42:46 pierre
|
|
* CDECL changed to CVAR for variables
|
|
specifications are read in structures also
|
|
+ started adding GPC compatibility mode ( option -Sp)
|
|
* names changed to lowercase
|
|
|
|
Revision 1.34 1998/08/21 14:08:53 pierre
|
|
+ TEST_FUNCRET now default (old code removed)
|
|
works also for m68k (at least compiles)
|
|
|
|
Revision 1.33 1998/08/20 12:53:27 peter
|
|
* object_options are always written for object syms
|
|
|
|
Revision 1.32 1998/08/20 09:26:46 pierre
|
|
+ funcret setting in underproc testing
|
|
compile with _dTEST_FUNCRET
|
|
|
|
Revision 1.31 1998/08/17 10:10:12 peter
|
|
- removed OLDPPU
|
|
|
|
Revision 1.30 1998/08/13 10:57:29 peter
|
|
* constant sets are now written correctly to the ppufile
|
|
|
|
Revision 1.29 1998/08/11 15:31:42 peter
|
|
* write extended to ppu file
|
|
* new version 0.99.7
|
|
|
|
Revision 1.28 1998/08/11 14:07:27 peter
|
|
* fixed pushing of high value for openarray
|
|
|
|
Revision 1.27 1998/08/10 14:50:31 peter
|
|
+ localswitches, moduleswitches, globalswitches splitting
|
|
|
|
Revision 1.26 1998/08/10 10:18:35 peter
|
|
+ Compiler,Comphook unit which are the new interface units to the
|
|
compiler
|
|
|
|
Revision 1.25 1998/07/30 11:18:19 florian
|
|
+ first implementation of try ... except on .. do end;
|
|
* limitiation of 65535 bytes parameters for cdecl removed
|
|
|
|
Revision 1.24 1998/07/20 18:40:16 florian
|
|
* handling of ansi string constants should now work
|
|
|
|
Revision 1.23 1998/07/14 21:37:24 peter
|
|
* fixed packrecords as discussed at the alias
|
|
|
|
Revision 1.22 1998/07/14 14:47:08 peter
|
|
* released NEWINPUT
|
|
|
|
Revision 1.21 1998/07/13 21:17:38 florian
|
|
* changed to compile with TP
|
|
|
|
Revision 1.20 1998/07/10 00:00:05 peter
|
|
* fixed ttypesym bug finally
|
|
* fileinfo in the symtable and better using for unused vars
|
|
|
|
Revision 1.19 1998/07/07 17:40:39 peter
|
|
* packrecords 4 works
|
|
* word aligning of parameters
|
|
|
|
Revision 1.18 1998/07/07 11:20:15 peter
|
|
+ NEWINPUT for a better inputfile and scanner object
|
|
|
|
Revision 1.17 1998/06/24 14:48:40 peter
|
|
* ifdef newppu -> ifndef oldppu
|
|
|
|
Revision 1.16 1998/06/19 15:40:42 peter
|
|
* removed cosntructor/constructor warning and 0.99.5 recompiles it again
|
|
|
|
Revision 1.15 1998/06/17 14:10:18 peter
|
|
* small os2 fixes
|
|
* fixed interdependent units with newppu (remake3 under linux works now)
|
|
|
|
Revision 1.14 1998/06/16 08:56:34 peter
|
|
+ targetcpu
|
|
* cleaner pmodules for newppu
|
|
|
|
Revision 1.13 1998/06/15 15:38:10 pierre
|
|
* small bug in systems.pas corrected
|
|
+ operators in different units better hanlded
|
|
|
|
Revision 1.12 1998/06/15 14:23:44 daniel
|
|
|
|
* Reverted my changes.
|
|
|
|
Revision 1.10 1998/06/13 00:10:18 peter
|
|
* working browser and newppu
|
|
* some small fixes against crashes which occured in bp7 (but not in
|
|
fpc?!)
|
|
|
|
Revision 1.9 1998/06/12 16:15:35 pierre
|
|
* external name 'C_var';
|
|
export name 'intern_C_var';
|
|
cdecl;
|
|
cdecl;external;
|
|
are now supported only with -Sv switch
|
|
|
|
Revision 1.8 1998/06/11 10:11:59 peter
|
|
* -gb works again
|
|
|
|
Revision 1.7 1998/06/09 16:01:51 pierre
|
|
+ added procedure directive parsing for procvars
|
|
(accepted are popstack cdecl and pascal)
|
|
+ added C vars with the following syntax
|
|
var C calias 'true_c_name';(can be followed by external)
|
|
reason is that you must add the Cprefix
|
|
|
|
which is target dependent
|
|
|
|
Revision 1.6 1998/06/08 22:59:53 peter
|
|
* smartlinking works for win32
|
|
* some defines to exclude some compiler parts
|
|
|
|
Revision 1.5 1998/06/04 23:52:02 peter
|
|
* m68k compiles
|
|
+ .def file creation moved to gendef.pas so it could also be used
|
|
for win32
|
|
|
|
Revision 1.4 1998/06/04 09:55:46 pierre
|
|
* demangled name of procsym reworked to become independant of the mangling scheme
|
|
|
|
Revision 1.3 1998/06/03 22:14:20 florian
|
|
* problem with sizes of classes fixed (if the anchestor was declared
|
|
forward, the compiler doesn't update the child classes size)
|
|
|
|
Revision 1.2 1998/05/28 14:40:29 peter
|
|
* fixes for newppu, remake3 works now with it
|
|
|
|
Revision 1.1 1998/05/27 19:45:09 peter
|
|
* symtable.pas splitted into includefiles
|
|
* symtable adapted for $ifndef OLDPPU
|
|
|
|
}
|
|
|