paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 11:29:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

* remove a lot of code to support typen in loadn-procsym

Browse Source
This commit is contained in:
peter 2003-01-05 22:44:14 +00:00
parent 8423a146b0
commit a0fbe08d83
3 changed files with 92 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

171
compiler/ncgld.pas
View File

@ -68,7 +68,6 @@ implementation
var var
intreg, intreg,
hregister : tregister; hregister : tregister;
freereg : boolean;
symtabletype : tsymtabletype; symtabletype : tsymtabletype;
i : longint; i : longint;
href : treference; href : treference;
@ -290,107 +289,80 @@ implementation
begin begin
if assigned(left) then if assigned(left) then
begin begin
{ {
THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK
ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS
CONSISTS OF TWO OS_ADDR, so you cannot set it CONSISTS OF TWO OS_ADDR, so you cannot set it
to OS_64 - how to solve?? Carl to OS_64 - how to solve?? Carl
} }
if (sizeof(aword) = 4) then if (sizeof(aword) = 4) then
location_reset(location,LOC_CREFERENCE,OS_64) location_reset(location,LOC_CREFERENCE,OS_64)
else else
internalerror(20020520); internalerror(20020520);
tg.GetTemp(exprasmlist,2*POINTER_SIZE,tt_normal,location.reference); tg.GetTemp(exprasmlist,2*POINTER_SIZE,tt_normal,location.reference);
freereg:=false; secondpass(left);
{ called as type.method, then we only need to return { load class instance address }
the address of the function, not the self pointer } case left.location.loc of
if left.nodetype=typen then LOC_CREGISTER,
LOC_REGISTER:
begin
hregister:=left.location.register;
if is_object(left.resulttype.def) then
CGMessage(cg_e_illegal_expression);
end;
LOC_CREFERENCE,
LOC_REFERENCE:
begin
hregister:=rg.getaddressregister(exprasmlist);
if is_class_or_interface(left.resulttype.def) then
cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,hregister)
else
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister);
location_release(exprasmlist,left.location);
location_freetemp(exprasmlist,left.location);
end;
else
internalerror(26019);
end;
{ store the class instance address }
href:=location.reference;
inc(href.offset,POINTER_SIZE);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
{ virtual method ? }
if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then
begin begin
{ there is no instance, we return 0 } { load vmt pointer }
href:=location.reference; reference_reset_base(href,hregister,0);
inc(href.offset,POINTER_SIZE); reference_release(exprasmlist,href);
cg.a_load_const_ref(exprasmlist,OS_ADDR,0,href); hregister:=rg.getaddressregister(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
reference_reset_base(href,hregister,tprocdef(resulttype.def)._class.vmtmethodoffset(
tprocdef(resulttype.def).extnumber));
reference_release(exprasmlist,href);
{ load method address }
hregister:=rg.getaddressregister(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
{ ... and store it }
cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
rg.ungetaddressregister(exprasmlist,hregister);
end end
else else
begin begin
secondpass(left); { we don't use the hregister }
rg.ungetregister(exprasmlist,hregister);
{ load class instance address } { load address of the function }
case left.location.loc of reference_reset_symbol(href,objectlibrary.newasmsymbol(tprocdef(resulttype.def).mangledname),0);
LOC_CREGISTER, hregister:=cg.get_scratch_reg_address(exprasmlist);
LOC_REGISTER: cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
begin cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
hregister:=left.location.register; cg.free_scratch_reg(exprasmlist,hregister);
if is_object(left.resulttype.def) then
CGMessage(cg_e_illegal_expression);
end;
LOC_CREFERENCE,
LOC_REFERENCE:
begin
hregister:=rg.getaddressregister(exprasmlist);
if is_class_or_interface(left.resulttype.def) then
cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,hregister)
else
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister);
location_release(exprasmlist,left.location);
location_freetemp(exprasmlist,left.location);
end;
else
internalerror(26019);
end;
{ store the class instance address }
href:=location.reference;
inc(href.offset,POINTER_SIZE);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
{ hregister will be reused when loading a virtual method }
freereg:=true;
end; end;
{ virtual method ? }
if (po_virtualmethod in tprocdef(resulttype.def).procoptions) then
begin
if not freereg then
begin
if left.nodetype <> typen then
internalerror(200205161);
reference_reset_symbol(href,objectlibrary.newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),
tprocdef(resulttype.def)._class.vmtmethodoffset(tprocdef(resulttype.def).extnumber));
end
else
begin
{ load vmt pointer }
reference_reset_base(href,hregister,0);
reference_release(exprasmlist,href);
hregister:=rg.getaddressregister(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
reference_reset_base(href,hregister,tprocdef(resulttype.def)._class.vmtmethodoffset(
tprocdef(resulttype.def).extnumber));
reference_release(exprasmlist,href);
end;
{ load method address }
hregister:=rg.getaddressregister(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
{ ... and store it }
cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
rg.ungetaddressregister(exprasmlist,hregister);
end
else
begin
{ we don't use the hregister }
if freereg then
rg.ungetregister(exprasmlist,hregister);
{ load address of the function }
reference_reset_symbol(href,objectlibrary.newasmsymbol(tprocdef(resulttype.def).mangledname),0);
hregister:=cg.get_scratch_reg_address(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
cg.free_scratch_reg(exprasmlist,hregister);
end;
end end
else else
begin begin
@ -987,7 +959,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.42 2002-12-20 18:13:46 peter Revision 1.43 2003-01-05 22:44:14 peter
* remove a lot of code to support typen in loadn-procsym
Revision 1.42 2002/12/20 18:13:46 peter
* fixes for fpu values in arrayconstructor * fixes for fpu values in arrayconstructor
Revision 1.41 2002/11/27 20:04:39 peter Revision 1.41 2002/11/27 20:04:39 peter

45
compiler/nld.pas
View File

@ -178,7 +178,11 @@ implementation
begin begin
p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry, p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry,
tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc); tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc);
if assigned(tcallnode(p1).methodpointer) then { when the methodpointer is typen we've something like:
tobject.create. Then only the address is needed of the
method without a self pointer }
if assigned(tcallnode(p1).methodpointer) and
(tcallnode(p1).methodpointer.nodetype<>typen) then
begin begin
tloadnode(p2).set_mp(tcallnode(p1).methodpointer); tloadnode(p2).set_mp(tcallnode(p1).methodpointer);
tcallnode(p1).methodpointer:=nil; tcallnode(p1).methodpointer:=nil;
@ -268,6 +272,9 @@ implementation
procedure tloadnode.set_mp(p:tnode); procedure tloadnode.set_mp(p:tnode);
begin begin
{ typen nodes should not be set }
if p.nodetype=typen then
internalerror(200301042);
left:=p; left:=p;
end; end;
@ -376,38 +383,9 @@ implementation
else else
resulttype.setdef(procdef); resulttype.setdef(procdef);
if (m_tp_procvar in aktmodeswitches) then
begin
if assigned(left) then
begin
if left.nodetype=typen then
begin
{ we need to return only a voidpointer,
so no need to keep the typen }
left.free;
left:=nil;
end;
end
else
begin
{ if the owner of the procsym is a object, }
{ left must be set, if left isn't set }
{ it can be only self }
if (tprocsym(symtableentry).owner.symtabletype=objectsymtable) then
left:=cselfnode.create(tobjectdef(symtableentry.owner.defowner));
end;
end;
{ process methodpointer } { process methodpointer }
if assigned(left) then if assigned(left) then
begin resulttypepass(left);
resulttypepass(left);
{ turn on the allowed flag, the secondpass
will handle the typen itself }
if left.nodetype=typen then
ttypenode(left).allowed:=true;
end;
end; end;
else else
internalerror(200104141); internalerror(200104141);
@ -1272,7 +1250,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.78 2003-01-03 12:15:56 daniel Revision 1.79 2003-01-05 22:44:14 peter
* remove a lot of code to support typen in loadn-procsym
Revision 1.78 2003/01/03 12:15:56 daniel
* Removed ifdefs around notifications * Removed ifdefs around notifications
ifdefs around for loop optimizations remain ifdefs around for loop optimizations remain

8
compiler/pexpr.pas
View File

@ -709,7 +709,8 @@ implementation
else else
aprocdef:=nil; aprocdef:=nil;
p2:=cloadnode.create_procvar(sym,aprocdef,st); p2:=cloadnode.create_procvar(sym,aprocdef,st);
if assigned(p1) then if assigned(p1) and
(p1.nodetype<>typen) then
tloadnode(p2).set_mp(p1); tloadnode(p2).set_mp(p1);
p1:=p2; p1:=p2;
@ -2303,7 +2304,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.96 2002-12-11 22:40:36 peter Revision 1.97 2003-01-05 22:44:14 peter
* remove a lot of code to support typen in loadn-procsym
Revision 1.96 2002/12/11 22:40:36 peter
* assigned(procvar) fix for delphi mode, fixes tb0430 * assigned(procvar) fix for delphi mode, fixes tb0430
Revision 1.95 2002/11/30 11:12:48 carl Revision 1.95 2002/11/30 11:12:48 carl