paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-26 18:08:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed varargs

Browse Source 
* replaced dynarray with tlist
This commit is contained in:
peter 2004-11-22 22:01:19 +00:00
parent d8b1ea061b
commit 8cf8c54609
6 changed files with 111 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler/i386/cpupara.pas
View File

@ -51,8 +51,8 @@ unit cpupara;
procedure createtempparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);override; procedure createtempparaloc(list: taasmoutput;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);override;
private private
procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist;var parasize:longint); procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist;var parareg,parasize:longint); procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parareg,parasize:longint);
end; end;
implementation implementation
@ -284,7 +284,7 @@ unit cpupara;
end; end;
procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist;var parasize:longint); procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
var var
i : integer; i : integer;
hp : tparavarsym; hp : tparavarsym;
@ -368,7 +368,7 @@ unit cpupara;
end; end;
procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist; procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
var parareg,parasize:longint); var parareg,parasize:longint);
var var
hp : tparavarsym; hp : tparavarsym;
@ -514,7 +514,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.59 2004-11-21 17:54:59 peter Revision 1.60 2004-11-22 22:01:19 peter
* fixed varargs
* replaced dynarray with tlist
Revision 1.59 2004/11/21 17:54:59 peter
* ttempcreatenode.create_reg merged into .create with parameter * ttempcreatenode.create_reg merged into .create with parameter
whether a register is allowed whether a register is allowed
* funcret_paraloc renamed to funcretloc * funcret_paraloc renamed to funcretloc

71
compiler/ncal.pas
View File

