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

+ added freeintparaloc

Browse Source 
* ppc get/freeintparaloc now check whether the parameter regs are
    properly allocated/deallocated (and get an extra list para)
  * ppc a_call_* now internalerrors if pi_do_call is not yet set
  * fixed lot of missing pi_do_call's
This commit is contained in:
Jonas Maebe 2003-06-07 18:57:04 +00:00
parent acdfd1d445
commit edb2179730
21 changed files with 432 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
compiler/cgobj.pas
View File

@ -1309,15 +1309,18 @@ unit cgobj;
{$ifdef FPC}
{$warning FIX ME!}
{$endif}
a_paramaddr_ref(list,dest,paramanager.getintparaloc(3));
a_paramaddr_ref(list,dest,paramanager.getintparaloc(list,3));
if loadref then
a_param_ref(list,OS_ADDR,source,paramanager.getintparaloc(2))
a_param_ref(list,OS_ADDR,source,paramanager.getintparaloc(list,2))
else
a_paramaddr_ref(list,source,paramanager.getintparaloc(2));
a_paramaddr_ref(list,source,paramanager.getintparaloc(list,2));
if delsource then
reference_release(list,source);
a_param_const(list,OS_INT,len,paramanager.getintparaloc(1));
a_param_const(list,OS_INT,len,paramanager.getintparaloc(list,1));
a_call_name(list,'FPC_SHORTSTR_ASSIGN');
paramanager.freeintparaloc(list,3);
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
end;
@ -1342,19 +1345,21 @@ unit cgobj;
if incrfunc<>'' then
begin
{ these functions get the pointer by value }
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1));
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1));
a_call_name(list,incrfunc);
end
else
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
a_call_name(list,'FPC_ADDREF');
paramanager.freeintparaloc(list,2);
end;
paramanager.freeintparaloc(list,1);
end;
@ -1384,24 +1389,28 @@ unit cgobj;
if needrtti then
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
end;
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
a_call_name(list,decrfunc);
if needrtti then
paramanager.freeintparaloc(list,2);
end
else
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
a_call_name(list,'FPC_DECREF');
paramanager.freeintparaloc(list,2);
end;
paramanager.freeintparaloc(list,1);
end;
@ -1416,12 +1425,14 @@ unit cgobj;
else
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
a_call_name(list,'FPC_INITIALIZE');
paramanager.freeintparaloc(list,1);
paramanager.freeintparaloc(list,2);
end;
end;
@ -1437,12 +1448,14 @@ unit cgobj;
else
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
a_call_name(list,'FPC_FINALIZE');
paramanager.freeintparaloc(list,1);
paramanager.freeintparaloc(list,2);
end;
end;
@ -1568,8 +1581,9 @@ unit cgobj;
procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
begin
a_param_const(list,OS_32,stackframesize,paramanager.getintparaloc(1));
a_param_const(list,OS_32,stackframesize,paramanager.getintparaloc(list,1));
a_call_name(list,'FPC_STACKCHECK');
paramanager.freeintparaloc(list,1);
end;
@ -1602,8 +1616,9 @@ unit cgobj;
begin
objectlibrary.getlabel(oklabel);
a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
a_param_const(list,OS_INT,210,paramanager.getintparaloc(1));
a_param_const(list,OS_INT,210,paramanager.getintparaloc(list,1));
a_call_name(list,'FPC_HANDLEERROR');
paramanager.freeintparaloc(list,1);
a_label(list,oklabel);
end;
end;
@ -1616,15 +1631,18 @@ unit cgobj;
if (cs_check_object in aktlocalswitches) then
begin
reference_reset_symbol(hrefvmt,objectlibrary.newasmsymboldata(objdef.vmt_mangledname),0);
a_paramaddr_ref(list,hrefvmt,paramanager.getintparaloc(2));
a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(1));
a_paramaddr_ref(list,hrefvmt,paramanager.getintparaloc(list,2));
a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(list,1));
a_call_name(list,'FPC_CHECK_OBJECT_EXT');
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
end
else
if (cs_check_range in aktlocalswitches) then
begin
a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(1));
a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(list,1));
a_call_name(list,'FPC_CHECK_OBJECT');
paramanager.freeintparaloc(list,1);
end;
end;
@ -1700,7 +1718,14 @@ finalization
end.
{
$Log$
Revision 1.108 2003-06-06 14:43:02 peter
Revision 1.109 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.108 2003/06/06 14:43:02 peter
* g_copyopenarrayvalue gets length reference
* don't copy open arrays for cdecl

14
compiler/i386/cpupara.pas
View File

@ -29,6 +29,7 @@ unit cpupara;
interface
uses
aasmtai,
cpubase,
globtype,
cginfo,
@ -43,7 +44,7 @@ unit cpupara;
ti386paramanager = class(tparamanager)
function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
function push_addr_param(def : tdef;calloption : tproccalloption) : boolean;override;
function getintparaloc(nr : longint) : tparalocation;override;
function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;override;
function getparaloc(p : tdef) : tcgloc;
procedure create_param_loc_info(p : tabstractprocdef);override;
function getselflocation(p : tabstractprocdef) : tparalocation;override;
@ -110,7 +111,7 @@ unit cpupara;
end;
function ti386paramanager.getintparaloc(nr : longint) : tparalocation;
function ti386paramanager.getintparaloc(list: taasmoutput; nr : longint) : tparalocation;
begin
getintparaloc.loc:=LOC_REFERENCE;
getintparaloc.reference.index.enum:=R_EBP;
@ -168,7 +169,14 @@ begin
end.
{
$Log$
Revision 1.17 2003-06-06 14:41:22 peter
Revision 1.18 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.17 2003/06/06 14:41:22 peter
* needs cpuinfo
Revision 1.16 2003/06/06 07:36:06 michael

15
compiler/i386/n386add.pas
View File

@ -373,10 +373,10 @@ interface
{$endif newra}
secondpass(left);
location_release(exprasmlist,left.location);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(exprasmlist,2));
secondpass(right);
location_release(exprasmlist,right.location);
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(exprasmlist,1));
{$ifdef newra}
r.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
@ -389,6 +389,8 @@ interface
rg.saveintregvars(exprasmlist,regstopush);
{$endif}
cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
@ -1642,7 +1644,14 @@ begin
end.
{
$Log$
Revision 1.70 2003-06-03 13:01:59 daniel
Revision 1.71 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.70 2003/06/03 13:01:59 daniel
* Register allocator finished
Revision 1.69 2003/05/30 23:49:18 jonas

15
compiler/m68k/n68kmat.pas
View File

@ -146,8 +146,9 @@ implementation
objectlibrary.getlabel(continuelabel);
{ compare against zero, if not zero continue }
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(1));
cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
paramanager.freeintparaloc(exprasmlist,1);
cg.a_label(exprasmlist, continuelabel);
if signed then
exprasmlist.concat(taicpu.op_reg_reg(A_DIVS,S_L,denum,num))
@ -188,8 +189,9 @@ implementation
objectlibrary.getlabel(continuelabel);
{ compare against zero, if not zero continue }
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(1));
cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
paramanager.freeintparaloc(exprasmlist,1);
cg.a_label(exprasmlist, continuelabel);
tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
@ -242,7 +244,14 @@ begin
end.
{
$Log$
Revision 1.6 2003-02-19 22:00:16 daniel
Revision 1.7 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.6 2003/02/19 22:00:16 daniel
* Code generator converted to new register notation
- Horribily outdated todo.txt removed

21
compiler/ncgcal.pas
View File

@ -379,12 +379,12 @@ implementation
if current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
begin
reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(exprasmlist,1));
end
{ one nesting level }
else if (current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
begin
cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,paramanager.getintparaloc(1));
cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,paramanager.getintparaloc(exprasmlist,1));
end
{ very complex nesting level ... }
else if (current_procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
@ -399,7 +399,7 @@ implementation
cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,hregister);
dec(i);
end;
cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paramanager.getintparaloc(1));
cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paramanager.getintparaloc(exprasmlist,1));
rg.ungetaddressregister(exprasmlist,hregister);
end;
end;
@ -949,8 +949,9 @@ implementation
if iolabel<>nil then
begin
reference_reset_symbol(href,iolabel,0);
cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_IOCHECK');
paramanager.freeintparaloc(exprasmlist,1);
end;
{ restore registers }
@ -1294,8 +1295,9 @@ implementation
if iolabel<>nil then
begin
reference_reset_symbol(href,iolabel,0);
cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_IOCHECK');
paramanager.freeintparaloc(exprasmlist,1);
end;
{ restore registers }
@ -1380,7 +1382,14 @@ begin
end.
{
$Log$
Revision 1.85 2003-06-04 06:43:36 jonas
Revision 1.86 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.85 2003/06/04 06:43:36 jonas
* fixed double secondpassing of procvar loads
Revision 1.84 2003/06/03 21:11:09 peter

39
compiler/ncgflw.pas
View File

@ -816,15 +816,15 @@ implementation
secondpass(frametree);
if codegenerror then
exit;
cg.a_param_loc(exprasmlist,frametree.location,paramanager.getintparaloc(2));
cg.a_param_loc(exprasmlist,frametree.location,paramanager.getintparaloc(exprasmlist,3));
end
else
cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(exprasmlist,3));
{ push address }
secondpass(right);
if codegenerror then
exit;
cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(1));
cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(exprasmlist,2));
end
else
begin
@ -835,16 +835,19 @@ implementation
{ push current frame }
r.enum:=R_INTREGISTER;
r.number:=NR_FRAME_POINTER_REG;
cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(2));
cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(exprasmlist,3));
{ push current address }
cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(exprasmlist,2));
end;
{ push object }
secondpass(left);
if codegenerror then
exit;
cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(1));
cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_RAISEEXCEPTION');
paramanager.freeintparaloc(exprasmlist,3);
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
end
else
begin
@ -893,8 +896,9 @@ implementation
cg.a_call_name(exprasmlist,'FPC_POPOBJECTSTACK');
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RESULT_REG;
cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(1));
cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
paramanager.freeintparaloc(exprasmlist,1);
end;
@ -998,8 +1002,9 @@ implementation
{ FPC_CATCHES must be called with
'default handler' flag (=-1)
}
cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(1));
cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_CATCHES');
paramanager.freeintparaloc(exprasmlist,1);
{ the destruction of the exception object must be also }
{ guarded by an exception frame }
@ -1021,8 +1026,9 @@ implementation
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RESULT_REG;
cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(1));
cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
paramanager.freeintparaloc(exprasmlist,1);
{ we don't need to restore esi here because reraise never }
{ returns }
cg.a_call_name(exprasmlist,'FPC_RERAISE');
@ -1142,8 +1148,9 @@ implementation
{ send the vmt parameter }
reference_reset_symbol(href2,objectlibrary.newasmsymboldata(excepttype.vmt_mangledname),0);
cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_CATCHES');
paramanager.freeintparaloc(exprasmlist,1);
{ is it this catch? No. go to next onlabel }
r.enum:=R_INTREGISTER;
@ -1187,8 +1194,9 @@ implementation
try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(1));
cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
paramanager.freeintparaloc(exprasmlist,1);
{ we don't need to restore esi here because reraise never }
{ returns }
cg.a_call_name(exprasmlist,'FPC_RERAISE');
@ -1419,7 +1427,14 @@ begin
end.
{
$Log$
Revision 1.68 2003-06-03 21:11:09 peter
Revision 1.69 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.68 2003/06/03 21:11:09 peter
* cg.a_load_* get a from and to size specifier
* makeregsize only accepts newregister
* i386 uses generic tcgnotnode,tcgunaryminus

21
compiler/ncginl.pas
View File

@ -192,22 +192,26 @@ implementation
{ erroraddr }
r.enum:=R_INTREGISTER;
r.number:=NR_FRAME_POINTER_REG;
cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(4));
cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(exprasmlist,4));
{ lineno }
cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(3));
cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(exprasmlist,3));
{ filename string }
hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
firstpass(tnode(hp2));
secondpass(tnode(hp2));
if codegenerror then
exit;
cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(2));
cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(exprasmlist,2));
hp2.free;
{ push msg }
secondpass(tcallparanode(tcallparanode(left).right).left);
cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paramanager.getintparaloc(exprasmlist,1));
{ call }
cg.a_call_name(exprasmlist,'FPC_ASSERT');
paramanager.freeintparaloc(exprasmlist,4);
paramanager.freeintparaloc(exprasmlist,3);
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
cg.a_label(exprasmlist,truelabel);
truelabel:=otlabel;
falselabel:=oflabel;
@ -682,7 +686,14 @@ end.
{
$Log$
Revision 1.35 2003-06-03 21:11:09 peter
Revision 1.36 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.35 2003/06/03 21:11:09 peter
* cg.a_load_* get a from and to size specifier
* makeregsize only accepts newregister
* i386 uses generic tcgnotnode,tcgunaryminus

12
compiler/ncgld.pas
View File

@ -150,7 +150,7 @@ implementation
rg.saveusedintregisters(exprasmlist,pushed,[RS_FUNCTION_RESULT_REG]-[hregister.number shr 8]);
{$endif}
reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(symtableentry).mangledname),0);
cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(exprasmlist,1));
{$ifdef newra}
rg.ungetregisterint(exprasmlist,hregister);
r:=rg.getexplicitregisterint(exprasmlist,NR_EAX);
@ -158,6 +158,7 @@ implementation
{ the called procedure isn't allowed to change }
{ any register except EAX }
cg.a_call_reg(exprasmlist,hregister);
paramanager.freeintparaloc(exprasmlist,1);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,r);
hregister:=rg.getregisterint(exprasmlist,OS_ADDR);
@ -934,7 +935,14 @@ begin
end.
{
$Log$
Revision 1.66 2003-06-03 21:11:09 peter
Revision 1.67 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.66 2003/06/03 21:11:09 peter
* cg.a_load_* get a from and to size specifier
* makeregsize only accepts newregister
* i386 uses generic tcgnotnode,tcgunaryminus

11
compiler/ncgmat.pas
View File

@ -334,7 +334,7 @@ implementation
}
objectlibrary.getlabel(hl);
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl);
cg.a_param_const(exprasmlist,OS_S32,200,paramanager.getintparaloc(1));
cg.a_param_const(exprasmlist,OS_S32,200,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_HANDLERROR');
cg.a_label(exprasmlist,hl);
if nodetype = modn then
@ -514,7 +514,14 @@ begin
end.
{
$Log$
Revision 1.13 2003-06-03 21:11:09 peter
Revision 1.14 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.13 2003/06/03 21:11:09 peter
* cg.a_load_* get a from and to size specifier
* makeregsize only accepts newregister
* i386 uses generic tcgnotnode,tcgunaryminus

42
compiler/ncgmem.pas
View File

@ -258,8 +258,9 @@ implementation
not(cs_compilesystem in aktmoduleswitches) and
(not tpointerdef(left.resulttype.def).is_far) then
begin
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
paramanager.freeintparaloc(exprasmlist,1);
end;
end;
@ -305,8 +306,9 @@ implementation
(cs_checkpointer in aktglobalswitches) and
not(cs_compilesystem in aktmoduleswitches) then
begin
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
paramanager.freeintparaloc(exprasmlist,1);
end;
end
else if is_interfacecom(left.resulttype.def) then
@ -318,8 +320,9 @@ implementation
(cs_checkpointer in aktglobalswitches) and
not(cs_compilesystem in aktmoduleswitches) then
begin
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
paramanager.freeintparaloc(exprasmlist,1);
end;
end
@ -512,8 +515,8 @@ implementation
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(2));
cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(1));
cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(exprasmlist,2));
cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(exprasmlist,1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
@ -526,6 +529,8 @@ implementation
rg.saveintregvars(exprasmlist,all_intregisters);
{$endif}
cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
@ -578,7 +583,7 @@ implementation
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(exprasmlist,1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
@ -591,6 +596,7 @@ implementation
rg.saveintregvars(exprasmlist,all_intregisters);
{$endif}
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
paramanager.freeintparaloc(exprasmlist,1);
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
@ -625,7 +631,7 @@ implementation
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
@ -638,6 +644,7 @@ implementation
rg.saveintregvars(exprasmlist,all_intregisters);
{$endif}
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
paramanager.freeintparaloc(exprasmlist,1);
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
@ -723,10 +730,10 @@ implementation
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(2));
cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(exprasmlist,2));
href:=location.reference;
dec(href.offset,7);
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(exprasmlist,1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
@ -739,6 +746,8 @@ implementation
rg.saveintregvars(exprasmlist,all_intregisters);
{$endif}
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
@ -878,10 +887,10 @@ implementation
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(2));
cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(exprasmlist,2));
href:=location.reference;
dec(href.offset,7);
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(exprasmlist,1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
@ -894,6 +903,8 @@ implementation
rg.saveintregvars(exprasmlist,all_intregisters);
{$endif}
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
@ -937,7 +948,14 @@ begin
end.
{
$Log$
Revision 1.59 2003-06-03 21:11:09 peter
Revision 1.60 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.59 2003/06/03 21:11:09 peter
* cg.a_load_* get a from and to size specifier
* makeregsize only accepts newregister
* i386 uses generic tcgnotnode,tcgunaryminus

29
compiler/ncgset.pas
View File

@ -608,16 +608,22 @@ implementation
cg.a_load_loc_reg(exprasmlist,OS_INT,left.location,pleftreg);
location_freetemp(exprasmlist,left.location);
location_release(exprasmlist,left.location);
cg.a_param_reg(exprasmlist,OS_8,pleftreg,paramanager.getintparaloc(2));
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
cg.a_call_name(exprasmlist,'FPC_SET_IN_BYTE');
{ result of value is always one full register }
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RESULT_REG;
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,r,location.register);
cg.a_param_reg(exprasmlist,OS_8,pleftreg,paramanager.getintparaloc(exprasmlist,2));
{ release the allocated register }
if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
rg.ungetregisterint(exprasmlist,pleftreg);
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(exprasmlist,1));
cg.a_call_name(exprasmlist,'FPC_SET_IN_BYTE');
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
{ result of value is always one full register }
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RESULT_REG;
{$ifdef newra}
rg.getexplicitregisterint(exprasmlist,NR_FUNCTION_RESULT_REG);
rg.ungetregisterint(exprasmlist,r);
{$endif newra}
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,r,location.register);
location_release(exprasmlist,right.location);
end;
end;
@ -1116,7 +1122,14 @@ begin
end.
{
$Log$
Revision 1.40 2003-06-03 21:11:09 peter
Revision 1.41 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.40 2003/06/03 21:11:09 peter
* cg.a_load_* get a from and to size specifier
* makeregsize only accepts newregister
* i386 uses generic tcgnotnode,tcgunaryminus

36
compiler/ncgutil.pas
View File

@ -264,16 +264,20 @@ implementation
var r:Tregister;
begin
cg.a_paramaddr_ref(list,envbuf,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(list,jmpbuf,paramanager.getintparaloc(2));
cg.a_paramaddr_ref(list,envbuf,paramanager.getintparaloc(list,3));
cg.a_paramaddr_ref(list,jmpbuf,paramanager.getintparaloc(list,2));
{ push type of exceptionframe }
cg.a_param_const(list,OS_S32,1,paramanager.getintparaloc(1));
cg.a_param_const(list,OS_S32,1,paramanager.getintparaloc(list,1));
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
paramanager.freeintparaloc(list,3);
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RESULT_REG;
cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(list,1));
cg.a_call_name(list,'FPC_SETJMP');
paramanager.freeintparaloc(list,1);
cg.g_exception_reason_save(list, href);
cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,r,exceptlabel);
@ -1202,21 +1206,24 @@ implementation
tt_freeansistring :
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
paramanager.freeintparaloc(list,1);
end;
tt_widestring,
tt_freewidestring :
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
paramanager.freeintparaloc(list,1);
end;
tt_interfacecom :
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
cg.a_call_name(list,'FPC_INTF_DECR_REF');
paramanager.freeintparaloc(list,1);
end;
end;
hp:=hp^.next;
@ -1499,10 +1506,12 @@ implementation
(cs_profile in aktmoduleswitches) then
begin
reference_reset_symbol(href,objectlibrary.newasmsymboldata('etext'),0);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
cg.a_call_name(list,'_monstartup');
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
end;
{ initialize units }
@ -1954,7 +1963,14 @@ implementation
end.
{
$Log$
Revision 1.122 2003-06-06 14:43:02 peter
Revision 1.123 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.122 2003/06/06 14:43:02 peter
* g_copyopenarrayvalue gets length reference
* don't copy open arrays for cdecl

10
compiler/nflw.pas
View File

@ -1187,6 +1187,7 @@ implementation
function traisenode.pass_1 : tnode;
begin
result:=nil;
include(current_procinfo.flags,pi_do_call);
expectloc:=LOC_VOID;
if assigned(left) then
begin
@ -1426,7 +1427,14 @@ begin
end.
{
$Log$
Revision 1.75 2003-05-26 21:17:17 peter
Revision 1.76 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.75 2003/05/26 21:17:17 peter
* procinlinenode removed
* aktexit2label removed, fast exit removed
+ tcallnode.inlined_pass_2 added

15
compiler/nld.pas
View File

@ -492,6 +492,7 @@ implementation
if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
registers32:=1;
{ call to get address of threadvar }
if (vo_is_thread_var in tvarsym(symtableentry).varoptions) then
include(current_procinfo.flags,pi_do_call);
if nf_write in flags then
@ -811,6 +812,11 @@ implementation
firstpass(left);
firstpass(right);
{ assignment to refcounted variable -> inc/decref }
if (not is_class(left.resulttype.def) and
left.resulttype.def.needs_inittable) then
include(current_procinfo.flags,pi_do_call);
if codegenerror then
exit;
@ -1247,7 +1253,14 @@ begin
end.
{
$Log$
Revision 1.97 2003-06-07 14:39:18 jonas
Revision 1.98 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.97 2003/06/07 14:39:18 jonas
* set pi_do_call for accesses to threadvars
Revision 1.96 2003/05/26 19:38:28 peter

14
compiler/nmem.pas
View File

@ -693,6 +693,11 @@ implementation
if codegenerror then
exit;
if (nf_callunique in flags) and
(is_ansistring(left.resulttype.def) or
is_widestring(left.resulttype.def)) then
include(current_procinfo.flags,pi_do_call);
{ the register calculation is easy if a const index is used }
if right.nodetype=ordconstn then
begin
@ -897,7 +902,14 @@ begin
end.
{
$Log$
Revision 1.55 2003-05-24 17:15:24 jonas
Revision 1.56 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.55 2003/05/24 17:15:24 jonas
* added missing firstpass for withrefnode
Revision 1.54 2003/05/11 14:45:12 peter

33
compiler/paramgr.pas
View File

@ -30,6 +30,7 @@ unit paramgr;
uses
cpubase,
aasmtai,
globtype,
symconst,symtype,symdef;
@ -61,9 +62,23 @@ unit paramgr;
internal routines directly, where all parameters must
be 4-byte values.
In case the location is a register, this register is allocated.
Call freeintparaloc() after the call to free the locations again.
Default implementation: don't do anything at all (in case you don't
use register parameter passing)
@param(list Current assembler list)
@param(nr Parameter number of routine, starting from 1)
}
function getintparaloc(nr : longint) : tparalocation;virtual;abstract;
function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;virtual;abstract;
{# frees a parameter location allocated with getintparaloc
@param(list Current assembler list)
@param(nr Parameter numver of routine, starting from 1)
}
procedure freeintparaloc(list: taasmoutput; nr : longint); virtual;
{# This is used to populate the location information on all parameters
for the routine. This is used for normal call resolution.
}
@ -97,6 +112,8 @@ unit paramgr;
function getfuncresultloc(def : tdef;calloption:tproccalloption): tparalocation; virtual;
end;
procedure setparalocs(p : tprocdef);
function getfuncretusedregisters(def : tdef;calloption:tproccalloption): tregisterset;
@ -231,6 +248,11 @@ unit paramgr;
end;
procedure tparamanager.freeintparaloc(list: taasmoutput; nr : longint);
begin
end;
function tparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
begin
result.loc:=LOC_REFERENCE;
@ -399,7 +421,14 @@ end.
{
$Log$
Revision 1.40 2003-05-31 15:05:28 peter
Revision 1.41 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.40 2003/05/31 15:05:28 peter
* FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
Revision 1.39 2003/05/30 23:57:08 peter

22
compiler/powerpc/cgcpu.pas
View File

@ -77,7 +77,7 @@ unit cgcpu;
procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);override;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:integer);override;
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
procedure g_restore_frame_pointer(list : taasmoutput);override;
@ -252,7 +252,8 @@ const
list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s)));
if target_info.system=system_powerpc_macos then
list.concat(taicpu.op_none(A_NOP));
include(current_procinfo.flags,pi_do_call);
if not(pi_do_call in current_procinfo.flags) then
internalerror(2003060703);
end;
{ calling a procedure by address }
@ -283,7 +284,8 @@ const
//if target_info.system=system_powerpc_macos then
// //NOP is not needed here.
// list.concat(taicpu.op_none(A_NOP));
include(current_procinfo.flags,pi_do_call);
if not(pi_do_call in current_procinfo.flags) then
internalerror(2003060704);
//list.concat(tai_comment.create(strpnew('***** a_call_reg')));
end;
@ -315,7 +317,8 @@ const
//if target_info.system=system_powerpc_macos then
// //NOP is not needed here.
// list.concat(taicpu.op_none(A_NOP));
include(current_procinfo.flags,pi_do_call);
if not(pi_do_call in current_procinfo.flags) then
internalerror(2003060705);
//list.concat(tai_comment.create(strpnew('***** a_call_ref')));
end;
@ -2037,7 +2040,7 @@ const
tg.ungetiftemp(list,source);
end;
procedure tcgppc.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);
procedure tcgppc.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:integer);
var
lenref : treference;
power,len : longint;
@ -2563,7 +2566,14 @@ begin
end.
{
$Log$
Revision 1.104 2003-06-04 11:58:58 jonas
Revision 1.105 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.104 2003/06/04 11:58:58 jonas
* calculate localsize also in g_return_from_proc since it's now called
before g_stackframe_entry (still have to fix macos)
* compilation fixes (cycle doesn't work yet though)

34
compiler/powerpc/cpupara.pas
View File

@ -29,13 +29,15 @@ unit cpupara;
uses
globtype,
aasmtai,
cpubase,
symconst,symbase,symtype,symdef,paramgr;
type
tppcparamanager = class(tparamanager)
function push_addr_param(def : tdef;calloption : tproccalloption) : boolean;override;
function getintparaloc(nr : longint) : tparalocation;override;
function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;override;
procedure freeintparaloc(list: taasmoutput; nr : longint); override;
procedure create_param_loc_info(p : tabstractprocdef);override;
function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
end;
@ -45,9 +47,10 @@ unit cpupara;
uses
verbose,systems,
cpuinfo,cginfo,cgbase,
rgobj,
defutil;
function tppcparamanager.getintparaloc(nr : longint) : tparalocation;
function tppcparamanager.getintparaloc(list: taasmoutput; nr : longint) : tparalocation;
begin
fillchar(result,sizeof(tparalocation),0);
@ -58,6 +61,7 @@ unit cpupara;
result.loc:=LOC_REGISTER;
result.register.enum:=R_INTREGISTER;
result.register.number:=NR_R2+nr*(NR_R1-NR_R0);
rg.getexplicitregisterint(list,result.register.number);
end
else
begin
@ -69,6 +73,23 @@ unit cpupara;
result.size := OS_INT;
end;
procedure tppcparamanager.freeintparaloc(list: taasmoutput; nr : longint);
var
r: tregister;
begin
if nr<1 then
internalerror(2003060401)
else if nr<=8 then
begin
r.enum := R_INTREGISTER;
r.number := NR_R2+nr*(NR_R1-NR_R0);
rg.ungetregisterint(list,r);
end;
end;
function getparaloc(p : tdef) : tcgloc;
begin
@ -337,7 +358,14 @@ begin
end.
{
$Log$
Revision 1.34 2003-05-30 23:45:49 marco
Revision 1.35 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.34 2003/05/30 23:45:49 marco
* register skipping (aligning) for int64 parameters, sys V abi only.
Revision 1.33 2003/05/30 22:54:19 marco

40
compiler/powerpc/rgcpu.pas
View File

@ -43,22 +43,29 @@ unit rgcpu;
procedure saveusedotherregisters(list:Taasmoutput;
var saved:Tpushedsavedother;
const s:Tregisterset);override;
procedure cleartempgen; override;
private
usedpararegs: Tsupregset;
end;
implementation
uses
cgobj;
cgobj, verbose;
function trgcpu.getexplicitregisterint(list: taasmoutput; reg: Tnewregister): tregister;
var r:Tregister;
begin
if reg = NR_R0 then
if ((reg shr 8) in [RS_R0,RS_R2..RS_R12]) and
not((reg shr 8) in is_reg_var_int) then
begin
if (reg shr 8) in usedpararegs then
internalerror(2003060701);
include(usedpararegs,reg shr 8);
r.enum:=R_INTREGISTER;
r.number:=NR_R0;
r.number:=reg;
cg.a_reg_alloc(list,r);
result := r;
end
@ -69,8 +76,14 @@ unit rgcpu;
procedure trgcpu.ungetregisterint(list: taasmoutput; reg: tregister);
begin
if reg.enum = R_0 then
cg.a_reg_dealloc(list,reg)
if ((reg.number shr 8) in [RS_R0,RS_R2..RS_R12]) and
not((reg.number shr 8) in is_reg_var_int) then
begin
if not((reg.number shr 8) in usedpararegs) then
internalerror(2003060702);
exclude(usedpararegs,reg.number shr 8);
cg.a_reg_dealloc(list,reg);
end
else
inherited ungetregisterint(list,reg);
end;
@ -97,13 +110,28 @@ unit rgcpu;
filldword(saved,sizeof(saved) div 4,reg_not_saved);
end;
procedure trgcpu.cleartempgen;
begin
inherited cleartempgen;
usedpararegs := [];
end;
initialization
rg := trgcpu.create(32); {PPC has 32 registers.}
end.
{
$Log$
Revision 1.7 2003-05-24 13:38:04 jonas
Revision 1.8 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.7 2003/05/24 13:38:04 jonas
* don't save callee-save registers in the caller as well (the ppc code
that we generate is slow enough as it is without resorting to doing
double work :)

29
compiler/psub.pas
View File

@ -915,6 +915,21 @@ implementation
end;
procedure check_init_paras(p:tnamedindexitem;arg:pointer);
var
vs : tvarsym;
pd : tprocdef;
begin
if tsym(p).typ<>varsym then
exit;
with tvarsym(p) do
if (not is_class(vartype.def) and
vartype.def.needs_inittable and
(varspez in [vs_value,vs_out])) then
include(current_procinfo.flags,pi_do_call);
end;
procedure read_proc;
{
Parses the procedure directives, then parses the procedure body, then
@ -1052,6 +1067,11 @@ implementation
{ Insert local copies for value para }
pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
{ check if there are para's which require initing -> set }
{ pi_do_call (if not yet set) }
if not(pi_do_call in current_procinfo.flags) then
pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_init_paras,nil);
{ Update parameter information }
current_procinfo.allocate_implicit_parameter;
{$ifdef i386}
@ -1233,7 +1253,14 @@ begin
end.
{
$Log$
Revision 1.122 2003-06-03 13:01:59 daniel
Revision 1.123 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.122 2003/06/03 13:01:59 daniel
* Register allocator finished
Revision 1.121 2003/05/31 20:23:39 jonas

20
compiler/regvars.pas
View File

@ -184,10 +184,15 @@ implementation
while assigned(hp) do
begin
if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,
LOC_MMREGISTER,LOC_CREGISTER,LOC_CFPUREGISTER,
LOC_CMMREGISTER]) and
LOC_CREGISTER,LOC_CFPUREGISTER]) and
(TCGSize2Size[hp.paraloc.size] <= sizeof(aword)) then
tvarsym(hp.parasym).reg := hp.paraloc.register
begin
tvarsym(hp.parasym).reg := hp.paraloc.register;
if (hp.paraloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
rg.makeregvarint(hp.paraloc.register.number shr 8)
else
rg.makeregvarother(hp.paraloc.register);
end
else
begin
searchregvars(hp.parasym,@parasym);
@ -611,7 +616,14 @@ end.
{
$Log$
Revision 1.55 2003-06-03 21:11:09 peter
Revision 1.56 2003-06-07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.55 2003/06/03 21:11:09 peter
* cg.a_load_* get a from and to size specifier
* makeregsize only accepts newregister
* i386 uses generic tcgnotnode,tcgunaryminus