paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 14:19:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* methodpointer is loaded into a temp when it was a calln

Browse Source
This commit is contained in:
peter 2004-05-23 18:28:40 +00:00
parent 423fde7ac6
commit b86f2c6a25
13 changed files with 254 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/htypechk.pas
View File

@ -466,7 +466,7 @@ implementation
{ the nil as symtable signs firstcalln that this is
an overloaded operator }
t:=ccallnode.create(ppn,Tprocsym(operpd.procsym),nil,nil);
t:=ccallnode.create(ppn,Tprocsym(operpd.procsym),nil,nil,[]);
{ we already know the procdef to use, so it can
skip the overload choosing in callnode.det_resulttype }
@ -612,7 +612,7 @@ implementation
{ the nil as symtable signs firstcalln that this is
an overloaded operator }
ht:=ccallnode.create(ppn,Tprocsym(operpd.procsym),nil,nil);
ht:=ccallnode.create(ppn,Tprocsym(operpd.procsym),nil,nil,[]);
{ we already know the procdef to use, so it can
skip the overload choosing in callnode.det_resulttype }
@ -1922,7 +1922,10 @@ implementation
end.
{
$Log$
Revision 1.87 2004-05-23 15:03:40 peter
Revision 1.88 2004-05-23 18:28:40 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.87 2004/05/23 15:03:40 peter
* some typeconvs don't allow assignment or passing to var para
Revision 1.86 2004/05/16 13:29:46 peter

14
compiler/nbas.pas
View File

@ -27,7 +27,7 @@ unit nbas;
interface
uses
cpubase,cgbase,
cpuinfo,cpubase,cgbase,
aasmbase,aasmtai,aasmcpu,
node,tgobj,
symtype;
@ -393,7 +393,7 @@ implementation
not(cs_extsyntax in aktmoduleswitches) and
(hp.left.nodetype=calln) and
not(is_void(hp.left.resulttype.def)) and
not(nf_return_value_used in tcallnode(hp.left).flags) and
not(cnf_return_value_used in tcallnode(hp.left).callnodeflags) and
not((tcallnode(hp.left).procdefinition.proctypeoption=potype_constructor) and
assigned(tprocdef(tcallnode(hp.left).procdefinition)._class) and
is_object(tprocdef(tcallnode(hp.left).procdefinition)._class)) then
@ -667,6 +667,11 @@ implementation
begin
create(_restype,_size,_temptype);
tempinfo^.may_be_in_reg:=
{ temp must fit a single register }
(_size<=sizeof(aint)) and
{ size of register operations must be known }
(def_cgsize(_restype.def)<>OS_NO) and
{ no init/final needed }
not (_restype.def.needs_inittable) and
((_restype.def.deftype <> pointerdef) or
(not tpointerdef(_restype.def).pointertype.def.needs_inittable));
@ -1012,7 +1017,10 @@ begin
end.
{
$Log$
Revision 1.82 2004-05-23 15:06:20 peter
Revision 1.83 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.82 2004/05/23 15:06:20 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected

171
compiler/ncal.pas
View File

@ -37,10 +37,16 @@ interface
symbase,symtype,symsym,symdef,symtable;
type
tcallnodeflags = (
cnf_restypeset
tcallnodeflag = (
cnf_restypeset,
cnf_return_value_used,
cnf_inherited,
cnf_anon_inherited,
cnf_new_call,
cnf_dispose_call,
cnf_member_call { called with implicit methodpointer tree }
);
tcallnodeflagset = set of tcallnodeflags;
tcallnodeflags = set of tcallnodeflag;
tcallnode = class(tbinarynode)
private
@ -68,6 +74,8 @@ interface
procdefinition : tabstractprocdef;
procdefinitionderef : tderef;
{ tree that contains the pointer to the object for this method }
methodpointerinit,
methodpointerdone,
methodpointer : tnode;
{ inline function body }
inlinecode : tnode;
@ -82,12 +90,11 @@ interface
{ you can't have a function with an "array of char" resulttype }
{ the RTL) (JM) }
restype: ttype;
callnodeflags : tcallnodeflagset;
callnodeflags : tcallnodeflags;
{ only the processor specific nodes need to override this }
{ constructor }
constructor create(l:tnode; v : tprocsym;st : tsymtable; mp : tnode);virtual;
constructor create_def(l:tnode;def:tprocdef;mp:tnode);virtual;
constructor create(l:tnode; v : tprocsym;st : tsymtable; mp: tnode; callflags:tcallnodeflags);virtual;
constructor create_procvar(l,r:tnode);
constructor createintern(const name: string; params: tnode);
constructor createinternres(const name: string; params: tnode; const res: ttype);
@ -120,14 +127,15 @@ interface
end;
tcallnodeclass = class of tcallnode;
tcallparaflags = (
{ flags used by tcallparanode }
cpf_is_colon_para
tcallparaflag = (
cpf_is_colon_para,
cpf_varargs_para { belongs this para to varargs }
);
tcallparaflags = set of tcallparaflag;
tcallparanode = class(tbinarynode)
public
callparaflags : set of tcallparaflags;
callparaflags : tcallparaflags;
paraitem : tparaitem;
used_by_callnode : boolean;
{ only the processor specific nodes need to override this }
@ -150,7 +158,6 @@ interface
function reverseparameters(p: tcallparanode): tcallparanode;
var
ccallnode : tcallnodeclass;
ccallparanode : tcallparanodeclass;
@ -388,7 +395,7 @@ type
{ Handle varargs and hidden paras directly, no typeconvs or }
{ typechecking needed }
if (nf_varargs_para in flags) then
if (cpf_varargs_para in callparaflags) then
begin
{ convert pascal to C types }
case left.resulttype.def.deftype of
@ -608,31 +615,16 @@ type
TCALLNODE
****************************************************************************}
constructor tcallnode.create(l:tnode;v : tprocsym;st : tsymtable; mp : tnode);
constructor tcallnode.create(l:tnode;v : tprocsym;st : tsymtable; mp: tnode; callflags:tcallnodeflags);
begin
inherited create(calln,l,nil);
symtableprocentry:=v;
symtableproc:=st;
include(flags,nf_return_value_used);
callnodeflags:=callflags+[cnf_return_value_used];
methodpointer:=mp;
methodpointerinit:=nil;
methodpointerdone:=nil;
procdefinition:=nil;
callnodeflags:=[];
_funcretnode:=nil;
inlinecode:=nil;
paralength:=-1;
varargsparas:=nil;
end;
constructor tcallnode.create_def(l:tnode;def:tprocdef;mp:tnode);
begin
inherited create(calln,l,nil);
symtableprocentry:=nil;
symtableproc:=nil;
include(flags,nf_return_value_used);
methodpointer:=mp;
procdefinition:=def;
callnodeflags:=[];
_funcretnode:=nil;
inlinecode:=nil;
paralength:=-1;
@ -645,10 +637,11 @@ type
inherited create(calln,l,r);
symtableprocentry:=nil;
symtableproc:=nil;
include(flags,nf_return_value_used);
methodpointer:=nil;
methodpointerinit:=nil;
methodpointerdone:=nil;
procdefinition:=nil;
callnodeflags:=[];
callnodeflags:=[cnf_return_value_used];
_funcretnode:=nil;
inlinecode:=nil;
paralength:=-1;
@ -680,7 +673,7 @@ type
{$endif EXTDEBUG}
internalerror(200107271);
end;
self.create(params,tprocsym(srsym),symowner,nil);
self.create(params,tprocsym(srsym),symowner,nil,[]);
end;
@ -743,6 +736,8 @@ type
destructor tcallnode.destroy;
begin
methodpointer.free;
methodpointerinit.free;
methodpointerdone.free;
_funcretnode.free;
inlinecode.free;
if assigned(varargsparas) then
@ -762,6 +757,8 @@ type
ppufile.getderef(procdefinitionderef);
ppufile.getsmallset(callnodeflags);
methodpointer:=ppuloadnode(ppufile);
methodpointerinit:=ppuloadnode(ppufile);
methodpointerdone:=ppuloadnode(ppufile);
_funcretnode:=ppuloadnode(ppufile);
inlinecode:=ppuloadnode(ppufile);
end;
@ -774,6 +771,8 @@ type
ppufile.putderef(procdefinitionderef);
ppufile.putsmallset(callnodeflags);
ppuwritenode(ppufile,methodpointer);
ppuwritenode(ppufile,methodpointerinit);
ppuwritenode(ppufile,methodpointerdone);
ppuwritenode(ppufile,_funcretnode);
ppuwritenode(ppufile,inlinecode);
end;
@ -811,7 +810,7 @@ type
{ Connect paraitems }
pt:=tcallparanode(left);
while assigned(pt) and
(nf_varargs_para in pt.flags) do
(cpf_varargs_para in pt.callparaflags) do
pt:=tcallparanode(pt.right);
currpara:=tparaitem(procdefinition.Para.last);
while assigned(currpara) do
@ -842,6 +841,14 @@ type
n.methodpointer:=methodpointer.getcopy
else
n.methodpointer:=nil;
if assigned(methodpointerinit) then
n.methodpointerinit:=methodpointerinit.getcopy
else
n.methodpointerinit:=nil;
if assigned(methodpointerdone) then
n.methodpointerdone:=methodpointerdone.getcopy
else
n.methodpointerdone:=nil;
if assigned(_funcretnode) then
n._funcretnode:=_funcretnode.getcopy
else
@ -896,7 +903,7 @@ type
left:=ccallparanode.create(hp.left,left);
{ set callparanode resulttype and flags }
left.resulttype:=hp.left.resulttype;
include(left.flags,nf_varargs_para);
include(tcallparanode(left).callparaflags,cpf_varargs_para);
hp.left:=nil;
hp:=tarrayconstructornode(hp.right);
end;
@ -1033,7 +1040,7 @@ type
selftree:=nil;
{ inherited }
if (nf_inherited in flags) then
if (cnf_inherited in callnodeflags) then
selftree:=load_self_node
else
{ constructors }
@ -1041,7 +1048,7 @@ type
begin
{ push 0 as self when allocation is needed }
if (methodpointer.resulttype.def.deftype=classrefdef) or
(nf_new_call in flags) then
(cnf_new_call in callnodeflags) then
selftree:=cpointerconstnode.create(0,voidpointertype)
else
begin
@ -1090,12 +1097,12 @@ type
internalerror(200305051);
{ inherited call, no create/destroy }
if (nf_inherited in flags) then
if (cnf_inherited in callnodeflags) then
vmttree:=cpointerconstnode.create(0,voidpointertype)
else
{ do not create/destroy when called from member function
without specifying self explicit }
if (nf_member_call in flags) then
if (cnf_member_call in callnodeflags) then
begin
if (methodpointer.resulttype.def.deftype=classrefdef) and
(procdefinition.proctypeoption=potype_constructor) then
@ -1105,11 +1112,11 @@ type
end
else
{ constructor with extended syntax called from new }
if (nf_new_call in flags) then
if (cnf_new_call in callnodeflags) then
vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resulttype))
else
{ destructor with extended syntax called from dispose }
if (nf_dispose_call in flags) then
if (cnf_dispose_call in callnodeflags) then
vmttree:=cloadvmtaddrnode.create(methodpointer.getcopy)
else
if (methodpointer.resulttype.def.deftype=classrefdef) then
@ -1174,7 +1181,7 @@ type
i:=paralength;
while (i>procdefinition.maxparacount) do
begin
include(pt.flags,nf_varargs_para);
include(pt.callparaflags,cpf_varargs_para);
oldppt:=@pt.right;
pt:=tcallparanode(pt.right);
dec(i);
@ -1182,7 +1189,7 @@ type
{ skip varargs that are inserted by array of const }
while assigned(pt) and
(nf_varargs_para in pt.flags) do
(cpf_varargs_para in pt.callparaflags) do
pt:=tcallparanode(pt.right);
{ process normal parameters and insert hidden parameters }
@ -1271,7 +1278,7 @@ type
pt:=tcallparanode(left);
while assigned(pt) do
begin
if nf_varargs_para in pt.flags then
if cpf_varargs_para in pt.callparaflags then
begin
if not assigned(varargsparas) then
varargsparas:=tvarargspara.create;
@ -1300,6 +1307,9 @@ type
i : longint;
method_must_be_valid,
is_const : boolean;
hp : tnode;
mptemp : ttempcreatenode;
newstatement : tstatementnode;
label
errorexit;
begin
@ -1326,6 +1336,40 @@ type
goto errorexit;
end;
if assigned(methodpointer) then
begin
resulttypepass(methodpointer);
hp:=methodpointer;
while assigned(hp) and
(hp.nodetype=typeconvn) do
hp:=tunarynode(hp).left;
if assigned(hp) and
(
{ call result must always be loaded in temp to prevent
double creation }
(hp.nodetype=calln)
{ Also optimize also complex loads }
{$warning Complex loads can also be optimized}
// not(hp.nodetype in [typen,loadvmtaddrn,loadn])
) then
begin
{ methodpointer loading }
methodpointerinit:=internalstatements(newstatement);
mptemp:=ctempcreatenode.create_reg(methodpointer.resulttype,methodpointer.resulttype.def.size,tt_persistent);
addstatement(newstatement,mptemp);
addstatement(newstatement,cassignmentnode.create(
ctemprefnode.create(mptemp),
methodpointer));
resulttypepass(methodpointerinit);
{ new methodpointer is only a temp reference }
methodpointer:=ctemprefnode.create(mptemp);
resulttypepass(methodpointer);
{ methodpointer cleanup }
methodpointerdone:=ctempdeletenode.create(mptemp);
resulttypepass(methodpointerdone);
end;
end;
{ procedure variable ? }
if assigned(right) then
begin
@ -1404,7 +1448,7 @@ type
do this ugly hack in Delphi mode as it looks more
like a bug. It's also not documented }
if (m_delphi in aktmodeswitches) and
(nf_anon_inherited in flags) and
(cnf_anon_inherited in callnodeflags) and
(symtableprocentry.owner.symtabletype=objectsymtable) and
(po_overload in symtableprocentry.first_procdef.procoptions) and
(symtableprocentry.procdef_count>=2) then
@ -1416,7 +1460,7 @@ type
when there is only one proc definition, else the
loadnode will give a strange error }
if not(assigned(left)) and
not(nf_inherited in flags) and
not(cnf_inherited in callnodeflags) and
(m_tp_procvar in aktmodeswitches) and
(symtableprocentry.procdef_count=1) then
begin
@ -1576,12 +1620,15 @@ type
if assigned(methodpointer) then
begin
resulttypepass(methodpointer);
{ when methodpointer is a callnode we must load it first into a
temp to prevent the processing callnode twice }
if (methodpointer.nodetype=calln) then
internalerror(200405121);
{ direct call to inherited abstract method, then we
can already give a error in the compiler instead
of a runtime error }
if (nf_inherited in flags) and
if (cnf_inherited in callnodeflags) and
(po_abstractmethod in procdefinition.procoptions) then
CGMessage(cg_e_cant_call_abstract_method);
@ -1589,7 +1636,7 @@ type
{ called in a con- or destructor then a warning }
{ will be made }
{ con- and destructors need a pointer to the vmt }
if (nf_inherited in flags) and
if (cnf_inherited in callnodeflags) and
(procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
is_object(methodpointer.resulttype.def) and
not(current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) then
@ -1597,9 +1644,10 @@ type
if methodpointer.nodetype<>typen then
begin
hpt:=methodpointer;
while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
hpt:=tunarynode(hpt).left;
{ Remove all postfix operators }
hpt:=methodpointer;
while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
hpt:=tunarynode(hpt).left;
if (procdefinition.proctypeoption=potype_constructor) and
assigned(symtableproc) and
@ -1634,8 +1682,8 @@ type
methods. Ignore inherited and member calls, because the
class is then already created }
if (procdefinition.proctypeoption=potype_constructor) and
not(nf_inherited in flags) and
not(nf_member_call in flags) then
not(cnf_inherited in callnodeflags) and
not(cnf_member_call in callnodeflags) then
verifyabstractcalls;
end
else
@ -1788,6 +1836,12 @@ type
{ order parameters }
order_parameters;
if assigned(methodpointerinit) then
firstpass(methodpointerinit);
if assigned(methodpointerdone) then
firstpass(methodpointerdone);
{ function result node }
if assigned(_funcretnode) then
firstpass(_funcretnode);
@ -1868,7 +1922,7 @@ type
end
else
{ we have only to handle the result if it is used }
if (nf_return_value_used in flags) then
if (cnf_return_value_used in callnodeflags) then
begin
case resulttype.def.deftype of
enumdef,
@ -2056,7 +2110,10 @@ begin
end.
{
$Log$
Revision 1.234 2004-05-23 15:06:20 peter
Revision 1.235 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.234 2004/05/23 15:06:20 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected

6
compiler/ncgbas.pas
View File

@ -339,6 +339,7 @@ interface
end;
end;
{*****************************************************************************
TTEMPCREATENODE
*****************************************************************************}
@ -476,7 +477,10 @@ begin
end.
{
$Log$
Revision 1.61 2004-05-23 15:06:20 peter
Revision 1.62 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.61 2004/05/23 15:06:20 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected

23
compiler/ncgcal.pas
View File

@ -287,7 +287,7 @@ implementation
begin
{ 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
if not(cpf_varargs_para in callparaflags) and
paramanager.copy_value_on_stack(paraitem.paratyp,left.resulttype.def,
aktcallnode.procdefinition.proccalloption) then
begin
@ -361,7 +361,7 @@ implementation
if not(assigned(paraitem)) or
not(assigned(paraitem.paratype.def)) or
not(assigned(paraitem.parasym) or
(nf_varargs_para in flags)) then
(cpf_varargs_para in callparaflags)) then
internalerror(200304242);
{ Skip nothingn nodes which are used after disabling
@ -377,7 +377,7 @@ implementation
allocate_tempparaloc;
{ handle varargs first, because paraitem.parasym is not valid }
if (nf_varargs_para in flags) then
if (cpf_varargs_para in callparaflags) then
begin
if paramanager.push_addr_param(vs_value,left.resulttype.def,
aktcallnode.procdefinition.proccalloption) then
@ -537,7 +537,7 @@ implementation
end
else
{ we have only to handle the result if it is used }
if (nf_return_value_used in flags) then
if (cnf_return_value_used in callnodeflags) then
begin
if (resulttype.def.deftype=floatdef) then
begin
@ -1044,7 +1044,7 @@ implementation
release_para_temps;
{ if return value is not used }
if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
if (not(cnf_return_value_used in callnodeflags)) and (not is_void(resulttype.def)) then
begin
if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
begin
@ -1209,7 +1209,7 @@ implementation
{ if return value is not used }
if (not is_void(resulttype.def)) and
(not(nf_return_value_used in flags)) then
(not(cnf_return_value_used in callnodeflags)) then
begin
if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
begin
@ -1259,10 +1259,16 @@ implementation
procedure tcgcallnode.pass_2;
begin
if assigned(methodpointerinit) then
secondpass(methodpointerinit);
if assigned(inlinecode) then
inlined_pass_2
else
normal_pass_2;
if assigned(methodpointerdone) then
secondpass(methodpointerdone);
end;
@ -1272,7 +1278,10 @@ begin
end.
{
$Log$
Revision 1.166 2004-05-22 23:34:27 peter
Revision 1.167 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.166 2004/05/22 23:34:27 peter
tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
Revision 1.165 2004/04/28 15:19:03 florian

8
compiler/ncnv.pas
View File

@ -1226,8 +1226,7 @@ implementation
begin
include(current_procinfo.flags,pi_do_call);
inc(aprocdef.procsym.refs);
hp:=ccallnode.create(ccallparanode.create(left,nil),
Tprocsym(aprocdef.procsym),nil,nil);
hp:=ccallnode.create(ccallparanode.create(left,nil),Tprocsym(aprocdef.procsym),nil,nil,[]);
{ tell explicitly which def we must use !! (PM) }
tcallnode(hp).procdefinition:=aprocdef;
left:=nil;
@ -2447,7 +2446,10 @@ begin
end.
{
$Log$
Revision 1.146 2004-05-23 15:03:40 peter
Revision 1.147 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.146 2004/05/23 15:03:40 peter
* some typeconvs don't allow assignment or passing to var para
Revision 1.145 2004/05/23 14:14:18 florian

7
compiler/ninl.pas
View File

@ -1741,7 +1741,7 @@ implementation
srsym:=searchsymonlyin(systemunit,'SETTEXTBUF');
hp:=ccallparanode.create(cordconstnode.create(
tcallparanode(left).left.resulttype.def.size,s32inttype,true),left);
hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil);
hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil,[]);
left:=nil;
result:=hp;
end;
@ -2374,7 +2374,10 @@ begin
end.
{
$Log$
Revision 1.133 2004-03-18 16:19:03 peter
Revision 1.134 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.133 2004/03/18 16:19:03 peter
* fixed operator overload allowing for pointer-string
* replaced some type_e_mismatch with more informational messages

16
compiler/node.pas
View File

@ -204,17 +204,6 @@ interface
nf_write, { Node is written to }
nf_isproperty,
{ flags used by tcallnode }
nf_return_value_used,
nf_inherited,
nf_anon_inherited,
nf_new_call,
nf_dispose_call,
nf_member_call, { called with implicit methodpointer tree }
{ flags used by tcallparanode }
nf_varargs_para, { belongs this para to varargs }
{ taddrnode }
nf_procvarload,
nf_typedaddr,
@ -1093,7 +1082,10 @@ implementation
end.
{
$Log$
Revision 1.83 2004-05-23 15:06:21 peter
Revision 1.84 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.83 2004/05/23 15:06:21 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected

7
compiler/nutils.pas
View File

@ -354,7 +354,7 @@ implementation
load_vmt_pointer_node,
voidpointertype),
cpointerconstnode.create(1,voidpointertype))),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]),
nil));
end
else
@ -438,7 +438,10 @@ end.
{
$Log$
Revision 1.11 2004-05-23 15:04:49 peter
Revision 1.12 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.11 2004/05/23 15:04:49 peter
* generate better code for ansistring initialization
Revision 1.10 2004/02/20 21:55:59 peter

139
compiler/pexpr.pas
View File

@ -28,7 +28,7 @@ interface
uses
symtype,symdef,symbase,
node,
node,ncal,
globals,
cpuinfo;
@ -50,7 +50,7 @@ interface
function parse_paras(__colon,in_prop_paras : boolean) : tnode;
{ the ID token has to be consumed before calling this function }
procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callnflags:tnodeflags);
procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callflags:tcallnodeflags);
{$ifdef int64funcresok}
function get_intconst:TConstExprInt;
@ -75,7 +75,7 @@ implementation
symconst,symtable,symsym,defutil,defcmp,
{ pass 1 }
pass_1,htypechk,
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
{ parser }
scanner,
pbase,pinline,
@ -711,7 +711,7 @@ implementation
{ reads the parameter for a subroutine call }
procedure do_proc_call(sym:tsym;st:tsymtable;obj:tobjectdef;getaddr:boolean;var again : boolean;var p1:tnode);
procedure do_proc_call(sym:tsym;st:tsymtable;obj:tobjectdef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags);
var
membercall,
prevafterassn : boolean;
@ -798,19 +798,19 @@ implementation
consume(_RKLAMMER);
end;
end;
if assigned(obj) then
begin
if (st.symtabletype<>objectsymtable) then
internalerror(200310031);
p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1);
end
else
p1:=ccallnode.create(para,tprocsym(sym),st,p1);
{ indicate if this call was generated by a member and
no explicit self is used, this is needed to determine
how to handle a destructor call (PFV) }
if membercall then
include(p1.flags,nf_member_call);
include(callflags,cnf_member_call);
if assigned(obj) then
begin
if (st.symtabletype<>objectsymtable) then
internalerror(200310031);
p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags);
end
else
p1:=ccallnode.create(para,tprocsym(sym),st,p1,callflags);
end;
afterassignment:=prevafterassn;
end;
@ -860,6 +860,7 @@ implementation
paras : tnode;
p2 : tnode;
membercall : boolean;
callflags : tcallnodeflags;
begin
paras:=nil;
{ property parameters? read them only if the property really }
@ -888,12 +889,12 @@ implementation
case tpropertysym(sym).writeaccess.firstsym^.sym.typ of
procsym :
begin
callflags:=[];
{ generate the method call }
membercall:=maybe_load_methodpointer(st,p1);
p1:=ccallnode.create(paras,
tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1);
if membercall then
include(tcallnode(p1).flags,nf_member_call);
include(callflags,cnf_member_call);
p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1,callflags);
paras:=nil;
consume(_ASSIGNMENT);
{ read the expression }
@ -903,7 +904,8 @@ implementation
if assigned(getprocvardef) then
handle_procvar(getprocvardef,p2);
tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
include(tcallnode(p1).flags,nf_isproperty);
{ mark as property, both the tcallnode and the real call block }
include(p1.flags,nf_isproperty);
getprocvardef:=nil;
end;
varsym :
@ -943,11 +945,12 @@ implementation
end;
procsym :
begin
callflags:=[];
{ generate the method call }
membercall:=maybe_load_methodpointer(st,p1);
p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).readaccess.firstsym^.sym),st,p1);
if membercall then
include(tcallnode(p1).flags,nf_member_call);
include(callflags,cnf_member_call);
p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).readaccess.firstsym^.sym),st,p1,callflags);
paras:=nil;
include(p1.flags,nf_isproperty);
end
@ -972,16 +975,12 @@ implementation
{ the ID token has to be consumed before calling this function }
procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callnflags:tnodeflags);
procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callflags:tcallnodeflags);
var
static_name : string;
isclassref : boolean;
srsymtable : tsymtable;
{$ifdef CHECKINHERITEDRESULT}
newstatement : tstatementnode;
newblock : tblocknode;
{$endif CHECKINHERITEDRESULT}
isclassref : boolean;
srsymtable : tsymtable;
begin
if sym=nil then
begin
@ -1011,77 +1010,16 @@ implementation
begin
do_proc_call(sym,sym.owner,classh,
(getaddr and not(token in [_CARET,_POINT])),
again,p1);
{ add provided flags }
if (p1.nodetype=calln) then
p1.flags:=p1.flags+callnflags;
again,p1,callflags);
{ we need to know which procedure is called }
do_resulttypepass(p1);
{ now we know the method that is called }
if (p1.nodetype=calln) and
assigned(tcallnode(p1).procdefinition) then
begin
{ calling using classref? }
if isclassref and
not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
Message(parser_e_only_class_methods_via_class_ref);
{$ifdef CHECKINHERITEDRESULT}
{ when calling inherited constructor we need to check the return value }
if (nf_inherited in callnflags) and
(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
begin
{
For Classes:
self:=inherited constructor
if self=nil then
exit
For objects:
if inherited constructor=false then
begin
self:=nil;
exit;
end;
}
if is_class(tprocdef(tcallnode(p1).procdefinition)._class) then
begin
newblock:=internalstatements(newstatement,true);
addstatement(newstatement,cassignmentnode.create(
ctypeconvnode.create(
load_self_pointer_node,
voidpointertype),
ctypeconvnode.create(
p1,
voidpointertype)));
addstatement(newstatement,cifnode.create(
caddnode.create(equaln,
load_self_pointer_node,
cnilnode.create),
cexitnode.create(nil),
nil));
p1:=newblock;
end
else
if is_object(tprocdef(tcallnode(p1).procdefinition)._class) then
begin
newblock:=internalstatements(newstatement,true);
addstatement(newstatement,call_fail_node);
addstatement(newstatement,cexitnode.create(nil));
p1:=cifnode.create(
caddnode.create(equaln,
cordconstnode.create(0,booltype,false),
p1),
newblock,
nil);
end
else
internalerror(200305133);
end;
{$endif CHECKINHERITEDRESULT}
do_resulttypepass(p1);
end;
{ calling using classref? }
if isclassref and
(p1.nodetype=calln) and
assigned(tcallnode(p1).procdefinition) and
not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
Message(parser_e_only_class_methods_via_class_ref);
end;
varsym:
begin
@ -1386,7 +1324,7 @@ implementation
(po_classmethod in current_procinfo.procdef.procoptions);
do_proc_call(srsym,srsymtable,nil,
(getaddr and not(token in [_CARET,_POINT])),
again,p1);
again,p1,[]);
{ we need to know which procedure is called }
if possible_error then
begin
@ -1867,7 +1805,7 @@ implementation
htype.setdef(tclassrefdef.create(htype));
p1:=ctypenode.create(htype);
end;
do_member_read(classh,false,sym,p1,again,[nf_inherited,nf_anon_inherited]);
do_member_read(classh,false,sym,p1,again,[cnf_inherited,cnf_anon_inherited]);
end
else
begin
@ -1882,7 +1820,7 @@ implementation
(sym.typ<>procsym) then
internalerror(200303171);
p1:=nil;
do_proc_call(sym,sym.owner,classh,false,again,p1);
do_proc_call(sym,sym.owner,classh,false,again,p1,[]);
end
else
begin
@ -2427,7 +2365,10 @@ implementation
end.
{
$Log$
Revision 1.155 2004-05-16 15:03:48 florian
Revision 1.156 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.155 2004/05/16 15:03:48 florian
+ support for assigned(<dyn. array>) added
Revision 1.154 2004/04/29 19:56:37 daniel

57
compiler/pinline.pas
View File

@ -75,7 +75,7 @@ implementation
destructorname : stringid;
sym : tsym;
classh : tobjectdef;
callflag : tnodeflag;
callflag : tcallnodeflag;
destructorpos,
storepos : tfileposinfo;
begin
@ -153,9 +153,9 @@ implementation
p2:=cderefnode.create(p);
do_resulttypepass(p2);
if is_new then
callflag:=nf_new_call
callflag:=cnf_new_call
else
callflag:=nf_dispose_call;
callflag:=cnf_dispose_call;
if is_new then
do_member_read(classh,false,sym,p2,again,[callflag])
else
@ -164,11 +164,7 @@ implementation
do_member_read(classh,false,sym,p2,again,[callflag])
else
begin
p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2);
if is_new then
include(p2.flags,nf_new_call)
else
include(p2.flags,nf_dispose_call);
p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2,[callflag]);
{ support dispose(p,done()); }
if try_to_consume(_LKLAMMER) then
begin
@ -185,7 +181,22 @@ implementation
{ we need the real called method }
do_resulttypepass(p2);
if p2.nodetype<>calln then
if (p2.nodetype=calln) then
begin
if is_new then
begin
if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
Message(parser_e_expr_have_to_be_constructor_call);
p2.resulttype:=p.resulttype;
p2:=cassignmentnode.create(p,p2);
end
else
begin
if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
Message(parser_e_expr_have_to_be_destructor_call);
end;
end
else
begin
if is_new then
CGMessage(parser_e_expr_have_to_be_constructor_call)
@ -193,22 +204,7 @@ implementation
CGMessage(parser_e_expr_have_to_be_destructor_call);
end;
if not codegenerror then
begin
if is_new then
begin
if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
Message(parser_e_expr_have_to_be_constructor_call);
p2.resulttype:=p.resulttype;
p2:=cassignmentnode.create(p,p2);
end
else
begin
if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
Message(parser_e_expr_have_to_be_destructor_call);
end;
end;
new_dispose_statement:=p2;
result:=p2;
end;
end
else
@ -373,7 +369,7 @@ implementation
afterassignment:=false;
sym:=searchsym_in_class(classh,pattern);
consume(_ID);
do_member_read(classh,false,sym,p1,again,[nf_new_call]);
do_member_read(classh,false,sym,p1,again,[cnf_new_call]);
{ we need to know which procedure is called }
do_resulttypepass(p1);
if not(
@ -531,8 +527,6 @@ implementation
var
newblock,
paras : tnode;
npara,
destppn,
ppn : tcallparanode;
begin
{ for easy exiting if something goes wrong }
@ -633,7 +627,9 @@ implementation
paradef : tdef;
counter : integer;
newstatement : tstatementnode;
{$ifdef ansistring_bits}
mode : byte;
{$endif ansistring_bits}
begin
{ for easy exiting if something goes wrong }
result := cerrornode.create;
@ -763,7 +759,10 @@ implementation
end.
{
$Log$
Revision 1.30 2004-04-29 19:56:37 daniel
Revision 1.31 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.30 2004/04/29 19:56:37 daniel
* Prepare compiler infrastructure for multiple ansistring types
Revision 1.29 2004/02/04 18:45:29 jonas

7
compiler/pstatmnt.pas
View File

@ -977,7 +977,7 @@ implementation
- dispose of temp stack space
- dispose on FPU stack }
if (p.nodetype=calln) then
exclude(p.flags,nf_return_value_used);
exclude(tcallnode(p).callnodeflags,cnf_return_value_used);
code:=p;
end;
@ -1105,7 +1105,10 @@ implementation
end.
{
$Log$
Revision 1.133 2004-05-23 11:39:38 peter
Revision 1.134 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.133 2004/05/23 11:39:38 peter
* give error when goto jumps to label outside current proc scope
Revision 1.132 2004/03/04 17:22:10 peter

16
compiler/psub.pas
View File

@ -302,7 +302,7 @@ implementation
ctypeconvnode.create_explicit(
load_self_pointer_node,
voidpointertype),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node)),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node,[])),
nil));
end
else
@ -361,7 +361,7 @@ implementation
caddnode.create(unequaln,
load_vmt_pointer_node,
cnilnode.create),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]),
nil));
end
else
@ -399,7 +399,7 @@ implementation
caddnode.create(unequaln,
load_vmt_pointer_node,
cnilnode.create)),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]),
nil));
end
else
@ -426,7 +426,7 @@ implementation
load_vmt_pointer_node,
voidpointertype),
cpointerconstnode.create(1,voidpointertype))),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]),
nil));
end
else
@ -466,6 +466,7 @@ implementation
var
pd : tprocdef;
newstatement : tstatementnode;
dummycall : tcallnode;
begin
generate_except_block:=internalstatements(newstatement);
@ -482,7 +483,7 @@ implementation
caddnode.create(unequaln,
load_vmt_pointer_node,
cnilnode.create),
ccallnode.create(nil,tprocsym(pd.procsym),pd.procsym.owner,load_self_node),
ccallnode.create(nil,tprocsym(pd.procsym),pd.procsym.owner,load_self_node,[]),
nil));
end;
end
@ -1379,7 +1380,10 @@ implementation
end.
{
$Log$
Revision 1.191 2004-05-23 15:06:21 peter
Revision 1.192 2004-05-23 18:28:41 peter
* methodpointer is loaded into a temp when it was a calln
Revision 1.191 2004/05/23 15:06:21 peter
* implicit_finally flag must be set in pass1
* add check whether the implicit frame is generated when expected