@ -28,7 +28,7 @@ interface
uses uses
cutils,cclasses, cutils,cclasses,
globtype,cpuinfo, globtype,
paramgr,parabase, paramgr,parabase,
node,nbas,nutils, node,nbas,nutils,
{$ifdef state_tracking} {$ifdef state_tracking}
@ -50,10 +50,8 @@ interface
tcallnode = class(tbinarynode) tcallnode = class(tbinarynode)
private private
{$ifndef VER1_0}
{ info for inlining } { info for inlining }
inlinelocals: array of tnode; inlinelocals: TList;
{$endif VER1_0}
{ number of parameters passed from the source, this does not include the hidden parameters } { number of parameters passed from the source, this does not include the hidden parameters }
paralength : smallint; paralength : smallint;
function gen_self_tree_methodpointer:tnode; function gen_self_tree_methodpointer:tnode;
@ -70,9 +68,7 @@ interface
procedure createinlineparas(var createstatement, deletestatement: tstatementnode); procedure createinlineparas(var createstatement, deletestatement: tstatementnode);
function replaceparaload(var n: tnode; arg: pointer): foreachnoderesult; function replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
{$ifndef VER1_0}
procedure createlocaltemps(p:TNamedIndexItem;arg:pointer); procedure createlocaltemps(p:TNamedIndexItem;arg:pointer);
{$endif VER1_0}
protected protected
pushedparasize : longint; pushedparasize : longint;
public public
@ -820,6 +816,8 @@ type
destructor tcallnode.destroy; destructor tcallnode.destroy;
var
i : longint;
begin begin
methodpointer.free; methodpointer.free;
methodpointerinit.free; methodpointerinit.free;
@ -827,7 +825,11 @@ type
_funcretnode.free; _funcretnode.free;
inlinecode.free; inlinecode.free;
if assigned(varargsparas) then if assigned(varargsparas) then
begin
for i:=0 to varargsparas.count-1 do
tparavarsym(varargsparas[i]).free;
varargsparas.free; varargsparas.free;
end;
inherited destroy; inherited destroy;
end; end;
@ -969,7 +971,7 @@ type
for i:=0 to varargsparas.count-1 do for i:=0 to varargsparas.count-1 do
begin begin
hp:=tparavarsym(varargsparas[i]); hp:=tparavarsym(varargsparas[i]);
hpn:=tparavarsym.create(hp.realname,0,hp.varspez,hp.vartype); hpn:=tparavarsym.create(hp.realname,hp.paranr,hp.varspez,hp.vartype);
n.varargsparas.add(hpn); n.varargsparas.add(hpn);
end; end;
end end
@ -1370,16 +1372,27 @@ type
pt:=tcallparanode(pt.right); pt:=tcallparanode(pt.right);
end; end;
{ Create parasyms for varargs } { Create parasyms for varargs, first count the number of varargs paras,
then insert the parameters with numbering in reverse order. The SortParas
will set the correct order at the end}
pt:=tcallparanode(left); pt:=tcallparanode(left);
i:=0; i:=0;
while assigned(pt) do while assigned(pt) do
begin begin
if cpf_varargs_para in pt.callparaflags then if cpf_varargs_para in pt.callparaflags then
inc(i);
pt:=tcallparanode(pt.right);
end;
if (i>0) then
begin begin
if not assigned(varargsparas) then
varargsparas:=tvarargsparalist.create; varargsparas:=tvarargsparalist.create;
varargspara:=tparavarsym.create('va'+tostr(i),0,vs_value,pt.resulttype); pt:=tcallparanode(left);
while assigned(pt) do
begin
if cpf_varargs_para in pt.callparaflags then
begin
varargspara:=tparavarsym.create('va'+tostr(i),i,vs_value,pt.resulttype);
dec(i);
{ varargspara is left-right, use insert { varargspara is left-right, use insert
instead of concat } instead of concat }
varargsparas.add(varargspara); varargsparas.add(varargspara);
@ -1387,6 +1400,8 @@ type
end; end;
pt:=tcallparanode(pt.right); pt:=tcallparanode(pt.right);
end; end;
varargsparas.sortparas;
end;
end; end;
@ -1397,7 +1412,6 @@ type
hpt : tnode; hpt : tnode;
pt : tcallparanode; pt : tcallparanode;
lastpara : longint; lastpara : longint;
currpara : tparavarsym;
paraidx, paraidx,
cand_cnt : integer; cand_cnt : integer;
i : longint; i : longint;
@ -1892,27 +1906,24 @@ type
resulttypepass(n); resulttypepass(n);
result := fen_true; result := fen_true;
end end
{$ifndef VER1_0}
else else
begin begin
{ local? } { local? }
if (tloadnode(n).symtableentry.typ <> localvarsym) then if (tloadnode(n).symtableentry.typ <> localvarsym) then
exit; exit;
if (tloadnode(n).symtableentry.indexnr > high(inlinelocals)) or if (tloadnode(n).symtableentry.indexnr >= inlinelocals.count) or
not assigned(inlinelocals[tloadnode(n).symtableentry.indexnr]) then not assigned(inlinelocals[tloadnode(n).symtableentry.indexnr]) then
internalerror(20040720); internalerror(20040720);
temp := inlinelocals[tloadnode(n).symtableentry.indexnr].getcopy; temp := tnode(inlinelocals[tloadnode(n).symtableentry.indexnr]).getcopy;
n.free; n.free;
n := temp; n := temp;
resulttypepass(n); resulttypepass(n);
result := fen_true; result := fen_true;
end; end;
{$endif ndef VER1_0}
end; end;
end; end;
{$ifndef VER1_0}
type type
ptempnodes = ^ttempnodes; ptempnodes = ^ttempnodes;
ttempnodes = record ttempnodes = record
@ -1921,14 +1932,13 @@ type
procedure tcallnode.createlocaltemps(p:TNamedIndexItem;arg:pointer); procedure tcallnode.createlocaltemps(p:TNamedIndexItem;arg:pointer);
var var
tempinfo: ptempnodes absolute ptempnodes(arg); tempinfo: ptempnodes absolute arg;
tempnode: ttempcreatenode; tempnode: ttempcreatenode;
begin begin
if (tsymentry(p).typ <> localvarsym) then if (tsymentry(p).typ <> localvarsym) then
exit; exit;
if (p.indexnr > high(inlinelocals)) then if (p.indexnr >= inlinelocals.count) then
setlength(inlinelocals,p.indexnr+10); inlinelocals.capacity:=p.indexnr+10;
{$ifndef VER1_0}
if (vo_is_funcret in tabstractvarsym(p).varoptions) and if (vo_is_funcret in tabstractvarsym(p).varoptions) and
assigned(funcretnode) then assigned(funcretnode) then
begin begin
@ -1943,7 +1953,6 @@ type
inlinelocals[tabstractvarsym(p).indexnr] := funcretnode.getcopy inlinelocals[tabstractvarsym(p).indexnr] := funcretnode.getcopy
end end
else else
{$endif ndef VER1_0}
begin begin
tempnode := ctempcreatenode.create(tabstractvarsym(p).vartype,tabstractvarsym(p).vartype.def.size,tt_persistent,true); tempnode := ctempcreatenode.create(tabstractvarsym(p).vartype,tabstractvarsym(p).vartype.def.size,tt_persistent,true);
addstatement(tempinfo^.createstatement,tempnode); addstatement(tempinfo^.createstatement,tempnode);
@ -1964,7 +1973,6 @@ type
inlinelocals[p.indexnr] := ctemprefnode.create(tempnode); inlinelocals[p.indexnr] := ctemprefnode.create(tempnode);
end; end;
end; end;
{$endif ndef VER1_0}
procedure tcallnode.createinlineparas(var createstatement, deletestatement: tstatementnode); procedure tcallnode.createinlineparas(var createstatement, deletestatement: tstatementnode);
@ -1972,9 +1980,7 @@ type
para: tcallparanode; para: tcallparanode;
tempnode: ttempcreatenode; tempnode: ttempcreatenode;
hp: tnode; hp: tnode;
{$ifndef VER1_0}
tempnodes: ttempnodes; tempnodes: ttempnodes;
{$endif ndef VER1_0}
begin begin
{ parameters } { parameters }
para := tcallparanode(left); para := tcallparanode(left);
@ -2027,18 +2033,16 @@ type
para := tcallparanode(para.right); para := tcallparanode(para.right);
end; end;
end; end;
{$ifndef VER1_0}
{ local variables } { local variables }
if not assigned(tprocdef(procdefinition).localst) or if not assigned(tprocdef(procdefinition).localst) or
(tprocdef(procdefinition).localst.symindex.count = 0) then (tprocdef(procdefinition).localst.symindex.count = 0) then
exit; exit;
tempnodes.createstatement := createstatement; tempnodes.createstatement := createstatement;
tempnodes.deletestatement := deletestatement; tempnodes.deletestatement := deletestatement;
setlength(inlinelocals,tprocdef(procdefinition).localst.symindex.count); inlinelocals.capacity:=tprocdef(procdefinition).localst.symindex.count;
tprocdef(procdefinition).localst.foreach(@createlocaltemps,@tempnodes); tprocdef(procdefinition).localst.foreach(@createlocaltemps,@tempnodes);
createstatement := tempnodes.createstatement; createstatement := tempnodes.createstatement;
deletestatement := tempnodes.deletestatement; deletestatement := tempnodes.deletestatement;
{$endif ndef VER1_0}
end; end;
@ -2079,10 +2083,11 @@ type
{ replace the parameter loads with the parameter values } { replace the parameter loads with the parameter values }
foreachnode(result,replaceparaload,@fileinfo); foreachnode(result,replaceparaload,@fileinfo);
{ free the temps for the locals } { free the temps for the locals }
for i := 0 to high(inlinelocals) do for i := 0 to inlinelocals.count-1 do
if assigned(inlinelocals[i]) then if assigned(inlinelocals[i]) then
inlinelocals[i].free; tnode(inlinelocals[i]).free;
setlength(inlinelocals,0); inlinelocals.free;
inlinelocals:=nil;
addstatement(createstatement,result); addstatement(createstatement,result);
addstatement(createstatement,deleteblock); addstatement(createstatement,deleteblock);
{ set function result location if necessary } { set function result location if necessary }
@ -2399,7 +2404,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.261 2004-11-21 17:54:59 peter Revision 1.262 2004-11-22 22:01:19 peter
* fixed varargs
* replaced dynarray with tlist
Revision 1.261 2004/11/21 17:54:59 peter
* ttempcreatenode.create_reg merged into .create with parameter * ttempcreatenode.create_reg merged into .create with parameter
whether a register is allowed whether a register is allowed
* funcret_paraloc renamed to funcretloc * funcret_paraloc renamed to funcretloc

