paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 00:47:16 +01:00
Code Issues Packages Projects Releases Wiki Activity

* c style array of const generates callparanodes

Browse Source 
* varargs paraloc fixes
This commit is contained in:
peter 2003-10-05 21:21:52 +00:00
parent 8cc8117930
commit da9f5e2319
11 changed files with 548 additions and 594 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/htypechk.pas
View File

@ -72,7 +72,6 @@ interface
{$ifdef extdebug}
count_ref : boolean = true;
{$endif def extdebug}
get_para_resulttype : boolean = false;
allow_array_constructor : boolean = false;
{ is overloading of this operator allowed for this
@ -996,7 +995,11 @@ implementation
end.
{
$Log$
Revision 1.67 2003-10-01 20:34:48 peter
Revision 1.68 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.67 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

59
compiler/i386/cpupara.pas
View File

@ -29,9 +29,9 @@ unit cpupara;
interface
uses
cclasses,globtype,
aasmtai,
cpubase,
globtype,
cgbase,
symconst,symtype,symdef,paramgr;
@ -49,6 +49,7 @@ unit cpupara;
function get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;override;
function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tlinkedlist):longint;override;
private
procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
function create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
@ -258,15 +259,53 @@ unit cpupara;
end;
function ti386paramanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tlinkedlist):longint;
var
hp : tparaitem;
paraloc : tparalocation;
l,
varalign,
paraalign,
parasize : longint;
begin
parasize:=0;
paraalign:=get_para_align(p.proccalloption);
{ Retrieve last know info from normal parameters }
hp:=tparaitem(p.para.last);
if assigned(hp) then
parasize:=hp.paraloc[callerside].reference.offset;
{ Assign varargs }
hp:=tparaitem(varargspara.first);
while assigned(hp) do
begin
paraloc.size:=def_cgsize(hp.paratype.def);
paraloc.loc:=LOC_REFERENCE;
paraloc.alignment:=paraalign;
paraloc.reference.index:=NR_STACK_POINTER_REG;
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
varalign:=size_2_align(l);
paraloc.reference.offset:=parasize+target_info.first_parm_offset;
varalign:=used_align(varalign,paraalign,paraalign);
parasize:=align(parasize+l,varalign);
hp.paraloc[callerside]:=paraloc;
hp:=tparaitem(hp.next);
end;
{ We need to return the size allocated }
result:=parasize;
end;
function ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
var
hp : tparaitem;
paraloc : tparalocation;
l,
varalign,
paraalign,
parasize : longint;
begin
parasize:=0;
paraalign:=get_para_align(p.proccalloption);
{ we push Flags and CS as long
to cope with the IRETD
and we save 6 register + 4 selectors }
@ -281,12 +320,12 @@ unit cpupara;
else
paraloc.size:=def_cgsize(hp.paratype.def);
paraloc.loc:=LOC_REFERENCE;
paraloc.alignment:=p.paraalign;
paraloc.alignment:=paraalign;
paraloc.reference.index:=NR_FRAME_POINTER_REG;
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
varalign:=size_2_align(l);
paraloc.reference.offset:=parasize+target_info.first_parm_offset;
varalign:=used_align(varalign,p.paraalign,p.paraalign);
varalign:=used_align(varalign,paraalign,paraalign);
parasize:=align(parasize+l,varalign);
if (side=callerside) then
begin
@ -309,10 +348,12 @@ unit cpupara;
is_64bit : boolean;
l,parareg,
varalign,
paraalign,
parasize : longint;
begin
parareg:=0;
parasize:=0;
paraalign:=get_para_align(p.proccalloption);
hp:=tparaitem(p.para.first);
while assigned(hp) do
begin
@ -320,7 +361,7 @@ unit cpupara;
paraloc.size:=OS_ADDR
else
paraloc.size:=def_cgsize(hp.paratype.def);
paraloc.alignment:=p.paraalign;
paraloc.alignment:=paraalign;
is_64bit:=(paraloc.size in [OS_64,OS_S64,OS_F64]);
{
EAX
@ -343,7 +384,7 @@ unit cpupara;
subreg:=R_SUBWHOLE
else
subreg:=cgsize2subreg(paraloc.size);
paraloc.alignment:=p.paraalign;
paraloc.alignment:=paraalign;
paraloc.register:=newreg(R_INTREGISTER,parasupregs[parareg],subreg);
inc(parareg);
end
@ -354,7 +395,7 @@ unit cpupara;
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
varalign:=size_2_align(l);
paraloc.reference.offset:=parasize+target_info.first_parm_offset;
varalign:=used_align(varalign,p.paraalign,p.paraalign);
varalign:=used_align(varalign,paraalign,paraalign);
parasize:=align(parasize+l,varalign);
end;
if (side=callerside) and
@ -399,7 +440,11 @@ begin
end.
{
$Log$
Revision 1.36 2003-10-03 22:00:33 peter
Revision 1.37 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.36 2003/10/03 22:00:33 peter
* parameter alignment fixes
Revision 1.35 2003/10/01 20:34:49 peter

446
compiler/ncal.pas
View File

@ -55,8 +55,8 @@ interface
tcallnode = class(tbinarynode)
private
paravisible : boolean;
paralength : smallint;
paravisible : boolean;
paralength : smallint;
function candidates_find:pcandidate;
procedure candidates_free(procs:pcandidate);
procedure candidates_list(procs:pcandidate;all:boolean);
@ -75,6 +75,7 @@ interface
ret_in_param return value }
_funcretnode : tnode;
procedure setfuncretnode(const returnnode: tnode);
procedure convert_carg_array_of_const;
public
{ the symbol containing the definition of the procedure }
{ to call }
@ -89,6 +90,8 @@ interface
methodpointer : tnode;
{ inline function body }
inlinecode : tnode;
{ varargs tparaitems }
varargsparas : tlinkedlist;
{ node that specifies where the result should be put for calls }
{ that return their result in a parameter }
property funcretnode: tnode read _funcretnode write setfuncretnode;
@ -137,13 +140,11 @@ interface
tcallparaflags = (
{ flags used by tcallparanode }
cpf_exact_match_found,
cpf_convlevel1found,
cpf_convlevel2found,
cpf_is_colon_para
);
tcallparanode = class(tbinarynode)
public
callparaflags : set of tcallparaflags;
paraitem : tparaitem;
used_by_callnode : boolean;
@ -589,18 +590,14 @@ type
procedure tcallparanode.get_paratype;
var
old_get_para_resulttype : boolean;
old_array_constructor : boolean;
begin
inc(parsing_para_level);
if assigned(right) then
tcallparanode(right).get_paratype;
old_array_constructor:=allow_array_constructor;
old_get_para_resulttype:=get_para_resulttype;
get_para_resulttype:=true;
allow_array_constructor:=true;
resulttypepass(left);
get_para_resulttype:=old_get_para_resulttype;
allow_array_constructor:=old_array_constructor;
if codegenerror then
resulttype:=generrortype
@ -630,164 +627,164 @@ type
if not assigned(left.resulttype.def) then
resulttypepass(left);
{ Handle varargs and hidden paras directly, no typeconvs or }
{ typechecking needed }
if (nf_varargs_para in flags) then
if (left.nodetype<>nothingn) then
begin
{ convert pascal to C types }
case left.resulttype.def.deftype of
stringdef :
inserttypeconv(left,charpointertype);
floatdef :
inserttypeconv(left,s64floattype);
end;
set_varstate(left,true);
resulttype:=left.resulttype;
end
else
if (paraitem.is_hidden) then
begin
set_varstate(left,true);
resulttype:=left.resulttype;
end
else
begin
{ Do we need arrayconstructor -> set conversion, then insert
it here before the arrayconstructor node breaks the tree
with its conversions of enum->ord }
if (left.nodetype=arrayconstructorn) and
(paraitem.paratype.def.deftype=setdef) then
inserttypeconv(left,paraitem.paratype);
{ set some settings needed for arrayconstructor }
if is_array_constructor(left.resulttype.def) then
begin
if is_array_of_const(paraitem.paratype.def) then
begin
if assigned(aktcallnode) and
(aktcallnode.procdefinition.proccalloption in [pocall_cppdecl,pocall_cdecl]) then
include(left.flags,nf_cargs);
{ force variant array }
include(left.flags,nf_forcevaria);
end
else
begin
include(left.flags,nf_novariaallowed);
{ now that the resultting type is know we can insert the required
typeconvs for the array constructor }
tarrayconstructornode(left).force_type(tarraydef(paraitem.paratype.def).elementtype);
{ Handle varargs and hidden paras directly, no typeconvs or }
{ typechecking needed }
if (nf_varargs_para in flags) then
begin
{ convert pascal to C types }
case left.resulttype.def.deftype of
stringdef :
inserttypeconv(left,charpointertype);
floatdef :
inserttypeconv(left,s64floattype);
end;
end;
{ check if local proc/func is assigned to procvar }
if left.resulttype.def.deftype=procvardef then
test_local_to_procvar(tprocvardef(left.resulttype.def),paraitem.paratype.def);
{ test conversions }
if not(is_shortstring(left.resulttype.def) and
is_shortstring(paraitem.paratype.def)) and
(paraitem.paratype.def.deftype<>formaldef) then
set_varstate(left,true);
resulttype:=left.resulttype;
end
else
if (paraitem.is_hidden) then
begin
{ Process open parameters }
if paramanager.push_high_param(paraitem.paratyp,paraitem.paratype.def,aktcallnode.procdefinition.proccalloption) then
begin
{ insert type conv but hold the ranges of the array }
oldtype:=left.resulttype;
inserttypeconv(left,paraitem.paratype);
left.resulttype:=oldtype;
end
else
begin
{ for ordinals, floats and enums, verify if we might cause
some range-check errors. }
if (paraitem.paratype.def.deftype in [enumdef,orddef,floatdef]) and
(left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
(left.nodetype in [vecn,loadn,calln]) then
begin
if (left.resulttype.def.size>paraitem.paratype.def.size) then
begin
if (cs_check_range in aktlocalswitches) then
Message(type_w_smaller_possible_range_check)
else
Message(type_h_smaller_possible_range_check);
end;
end;
inserttypeconv(left,paraitem.paratype);
end;
if codegenerror then
begin
dec(parsing_para_level);
exit;
end;
end;
{ check var strings }
if (cs_strict_var_strings in aktlocalswitches) and
is_shortstring(left.resulttype.def) and
is_shortstring(paraitem.paratype.def) and
(paraitem.paratyp in [vs_out,vs_var]) and
not(is_open_string(paraitem.paratype.def)) and
not(equal_defs(left.resulttype.def,paraitem.paratype.def)) then
begin
aktfilepos:=left.fileinfo;
CGMessage(type_e_strict_var_string_violation);
end;
{ Handle formal parameters separate }
if (paraitem.paratype.def.deftype=formaldef) then
begin
{ load procvar if a procedure is passed }
if (m_tp_procvar in aktmodeswitches) and
(left.nodetype=calln) and
(is_void(left.resulttype.def)) then
load_procvar_from_calln(left);
case paraitem.paratyp of
vs_var,
vs_out :
begin
if not valid_for_formal_var(left) then
CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
end;
vs_const :
begin
if not valid_for_formal_const(left) then
CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
end;
end;
set_varstate(left,true);
resulttype:=left.resulttype;
end
else
begin
{ check if the argument is allowed }
if (paraitem.paratyp in [vs_out,vs_var]) then
valid_for_var(left);
{ Do we need arrayconstructor -> set conversion, then insert
it here before the arrayconstructor node breaks the tree
with its conversions of enum->ord }
if (left.nodetype=arrayconstructorn) and
(paraitem.paratype.def.deftype=setdef) then
inserttypeconv(left,paraitem.paratype);
{ set some settings needed for arrayconstructor }
if is_array_constructor(left.resulttype.def) then
begin
if is_array_of_const(paraitem.paratype.def) then
begin
{ force variant array }
include(left.flags,nf_forcevaria);
end
else
begin
include(left.flags,nf_novariaallowed);
{ now that the resultting type is know we can insert the required
typeconvs for the array constructor }
tarrayconstructornode(left).force_type(tarraydef(paraitem.paratype.def).elementtype);
end;
end;
{ check if local proc/func is assigned to procvar }
if left.resulttype.def.deftype=procvardef then
test_local_to_procvar(tprocvardef(left.resulttype.def),paraitem.paratype.def);
{ test conversions }
if not(is_shortstring(left.resulttype.def) and
is_shortstring(paraitem.paratype.def)) and
(paraitem.paratype.def.deftype<>formaldef) then
begin
{ Process open parameters }
if paramanager.push_high_param(paraitem.paratyp,paraitem.paratype.def,aktcallnode.procdefinition.proccalloption) then
begin
{ insert type conv but hold the ranges of the array }
oldtype:=left.resulttype;
inserttypeconv(left,paraitem.paratype);
left.resulttype:=oldtype;
end
else
begin
{ for ordinals, floats and enums, verify if we might cause
some range-check errors. }
if (paraitem.paratype.def.deftype in [enumdef,orddef,floatdef]) and
(left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
(left.nodetype in [vecn,loadn,calln]) then
begin
if (left.resulttype.def.size>paraitem.paratype.def.size) then
begin
if (cs_check_range in aktlocalswitches) then
Message(type_w_smaller_possible_range_check)
else
Message(type_h_smaller_possible_range_check);
end;
end;
inserttypeconv(left,paraitem.paratype);
end;
if codegenerror then
begin
dec(parsing_para_level);
exit;
end;
end;
{ check var strings }
if (cs_strict_var_strings in aktlocalswitches) and
is_shortstring(left.resulttype.def) and
is_shortstring(paraitem.paratype.def) and
(paraitem.paratyp in [vs_out,vs_var]) and
not(is_open_string(paraitem.paratype.def)) and
not(equal_defs(left.resulttype.def,paraitem.paratype.def)) then
begin
aktfilepos:=left.fileinfo;
CGMessage(type_e_strict_var_string_violation);
end;
{ Handle formal parameters separate }
if (paraitem.paratype.def.deftype=formaldef) then
begin
{ load procvar if a procedure is passed }
if (m_tp_procvar in aktmodeswitches) and
(left.nodetype=calln) and
(is_void(left.resulttype.def)) then
load_procvar_from_calln(left);
case paraitem.paratyp of
vs_var,
vs_out :
begin
if not valid_for_formal_var(left) then
CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
end;
vs_const :
begin
if not valid_for_formal_const(left) then
CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
end;
end;
end
else
begin
{ check if the argument is allowed }
if (paraitem.paratyp in [vs_out,vs_var]) then
valid_for_var(left);
end;
if paraitem.paratyp in [vs_var,vs_const] then
begin
{ Causes problems with const ansistrings if also }
{ done for vs_const (JM) }
if paraitem.paratyp = vs_var then
set_unique(left);
make_not_regable(left);
end;
{ ansistrings out paramaters doesn't need to be }
{ unique, they are finalized }
if paraitem.paratyp=vs_out then
make_not_regable(left);
if do_count then
begin
{ not completly proper, but avoids some warnings }
{if (paraitem.paratyp in [vs_var,vs_out]) then
set_funcret_is_valid(left); }
set_varstate(left,not(paraitem.paratyp in [vs_var,vs_out]));
end;
{ must only be done after typeconv PM }
resulttype:=paraitem.paratype;
end;
if paraitem.paratyp in [vs_var,vs_const] then
begin
{ Causes problems with const ansistrings if also }
{ done for vs_const (JM) }
if paraitem.paratyp = vs_var then
set_unique(left);
make_not_regable(left);
end;
{ ansistrings out paramaters doesn't need to be }
{ unique, they are finalized }
if paraitem.paratyp=vs_out then
make_not_regable(left);
if do_count then
begin
{ not completly proper, but avoids some warnings }
{if (paraitem.paratyp in [vs_var,vs_out]) then
set_funcret_is_valid(left); }
set_varstate(left,not(paraitem.paratyp in [vs_var,vs_out]));
end;
{ must only be done after typeconv PM }
resulttype:=paraitem.paratype;
end;
end;
{ process next node }
if assigned(right) then
@ -802,9 +799,6 @@ type
procedure tcallparanode.det_registers;
var
old_get_para_resulttype : boolean;
old_array_constructor : boolean;
begin
if assigned(right) then
begin
@ -817,13 +811,7 @@ type
{$endif}
end;
old_array_constructor:=allow_array_constructor;
old_get_para_resulttype:=get_para_resulttype;
get_para_resulttype:=true;
allow_array_constructor:=true;
firstpass(left);
get_para_resulttype:=old_get_para_resulttype;
allow_array_constructor:=old_array_constructor;
if left.registers32>registers32 then
registers32:=left.registers32;
@ -839,13 +827,7 @@ type
procedure tcallparanode.firstcallparan(do_count : boolean);
begin
if not assigned(left.resulttype.def) then
begin
get_paratype;
{
if assigned(defcoll) then
insert_typeconv(defcoll,do_count);
}
end;
get_paratype;
det_registers;
end;
@ -881,6 +863,7 @@ type
_funcretnode:=nil;
inlinecode:=nil;
paralength:=-1;
varargsparas:=nil;
end;
@ -896,6 +879,7 @@ type
_funcretnode:=nil;
inlinecode:=nil;
paralength:=-1;
varargsparas:=nil;
end;
@ -911,6 +895,7 @@ type
_funcretnode:=nil;
inlinecode:=nil;
paralength:=-1;
varargsparas:=nil;
end;
@ -1003,6 +988,8 @@ type
methodpointer.free;
_funcretnode.free;
inlinecode.free;
if assigned(varargsparas) then
varargsparas.free;
inherited destroy;
end;
@ -1053,6 +1040,7 @@ type
function tcallnode.getcopy : tnode;
var
n : tcallnode;
hp : tparaitem;
begin
n:=tcallnode(inherited getcopy);
n.symtableprocentry:=symtableprocentry;
@ -1072,6 +1060,18 @@ type
n.inlinecode:=inlinecode.getcopy
else
n.inlinecode:=nil;
if assigned(varargsparas) then
begin
n.varargsparas:=tlinkedlist.create;
hp:=tparaitem(varargsparas.first);
while assigned(hp) do
begin
n.varargsparas.concat(hp.getcopy);
hp:=tparaitem(hp.next);
end;
end
else
n.varargsparas:=nil;
result:=n;
end;
@ -1082,6 +1082,38 @@ type
end;
procedure tcallnode.convert_carg_array_of_const;
var
hp : tarrayconstructornode;
oldleft : tcallparanode;
begin
oldleft:=tcallparanode(left);
{ Get arrayconstructor node and insert typeconvs }
hp:=tarrayconstructornode(oldleft.left);
hp.insert_typeconvs;
{ Add c args parameters }
{ It could be an empty set }
if assigned(hp) and
assigned(hp.left) then
begin
while assigned(hp) do
begin
left:=ccallparanode.create(hp.left,left);
{ set callparanode resulttype and flags }
left.resulttype:=hp.left.resulttype;
include(left.flags,nf_varargs_para);
hp.left:=nil;
hp:=tarrayconstructornode(hp.right);
end;
end;
{ Remove value of old array of const parameter, but keep it
in the list because it is required for bind_paraitem.
Generate a nothign to keep callparanoed.left valid }
oldleft.left.free;
oldleft.left:=cnothingnode.create;
end;
procedure tcallnode.verifyabstract(p : tnamedindexitem;arg:pointer);
var
@ -1805,6 +1837,7 @@ type
i : integer;
pt : tcallparanode;
oldppt : ^tcallparanode;
varargspara,
currpara : tparaitem;
used_by_callnode : boolean;
hiddentree : tnode;
@ -1815,19 +1848,21 @@ type
oldppt:=@left;
{ flag all callparanodes that belong to the varargs }
if (po_varargs in procdefinition.procoptions) then
begin
i:=paralength;
while (i>procdefinition.maxparacount) do
begin
include(tcallparanode(pt).flags,nf_varargs_para);
oldppt:=@pt.right;
pt:=tcallparanode(pt.right);
dec(i);
end;
end;
i:=paralength;
while (i>procdefinition.maxparacount) do
begin
include(pt.flags,nf_varargs_para);
oldppt:=@pt.right;
pt:=tcallparanode(pt.right);
dec(i);
end;
{ insert hidden parameters }
{ skip varargs that are inserted by array of const }
while assigned(pt) and
(nf_varargs_para in pt.flags) do
pt:=tcallparanode(pt.right);
{ process normal parameters and insert hidden parameters }
currpara:=tparaitem(procdefinition.Para.last);
while assigned(currpara) do
begin
@ -1891,13 +1926,30 @@ type
pt.used_by_callnode:=used_by_callnode;
oldppt^:=pt;
end;
{ Bind paraitem to this node and varsym }
if not assigned(pt) then
internalerror(200310052);
pt.paraitem:=currpara;
{ Next node and paraitem }
oldppt:=@pt.right;
pt:=tcallparanode(pt.right);
currpara:=tparaitem(currpara.previous);
currpara:=tparaitem(currpara.previous)
end;
{ Create paraitems for varargs }
pt:=tcallparanode(left);
while assigned(pt) do
begin
if nf_varargs_para in pt.flags then
begin
if not assigned(varargsparas) then
varargsparas:=tlinkedlist.create;
varargspara:=tparaitem.create;
varargspara.paratyp:=vs_value;
varargspara.paratype:=pt.resulttype;
varargsparas.concat(varargspara);
pt.paraitem:=varargspara;
end;
pt:=tcallparanode(pt.right);
end;
end;
@ -2240,6 +2292,12 @@ type
internalerror(200305061);
end;
{ Change loading of array of const to varargs }
if assigned(left) and
is_array_of_const(tparaitem(procdefinition.para.last).paratype.def) and
(procdefinition.proccalloption in [pocall_cppdecl,pocall_cdecl]) then
convert_carg_array_of_const;
{ bind paraitems to the callparanodes and insert hidden parameters }
aktcallnode:=self;
bind_paraitem;
@ -2550,7 +2608,11 @@ begin
end.
{
$Log$
Revision 1.190 2003-10-05 12:54:17 peter
Revision 1.191 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.190 2003/10/05 12:54:17 peter
* don't check for abstract methods when the constructor is called
by inherited
* fix private member error instead of wrong number of parameters

231
compiler/ncgcal.pas
View File

@ -48,6 +48,9 @@ interface
procedure normal_pass_2;
procedure inlined_pass_2;
protected
{ save the size of pushed parameter, needed po_clearstack
and alignment }
pushedparasize : longint;
framepointer_paraloc : tparalocation;
refcountedtemp : treference;
procedure handle_return_value;
@ -120,7 +123,7 @@ implementation
location_release(exprasmlist,left.location);
allocate_tempparaloc;
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
inc(pushedparasize,POINTER_SIZE);
inc(tcgcallnode(aktcallnode).pushedparasize,POINTER_SIZE);
end;
@ -174,8 +177,8 @@ implementation
begin
if tempparaloc.loc<>LOC_REFERENCE then
internalerror(200309291);
size:=align(tfloatdef(left.resulttype.def).size,aktcallnode.procdefinition.paraalign);
inc(pushedparasize,size);
size:=align(tfloatdef(left.resulttype.def).size,tempparaloc.alignment);
inc(tcgcallnode(aktcallnode).pushedparasize,size);
cg.g_stackpointer_alloc(exprasmlist,size);
reference_reset_base(href,NR_STACK_POINTER_REG,0);
cg.a_loadfpu_reg_ref(exprasmlist,def_cgsize(left.resulttype.def),left.location.register,href);
@ -183,22 +186,22 @@ implementation
LOC_REFERENCE,
LOC_CREFERENCE :
begin
sizetopush:=align(left.resulttype.def.size,aktcallnode.procdefinition.paraalign);
sizetopush:=align(left.resulttype.def.size,tempparaloc.alignment);
tempreference:=left.location.reference;
inc(tempreference.offset,sizetopush);
while (sizetopush>0) do
begin
if (sizetopush>=4) or (aktcallnode.procdefinition.paraalign>=4) then
if (sizetopush>=4) or (tempparaloc.alignment>=4) then
begin
cgsize:=OS_32;
inc(pushedparasize,4);
inc(tcgcallnode(aktcallnode).pushedparasize,4);
dec(tempreference.offset,4);
dec(sizetopush,4);
end
else
begin
cgsize:=OS_16;
inc(pushedparasize,2);
inc(tcgcallnode(aktcallnode).pushedparasize,2);
dec(tempreference.offset,2);
dec(sizetopush,2);
end;
@ -224,8 +227,10 @@ implementation
end
else
begin
{ copy the value on the stack or use normal parameter push? }
if paramanager.copy_value_on_stack(paraitem.paratyp,left.resulttype.def,
{ copy the value on the stack or use normal parameter push?
Check for varargs first because that has no paraitem }
if not(nf_varargs_para in flags) and
paramanager.copy_value_on_stack(paraitem.paratyp,left.resulttype.def,
aktcallnode.procdefinition.proccalloption) then
begin
location_release(exprasmlist,left.location);
@ -236,8 +241,8 @@ implementation
if not (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
internalerror(200204241);
{ push on stack }
size:=align(left.resulttype.def.size,aktcallnode.procdefinition.paraalign);
inc(pushedparasize,size);
size:=align(left.resulttype.def.size,tempparaloc.alignment);
inc(tcgcallnode(aktcallnode).pushedparasize,size);
cg.g_stackpointer_alloc(exprasmlist,size);
reference_reset_base(href,NR_STACK_POINTER_REG,0);
cg.g_concatcopy(exprasmlist,left.location.reference,href,size,false,false);
@ -257,7 +262,7 @@ implementation
cgsize:=def_cgsize(left.resulttype.def);
if cgsize in [OS_64,OS_S64] then
begin
inc(pushedparasize,8);
inc(tcgcallnode(aktcallnode).pushedparasize,8);
(*
if calloption=pocall_inline then
begin
@ -280,7 +285,7 @@ implementation
begin
location_release(exprasmlist,left.location);
allocate_tempparaloc;
inc(pushedparasize,aktcallnode.procdefinition.paraalign);
inc(tcgcallnode(aktcallnode).pushedparasize,align(tcgsize2size[tempparaloc.size],tempparaloc.alignment));
(*
if calloption=pocall_inline then
begin
@ -304,7 +309,7 @@ implementation
begin
location_release(exprasmlist,left.location);
allocate_tempparaloc;
inc(pushedparasize,8);
inc(tcgcallnode(aktcallnode).pushedparasize,8);
(*
if calloption=pocall_inline then
begin
@ -330,8 +335,10 @@ implementation
otlabel,
oflabel : tasmlabel;
begin
if not(assigned(paraitem.paratype.def) or
assigned(paraitem.parasym)) then
if not(assigned(paraitem)) or
not(assigned(paraitem.paratype.def)) or
not(assigned(paraitem.parasym) or
(nf_varargs_para in flags)) then
internalerror(200304242);
{ push from left to right if specified }
@ -339,97 +346,102 @@ implementation
(aktcallnode.procdefinition.proccalloption in pushleftright_pocalls) then
tcallparanode(right).secondcallparan;
otlabel:=truelabel;
oflabel:=falselabel;
objectlibrary.getlabel(truelabel);
objectlibrary.getlabel(falselabel);
secondpass(left);
{ Skip nothingn nodes which are used after disabling
a parameter }
if (left.nodetype<>nothingn) then
begin
otlabel:=truelabel;
oflabel:=falselabel;
objectlibrary.getlabel(truelabel);
objectlibrary.getlabel(falselabel);
secondpass(left);
{ handle varargs first, because defcoll is not valid }
if (nf_varargs_para in flags) then
begin
if paramanager.push_addr_param(vs_value,left.resulttype.def,
aktcallnode.procdefinition.proccalloption) then
push_addr_para
else
push_value_para;
end
{ hidden parameters }
else if paraitem.is_hidden then
begin
{ don't push a node that already generated a pointer type
by address for implicit hidden parameters }
if (vo_is_funcret in tvarsym(paraitem.parasym).varoptions) or
(not(left.resulttype.def.deftype in [pointerdef,classrefdef]) and
paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,
aktcallnode.procdefinition.proccalloption)) then
push_addr_para
else
push_value_para;
end
{ filter array of const c styled args }
else if is_array_of_const(left.resulttype.def) and (nf_cargs in left.flags) then
begin
{ nothing, everything is already pushed }
end
{ in codegen.handleread.. paraitem.data is set to nil }
else if assigned(paraitem.paratype.def) and
(paraitem.paratype.def.deftype=formaldef) then
begin
{ allow passing of a constant to a const formaldef }
if (tvarsym(paraitem.parasym).varspez=vs_const) and
(left.location.loc=LOC_CONSTANT) then
location_force_mem(exprasmlist,left.location);
{ allow @var }
if (left.nodetype=addrn) and
(not(nf_procvarload in left.flags)) then
begin
inc(pushedparasize,POINTER_SIZE);
location_release(exprasmlist,left.location);
allocate_tempparaloc;
cg.a_param_loc(exprasmlist,left.location,tempparaloc);
end
else
push_addr_para;
end
{ Normal parameter }
else
begin
{ don't push a node that already generated a pointer type
by address for implicit hidden parameters }
if (not(
paraitem.is_hidden and
(left.resulttype.def.deftype in [pointerdef,classrefdef])
) and
paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,
aktcallnode.procdefinition.proccalloption)) then
{ handle varargs first, because paraitem.parasym is not valid }
if (nf_varargs_para in flags) then
begin
{ Check for passing a constant to var,out parameter }
if (paraitem.paratyp in [vs_var,vs_out]) and
(left.location.loc<>LOC_REFERENCE) then
begin
{ passing self to a var parameter is allowed in
TP and delphi }
if not((left.location.loc=LOC_CREFERENCE) and
is_self_node(left)) then
internalerror(200106041);
end;
{ Force to be in memory }
if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
location_force_mem(exprasmlist,left.location);
push_addr_para;
if paramanager.push_addr_param(vs_value,left.resulttype.def,
aktcallnode.procdefinition.proccalloption) then
push_addr_para
else
push_value_para;
end
else
push_value_para;
end;
truelabel:=otlabel;
falselabel:=oflabel;
{ hidden parameters }
else if paraitem.is_hidden then
begin
{ don't push a node that already generated a pointer type
by address for implicit hidden parameters }
if (vo_is_funcret in tvarsym(paraitem.parasym).varoptions) or
(not(left.resulttype.def.deftype in [pointerdef,classrefdef]) and
paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,
aktcallnode.procdefinition.proccalloption)) then
push_addr_para
else
push_value_para;
end
{ filter array of const c styled args }
else if is_array_of_const(left.resulttype.def) and (nf_cargs in left.flags) then
begin
{ nothing, everything is already pushed }
end
{ formal def }
else if (paraitem.paratype.def.deftype=formaldef) then
begin
{ allow passing of a constant to a const formaldef }
if (tvarsym(paraitem.parasym).varspez=vs_const) and
(left.location.loc=LOC_CONSTANT) then
location_force_mem(exprasmlist,left.location);
{ update return location in callnode when this is the function
result }
if (vo_is_funcret in tvarsym(paraitem.parasym).varoptions) then
location_copy(aktcallnode.location,left.location);
{ allow @var }
if (left.nodetype=addrn) and
(not(nf_procvarload in left.flags)) then
begin
inc(tcgcallnode(aktcallnode).pushedparasize,POINTER_SIZE);
location_release(exprasmlist,left.location);
allocate_tempparaloc;
cg.a_param_loc(exprasmlist,left.location,tempparaloc);
end
else
push_addr_para;
end
{ Normal parameter }
else
begin
{ don't push a node that already generated a pointer type
by address for implicit hidden parameters }
if (not(
paraitem.is_hidden and
(left.resulttype.def.deftype in [pointerdef,classrefdef])
) and
paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,
aktcallnode.procdefinition.proccalloption)) then
begin
{ Check for passing a constant to var,out parameter }
if (paraitem.paratyp in [vs_var,vs_out]) and
(left.location.loc<>LOC_REFERENCE) then
begin
{ passing self to a var parameter is allowed in
TP and delphi }
if not((left.location.loc=LOC_CREFERENCE) and
is_self_node(left)) then
internalerror(200106041);
end;
{ Force to be in memory }
if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
location_force_mem(exprasmlist,left.location);
push_addr_para;
end
else
push_value_para;
end;
truelabel:=otlabel;
falselabel:=oflabel;
{ update return location in callnode when this is the function
result }
if assigned(paraitem.parasym) and
(vo_is_funcret in tvarsym(paraitem.parasym).varoptions) then
location_copy(aktcallnode.location,left.location);
end;
{ push from right to left }
if assigned(right) and
@ -597,7 +609,8 @@ implementation
if assigned(ppn.left) then
begin
{ don't release the funcret temp }
if not(vo_is_funcret in tvarsym(ppn.paraitem.parasym).varoptions) then
if not(assigned(ppn.paraitem.parasym)) or
not(vo_is_funcret in tvarsym(ppn.paraitem.parasym).varoptions) then
location_freetemp(exprasmlist,ppn.left.location);
{ process also all nodes of an array of const }
if ppn.left.nodetype=arrayconstructorn then
@ -697,6 +710,10 @@ implementation
procdefinition.has_paraloc_info:=true;
end;
{ calculate the parameter info for varargs }
if assigned(varargsparas) then
paramanager.create_varargs_paraloc_info(procdefinition,varargsparas);
iolabel:=nil;
rg.saveunusedstate(unusedstate);
@ -1307,7 +1324,11 @@ begin
end.
{
$Log$
Revision 1.124 2003-10-03 22:00:33 peter
Revision 1.125 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.124 2003/10/03 22:00:33 peter
* parameter alignment fixes
Revision 1.123 2003/10/01 20:34:48 peter

13
compiler/ncginl.pas
View File

@ -72,14 +72,9 @@ implementation
procedure tcginlinenode.pass_2;
var
oldpushedparasize : longint;
begin
location_reset(location,LOC_VOID,OS_NO);
{ save & reset pushedparasize }
oldpushedparasize:=pushedparasize;
pushedparasize:=0;
case inlinenumber of
in_assert_x_y:
begin
@ -165,8 +160,6 @@ implementation
{$endif SUPPORT_MMX}
else internalerror(9);
end;
{ reset pushedparasize }
pushedparasize:=oldpushedparasize;
end;
@ -663,7 +656,11 @@ end.
{
$Log$
Revision 1.43 2003-10-01 20:34:48 peter
Revision 1.44 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.43 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

232
compiler/ncgld.pas
View File

@ -696,153 +696,23 @@ implementation
elesize : longint;
tmpreg : tregister;
paraloc : tparalocation;
procedure push_value(p:tnode);
var
{$ifdef i386}
href : treference;
tempreference : treference;
sizetopush : longint;
size : longint;
{$endif i386}
cgsize : tcgsize;
begin
{ we've nothing to push when the size of the parameter is 0 }
if p.resulttype.def.size=0 then
exit;
if p.location.loc in [LOC_FLAGS,LOC_JUMP] then
internalerror(200309293);
{ Handle Floating point types differently }
if p.resulttype.def.deftype=floatdef then
begin
location_release(exprasmlist,p.location);
{$ifdef i386}
case p.location.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
begin
size:=align(tfloatdef(p.resulttype.def).size,std_param_align);
inc(pushedparasize,size);
cg.g_stackpointer_alloc(exprasmlist,size);
reference_reset_base(href,NR_STACK_POINTER_REG,0);
cg.a_loadfpu_reg_ref(exprasmlist,def_cgsize(p.resulttype.def),p.location.register,href);
end;
LOC_REFERENCE,
LOC_CREFERENCE :
begin
sizetopush:=align(p.resulttype.def.size,std_param_align);
tempreference:=p.location.reference;
inc(tempreference.offset,sizetopush);
while (sizetopush>0) do
begin
if sizetopush>=4 then
begin
cgsize:=OS_32;
inc(pushedparasize,4);
dec(tempreference.offset,4);
dec(sizetopush,4);
end
else
begin
cgsize:=OS_16;
inc(pushedparasize,2);
dec(tempreference.offset,2);
dec(sizetopush,2);
end;
cg.a_param_ref(exprasmlist,cgsize,tempreference,paraloc);
end;
end;
else
internalerror(200204243);
end;
{$else i386}
case p.location.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
cg.a_paramfpu_reg(exprasmlist,def_cgsize(p.resulttype.def),p.location.register,paraloc);
LOC_REFERENCE,
LOC_CREFERENCE :
cg.a_paramfpu_ref(exprasmlist,def_cgsize(p.resulttype.def),p.location.reference,paraloc)
else
internalerror(200204243);
end;
{$endif i386}
end
else
begin
{ copy the value on the stack or use normal parameter push? }
if paramanager.copy_value_on_stack(vs_value,p.resulttype.def,pocall_cdecl) then
begin
location_release(exprasmlist,p.location);
if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
internalerror(200204241);
{$ifdef i386}
{ push on stack }
size:=align(p.resulttype.def.size,std_param_align);
inc(pushedparasize,size);
cg.g_stackpointer_alloc(exprasmlist,size);
reference_reset_base(href,NR_STACK_POINTER_REG,0);
cg.g_concatcopy(exprasmlist,p.location.reference,href,size,false,false);
{$else i386}
cg.a_param_copy_ref(exprasmlist,p.resulttype.def.size,p.location.reference,paraloc);
{$endif i386}
end
else
begin
case p.location.loc of
LOC_CONSTANT,
LOC_REGISTER,
LOC_CREGISTER,
LOC_REFERENCE,
LOC_CREFERENCE :
begin
cgsize:=def_cgsize(p.resulttype.def);
if cgsize in [OS_64,OS_S64] then
begin
inc(pushedparasize,8);
cg64.a_param64_loc(exprasmlist,p.location,paraloc);
location_release(exprasmlist,p.location);
end
else
begin
location_release(exprasmlist,p.location);
inc(pushedparasize,std_param_align);
cg.a_param_loc(exprasmlist,p.location,paraloc);
end;
end;
else
internalerror(200204241);
end;
end;
end;
end;
begin
if nf_cargs in flags then
internalerror(200310054);
dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
if dovariant then
elesize:=8
else
elesize:=tarraydef(resulttype.def).elesize;
if nf_cargs in flags then
begin
location_reset(location,LOC_VOID,OS_NO);
{ Retrieve parameter location for push }
paraloc:=paramanager.getintparaloc(pocall_cdecl,1);
end
else
begin
location_reset(location,LOC_CREFERENCE,OS_NO);
fillchar(paraloc,sizeof(paraloc),0);
{ Allocate always a temp, also if no elements are required, to
be sure that location is valid (PFV) }
if tarraydef(resulttype.def).highrange=-1 then
tg.GetTemp(exprasmlist,elesize,tt_normal,location.reference)
else
tg.GetTemp(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,tt_normal,location.reference);
href:=location.reference;
end;
location_reset(location,LOC_CREFERENCE,OS_NO);
fillchar(paraloc,sizeof(paraloc),0);
{ Allocate always a temp, also if no elements are required, to
be sure that location is valid (PFV) }
if tarraydef(resulttype.def).highrange=-1 then
tg.GetTemp(exprasmlist,elesize,tt_normal,location.reference)
else
tg.GetTemp(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,tt_normal,location.reference);
href:=location.reference;
{ Process nodes in array constructor }
hp:=self;
while assigned(hp) do
@ -874,11 +744,8 @@ implementation
u64bit:
vtype:=vtQWord;
end;
if not(nf_cargs in flags) then
begin
freetemp:=false;
vaddr:=true;
end;
freetemp:=false;
vaddr:=true;
end
else if (lt.deftype=enumdef) or
is_integer(lt) then
@ -900,11 +767,8 @@ implementation
floatdef :
begin
vtype:=vtExtended;
if not(nf_cargs in flags) then
begin
freetemp:=false;
vaddr:=true;
end;
freetemp:=false;
vaddr:=true;
end;
procvardef,
pointerdef :
@ -948,53 +812,29 @@ implementation
end;
if vtype=$ff then
internalerror(14357);
{ write C style pushes or an pascal array }
if nf_cargs in flags then
{ write changing field update href to the next element }
inc(href.offset,4);
if vaddr then
begin
if vaddr then
begin
location_force_mem(exprasmlist,hp.left.location);
location_release(exprasmlist,hp.left.location);
cg.a_paramaddr_ref(exprasmlist,hp.left.location.reference,paraloc);
if freetemp then
location_freetemp(exprasmlist,hp.left.location);
inc(pushedparasize,pointer_size);
end
else
if vtype in [vtInt64,vtQword,vtExtended] then
push_value(hp.left)
else
begin
cg.a_param_loc(exprasmlist,hp.left.location,paraloc);
inc(pushedparasize,pointer_size);
end;
location_force_mem(exprasmlist,hp.left.location);
location_release(exprasmlist,hp.left.location);
tmpreg:=rg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,hp.left.location.reference,tmpreg);
rg.ungetregisterint(exprasmlist,tmpreg);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,tmpreg,href);
if freetemp then
location_freetemp(exprasmlist,hp.left.location);
end
else
begin
{ write changing field update href to the next element }
inc(href.offset,4);
if vaddr then
begin
location_force_mem(exprasmlist,hp.left.location);
location_release(exprasmlist,hp.left.location);
tmpreg:=rg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,hp.left.location.reference,tmpreg);
rg.ungetregisterint(exprasmlist,tmpreg);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,tmpreg,href);
if freetemp then
location_freetemp(exprasmlist,hp.left.location);
end
else
begin
location_release(exprasmlist,hp.left.location);
cg.a_load_loc_ref(exprasmlist,OS_ADDR,hp.left.location,href);
end;
{ update href to the vtype field and write it }
dec(href.offset,4);
cg.a_load_const_ref(exprasmlist, OS_INT,vtype,href);
{ goto next array element }
inc(href.offset,8);
location_release(exprasmlist,hp.left.location);
cg.a_load_loc_ref(exprasmlist,OS_ADDR,hp.left.location,href);
end;
{ update href to the vtype field and write it }
dec(href.offset,4);
cg.a_load_const_ref(exprasmlist, OS_INT,vtype,href);
{ goto next array element }
inc(href.offset,8);
end
else
{ normal array constructor of the same type }
@ -1045,7 +885,11 @@ begin
end.
{
$Log$
Revision 1.89 2003-10-01 20:34:48 peter
Revision 1.90 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.89 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

97
compiler/nld.pas
View File

@ -87,6 +87,7 @@ interface
function det_resulttype:tnode;override;
function docompare(p: tnode): boolean; override;
procedure force_type(tt:ttype);
procedure insert_typeconvs;
end;
tarrayconstructornodeclass = class of tarrayconstructornode;
@ -1001,7 +1002,7 @@ implementation
end;
function tarrayconstructornode.pass_1 : tnode;
procedure tarrayconstructornode.insert_typeconvs;
var
thp,
chp,
@ -1011,36 +1012,26 @@ implementation
orgflags : tnodeflags;
begin
dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
result:=nil;
{ only pass left tree, right tree contains next construct if any }
if assigned(left) then
begin
hp:=self;
while assigned(hp) do
begin
firstpass(hp.left);
resulttypepass(hp.left);
{ Insert typeconvs for array of const }
if dovariant then
begin
case hp.left.resulttype.def.deftype of
enumdef :
begin
hp.left:=ctypeconvnode.create_explicit(hp.left,s32bittype);
firstpass(hp.left);
end;
hp.left:=ctypeconvnode.create_explicit(hp.left,s32bittype);
arraydef :
begin
hp.left:=ctypeconvnode.create(hp.left,charpointertype);
firstpass(hp.left);
end;
hp.left:=ctypeconvnode.create(hp.left,charpointertype);
orddef :
begin
if is_integer(hp.left.resulttype.def) and
not(is_64bitint(hp.left.resulttype.def)) then
begin
hp.left:=ctypeconvnode.create(hp.left,s32bittype);
firstpass(hp.left);
end;
hp.left:=ctypeconvnode.create(hp.left,s32bittype);
end;
floatdef :
begin
@ -1049,21 +1040,14 @@ implementation
hp.left:=ctypeconvnode.create(hp.left,s64floattype)
else
hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
firstpass(hp.left);
end;
stringdef :
begin
if nf_cargs in flags then
begin
hp.left:=ctypeconvnode.create(hp.left,charpointertype);
firstpass(hp.left);
end;
hp.left:=ctypeconvnode.create(hp.left,charpointertype);
end;
procvardef :
begin
hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
firstpass(hp.left);
end;
hp.left:=ctypeconvnode.create(hp.left,voidpointertype);
variantdef,
pointerdef,
classrefdef,
@ -1072,44 +1056,33 @@ implementation
CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype.def.typename);
end;
end;
resulttypepass(hp.left);
hp:=tarrayconstructornode(hp.right);
end;
{ swap the tree for cargs }
if (nf_cargs in flags) and (not(nf_cargswap in flags)) then
begin
chp:=nil;
{ save resulttype }
htype:=resulttype;
{ we need a copy here, because self is destroyed }
{ by firstpass later }
hp:=tarrayconstructornode(getcopy);
{ we also need a copy of the nf_ forcevaria flag to restore }
{ later) (JM) }
orgflags := flags * [nf_forcevaria];
while assigned(hp) do
begin
thp:=tarrayconstructornode(hp.right);
hp.right:=chp;
chp:=hp;
hp:=thp;
end;
chp.flags := chp.flags+orgflags;
include(chp.flags,nf_cargs);
include(chp.flags,nf_cargswap);
chp.expectloc:=LOC_CREFERENCE;
calcregisters(chp,0,0,0);
chp.resulttype:=htype;
result:=chp;
exit;
end;
end;
{ C style has pushed everything on the stack, so
there is no return value }
if (nf_cargs in flags) then
expectloc:=LOC_VOID
else
expectloc:=LOC_CREFERENCE;
{ Calculate registers }
end;
function tarrayconstructornode.pass_1 : tnode;
var
hp : tarrayconstructornode;
begin
result:=nil;
{ Insert required type convs, this must be
done in pass 1, because the call must be
resulttypepassed already }
if assigned(left) then
begin
insert_typeconvs;
{ call firstpass for all nodes }
hp:=self;
while assigned(hp) do
begin
firstpass(hp.left);
hp:=tarrayconstructornode(hp.right);
end;
end;
expectloc:=LOC_CREFERENCE;
calcregisters(self,0,0,0);
end;
@ -1274,7 +1247,11 @@ begin
end.
{
$Log$
Revision 1.108 2003-10-01 20:34:48 peter
Revision 1.109 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.108 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

14
compiler/paramgr.pas
View File

@ -29,7 +29,7 @@ unit paramgr;
interface
uses
globtype,
cclasses,globtype,
cpubase,cgbase,
aasmtai,
symconst,symtype,symdef;
@ -101,6 +101,12 @@ unit paramgr;
}
function create_inline_paraloc_info(p : tabstractprocdef):longint;virtual;
{ This is used to populate the location information on all parameters
for the routine that are passed as varargs. It returns
the size allocated on the stack (including the normal parameters)
}
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tlinkedlist):longint;virtual;abstract;
{ Return the location of the low and high part of a 64bit parameter }
procedure splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);virtual;
@ -418,7 +424,11 @@ end.
{
$Log$
Revision 1.59 2003-10-03 22:00:33 peter
Revision 1.60 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.59 2003/10/03 22:00:33 peter
* parameter alignment fixes
Revision 1.58 2003/10/01 20:34:49 peter

15
compiler/pdecsub.pas
View File

@ -967,7 +967,7 @@ begin
begin
Message1(parser_w_not_supported_for_inline,'array of const');
Message(parser_w_inlining_disabled);
pd.set_calloption(pocall_default);
pd.proccalloption:=pocall_default;
end;
end;
hp:=tparaitem(hp.next);
@ -1583,7 +1583,7 @@ const
proccalloptionStr[pd.proccalloption],
proccalloptionStr[proc_direcdata[p].pocall]);
end;
pd.set_calloption(proc_direcdata[p].pocall);
pd.proccalloption:=proc_direcdata[p].pocall;
include(pd.procoptions,po_hascallingconvention);
end;
@ -1647,7 +1647,7 @@ const
begin
{ set the default calling convention if none provided }
if not(po_hascallingconvention in pd.procoptions) then
pd.set_calloption(aktdefproccall)
pd.proccalloption:=aktdefproccall
else
begin
if pd.proccalloption=pocall_none then
@ -1700,7 +1700,7 @@ const
if not(cs_support_inline in aktmoduleswitches) then
begin
Message(parser_e_proc_inline_not_supported);
pd.set_calloption(pocall_default);
pd.proccalloption:=pocall_default;
end;
end;
end;
@ -2027,7 +2027,6 @@ const
with the new data from the implementation }
hd.forwarddef:=pd.forwarddef;
hd.hasforward:=true;
hd.paraalign:=pd.paraalign;
hd.procoptions:=hd.procoptions+pd.procoptions;
if hd.extnumber=65535 then
hd.extnumber:=pd.extnumber;
@ -2127,7 +2126,11 @@ const
end.
{
$Log$
Revision 1.145 2003-10-05 11:10:52 peter
Revision 1.146 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.145 2003/10/05 11:10:52 peter
* temporary fix for compilerprocs on watcom
Revision 1.144 2003/10/03 22:00:33 peter

9
compiler/procinfo.pas
View File

@ -138,9 +138,6 @@ unit procinfo;
{ information about the current sub routine being parsed (@var(pprocinfo))}
current_procinfo : tprocinfo;
{ save the size of pushed parameter, needed for aligning }
pushedparasize : longint;
implementation
@ -220,7 +217,11 @@ implementation
end.
{
$Log$
Revision 1.2 2003-10-03 22:00:33 peter
Revision 1.3 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.2 2003/10/03 22:00:33 peter
* parameter alignment fixes
Revision 1.1 2003/10/01 20:34:49 peter

19
compiler/symdef.pas
View File

@ -423,7 +423,6 @@ interface
tabstractprocdef = class(tstoreddef)
{ saves a definition to the return type }
rettype : ttype;
paraalign : byte;
parast : tsymtable;
para : tlinkedlist;
proctypeoption : tproctypeoption;
@ -440,7 +439,6 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure deref;override;
procedure releasemem;
procedure set_calloption(calloption:tproccalloption);
function concatpara(afterpara:tparaitem;const tt:ttype;sym : tsym;defval:tsym;vhidden:boolean):tparaitem;
function insertpara(const tt:ttype;sym : tsym;defval:tsym;vhidden:boolean):tparaitem;
procedure removepara(currpara:tparaitem);
@ -3094,7 +3092,6 @@ implementation
parast.defowner:=self;
parast.next:=owner;
para:=TLinkedList.Create;
paraalign:=std_param_align;
minparacount:=0;
maxparacount:=0;
proctypeoption:=potype_none;
@ -3134,14 +3131,6 @@ implementation
end;
procedure tabstractprocdef.set_calloption(calloption:tproccalloption);
begin
proccalloption:=calloption;
{ Update parameter alignment }
paraalign:=paramanager.get_para_align(proccalloption);
end;
function tabstractprocdef.concatpara(afterpara:tparaitem;const tt:ttype;sym : tsym;defval:tsym;vhidden:boolean):tparaitem;
var
hp : TParaItem;
@ -3251,7 +3240,6 @@ implementation
maxparacount:=0;
ppufile.gettype(rettype);
fpu_used:=ppufile.getbyte;
paraalign:=ppufile.getbyte;
proctypeoption:=tproctypeoption(ppufile.getbyte);
proccalloption:=tproccalloption(ppufile.getbyte);
ppufile.getsmallset(procoptions);
@ -3297,7 +3285,6 @@ implementation
if simplify_ppu then
fpu_used:=0;
ppufile.putbyte(fpu_used);
ppufile.putbyte(paraalign);
ppufile.putbyte(ord(proctypeoption));
ppufile.putbyte(ord(proccalloption));
ppufile.putsmallset(procoptions);
@ -5916,7 +5903,11 @@ implementation
end.
{
$Log$
Revision 1.171 2003-10-05 12:56:35 peter
Revision 1.172 2003-10-05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes
Revision 1.171 2003/10/05 12:56:35 peter
* don't write procdefs that are released to ppu
Revision 1.170 2003/10/03 22:00:33 peter