paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 12:39:25 +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;
private
procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist;var parasize:longint);
procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tlist;var parareg,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:tparalist;var parareg,parasize:longint);
end;
implementation
@ -284,7 +284,7 @@ unit cpupara;
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
i : integer;
hp : tparavarsym;
@ -368,7 +368,7 @@ unit cpupara;
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
hp : tparavarsym;
@ -514,7 +514,11 @@ begin
end.
{
$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
whether a register is allowed
* funcret_paraloc renamed to funcretloc

87
compiler/ncal.pas
View File

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

35
compiler/parabase.pas
View File

@ -68,7 +68,11 @@ unit parabase;
va_uses_float_reg
);
tvarargsparalist = class(tlist)
tparalist = class(tlist)
procedure SortParas;
end;
tvarargsparalist = class(tparalist)
varargsinfo : set of tvarargsinfo;
{$ifdef x86_64}
{ x86_64 requires %al to contain the no. SSE regs passed }
@ -81,7 +85,8 @@ unit parabase;
implementation
uses
systems,verbose;
systems,verbose,
symsym;
{****************************************************************************
@ -222,11 +227,35 @@ implementation
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.
{
$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
* 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);
private
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;
function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
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
stack_offset: aword;
@ -587,7 +587,11 @@ begin
end.
{
$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
whether a register is allowed
* 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;
private
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);
end;
@ -207,7 +207,7 @@ implementation
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
paraloc : pcgparalocation;
@ -317,7 +317,11 @@ begin
end.
{
$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
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 }
rettype : ttype;
parast : tsymtable;
paras : tlist;
paras : tparalist;
proctypeoption : tproctypeoption;
proccalloption : tproccalloption;
procoptions : tprocoptions;
@ -3352,15 +3352,6 @@ implementation
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;
var
paracount : longint;
@ -3369,7 +3360,7 @@ implementation
we need to reresolve this unit (PFV) }
if assigned(paras) then
paras.free;
paras:=tlist.create;
paras:=tparalist.create;
paracount:=0;
minparacount:=0;
maxparacount:=0;
@ -3378,7 +3369,7 @@ implementation
{ Insert parameters in table }
parast.foreach(@insert_para,nil);
{ Order parameters }
paras.sort(@paranrcompare);
paras.sortparas;
end;
@ -6145,7 +6136,11 @@ implementation
end.
{
$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
the parents to prevent double manglednames