35
compiler/parabase.pas
View File

@ -68,7 +68,11 @@ unit parabase;
va_uses_float_reg va_uses_float_reg
); );
tvarargsparalist = class(tlist) tparalist = class(tlist)
procedure SortParas;
end;
tvarargsparalist = class(tparalist)
varargsinfo : set of tvarargsinfo; varargsinfo : set of tvarargsinfo;
{$ifdef x86_64} {$ifdef x86_64}
{ x86_64 requires %al to contain the no. SSE regs passed } { x86_64 requires %al to contain the no. SSE regs passed }
@ -81,7 +85,8 @@ unit parabase;
implementation implementation
uses uses
systems,verbose; systems,verbose,
symsym;
{**************************************************************************** {****************************************************************************
@ -222,11 +227,35 @@ implementation
end; end;
end; end;
{****************************************************************************
TParaList
****************************************************************************}
function ParaNrCompare(Item1, Item2: Pointer): Integer;
var
I1 : tparavarsym absolute Item1;
I2 : tparavarsym absolute Item2;
begin
Result:=I1.paranr-I2.paranr;
end;
procedure TParaList.SortParas;
begin
Sort(@ParaNrCompare);
end;
end. end.
{ {
$Log$ $Log$
Revision 1.5 2004-11-15 23:35:31 peter Revision 1.6 2004-11-22 22:01:19 peter
* fixed varargs
* replaced dynarray with tlist
Revision 1.5 2004/11/15 23:35:31 peter
* tparaitem removed, use tparavarsym instead * tparaitem removed, use tparavarsym instead
* parameter order is now calculated from paranr value in tparavarsym * parameter order is now calculated from paranr value in tparavarsym

10
compiler/powerpc/cpupara.pas
View File

@ -46,7 +46,7 @@ unit cpupara;
procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
private private
procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword); procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras:tlist; function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras:tparalist;
var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint; var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
function parseparaloc(p : tparavarsym;const s : string) : boolean;override; function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
end; end;
@ -289,7 +289,7 @@ unit cpupara;
function tppcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras:tlist; function tppcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras:tparalist;
var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint; var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
var var
stack_offset: aword; stack_offset: aword;
@ -587,7 +587,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.73 2004-11-21 17:54:59 peter Revision 1.74 2004-11-22 22:01:19 peter
* fixed varargs
* replaced dynarray with tlist
Revision 1.73 2004/11/21 17:54:59 peter
* ttempcreatenode.create_reg merged into .create with parameter * ttempcreatenode.create_reg merged into .create with parameter
whether a register is allowed whether a register is allowed
* funcret_paraloc renamed to funcretloc * funcret_paraloc renamed to funcretloc

10
compiler/sparc/cpupara.pas
View File

@ -45,7 +45,7 @@ interface
function create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override; function create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
private private
procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tlist; procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
var intparareg,parasize:longint); var intparareg,parasize:longint);
end; end;
@ -207,7 +207,7 @@ implementation
end; end;
procedure tsparcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tlist; procedure tsparcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
var intparareg,parasize:longint); var intparareg,parasize:longint);
var var
paraloc : pcgparalocation; paraloc : pcgparalocation;
@ -317,7 +317,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.50 2004-11-21 18:13:31 peter Revision 1.51 2004-11-22 22:01:19 peter
* fixed varargs
* replaced dynarray with tlist
Revision 1.50 2004/11/21 18:13:31 peter
* fixed funcretloc for sparc * fixed funcretloc for sparc
Revision 1.49 2004/11/21 17:54:59 peter Revision 1.49 2004/11/21 17:54:59 peter

