paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 07:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* reginfo now also only allocated during register allocation

Browse Source 
* third round of gdb cleanups: kick out most of concatstabto
This commit is contained in:
daniel 2004-01-26 16:12:27 +00:00
parent bf36516f33
commit 97e87aaebc
18 changed files with 873 additions and 385 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/aasmtai.pas
View File

@ -37,7 +37,7 @@ interface
globtype,globals,systems,
cpuinfo,cpubase,
cgbase,
symppu,symtype,
symtype,
aasmbase;
type
@ -1971,7 +1971,11 @@ implementation
end.
{
$Log$
Revision 1.66 2004-01-24 18:12:40 florian
Revision 1.67 2004-01-26 16:12:27 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.66 2004/01/24 18:12:40 florian
* fixed several arm floating point issues
Revision 1.65 2004/01/23 15:12:49 florian

8
compiler/fppu.pas
View File

@ -38,7 +38,7 @@ interface
uses
cutils,cclasses,
globtype,globals,finput,fmodule,
symbase,symppu,ppu;
symbase,ppu,symtype;
type
tppumodule = class(tmodule)
@ -1514,7 +1514,11 @@ uses
end.
{
$Log$
Revision 1.50 2004-01-22 17:23:56 peter
Revision 1.51 2004-01-26 16:12:27 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.50 2004/01/22 17:23:56 peter
* also check in the same dir as the unit we are loading from, this
makes UNITPATH working better

8
compiler/nbas.pas
View File

@ -30,7 +30,7 @@ interface
cpubase,cgbase,
aasmbase,aasmtai,aasmcpu,
node,tgobj,
symtype,symppu;
symtype;
type
tnothingnode = class(tnode)
@ -983,7 +983,11 @@ begin
end.
{
$Log$
Revision 1.74 2003-12-10 20:31:40 jonas
Revision 1.75 2004-01-26 16:12:27 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.74 2003/12/10 20:31:40 jonas
* override tblocknode.destroy so all statements are freed sequentially
instead of recusively.

8
compiler/ncal.pas
View File

@ -34,7 +34,7 @@ interface
{$ifdef state_tracking}
nstate,
{$endif state_tracking}
symbase,symtype,symppu,symsym,symdef,symtable;
symbase,symtype,symsym,symdef,symtable;
type
pcandidate = ^tcandidate;
@ -2711,7 +2711,11 @@ begin
end.
{
$Log$
Revision 1.220 2004-01-15 15:16:18 daniel
Revision 1.221 2004-01-26 16:12:27 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.220 2004/01/15 15:16:18 daniel
* Some minor stuff
* Managed to eliminate speed effects of string compression

8
compiler/ncnv.pas
View File

@ -28,7 +28,7 @@ interface
uses
node,
symtype,symppu,
symtype,
defutil,defcmp,
nld
{$ifdef Delphi}
@ -2405,7 +2405,11 @@ begin
end.
{
$Log$
Revision 1.134 2003-12-26 00:32:21 florian
Revision 1.135 2004-01-26 16:12:27 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.134 2003/12/26 00:32:21 florian
+ fpu<->mm register conversion
Revision 1.133 2003/12/22 23:11:15 peter

8
compiler/ncon.pas
View File

@ -30,7 +30,7 @@ interface
globtype,widestr,
node,
aasmbase,aasmtai,cpuinfo,globals,
symconst,symppu,symtype,symdef,symsym;
symconst,symtype,symdef,symsym;
type
trealconstnode = class(tnode)
@ -950,7 +950,11 @@ begin
end.
{
$Log$
Revision 1.57 2004-01-12 16:35:40 peter
Revision 1.58 2004-01-26 16:12:27 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.57 2004/01/12 16:35:40 peter
* range check error
Revision 1.56 2003/10/23 14:44:07 peter

8
compiler/nflw.pas
View File

@ -30,7 +30,7 @@ interface
uses
node,cpubase,
aasmbase,aasmtai,aasmcpu,symnot,
symppu,symtype,symbase,symdef,symsym;
symtype,symbase,symdef,symsym;
type
{ flags used by loop nodes }
@ -1475,7 +1475,11 @@ begin
end.
{
$Log$
Revision 1.91 2003-12-28 22:51:18 florian
Revision 1.92 2004-01-26 16:12:27 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.91 2003/12/28 22:51:18 florian
+ except handling related nodes now include pi_do_call if necessary
Revision 1.90 2003/12/08 19:29:21 peter

10
compiler/ninl.pas
View File

@ -27,7 +27,7 @@ unit ninl;
interface
uses
node,htypechk,cpuinfo,symppu;
node,htypechk,cpuinfo,symtype;
{$i compinnr.inc}
@ -72,7 +72,7 @@ implementation
uses
verbose,globals,systems,
globtype, cutils,
symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defutil,defcmp,
symbase,symconst,symdef,symsym,symtable,paramgr,defutil,defcmp,
pass_1,
ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,
cgbase,procinfo
@ -2366,7 +2366,11 @@ begin
end.
{
$Log$
Revision 1.126 2003-12-31 20:47:02 jonas
Revision 1.127 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.126 2003/12/31 20:47:02 jonas
* properly fixed assigned() mess (by handling it separately in ncginl)
-> all assigned()-related tests in the test suite work again

8
compiler/nld.pas
View File

@ -31,7 +31,7 @@ interface
{$ifdef state_tracking}
nstate,
{$endif}
symconst,symppu,symbase,symtype,symsym,symdef;
symconst,symbase,symtype,symsym,symdef;
type
tloadnode = class(tunarynode)
@ -1246,7 +1246,11 @@ begin
end.
{
$Log$
Revision 1.119 2003-12-01 18:44:15 peter
Revision 1.120 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.119 2003/12/01 18:44:15 peter
* fixed some crashes
* fixed varargs and register calling probs

8
compiler/nmem.pas
View File

@ -28,7 +28,7 @@ interface
uses
node,
symtype,symppu,symdef,symsym,symtable,
symdef,symsym,symtable,symtype,
cpubase;
type
@ -967,7 +967,11 @@ begin
end.
{
$Log$
Revision 1.76 2003-12-12 15:42:53 peter
Revision 1.77 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.76 2003/12/12 15:42:53 peter
* don't give warnings for shortstring vecnodes
Revision 1.75 2003/12/08 22:35:06 peter

8
compiler/node.pas
View File

@ -31,7 +31,7 @@ interface
globtype,globals,
cpubase,cgbase,
aasmbase,
symtype,symppu;
symtype;
type
pconstset = ^tconstset;
@ -1087,7 +1087,11 @@ implementation
end.
{
$Log$
Revision 1.79 2003-12-26 00:32:22 florian
Revision 1.80 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.79 2003/12/26 00:32:22 florian
+ fpu<->mm register conversion
Revision 1.78 2003/12/01 18:44:15 peter

9
compiler/nset.pas
View File

@ -28,8 +28,7 @@ interface
uses
node,globals,
aasmbase,aasmtai,
symppu;
aasmbase,aasmtai,symtype;
type
pcaserecord = ^tcaserecord;
@ -695,7 +694,11 @@ begin
end.
{
$Log$
Revision 1.50 2003-11-10 19:10:57 peter
Revision 1.51 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.50 2003/11/10 19:10:57 peter
* check for enumdef.maxval<255 instead of enumdef.savesize
Revision 1.49 2003/10/23 14:44:07 peter

43
compiler/rgobj.pas
View File

@ -240,6 +240,8 @@ unit rgobj;
{$ifdef EXTDEBUG}
procedure writegraph(loopidx:longint);
{$endif EXTDEBUG}
{# Disposes of the reginfo array.}
procedure dispose_reginfo;
{# Prepare the register colouring.}
procedure prepare_colouring;
{# Clean up after register colouring.}
@ -374,15 +376,15 @@ implementation
used_in_proc:=[];
live_registers.init;
{ Get reginfo for CPU registers }
reginfo:=allocmem(first_imaginary*sizeof(treginfo));
maxreginfo:=first_imaginary;
maxreginfoinc:=16;
worklist_moves:=Tlinkedlist.create;
reginfo:=allocmem(first_imaginary*sizeof(treginfo));
for i:=0 to first_imaginary-1 do
begin
reginfo[i].degree:=high(tsuperregister);
reginfo[i].alias:=RS_INVALID;
end;
worklist_moves:=Tlinkedlist.create;
{ Usable registers }
fillchar(usable_registers,sizeof(usable_registers),0);
for i:=low(Ausable) to high(Ausable) do
@ -399,8 +401,6 @@ implementation
destructor trgobj.destroy;
var i:Tsuperregister;
begin
spillednodes.done;
simplifyworklist.done;
@ -408,17 +408,28 @@ implementation
spillworklist.done;
coalescednodes.done;
selectstack.done;
for i:=0 to maxreg-1 do
begin
if reginfo[i].adjlist<>nil then
dispose(reginfo[i].adjlist,done);
if reginfo[i].movelist<>nil then
dispose(reginfo[i].movelist);
end;
freemem(reginfo);
worklist_moves.free;
dispose_reginfo;
end;
procedure Trgobj.dispose_reginfo;
var i:Tsuperregister;
begin
if reginfo<>nil then
begin
for i:=0 to maxreg-1 do
begin
if reginfo[i].adjlist<>nil then
dispose(reginfo[i].adjlist,done);
if reginfo[i].movelist<>nil then
dispose(reginfo[i].movelist);
end;
freemem(reginfo);
reginfo:=nil;
end;
end;
function trgobj.getnewreg(subreg:tsubregister):tsuperregister;
var
@ -503,6 +514,7 @@ implementation
var
spillingcounter:byte;
endspill:boolean;
i:Tsuperregister;
begin
{ Insert regalloc info for imaginary registers }
insert_regalloc_info(list,headertai);
@ -528,6 +540,7 @@ implementation
until endspill;
ibitmap.free;
translate_registers(list);
dispose_reginfo;
end;
@ -1817,9 +1830,9 @@ implementation
end.
{
$Log$
Revision 1.113 2004-01-25 23:21:02 daniel
* Keep interference bitmap only allocated during register allocation.
Saves 2 mb of memory.
Revision 1.114 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.112 2004/01/12 16:37:59 peter
* moved spilling code from taicpu to rg

8
compiler/symdef.pas
View File

@ -33,7 +33,7 @@ interface
{ symtable }
symconst,symbase,symtype,
{ ppu }
symppu,ppu,
ppu,
{ node }
node,
{ aasm }
@ -6191,7 +6191,11 @@ implementation
end.
{
$Log$
Revision 1.206 2004-01-25 20:23:28 daniel
Revision 1.207 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.206 2004/01/25 20:23:28 daniel
* More gdb cleanup: make record & object stab generation linear instead
of quadratic.

464
compiler/symsym.pas
View File

@ -33,7 +33,7 @@ interface
{ symtable }
symconst,symbase,symtype,symdef,defcmp,
{ ppu }
ppu,symppu,
ppu,
cclasses,symnot,
{ aasm }
aasmbase,aasmtai,
@ -50,30 +50,20 @@ interface
protected
_mangledname : pstring;
public
refs : longint;
lastref,
defref,
lastwritten : tref;
refcount : longint;
{$ifdef GDB}
isstabwritten : boolean;
{$endif GDB}
constructor create(const n : string);
constructor loadsym(ppufile:tcompilerppufile);
destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);virtual;abstract;
procedure writesym(ppufile:tcompilerppufile);
procedure buildderef;override;
procedure deref;override;
{$ifdef GDB}
function get_var_value(const s:string):string;
function stabstr_evaluate(const s:string;vars:array of string):Pchar;
function stabstring : pchar;virtual;
procedure concatstabto(asmlist : taasmoutput);virtual;
procedure concatstabto(asmlist : taasmoutput);
{$endif GDB}
procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
function is_visible_for_object(currobjdef:tobjectdef):boolean;
function mangledname : string;
procedure generate_mangledname;virtual;abstract;
end;
@ -97,11 +87,11 @@ interface
destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef GDB}
procedure concatstabto(asmlist : taasmoutput);override;
function stabstring:Pchar;override;
{$endif GDB}
end;
terrorsym = class(tstoredsym)
terrorsym = class(Tsym)
constructor create;
end;
@ -151,7 +141,6 @@ interface
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
{$ifdef GDB}
function stabstring : pchar;override;
procedure concatstabto(asmlist : taasmoutput);override;
{$endif GDB}
end;
@ -170,7 +159,6 @@ interface
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
{$ifdef GDB}
function stabstring : pchar;override;
procedure concatstabto(asmlist : taasmoutput);override;
{$endif GDB}
end;
@ -202,7 +190,6 @@ interface
procedure unregister_notification(id:cardinal);
{$ifdef GDB}
function stabstring : pchar;override;
procedure concatstabto(asmlist : taasmoutput);override;
{$endif GDB}
private
procedure setvartype(const newtype: ttype);
@ -233,7 +220,6 @@ interface
procedure dooverride(overriden:tpropertysym);
{$ifdef GDB}
function stabstring : pchar;override;
procedure concatstabto(asmlist : taasmoutput);override;
{$endif GDB}
end;
@ -251,7 +237,7 @@ interface
function mangledname : string;
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef GDB}
procedure concatstabto(asmlist : taasmoutput);override;
function stabstring : pchar;override;
{$endif GDB}
end;
@ -298,7 +284,6 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef GDB}
function stabstring : pchar;override;
procedure concatstabto(asmlist : taasmoutput);override;
{$endif GDB}
end;
@ -314,7 +299,7 @@ interface
procedure deref;override;
procedure order;
{$ifdef GDB}
procedure concatstabto(asmlist : taasmoutput);override;
function stabstring:Pchar;
{$endif GDB}
end;
@ -325,7 +310,7 @@ interface
destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef GDB}
procedure concatstabto(asmlist : taasmoutput);override;
function stabstring:Pchar;
{$endif GDB}
end;
@ -408,15 +393,6 @@ implementation
isstabwritten := false;
{$endif GDB}
fileinfo:=akttokenpos;
defref:=nil;
refs:=0;
lastwritten:=nil;
refcount:=0;
if (cs_browser in aktmoduleswitches) and make_ref then
begin
defref:=tref.create(defref,@akttokenpos);
inc(refcount);
end;
lastref:=defref;
_mangledname:=nil;
end;
@ -427,25 +403,13 @@ implementation
s : string;
nr : word;
begin
nr:=ppufile.getword;
s:=ppufile.getstring;
inherited create(s);
{ force the correct indexnr. must be after create! }
indexnr:=nr;
ppufile.getposinfo(fileinfo);
ppufile.getsmallset(symoptions);
lastref:=nil;
defref:=nil;
refs:=0;
lastwritten:=nil;
refcount:=0;
inherited loadsym(ppufile);
_mangledname:=nil;
{$ifdef GDB}
isstabwritten := false;
{$endif GDB}
end;
procedure tstoredsym.buildderef;
begin
end;
@ -456,76 +420,6 @@ implementation
end;
procedure tstoredsym.load_references(ppufile:tcompilerppufile;locals:boolean);
var
pos : tfileposinfo;
move_last : boolean;
begin
move_last:=lastwritten=lastref;
while (not ppufile.endofentry) do
begin
ppufile.getposinfo(pos);
inc(refcount);
lastref:=tref.create(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 tstoredsym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
var
d : tderef;
ref : tref;
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 }
d.reset;
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
d.build(self);
ppufile.putderef(d);
symref_written:=true;
end;
ppufile.putposinfo(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
ppufile.writeentry(ibsymref);
write_references:=symref_written;
end;
destructor tstoredsym.destroy;
begin
if assigned(_mangledname) then
@ -552,15 +446,6 @@ implementation
inherited destroy;
end;
procedure tstoredsym.writesym(ppufile:tcompilerppufile);
begin
ppufile.putword(indexnr);
ppufile.putstring(_realname^);
ppufile.putposinfo(fileinfo);
ppufile.putsmallset(symoptions);
end;
{$ifdef GDB}
function Tstoredsym.get_var_value(const s:string):string;
@ -609,45 +494,12 @@ implementation
begin
stab_str := stabstring;
if assigned(stab_str) then
asmList.concat(Tai_stabs.Create(stab_str));
asmlist.concat(Tai_stabs.create(stab_str));
isstabwritten:=true;
end;
end;
{$endif GDB}
function tstoredsym.is_visible_for_object(currobjdef:tobjectdef):boolean;
begin
is_visible_for_object:=false;
{ private symbols are allowed when we are in the same
module as they are defined }
if (sp_private in symoptions) and
assigned(owner.defowner) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0) then
exit;
{ protected symbols are vissible in the module that defines them and
also visible to related objects }
if (sp_protected in symoptions) and
(
(
assigned(owner.defowner) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0)
) and
not(
assigned(currobjdef) and
currobjdef.is_related(tobjectdef(owner.defowner))
)
) then
exit;
is_visible_for_object:=true;
end;
function tstoredsym.mangledname : string;
begin
if not assigned(_mangledname) then
@ -759,10 +611,11 @@ implementation
end;
{$ifdef GDB}
procedure tunitsym.concatstabto(asmlist : taasmoutput);
begin
{Nothing to write to stabs !}
end;
function Tunitsym.stabstring:Pchar;
begin
stabstring:=nil;
end;
{$endif GDB}
{****************************************************************************
@ -1362,13 +1215,7 @@ implementation
function tprocsym.stabstring : pchar;
begin
internalerror(200111171);
stabstring:=nil;
end;
procedure tprocsym.concatstabto(asmlist : taasmoutput);
begin
internalerror(200111172);
end;
{$endif GDB}
@ -1526,11 +1373,6 @@ implementation
{ !!!! don't know how to handle }
stabstring:=nil;
end;
procedure tpropertysym.concatstabto(asmlist : taasmoutput);
begin
{ !!!! don't know how to handle }
end;
{$endif GDB}
@ -1648,10 +1490,11 @@ implementation
{$ifdef GDB}
procedure tabsolutesym.concatstabto(asmlist : taasmoutput);
begin
{ I don't know how to handle this !! }
end;
function Tabsolutesym.stabstring:Pchar;
begin
stabstring:=nil;
end;
{$endif GDB}
@ -1849,124 +1692,117 @@ implementation
end;
{$ifdef GDB}
function tvarsym.stabstring : pchar;
var
st : string;
threadvaroffset : string;
regidx : tregisterindex;
begin
stabstring:=nil;
st:=tstoreddef(vartype.def).numberstring;
if (vo_is_thread_var in varoptions) then
threadvaroffset:='+'+tostr(pointer_size)
else
threadvaroffset:='';
function Tvarsym.stabstring:Pchar;
case owner.symtabletype of
objectsymtable :
if (sp_static in symoptions) then
begin
if (cs_gdb_gsym in aktglobalswitches) then
st:='G'+st
else
st:='S'+st;
stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
end;
globalsymtable :
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:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
end;
staticsymtable :
stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
parasymtable,
localsymtable :
begin
{ There is no space allocated for not referenced locals }
if (owner.symtabletype=localsymtable) and (refs=0) then
exit;
var st:string;
threadvaroffset:string;
regidx:Tregisterindex;
c:char;
if (vo_is_C_var in varoptions) then
begin
stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}',[st]);
exit;
end;
if (owner.symtabletype=parasymtable) then
begin
if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and
not(vo_has_local_copy in varoptions) then
st := 'v'+st { should be 'i' but 'i' doesn't work }
else
st := 'p'+st;
end;
case localloc.loc of
LOC_REGISTER, LOC_FPUREGISTER :
begin
regidx:=findreg_by_number(localloc.register);
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
end;
LOC_REFERENCE :
{ offset to ebp => will not work if the framepointer is esp
so some optimizing will make things harder to debug }
stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
else
internalerror(2003091814);
end;
end;
else
stabstring := inherited stabstring;
end;
end;
begin
if (vo_is_self in varoptions) then
begin
if localloc.loc<>LOC_REFERENCE then
internalerror(2003091815);
if (po_classmethod in current_procinfo.procdef.procoptions) or
(po_staticmethod in current_procinfo.procdef.procoptions) then
stabstring:=stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2',
[Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)])
else
begin
if not(is_class(current_procinfo.procdef._class)) then
c:='v'
else
c:='p';
stabstring:=stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2',
[c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)]);
end;
end
else
(*
if (localloc.loc=LOC_REGISTER) then
begin
regidx:=findreg_by_number(localloc.register);
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',
[Tstoreddef(vartype.def).numberstring,tostr(regstabs_table[regidx])]);
end
else
*)
begin
stabstring:=nil;
st:=tstoreddef(vartype.def).numberstring;
if (vo_is_thread_var in varoptions) then
threadvaroffset:='+'+tostr(pointer_size)
else
threadvaroffset:='';
case owner.symtabletype of
objectsymtable:
if (sp_static in symoptions) then
begin
if (cs_gdb_gsym in aktglobalswitches) then
st:='G'+st
else
st:='S'+st;
stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',
[st,threadvaroffset]);
end;
globalsymtable:
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:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
end;
staticsymtable :
stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
parasymtable,localsymtable:
begin
{ There is no space allocated for not referenced locals }
if (owner.symtabletype=localsymtable) and (refs=0) then
exit;
procedure tvarsym.concatstabto(asmlist : taasmoutput);
var
regidx : tregisterindex;
stab_str : pchar;
c : char;
begin
if (owner.symtabletype=parasymtable) and
(copy(name,1,6)='hidden') then
exit;
if (vo_is_self in varoptions) then
begin
if localloc.loc<>LOC_REFERENCE then
internalerror(2003091815);
if (po_classmethod in current_procinfo.procdef.procoptions) or
(po_staticmethod in current_procinfo.procdef.procoptions) then
asmlist.concat(Tai_stabs.create(stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2',
[Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)])))
else
begin
if not(is_class(current_procinfo.procdef._class)) then
c:='v'
else
c:='p';
asmlist.concat(Tai_stabs.create(stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2',
[c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)])));
end;
end
else
if (localloc.loc=LOC_REGISTER) then
begin
regidx:=findreg_by_number(localloc.register);
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
asmlist.concat(Tai_stabs.create(stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',
[Tstoreddef(vartype.def).numberstring,tostr(regstabs_table[regidx])])));
end
else
inherited concatstabto(asmlist);
end;
if (vo_is_C_var in varoptions) then
begin
stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}',[st]);
exit;
end;
if (owner.symtabletype=parasymtable) then
begin
if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and
not(vo_has_local_copy in varoptions) then
st := 'v'+st { should be 'i' but 'i' doesn't work }
else
st := 'p'+st;
end;
case localloc.loc of
LOC_REGISTER, LOC_FPUREGISTER :
begin
regidx:=findreg_by_number(localloc.register);
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
end;
LOC_REFERENCE :
{ offset to ebp => will not work if the framepointer is esp
so some optimizing will make things harder to debug }
stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
else
internalerror(2003091814);
end;
end;
else
stabstring := inherited stabstring;
end;
end;
end;
{$endif GDB}
procedure tvarsym.setvartype(const newtype: ttype);
@ -2337,12 +2173,6 @@ implementation
end;
stabstring:=stabstr_evaluate('"${name}:c=$1",${N_FUNCTION},0,${line},0',[st]);
end;
procedure tconstsym.concatstabto(asmlist : taasmoutput);
begin
if consttyp <> conststring then
inherited concatstabto(asmlist);
end;
{$endif GDB}
@ -2428,9 +2258,10 @@ implementation
{$ifdef GDB}
procedure tenumsym.concatstabto(asmlist : taasmoutput);
function Tenumsym.stabstring:Pchar;
begin
{enum elements have no stab !}
{enum elements have no stab !}
end;
{$EndIf GDB}
@ -2534,22 +2365,17 @@ implementation
var stabchar:string[2];
begin
if restype.def.deftype in tagtypes then
stabchar:='Tt'
if restype.def=nil then
stabstring:=nil
else
stabchar:='t';
stabstring:=stabstr_evaluate('"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,tstoreddef(restype.def).numberstring]);
begin
if restype.def.deftype in tagtypes then
stabchar:='Tt'
else
stabchar:='t';
stabstring:=stabstr_evaluate('"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,tstoreddef(restype.def).numberstring]);
end;
end;
procedure ttypesym.concatstabto(asmlist : taasmoutput);
begin
{not stabs for forward defs }
if assigned(restype.def) then
if (restype.def.typesym = self) then
tstoreddef(restype.def).concatstabto(asmlist)
else
inherited concatstabto(asmlist);
end;
{$endif GDB}
@ -2584,9 +2410,11 @@ implementation
end;
{$ifdef GDB}
procedure tsyssym.concatstabto(asmlist : taasmoutput);
begin
end;
function Tsyssym.stabstring:Pchar;
begin
stabstring:=nil
end;
{$endif GDB}
@ -2719,7 +2547,11 @@ implementation
end.
{
$Log$
Revision 1.144 2004-01-25 11:33:48 daniel
Revision 1.145 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.144 2004/01/25 11:33:48 daniel
* 2nd round of gdb cleanup
Revision 1.143 2004/01/16 18:08:39 daniel

45
compiler/symtable.pas
View File

@ -33,7 +33,7 @@ interface
{ symtable }
symconst,symbase,symtype,symdef,symsym,
{ ppu }
ppu,symppu,
ppu,
{ assembler }
aasmtai
;
@ -399,18 +399,18 @@ implementation
procedure tstoredsymtable.writesyms(ppufile:tcompilerppufile);
var
pd : tstoredsym;
pd : Tsym;
begin
{ each definition get a number, write then the amount of syms and the
datasize to the ibsymdef entry }
ppufile.putlongint(symindex.count);
ppufile.writeentry(ibstartsyms);
{ foreach is used to write all symbols }
pd:=tstoredsym(symindex.first);
pd:=Tsym(symindex.first);
while assigned(pd) do
begin
pd.ppuwrite(ppufile);
pd:=tstoredsym(pd.indexnext);
pd:=Tsym(pd.indexnext);
end;
{ end of symbols }
ppufile.writeentry(ibendsyms);
@ -421,7 +421,7 @@ implementation
var
b : byte;
d : tderef;
sym : tstoredsym;
sym : Tsym;
prdef : tstoreddef;
begin
b:=ppufile.readentry;
@ -433,7 +433,7 @@ implementation
ibsymref :
begin
ppufile.getderef(d);
sym:=tstoredsym(d.resolve);
sym:=Tsym(d.resolve);
if assigned(sym) then
sym.load_references(ppufile,locals);
end;
@ -459,15 +459,15 @@ implementation
procedure tstoredsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
var
pd : tstoredsym;
pd : Tsym;
begin
ppufile.writeentry(ibbeginsymtablebrowser);
{ write all symbols }
pd:=tstoredsym(symindex.first);
pd:=Tsym(symindex.first);
while assigned(pd) do
begin
pd.write_references(ppufile,locals);
pd:=tstoredsym(pd.indexnext);
pd:=Tsym(pd.indexnext);
end;
ppufile.writeentry(ibendsymtablebrowser);
end;
@ -610,10 +610,10 @@ implementation
function tstoredsymtable.speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;
var
hp : tstoredsym;
hp : Tsym;
newref : tref;
begin
hp:=tstoredsym(inherited speedsearch(s,speedvalue));
hp:=Tsym(inherited speedsearch(s,speedvalue));
if assigned(hp) then
begin
{ reject non static members in static procedures }
@ -636,8 +636,7 @@ implementation
as TCHILDCLASS.Create did not generate appropriate
stabs debug info if TCHILDCLASS wasn't used anywhere else PM }
if (cs_debuginfo in aktmoduleswitches) and
(hp.typ=typesym) and
make_ref then
(hp.typ=typesym) and make_ref then
begin
if assigned(ttypesym(hp).restype.def) then
tstoreddef(ttypesym(hp).restype.def).numberstring
@ -765,12 +764,12 @@ implementation
(copy(p.name,1,3)='def') then
exit;
{ do not claim for inherited private fields !! }
if (tstoredsym(p).refs=0) and (tsym(p).owner.symtabletype=objectsymtable) then
if (Tsym(p).refs=0) and (tsym(p).owner.symtabletype=objectsymtable) then
MessagePos2(tsym(p).fileinfo,sym_n_private_method_not_used,tsym(p).owner.realname^,tsym(p).realname)
{ units references are problematic }
else
begin
if (tstoredsym(p).refs=0) and
if (Tsym(p).refs=0) and
not(tsym(p).typ in [enumsym,unitsym]) and
not(is_funcret_sym(tsym(p))) and
(
@ -1174,7 +1173,7 @@ implementation
{ but private ids can be reused }
hsym:=search_class_member(tobjectdef(defowner),sym.name);
if assigned(hsym) and
tstoredsym(hsym).is_visible_for_object(tobjectdef(defowner)) then
Tsym(hsym).is_visible_for_object(tobjectdef(defowner)) then
begin
DuplicateSym(hsym);
exit;
@ -1313,7 +1312,7 @@ implementation
hsym:=search_class_member(tobjectdef(next.defowner),sym.name);
{ private ids can be reused }
if assigned(hsym) and
tstoredsym(hsym).is_visible_for_object(tobjectdef(next.defowner)) then
Tsym(hsym).is_visible_for_object(tobjectdef(next.defowner)) then
begin
{ delphi allows to reuse the names in a class, but not
in object (tp7 compatible) }
@ -1801,7 +1800,7 @@ implementation
srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
if assigned(srsym) and
(not assigned(current_procinfo) or
tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
Tsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
begin
searchsym:=true;
exit;
@ -1832,7 +1831,7 @@ implementation
srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
if assigned(srsym) and
(not assigned(current_procinfo) or
tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
Tsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
begin
result:=true;
exit;
@ -1899,7 +1898,7 @@ implementation
begin
sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
if assigned(sym) and
tstoredsym(sym).is_visible_for_object(topclassh) then
Tsym(sym).is_visible_for_object(topclassh) then
break;
classh:=classh.childof;
end;
@ -2298,7 +2297,11 @@ implementation
end.
{
$Log$
Revision 1.125 2004-01-15 15:16:18 daniel
Revision 1.126 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.125 2004/01/15 15:16:18 daniel
* Some minor stuff
* Managed to eliminate speed effects of string compression

591
compiler/symtype.pas
View File

@ -36,7 +36,7 @@ interface
{ symtable }
symconst,symbase,
{ aasm }
aasmbase
aasmbase,ppu,cpuinfo
;
type
@ -45,6 +45,8 @@ interface
************************************************}
tsym = class;
Tcompilerppufile=class;
{************************************************
TRef
@ -92,17 +94,39 @@ interface
{ this object is the base for all symbol objects }
tsym = class(tsymentry)
protected
{$ifdef GDB}
{ isstabwritten : boolean;}
{$endif GDB}
public
_realname : pstring;
fileinfo : tfileposinfo;
symoptions : tsymoptions;
refs : longint;
lastref,
defref,
lastwritten : tref;
refcount : longint;
{$ifdef GDB}
{ function get_var_value(const s:string):string;
function stabstr_evaluate(const s:string;vars:array of string):Pchar;
function stabstring : pchar;virtual;
procedure concatstabto(asmlist : taasmoutput);virtual;}
{$endif GDB}
constructor create(const n : string);
constructor loadsym(ppufile:tcompilerppufile);
destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);virtual;abstract;
procedure writesym(ppufile:tcompilerppufile);
function realname:string;
procedure buildderef;virtual;abstract;
procedure buildderefimpl;virtual;abstract;
procedure deref;virtual;abstract;
procedure derefimpl;virtual;abstract;
function gettypedef:tdef;virtual;
procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
function is_visible_for_object(currobjdef:Tdef):boolean;
end;
{************************************************
@ -163,6 +187,29 @@ interface
procedure buildderef;
end;
{************************************************
Tcompilerppufile
************************************************}
tcompilerppufile=class(tppufile)
public
procedure checkerror;
procedure getguid(var g: tguid);
function getexprint:tconstexprint;
function getptruint:TConstPtrUInt;
procedure getposinfo(var p:tfileposinfo);
procedure getderef(var d:tderef);
function getsymlist:tsymlist;
procedure gettype(var t:ttype);
function getasmsymbol:tasmsymbol;
procedure putguid(const g: tguid);
procedure putexprint(v:tconstexprint);
procedure PutPtrUInt(v:TConstPtrUInt);
procedure putposinfo(const p:tfileposinfo);
procedure putderef(const d:tderef);
procedure putsymlist(p:tsymlist);
procedure puttype(const t:ttype);
procedure putasmsymbol(s:tasmsymbol);
end;
{$ifdef MEMDEBUG}
var
@ -180,7 +227,8 @@ implementation
uses
verbose,
fmodule;
fmodule,
symdef;
{****************************************************************************
Tdef
@ -248,8 +296,40 @@ implementation
_realname:=stringdup(n);
typ:=abstractsym;
symoptions:=[];
defref:=nil;
refs:=0;
lastwritten:=nil;
refcount:=0;
if (cs_browser in aktmoduleswitches) and make_ref then
begin
defref:=tref.create(defref,@akttokenpos);
inc(refcount);
end;
end;
constructor tsym.loadsym(ppufile:tcompilerppufile);
var
s : string;
nr : word;
begin
nr:=ppufile.getword;
s:=ppufile.getstring;
if s[1]='$' then
inherited createname(copy(s,2,255))
else
inherited createname(upper(s));
_realname:=stringdup(s);
typ:=abstractsym;
{ force the correct indexnr. must be after create! }
indexnr:=nr;
ppufile.getposinfo(fileinfo);
ppufile.getsmallset(symoptions);
lastref:=nil;
defref:=nil;
refs:=0;
lastwritten:=nil;
refcount:=0;
end;
destructor tsym.destroy;
begin
@ -263,6 +343,68 @@ implementation
inherited destroy;
end;
procedure Tsym.writesym(ppufile:tcompilerppufile);
begin
ppufile.putword(indexnr);
ppufile.putstring(_realname^);
ppufile.putposinfo(fileinfo);
ppufile.putsmallset(symoptions);
end;
{$ifdef xGDB}
function Tsym.get_var_value(const s:string):string;
begin
if s='name' then
get_var_value:=name
else if s='ownername' then
get_var_value:=owner.name^
else if s='mangledname' then
get_var_value:=mangledname
else if s='line' then
get_var_value:=tostr(fileinfo.line)
else if s='N_LSYM' then
get_var_value:=tostr(N_LSYM)
else if s='N_LCSYM' then
get_var_value:=tostr(N_LCSYM)
else if s='N_RSYM' then
get_var_value:=tostr(N_RSYM)
else if s='N_TSYM' then
get_var_value:=tostr(N_TSYM)
else if s='N_STSYM' then
get_var_value:=tostr(N_STSYM)
else if s='N_FUNCTION' then
get_var_value:=tostr(N_FUNCTION)
else
internalerror(200401152);
end;
function Tsym.stabstr_evaluate(const s:string;vars:array of string):Pchar;
begin
stabstr_evaluate:=string_evaluate(s,@get_var_value,vars);
end;
function Tsym.stabstring : pchar;
begin
stabstring:=stabstr_evaluate('"${name}",${N_LSYM},0,${line},0',[]);
end;
procedure Tsym.concatstabto(asmlist : taasmoutput);
var
stab_str : pchar;
begin
if not isstabwritten then
begin
stab_str := stabstring;
if assigned(stab_str) then
asmList.concat(Tai_stabs.Create(stab_str));
isstabwritten:=true;
end;
end;
{$endif xGDB}
function tsym.realname : string;
begin
@ -279,6 +421,107 @@ implementation
end;
procedure Tsym.load_references(ppufile:tcompilerppufile;locals:boolean);
var
pos : tfileposinfo;
move_last : boolean;
begin
move_last:=lastwritten=lastref;
while (not ppufile.endofentry) do
begin
ppufile.getposinfo(pos);
inc(refcount);
lastref:=tref.create(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(ppufile:tcompilerppufile;locals:boolean):boolean;
var
d : tderef;
ref : tref;
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 }
d.reset;
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
d.build(self);
ppufile.putderef(d);
symref_written:=true;
end;
ppufile.putposinfo(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
ppufile.writeentry(ibsymref);
write_references:=symref_written;
end;
function Tsym.is_visible_for_object(currobjdef:Tdef):boolean;
begin
is_visible_for_object:=false;
{ private symbols are allowed when we are in the same
module as they are defined }
if (sp_private in symoptions) and
assigned(owner.defowner) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0) then
exit;
{ protected symbols are vissible in the module that defines them and
also visible to related objects }
if (sp_protected in symoptions) and
(
(
assigned(owner.defowner) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0)
) and
not(
assigned(currobjdef) and
Tobjectdef(currobjdef).is_related(tobjectdef(owner.defowner))
)
) then
exit;
is_visible_for_object:=true;
end;
{****************************************************************************
TRef
****************************************************************************}
@ -912,6 +1155,340 @@ implementation
end;
end;
{*****************************************************************************
TCompilerPPUFile
*****************************************************************************}
procedure tcompilerppufile.checkerror;
begin
if error then
Message(unit_f_ppu_read_error);
end;
procedure tcompilerppufile.getguid(var g: tguid);
begin
getdata(g,sizeof(g));
end;
function tcompilerppufile.getexprint:tconstexprint;
var
l1,l2 : longint;
begin
if sizeof(tconstexprint)=8 then
begin
l1:=getlongint;
l2:=getlongint;
{$ifopt R+}
{$define Range_check_on}
{$endif opt R+}
{$R- needed here }
{$ifdef Delphi}
result:=int64(l1)+(int64(l2) shl 32);
{$else}
result:=qword(l1)+(int64(l2) shl 32);
{$endif}
{$ifdef Range_check_on}
{$R+}
{$undef Range_check_on}
{$endif Range_check_on}
end
else
result:=tconstexprint(getlongint);
end;
function tcompilerppufile.getPtrUInt:TConstPtrUInt;
var
l1,l2 : longint;
begin
if sizeof(TConstPtrUInt)=8 then
begin
l1:=getlongint;
l2:=getlongint;
{$ifopt R+}
{$define Range_check_on}
{$endif opt R+}
{$R- needed here }
{$ifdef Delphi}
result:=int64(l1)+(int64(l2) shl 32);
{$else}
result:=qword(l1)+(int64(l2) shl 32);
{$endif}
{$ifdef Range_check_on}
{$R+}
{$undef Range_check_on}
{$endif Range_check_on}
end
else
result:=TConstPtrUInt(getlongint);
end;
procedure tcompilerppufile.getposinfo(var p:tfileposinfo);
var
info : byte;
begin
{
info byte layout in bits:
0-1 - amount of bytes for fileindex
2-3 - amount of bytes for line
4-5 - amount of bytes for column
}
info:=getbyte;
case (info and $03) of
0 : p.fileindex:=getbyte;
1 : p.fileindex:=getword;
2 : p.fileindex:=(getbyte shl 16) or getword;
3 : p.fileindex:=getlongint;
end;
case ((info shr 2) and $03) of
0 : p.line:=getbyte;
1 : p.line:=getword;
2 : p.line:=(getbyte shl 16) or getword;
3 : p.line:=getlongint;
end;
case ((info shr 4) and $03) of
0 : p.column:=getbyte;
1 : p.column:=getword;
2 : p.column:=(getbyte shl 16) or getword;
3 : p.column:=getlongint;
end;
end;
procedure tcompilerppufile.getderef(var d:tderef);
begin
d.dataidx:=getlongint;
end;
function tcompilerppufile.getsymlist:tsymlist;
var
symderef : tderef;
tt : ttype;
slt : tsltype;
idx : longint;
p : tsymlist;
begin
p:=tsymlist.create;
getderef(p.procdefderef);
repeat
slt:=tsltype(getbyte);
case slt of
sl_none :
break;
sl_call,
sl_load,
sl_subscript :
begin
getderef(symderef);
p.addsymderef(slt,symderef);
end;
sl_typeconv :
begin
gettype(tt);
p.addtype(slt,tt);
end;
sl_vec :
begin
idx:=getlongint;
p.addconst(slt,idx);
end;
else
internalerror(200110204);
end;
until false;
getsymlist:=tsymlist(p);
end;
procedure tcompilerppufile.gettype(var t:ttype);
begin
getderef(t.deref);
t.def:=nil;
t.sym:=nil;
end;
function tcompilerppufile.getasmsymbol:tasmsymbol;
begin
getasmsymbol:=tasmsymbol(pointer(getlongint));
end;
procedure tcompilerppufile.putposinfo(const p:tfileposinfo);
var
oldcrc : boolean;
info : byte;
begin
{ posinfo is not relevant for changes in PPU }
oldcrc:=do_crc;
do_crc:=false;
{
info byte layout in bits:
0-1 - amount of bytes for fileindex
2-3 - amount of bytes for line
4-5 - amount of bytes for column
}
info:=0;
{ calculate info byte }
if (p.fileindex>$ff) then
begin
if (p.fileindex<=$ffff) then
info:=info or $1
else
if (p.fileindex<=$ffffff) then
info:=info or $2
else
info:=info or $3;
end;
if (p.line>$ff) then
begin
if (p.line<=$ffff) then
info:=info or $4
else
if (p.line<=$ffffff) then
info:=info or $8
else
info:=info or $c;
end;
if (p.column>$ff) then
begin
if (p.column<=$ffff) then
info:=info or $10
else
if (p.column<=$ffffff) then
info:=info or $20
else
info:=info or $30;
end;
{ write data }
putbyte(info);
case (info and $03) of
0 : putbyte(p.fileindex);
1 : putword(p.fileindex);
2 : begin
putbyte(p.fileindex shr 16);
putword(p.fileindex and $ffff);
end;
3 : putlongint(p.fileindex);
end;
case ((info shr 2) and $03) of
0 : putbyte(p.line);
1 : putword(p.line);
2 : begin
putbyte(p.line shr 16);
putword(p.line and $ffff);
end;
3 : putlongint(p.line);
end;
case ((info shr 4) and $03) of
0 : putbyte(p.column);
1 : putword(p.column);
2 : begin
putbyte(p.column shr 16);
putword(p.column and $ffff);
end;
3 : putlongint(p.column);
end;
do_crc:=oldcrc;
end;
procedure tcompilerppufile.putguid(const g: tguid);
begin
putdata(g,sizeof(g));
end;
procedure tcompilerppufile.putexprint(v:tconstexprint);
begin
if sizeof(TConstExprInt)=8 then
begin
putlongint(longint(lo(v)));
putlongint(longint(hi(v)));
end
else if sizeof(TConstExprInt)=4 then
putlongint(longint(v))
else
internalerror(2002082601);
end;
procedure tcompilerppufile.PutPtrUInt(v:TConstPtrUInt);
begin
if sizeof(TConstPtrUInt)=8 then
begin
putlongint(longint(lo(v)));
putlongint(longint(hi(v)));
end
else if sizeof(TConstPtrUInt)=4 then
putlongint(longint(v))
else
internalerror(2002082601);
end;
procedure tcompilerppufile.putderef(const d:tderef);
var
oldcrc : boolean;
begin
oldcrc:=do_crc;
do_crc:=false;
putlongint(d.dataidx);
do_crc:=oldcrc;
end;
procedure tcompilerppufile.putsymlist(p:tsymlist);
var
hp : psymlistitem;
begin
putderef(p.procdefderef);
hp:=p.firstsym;
while assigned(hp) do
begin
putbyte(byte(hp^.sltype));
case hp^.sltype of
sl_call,
sl_load,
sl_subscript :
putderef(hp^.symderef);
sl_typeconv :
puttype(hp^.tt);
sl_vec :
putlongint(hp^.value);
else
internalerror(200110205);
end;
hp:=hp^.next;
end;
putbyte(byte(sl_none));
end;
procedure tcompilerppufile.puttype(const t:ttype);
begin
putderef(t.deref);
end;
procedure tcompilerppufile.putasmsymbol(s:tasmsymbol);
begin
if assigned(s) then
begin
if s.ppuidx=-1 then
begin
inc(objectlibrary.asmsymbolppuidx);
s.ppuidx:=objectlibrary.asmsymbolppuidx;
end;
putlongint(s.ppuidx);
end
else
putlongint(0);
end;
{$ifdef MEMDEBUG}
initialization
@ -943,7 +1520,11 @@ finalization
end.
{
$Log$
Revision 1.34 2003-11-10 22:02:52 peter
Revision 1.35 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.34 2003/11/10 22:02:52 peter
* cross unit inlining fixed
Revision 1.33 2003/10/28 15:36:01 peter
@ -1044,3 +1625,7 @@ end.
on demand from tprocdef.mangledname
}
end.

8
compiler/x86/aasmcpu.pas
View File

@ -34,7 +34,7 @@ interface
cclasses,globals,verbose,
cpuinfo,cpubase,
cgbase,
symppu,symtype,symsym,
symtype,symsym,
aasmbase,aasmtai;
const
@ -1971,7 +1971,11 @@ implementation
end.
{
$Log$
Revision 1.45 2004-01-15 14:01:32 florian
Revision 1.46 2004-01-26 16:12:28 daniel
* reginfo now also only allocated during register allocation
* third round of gdb cleanups: kick out most of concatstabto
Revision 1.45 2004/01/15 14:01:32 florian
+ x86 instruction tables for x86-64 extended
Revision 1.44 2004/01/12 16:37:59 peter