21
compiler/symdef.pas
View File

@ -432,7 +432,7 @@ interface
{ saves a definition to the return type } { saves a definition to the return type }
rettype : ttype; rettype : ttype;
parast : tsymtable; parast : tsymtable;
paras : tlist; paras : tparalist;
proctypeoption : tproctypeoption; proctypeoption : tproctypeoption;
proccalloption : tproccalloption; proccalloption : tproccalloption;
procoptions : tprocoptions; procoptions : tprocoptions;
@ -3352,15 +3352,6 @@ implementation
end; end;
function ParaNrCompare(Item1, Item2: Pointer): Integer;
var
I1 : tparavarsym absolute Item1;
I2 : tparavarsym absolute Item2;
begin
Result:=I1.paranr-I2.paranr;
end;
procedure tabstractprocdef.calcparas; procedure tabstractprocdef.calcparas;
var var
paracount : longint; paracount : longint;
@ -3369,7 +3360,7 @@ implementation
we need to reresolve this unit (PFV) } we need to reresolve this unit (PFV) }
if assigned(paras) then if assigned(paras) then
paras.free; paras.free;
paras:=tlist.create; paras:=tparalist.create;
paracount:=0; paracount:=0;
minparacount:=0; minparacount:=0;
maxparacount:=0; maxparacount:=0;
@ -3378,7 +3369,7 @@ implementation
{ Insert parameters in table } { Insert parameters in table }
parast.foreach(@insert_para,nil); parast.foreach(@insert_para,nil);
{ Order parameters } { Order parameters }
paras.sort(@paranrcompare); paras.sortparas;
end; end;
@ -6145,7 +6136,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.278 2004-11-21 21:51:31 peter Revision 1.279 2004-11-22 22:01:19 peter
* fixed varargs
* replaced dynarray with tlist
Revision 1.278 2004/11/21 21:51:31 peter
* manglednames for nested procedures include full parameters from * manglednames for nested procedures include full parameters from
the parents to prevent double manglednames the parents to prevent double manglednames