* tempgen cleanup

* tt_noreuse temp type added that will be used in genentrycode
This commit is contained in:
peter 2002-08-23 16:14:48 +00:00
parent 770b338833
commit 4b81e16fe2
19 changed files with 466 additions and 541 deletions

View File

@ -30,7 +30,16 @@ unit cpunode;
uses uses
{ generic nodes } { generic nodes }
ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl, ncgbas,
ncgld,
ncgflw,
ncgcnv,
ncgmem,
ncgmat,
ncgcon,
ncgcal,
ncgset,
ncginl,
{ to be able to only parts of the generic code, { to be able to only parts of the generic code,
the processor specific nodes must be included the processor specific nodes must be included
after the generic one (FK) after the generic one (FK)
@ -52,7 +61,11 @@ unit cpunode;
end. end.
{ {
$Log$ $Log$
Revision 1.16 2002-08-18 20:06:29 peter Revision 1.17 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.16 2002/08/18 20:06:29 peter
* inlining is now also allowed in interface * inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload * renamed write/load to ppuwrite/ppuload
* tnode storing in ppu * tnode storing in ppu

View File

@ -357,10 +357,10 @@ interface
{ or a function result, so simply check for a } { or a function result, so simply check for a }
{ temp of 256 bytes(JM) } { temp of 256 bytes(JM) }
if not(tg.istemp(left.location.reference) and if not(tg.istemp(left.location.reference) and
(tg.getsizeoftemp(left.location.reference) = 256)) and (tg.SizeOfTemp(left.location.reference) = 256)) and
not(nf_use_strconcat in flags) then not(nf_use_strconcat in flags) then
begin begin
tg.gettempofsizereference(exprasmlist,256,href); tg.GetTemp(exprasmlist,256,tt_normal,href);
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false); cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
{ location is released by copyshortstring } { location is released by copyshortstring }
location_freetemp(exprasmlist,left.location); location_freetemp(exprasmlist,left.location);
@ -1551,7 +1551,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.48 2002-08-14 18:41:48 jonas Revision 1.49 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.48 2002/08/14 18:41:48 jonas
- remove valuelow/valuehigh fields from tlocation, because they depend - remove valuelow/valuehigh fields from tlocation, because they depend
on the endianess of the host operating system -> difficult to get on the endianess of the host operating system -> difficult to get
right. Use lo/hi(location.valueqword) instead (remember to use right. Use lo/hi(location.valueqword) instead (remember to use

View File

@ -225,7 +225,7 @@ implementation
(left.resulttype.def.deftype=procvardef) and (left.resulttype.def.deftype=procvardef) and
(ttypeconvnode(left).left.nodetype=niln) then (ttypeconvnode(left).left.nodetype=niln) then
begin begin
tg.gettempofsizereference(exprasmlist,tcgsize2size[left.location.size],href); tg.GetTemp(exprasmlist,tcgsize2size[left.location.size],tt_normal,href);
cg.a_load_loc_ref(exprasmlist,left.location,href); cg.a_load_loc_ref(exprasmlist,left.location,href);
location_reset(left.location,LOC_REFERENCE,left.location.size); location_reset(left.location,LOC_REFERENCE,left.location.size);
left.location.reference:=href; left.location.reference:=href;
@ -318,6 +318,8 @@ implementation
pop_allowed : boolean; pop_allowed : boolean;
release_tmpreg : boolean; release_tmpreg : boolean;
constructorfailed : tasmlabel; constructorfailed : tasmlabel;
returnref,
pararef : treference;
label label
dont_call; dont_call;
@ -335,12 +337,12 @@ implementation
{ already here, we avoid later a push/pop } { already here, we avoid later a push/pop }
if is_widestring(resulttype.def) then if is_widestring(resulttype.def) then
begin begin
tg.gettempwidestringreference(exprasmlist,refcountedtemp); tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp); cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
end end
else if is_ansistring(resulttype.def) then else if is_ansistring(resulttype.def) then
begin begin
tg.gettempansistringreference(exprasmlist,refcountedtemp); tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp); cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
end; end;
@ -366,7 +368,10 @@ implementation
the para's are stored there } the para's are stored there }
tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel; tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
if assigned(params) then if assigned(params) then
inlinecode.para_offset:=tg.gettempofsizepersistant(exprasmlist,inlinecode.para_size); begin
tg.GetTemp(exprasmlist,inlinecode.para_size,tt_persistant,pararef);
inlinecode.para_offset:=pararef.offset;
end;
store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup; store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset; tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
{$ifdef extdebug} {$ifdef extdebug}
@ -500,7 +505,10 @@ implementation
{ Allocate return value for inlined routines } { Allocate return value for inlined routines }
if inlined and if inlined and
(resulttype.def.size>0) then (resulttype.def.size>0) then
inlinecode.retoffset:=tg.gettempofsizepersistant(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign)); begin
tg.GetTemp(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign),tt_persistant,returnref);
inlinecode.retoffset:=returnref.offset;
end;
{ Allocate return value when returned in argument } { Allocate return value when returned in argument }
if paramanager.ret_in_param(resulttype.def) then if paramanager.ret_in_param(resulttype.def) then
@ -518,9 +526,7 @@ implementation
begin begin
if inlined then if inlined then
begin begin
reference_reset(funcretref); tg.GetTemp(exprasmlist,resulttype.def.size,tt_persistant,funcretref);
funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
funcretref.base:=procinfo.framepointer;
{$ifdef extdebug} {$ifdef extdebug}
Comment(V_debug,'function return value is at offset ' Comment(V_debug,'function return value is at offset '
+tostr(funcretref.offset)); +tostr(funcretref.offset));
@ -530,7 +536,7 @@ implementation
{$endif extdebug} {$endif extdebug}
end end
else else
tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref); tg.GetTemp(exprasmlist,resulttype.def.size,tt_normal,funcretref);
end; end;
{ This must not be counted for C code { This must not be counted for C code
@ -987,7 +993,7 @@ implementation
secondpass(inlinecode); secondpass(inlinecode);
{ free the args } { free the args }
if tprocdef(procdefinition).parast.datasize>0 then if tprocdef(procdefinition).parast.datasize>0 then
tg.ungetpersistanttemp(exprasmlist,tprocdef(procdefinition).parast.address_fixup); tg.UnGetTemp(exprasmlist,pararef);
end; end;
end end
else else
@ -1269,7 +1275,7 @@ implementation
end; end;
if inlined then if inlined then
begin begin
tg.ungetpersistanttemp(exprasmlist,inlinecode.retoffset); tg.UnGetTemp(exprasmlist,returnref);
tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup; tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
right:=inlinecode; right:=inlinecode;
end; end;
@ -1278,7 +1284,7 @@ implementation
{ from now on the result can be freed normally } { from now on the result can be freed normally }
if inlined and paramanager.ret_in_param(resulttype.def) then if inlined and paramanager.ret_in_param(resulttype.def) then
tg.persistanttemptonormal(funcretref.offset); tg.ChangeTempType(funcretref,tt_normal);
{ if return value is not used } { if return value is not used }
if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
@ -1309,7 +1315,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.65 2002-08-18 20:06:30 peter Revision 1.66 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.65 2002/08/18 20:06:30 peter
* inlining is now also allowed in interface * inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload * renamed write/load to ppuwrite/ppuload
* tnode storing in ppu * tnode storing in ppu

View File

@ -200,8 +200,8 @@ implementation
objectlibrary.getlabel(endexceptlabel); objectlibrary.getlabel(endexceptlabel);
objectlibrary.getlabel(lastonlabel); objectlibrary.getlabel(lastonlabel);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf); tg.GetTemp(exprasmlist,JMP_BUF_SIZE,tt_persistant,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr); tg.GetTemp(exprasmlist,12,tt_persistant,tempaddr);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3)); cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2)); cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
{ push type of exceptionframe } { push type of exceptionframe }
@ -236,8 +236,8 @@ implementation
cg.a_label(exprasmlist,exceptlabel); cg.a_label(exprasmlist,exceptlabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
tg.ungetpersistanttempreference(exprasmlist,tempaddr); tg.UnGetTemp(exprasmlist,tempaddr);
tg.ungetpersistanttempreference(exprasmlist,tempbuf); tg.UnGetTemp(exprasmlist,tempbuf);
exprasmList.concat(tai_regalloc.Alloc(R_EAX)); exprasmList.concat(tai_regalloc.Alloc(R_EAX));
emit_reg(A_POP,S_L,R_EAX); emit_reg(A_POP,S_L,R_EAX);
@ -278,8 +278,8 @@ implementation
objectlibrary.getlabel(doobjectdestroy); objectlibrary.getlabel(doobjectdestroy);
objectlibrary.getlabel(doobjectdestroyandreraise); objectlibrary.getlabel(doobjectdestroyandreraise);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf); tg.GetTemp(exprasmlist,JMP_BUF_SIZE,tt_persistant,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr); tg.GetTemp(exprasmlist,12,tt_persistant,tempaddr);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3)); cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2)); cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
{ push type of exceptionframe } { push type of exceptionframe }
@ -303,8 +303,8 @@ implementation
cg.a_label(exprasmlist,doobjectdestroyandreraise); cg.a_label(exprasmlist,doobjectdestroyandreraise);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
tg.ungetpersistanttempreference(exprasmlist,tempaddr); tg.Ungettemp(exprasmlist,tempaddr);
tg.ungetpersistanttempreference(exprasmlist,tempbuf); tg.Ungettemp(exprasmlist,tempbuf);
exprasmList.concat(tai_regalloc.Alloc(R_EAX)); exprasmList.concat(tai_regalloc.Alloc(R_EAX));
exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX)); exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX));
@ -433,7 +433,7 @@ implementation
emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX); emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
emitjmp(C_E,nextonlabel); emitjmp(C_E,nextonlabel);
ref.symbol:=nil; ref.symbol:=nil;
tg.gettempofsizereference(exprasmlist,4,ref); tg.GetTemp(exprasmlist,4,tt_normal,ref);
{ what a hack ! } { what a hack ! }
if assigned(exceptsymtable) then if assigned(exceptsymtable) then
@ -447,8 +447,8 @@ implementation
{ we've to destroy the old one } { we've to destroy the old one }
objectlibrary.getlabel(doobjectdestroyandreraise); objectlibrary.getlabel(doobjectdestroyandreraise);
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr); tg.GetTemp(exprasmlist,12,tt_persistant,tempaddr);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf); tg.GetTemp(exprasmlist,JMP_BUF_SIZE,tt_persistant,tempbuf);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3)); cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2)); cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1)); cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
@ -488,8 +488,8 @@ implementation
objectlibrary.getlabel(doobjectdestroy); objectlibrary.getlabel(doobjectdestroy);
cg.a_label(exprasmlist,doobjectdestroyandreraise); cg.a_label(exprasmlist,doobjectdestroyandreraise);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
tg.ungetpersistanttempreference(exprasmlist,tempaddr); tg.Ungettemp(exprasmlist,tempaddr);
tg.ungetpersistanttempreference(exprasmlist,tempbuf); tg.Ungettemp(exprasmlist,tempbuf);
exprasmList.concat(tai_regalloc.Alloc(R_EAX)); exprasmList.concat(tai_regalloc.Alloc(R_EAX));
exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX)); exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX));
@ -601,8 +601,8 @@ implementation
aktbreaklabel:=breakfinallylabel; aktbreaklabel:=breakfinallylabel;
end; end;
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr); tg.Gettemp(exprasmlist,12,tt_persistant,tempaddr);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf); tg.Gettemp(exprasmlist,JMP_BUF_SIZE,tt_persistant,tempbuf);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3)); cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2)); cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
{ Type of stack-frame must be pushed} { Type of stack-frame must be pushed}
@ -630,8 +630,8 @@ implementation
cg.a_label(exprasmlist,finallylabel); cg.a_label(exprasmlist,finallylabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
tg.ungetpersistanttempreference(exprasmlist,tempaddr); tg.Ungettemp(exprasmlist,tempaddr);
tg.ungetpersistanttempreference(exprasmlist,tempbuf); tg.Ungettemp(exprasmlist,tempbuf);
{ finally code } { finally code }
flowcontrol:=[]; flowcontrol:=[];
@ -726,7 +726,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.33 2002-08-15 15:15:55 carl Revision 1.34 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.33 2002/08/15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should) * jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths * more generic nodes for maths
* several fixes for better m68k support * several fixes for better m68k support

View File

@ -97,10 +97,10 @@ begin
{ ti386addnode.pass_2 } { ti386addnode.pass_2 }
secondpass(left); secondpass(left);
if not(tg.istemp(left.location.reference) and if not(tg.istemp(left.location.reference) and
(tg.getsizeoftemp(left.location.reference) = 256)) and (tg.sizeoftemp(left.location.reference) = 256)) and
not(nf_use_strconcat in flags) then not(nf_use_strconcat in flags) then
begin begin
tg.gettempofsizereference(exprasmlist,256,href); tg.Gettemp(exprasmlist,256,tt_normal,href);
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false); cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
{ location is released by copyshortstring } { location is released by copyshortstring }
location_freetemp(exprasmlist,left.location); location_freetemp(exprasmlist,left.location);
@ -205,10 +205,10 @@ begin
{ ti386addnode.pass_2 } { ti386addnode.pass_2 }
secondpass(left); secondpass(left);
if not(tg.istemp(left.location.reference) and if not(tg.istemp(left.location.reference) and
(tg.getsizeoftemp(left.location.reference) = 256)) and (tg.sizeoftemp(left.location.reference) = 256)) and
not(nf_use_strconcat in flags) then not(nf_use_strconcat in flags) then
begin begin
tg.gettempofsizereference(exprasmlist,256,href); tg.GetTemp(exprasmlist,256,tt_normal,href);
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false); cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
{ release the registers } { release the registers }
location_freetemp(exprasmlist,left.location); location_freetemp(exprasmlist,left.location);
@ -248,7 +248,11 @@ end.
{ {
$Log$ $Log$
Revision 1.23 2002-08-11 14:32:30 peter Revision 1.24 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.23 2002/08/11 14:32:30 peter
* renamed current_library to objectlibrary * renamed current_library to objectlibrary
Revision 1.22 2002/08/11 13:24:17 peter Revision 1.22 2002/08/11 13:24:17 peter

View File

@ -109,7 +109,7 @@ unit rgcpu;
dec(countunusedregsint); dec(countunusedregsint);
exclude(unusedregsint,r); exclude(unusedregsint,r);
end; end;
tg.ungetpersistanttemp(list,hr.offset); tg.ungettemp(list,hr);
end; end;
end; end;
end; end;
@ -133,7 +133,7 @@ unit rgcpu;
not(r in unusedregsaddr) then not(r in unusedregsaddr) then
begin begin
{ then save it } { then save it }
tg.gettempofsizereferencepersistant(list,pointer_size,hr); tg.gettemp(list,pointer_size,tt_persistant,hr);
saved[r].ofs:=hr.offset; saved[r].ofs:=hr.offset;
cg.a_load_reg_ref(list,OS_ADDR,r,hr); cg.a_load_reg_ref(list,OS_ADDR,r,hr);
cg.a_reg_dealloc(list,r); cg.a_reg_dealloc(list,r);
@ -151,7 +151,11 @@ end.
{ {
$Log$ $Log$
Revision 1.2 2002-08-12 15:08:44 carl Revision 1.3 2002-08-23 16:14:50 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.2 2002/08/12 15:08:44 carl
+ stab register indexes for powerpc (moved from gdb to cpubase) + stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo + tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class + linker in target_info is now a class

View File

@ -240,6 +240,8 @@ interface
*****************************************************************************} *****************************************************************************}
procedure tcgtempcreatenode.pass_2; procedure tcgtempcreatenode.pass_2;
var
temptype : ttemptype;
begin begin
{ if we're secondpassing the same tcgtempcreatenode twice, we have a bug } { if we're secondpassing the same tcgtempcreatenode twice, we have a bug }
if tempinfo^.valid then if tempinfo^.valid then
@ -247,9 +249,10 @@ interface
{ get a (persistent) temp } { get a (persistent) temp }
if persistent then if persistent then
tg.gettempofsizereferencepersistant(exprasmlist,size,tempinfo^.ref) temptype:=tt_persistant
else else
tg.gettempofsizereference(exprasmlist,size,tempinfo^.ref); temptype:=tt_normal;
tg.GetTemp(exprasmlist,size,temptype,tempinfo^.ref);
tempinfo^.valid := true; tempinfo^.valid := true;
end; end;
@ -276,9 +279,9 @@ interface
procedure tcgtempdeletenode.pass_2; procedure tcgtempdeletenode.pass_2;
begin begin
if release_to_normal then if release_to_normal then
tg.persistanttemptonormal(tempinfo^.ref.offset) tg.ChangeTempType(tempinfo^.ref,tt_normal)
else else
tg.ungetpersistanttempreference(exprasmlist,tempinfo^.ref); tg.UnGetTemp(exprasmlist,tempinfo^.ref);
end; end;
@ -293,7 +296,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.22 2002-08-11 14:32:26 peter Revision 1.23 2002-08-23 16:14:48 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.22 2002/08/11 14:32:26 peter
* renamed current_library to objectlibrary * renamed current_library to objectlibrary
Revision 1.21 2002/08/11 13:24:11 peter Revision 1.21 2002/08/11 13:24:11 peter

View File

@ -227,7 +227,7 @@ implementation
(left.resulttype.def.deftype=procvardef) and (left.resulttype.def.deftype=procvardef) and
(ttypeconvnode(left).left.nodetype=niln) then (ttypeconvnode(left).left.nodetype=niln) then
begin begin
tg.gettempofsizereference(exprasmlist,tcgsize2size[left.location.size],href); tg.GetTemp(exprasmlist,tcgsize2size[left.location.size],tt_normal,href);
cg.a_load_loc_ref(exprasmlist,left.location,href); cg.a_load_loc_ref(exprasmlist,left.location,href);
location_reset(left.location,LOC_REFERENCE,left.location.size); location_reset(left.location,LOC_REFERENCE,left.location.size);
left.location.reference:=href; left.location.reference:=href;
@ -322,7 +322,8 @@ implementation
release_tmpreg : boolean; release_tmpreg : boolean;
constructorfailed : tasmlabel; constructorfailed : tasmlabel;
resultloc : tparalocation; resultloc : tparalocation;
returnref,
pararef : treference;
label label
dont_call; dont_call;
@ -339,12 +340,12 @@ implementation
{ already here, we avoid later a push/pop } { already here, we avoid later a push/pop }
if is_widestring(resulttype.def) then if is_widestring(resulttype.def) then
begin begin
tg.gettempwidestringreference(exprasmlist,refcountedtemp); tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp); cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
end end
else if is_ansistring(resulttype.def) then else if is_ansistring(resulttype.def) then
begin begin
tg.gettempansistringreference(exprasmlist,refcountedtemp); tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp); cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
end; end;
@ -359,7 +360,8 @@ implementation
{ Deciding whether we may still need the parameters happens next (JM) } { Deciding whether we may still need the parameters happens next (JM) }
if assigned(left) then if assigned(left) then
params:=left.getcopy params:=left.getcopy
else params := nil; else
params := nil;
if (procdefinition.proccalloption=pocall_inline) then if (procdefinition.proccalloption=pocall_inline) then
begin begin
@ -370,7 +372,10 @@ implementation
the para's are stored there } the para's are stored there }
tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel; tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
if assigned(params) then if assigned(params) then
inlinecode.para_offset:=tg.gettempofsizepersistant(exprasmlist,inlinecode.para_size); begin
tg.GetTemp(exprasmlist,inlinecode.para_size,tt_persistant,pararef);
inlinecode.para_offset:=pararef.offset;
end;
store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup; store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset; tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
{$ifdef extdebug} {$ifdef extdebug}
@ -507,7 +512,10 @@ implementation
{ Allocate return value for inlined routines } { Allocate return value for inlined routines }
if inlined then if inlined then
inlinecode.retoffset:=tg.gettempofsizepersistant(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign)); begin
tg.GetTemp(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign),tt_persistant,returnref);
inlinecode.retoffset:=returnref.offset;
end;
{ Allocate return value when returned in argument } { Allocate return value when returned in argument }
if paramanager.ret_in_param(resulttype.def) then if paramanager.ret_in_param(resulttype.def) then
@ -525,9 +533,7 @@ implementation
begin begin
if inlined then if inlined then
begin begin
reference_reset(funcretref); tg.GetTemp(exprasmlist,resulttype.def.size,tt_persistant,funcretref);
funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
funcretref.base:=procinfo.framepointer;
{$ifdef extdebug} {$ifdef extdebug}
Comment(V_debug,'function return value is at offset ' Comment(V_debug,'function return value is at offset '
+tostr(funcretref.offset)); +tostr(funcretref.offset));
@ -537,7 +543,7 @@ implementation
{$endif extdebug} {$endif extdebug}
end end
else else
tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref); tg.GetTemp(exprasmlist,resulttype.def.size,tt_normal,funcretref);
end; end;
{ This must not be counted for C code { This must not be counted for C code
@ -963,7 +969,7 @@ implementation
secondpass(inlinecode); secondpass(inlinecode);
{ free the args } { free the args }
if tprocdef(procdefinition).parast.datasize>0 then if tprocdef(procdefinition).parast.datasize>0 then
tg.ungetpersistanttemp(exprasmlist,tprocdef(procdefinition).parast.address_fixup); tg.UnGetTemp(exprasmlist,pararef);
end; end;
end; end;
{$ifdef dummy} {$ifdef dummy}
@ -1131,7 +1137,6 @@ implementation
if paramanager.ret_in_param(resulttype.def) then if paramanager.ret_in_param(resulttype.def) then
begin begin
location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def)); location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
location.reference.symbol:=nil;
location.reference:=funcretref; location.reference:=funcretref;
end end
else else
@ -1249,7 +1254,7 @@ implementation
end; end;
if inlined then if inlined then
begin begin
tg.ungetpersistanttemp(exprasmlist,inlinecode.retoffset); tg.ungettemp(exprasmlist,pararef);
tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup; tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
right:=inlinecode; right:=inlinecode;
end; end;
@ -1258,7 +1263,7 @@ implementation
{ from now on the result can be freed normally } { from now on the result can be freed normally }
if inlined and paramanager.ret_in_param(resulttype.def) then if inlined and paramanager.ret_in_param(resulttype.def) then
tg.persistanttemptonormal(funcretref.offset); tg.ChangeTempType(funcretref,tt_normal);
{ if return value is not used } { if return value is not used }
if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
@ -1303,6 +1308,7 @@ implementation
inlineentrycode,inlineexitcode : TAAsmoutput; inlineentrycode,inlineexitcode : TAAsmoutput;
oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel; oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
oldregstate: pointer; oldregstate: pointer;
localsref : treference;
{$ifdef GDB} {$ifdef GDB}
startlabel,endlabel : tasmlabel; startlabel,endlabel : tasmlabel;
pp : pchar; pp : pchar;
@ -1362,7 +1368,8 @@ implementation
st.symtablelevel:=oldprocdef.localst.symtablelevel; st.symtablelevel:=oldprocdef.localst.symtablelevel;
if st.datasize>0 then if st.datasize>0 then
begin begin
st.address_fixup:=tg.gettempofsizepersistant(exprasmlist,st.datasize)+st.datasize; tg.GetTemp(exprasmlist,st.datasize,tt_persistant,localsref);
st.address_fixup:=localsref.offset+st.datasize;
{$ifdef extdebug} {$ifdef extdebug}
Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup)); Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
exprasmList.concat(tai_comment.Create(strpnew( exprasmList.concat(tai_comment.Create(strpnew(
@ -1425,7 +1432,7 @@ implementation
{we can free the local data now, reset also the fixup address } {we can free the local data now, reset also the fixup address }
if st.datasize>0 then if st.datasize>0 then
begin begin
tg.ungetpersistanttemp(exprasmlist,st.address_fixup-st.datasize); tg.UnGetTemp(exprasmlist,localsref);
st.address_fixup:=0; st.address_fixup:=0;
end; end;
{ restore procinfo } { restore procinfo }
@ -1469,7 +1476,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.14 2002-08-20 16:55:38 peter Revision 1.15 2002-08-23 16:14:48 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.14 2002/08/20 16:55:38 peter
* don't write (stabs)line info when inlining a procedure * don't write (stabs)line info when inlining a procedure
Revision 1.13 2002/08/19 19:36:42 peter Revision 1.13 2002/08/19 19:36:42 peter

View File

@ -233,7 +233,7 @@ interface
case tstringdef(resulttype.def).string_typ of case tstringdef(resulttype.def).string_typ of
st_shortstring : st_shortstring :
begin begin
tg.gettempofsizereference(exprasmlist,256,location.reference); tg.GetTemp(exprasmlist,256,tt_normal,location.reference);
cg.a_load_loc_ref(exprasmlist,left.location, cg.a_load_loc_ref(exprasmlist,left.location,
location.reference); location.reference);
location_release(exprasmlist,left.location); location_release(exprasmlist,left.location);
@ -487,7 +487,11 @@ end.
{ {
$Log$ $Log$
Revision 1.26 2002-08-20 18:23:32 jonas Revision 1.27 2002-08-23 16:14:48 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.26 2002/08/20 18:23:32 jonas
* the as node again uses a compilerproc * the as node again uses a compilerproc
+ (untested) support for interface "as" statements + (untested) support for interface "as" statements

View File

@ -324,8 +324,7 @@ implementation
{ load into temporary variable } { load into temporary variable }
if right.nodetype<>ordconstn then if right.nodetype<>ordconstn then
begin begin
temp1.symbol:=nil; tg.GetTemp(exprasmlist,hs,tt_normal,temp1);
tg.gettempofsizereference(exprasmlist,hs,temp1);
temptovalue:=true; temptovalue:=true;
if (right.location.loc=LOC_REGISTER) or if (right.location.loc=LOC_REGISTER) or
(right.location.loc=LOC_CREGISTER) then (right.location.loc=LOC_CREGISTER) then
@ -695,9 +694,9 @@ do_jmp:
procedure try_new_exception(list : taasmoutput;var jmpbuf,envbuf, href : treference; procedure try_new_exception(list : taasmoutput;var jmpbuf,envbuf, href : treference;
a : aword; exceptlabel : tasmlabel); a : aword; exceptlabel : tasmlabel);
begin begin
tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,jmpbuf); tg.GetTemp(list,JMP_BUF_SIZE,tt_persistant,jmpbuf);
tg.gettempofsizereferencepersistant(list,12,envbuf); tg.GetTemp(list,12,tt_persistant,envbuf);
tg.gettempofsizereferencepersistant(list,sizeof(aword),href); tg.GetTemp(list,sizeof(aword),tt_persistant,href);
new_exception(list, jmpbuf,envbuf, href, a, exceptlabel); new_exception(list, jmpbuf,envbuf, href, a, exceptlabel);
end; end;
@ -706,8 +705,8 @@ do_jmp:
a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean); a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
begin begin
free_exception(list, jmpbuf, envbuf, href, a, endexceptlabel, onlyfree); free_exception(list, jmpbuf, envbuf, href, a, endexceptlabel, onlyfree);
tg.ungetpersistanttempreference(list,jmpbuf); tg.Ungettemp(list,jmpbuf);
tg.ungetpersistanttempreference(list,envbuf); tg.ungettemp(list,envbuf);
end; end;
@ -975,7 +974,7 @@ do_jmp:
{ is it this catch? No. go to next onlabel } { is it this catch? No. go to next onlabel }
cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,accumulator,nextonlabel); cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,accumulator,nextonlabel);
ref.symbol:=nil; ref.symbol:=nil;
tg.gettempofsizereference(exprasmlist,pointer_size,ref); tg.GetTemp(exprasmlist,pointer_size,tt_normal,ref);
{ what a hack ! } { what a hack ! }
if assigned(exceptsymtable) then if assigned(exceptsymtable) then
@ -1225,7 +1224,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.37 2002-08-19 19:36:43 peter Revision 1.38 2002-08-23 16:14:48 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.37 2002/08/19 19:36:43 peter
* More fixes for cross unit inlining, all tnodes are now implemented * More fixes for cross unit inlining, all tnodes are now implemented
* Moved pocall_internconst to po_internconst because it is not a * Moved pocall_internconst to po_internconst because it is not a
calling type at all and it conflicted when inlining of these small calling type at all and it conflicted when inlining of these small

View File

@ -82,7 +82,6 @@ implementation
absolutesym : absolutesym :
begin begin
{ this is only for toasm and toaddr } { this is only for toasm and toaddr }
location.reference.symbol:=nil;
if (tabsolutesym(symtableentry).abstyp=toaddr) then if (tabsolutesym(symtableentry).abstyp=toaddr) then
begin begin
{$ifdef i386} {$ifdef i386}
@ -119,8 +118,7 @@ implementation
hregister:=rg.getaddressregister(exprasmlist); hregister:=rg.getaddressregister(exprasmlist);
location.reference.symbol:=objectlibrary.newasmsymbol(tvarsym(symtableentry).mangledname); location.reference.symbol:=objectlibrary.newasmsymbol(tvarsym(symtableentry).mangledname);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,location.reference,hregister); cg.a_load_ref_reg(exprasmlist,OS_ADDR,location.reference,hregister);
location.reference.symbol:=nil; reference_reset_base(location.reference,hregister,0);
location.reference.base:=hregister;
end end
{ external variable } { external variable }
else if (vo_is_external in tvarsym(symtableentry).varoptions) then else if (vo_is_external in tvarsym(symtableentry).varoptions) then
@ -282,7 +280,7 @@ implementation
location_reset(location,LOC_CREFERENCE,OS_64) location_reset(location,LOC_CREFERENCE,OS_64)
else else
internalerror(20020520); internalerror(20020520);
tg.gettempofsizereference(exprasmlist,2*POINTER_SIZE,location.reference); tg.GetTemp(exprasmlist,2*POINTER_SIZE,tt_normal,location.reference);
freereg:=false; freereg:=false;
{ called as type.method, then we only need to return { called as type.method, then we only need to return
@ -771,9 +769,9 @@ implementation
{ Allocate always a temp, also if no elements are required, to { Allocate always a temp, also if no elements are required, to
be sure that location is valid (PFV) } be sure that location is valid (PFV) }
if tarraydef(resulttype.def).highrange=-1 then if tarraydef(resulttype.def).highrange=-1 then
tg.gettempofsizereference(exprasmlist,elesize,location.reference) tg.GetTemp(exprasmlist,elesize,tt_normal,location.reference)
else else
tg.gettempofsizereference(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,location.reference); tg.GetTemp(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,tt_normal,location.reference);
href:=location.reference; href:=location.reference;
end; end;
hp:=self; hp:=self;
@ -942,7 +940,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.24 2002-08-17 09:23:35 florian Revision 1.25 2002-08-23 16:14:48 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.24 2002/08/17 09:23:35 florian
* first part of procinfo rewrite * first part of procinfo rewrite
Revision 1.23 2002/08/14 18:13:28 jonas Revision 1.23 2002/08/14 18:13:28 jonas

View File

@ -33,66 +33,66 @@ type
tcgunaryminusnode = class(tunaryminusnode) tcgunaryminusnode = class(tunaryminusnode)
procedure pass_2;override; procedure pass_2;override;
protected protected
{ This routine is called to change the sign of the { This routine is called to change the sign of the
floating point value in the floating point floating point value in the floating point
register r. register r.
This routine should be overriden, since This routine should be overriden, since
the generic version is not optimal at all. The the generic version is not optimal at all. The
generic version assumes that floating generic version assumes that floating
point values are stored in the register point values are stored in the register
in IEEE-754 format. in IEEE-754 format.
} }
procedure emit_float_sign_change(r: tregister; _size : tcgsize);virtual; procedure emit_float_sign_change(r: tregister; _size : tcgsize);virtual;
end; end;
tcgmoddivnode = class(tmoddivnode) tcgmoddivnode = class(tmoddivnode)
procedure pass_2;override; procedure pass_2;override;
protected protected
{ This routine must do an actual 32-bit division, be it { This routine must do an actual 32-bit division, be it
signed or unsigned. The result must set into the the signed or unsigned. The result must set into the the
@var(num) register. @var(num) register.
@param(signed Indicates if the division must be signed) @param(signed Indicates if the division must be signed)
@param(denum Register containing the denominator @param(denum Register containing the denominator
@param(num Register containing the numerator, will also receive result) @param(num Register containing the numerator, will also receive result)
The actual optimizations regarding shifts have already The actual optimizations regarding shifts have already
been done and emitted, so this should really a do a divide. been done and emitted, so this should really a do a divide.
} }
procedure emit_div_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract; procedure emit_div_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract;
{ This routine must do an actual 32-bit modulo, be it { This routine must do an actual 32-bit modulo, be it
signed or unsigned. The result must set into the the signed or unsigned. The result must set into the the
@var(num) register. @var(num) register.
@param(signed Indicates if the modulo must be signed) @param(signed Indicates if the modulo must be signed)
@param(denum Register containing the denominator @param(denum Register containing the denominator
@param(num Register containing the numerator, will also receive result) @param(num Register containing the numerator, will also receive result)
The actual optimizations regarding shifts have already The actual optimizations regarding shifts have already
been done and emitted, so this should really a do a modulo. been done and emitted, so this should really a do a modulo.
} }
procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract; procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract;
{ This routine must do an actual 64-bit division, be it { This routine must do an actual 64-bit division, be it
signed or unsigned. The result must set into the the signed or unsigned. The result must set into the the
@var(num) register. @var(num) register.
@param(signed Indicates if the division must be signed) @param(signed Indicates if the division must be signed)
@param(denum Register containing the denominator @param(denum Register containing the denominator
@param(num Register containing the numerator, will also receive result) @param(num Register containing the numerator, will also receive result)
The actual optimizations regarding shifts have already The actual optimizations regarding shifts have already
been done and emitted, so this should really a do a divide. been done and emitted, so this should really a do a divide.
Currently, this routine should only be implemented on Currently, this routine should only be implemented on
64-bit systems, otherwise a helper is called in 1st pass. 64-bit systems, otherwise a helper is called in 1st pass.
} }
procedure emit64_div_reg_reg(signed: boolean;denum,num : tregister64);virtual; procedure emit64_div_reg_reg(signed: boolean;denum,num : tregister64);virtual;
end; end;
tcgshlshrnode = class(tshlshrnode) tcgshlshrnode = class(tshlshrnode)
procedure pass_2;override; procedure pass_2;override;
end; end;
implementation implementation
@ -116,7 +116,7 @@ implementation
{ get a temporary memory reference to store the floating { get a temporary memory reference to store the floating
point value point value
} }
tg.gettempofsizereference(exprasmlist,tcgsize2size[_size],href); tg.gettemp(exprasmlist,tcgsize2size[_size],tt_normal,href);
{ store the floating point value in the temporary memory area } { store the floating point value in the temporary memory area }
cg.a_loadfpu_reg_ref(exprasmlist,_size,r,href); cg.a_loadfpu_reg_ref(exprasmlist,_size,r,href);
{ only single and double ieee are supported } { only single and double ieee are supported }
@ -124,11 +124,11 @@ implementation
begin begin
{ on little-endian machine the most significant { on little-endian machine the most significant
32-bit value is stored at the highest address 32-bit value is stored at the highest address
} }
if target_info.endian = endian_little then if target_info.endian = endian_little then
inc(href.offset,4); inc(href.offset,4);
end end
else else
if _size <> OS_F32 then if _size <> OS_F32 then
internalerror(20020814); internalerror(20020814);
hreg := rg.getregisterint(exprasmlist); hreg := rg.getregisterint(exprasmlist);
@ -146,7 +146,7 @@ implementation
begin begin
{ on little-endian machine the most significant { on little-endian machine the most significant
32-bit value is stored at the highest address 32-bit value is stored at the highest address
} }
if target_info.endian = endian_little then if target_info.endian = endian_little then
dec(href.offset,4); dec(href.offset,4);
end; end;
@ -198,14 +198,14 @@ implementation
cg.a_loadfpu_ref_reg(exprasmlist, cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def), def_cgsize(left.resulttype.def),
left.location.reference,location.register); left.location.reference,location.register);
emit_float_sign_change(location.register,def_cgsize(left.resulttype.def)); emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));
end end
else else
begin begin
location.register:=rg.getregisterint(exprasmlist); location.register:=rg.getregisterint(exprasmlist);
{ why is the size is OS_INT, since in pass_1 we convert { why is the size is OS_INT, since in pass_1 we convert
everything to a signed natural value anyways everything to a signed natural value anyways
} }
cg.a_load_ref_reg(exprasmlist,OS_INT, cg.a_load_ref_reg(exprasmlist,OS_INT,
left.location.reference,location.register); left.location.reference,location.register);
cg.a_op_reg_reg(exprasmlist,OP_NEG,OS_INT,location.register, cg.a_op_reg_reg(exprasmlist,OP_NEG,OS_INT,location.register,
@ -216,14 +216,14 @@ implementation
begin begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
location.register:=left.location.register; location.register:=left.location.register;
emit_float_sign_change(location.register,def_cgsize(left.resulttype.def)); emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));
end; end;
LOC_CFPUREGISTER: LOC_CFPUREGISTER:
begin begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
location.register:=rg.getregisterfpu(exprasmlist); location.register:=rg.getregisterfpu(exprasmlist);
cg.a_loadfpu_reg_reg(exprasmlist,left.location.register,location.register); cg.a_loadfpu_reg_reg(exprasmlist,left.location.register,location.register);
emit_float_sign_change(location.register,def_cgsize(left.resulttype.def)); emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));
end; end;
else else
internalerror(200203225); internalerror(200203225);
@ -238,9 +238,9 @@ implementation
procedure tcgmoddivnode.emit64_div_reg_reg(signed: boolean; denum,num:tregister64); procedure tcgmoddivnode.emit64_div_reg_reg(signed: boolean; denum,num:tregister64);
begin begin
{ handled in pass_1 already, unless pass_1 is { handled in pass_1 already, unless pass_1 is
overriden overriden
} }
{ should be handled in pass_1 (JM) } { should be handled in pass_1 (JM) }
internalerror(200109052); internalerror(200109052);
end; end;
@ -267,10 +267,10 @@ implementation
location_copy(location,left.location); location_copy(location,left.location);
if is_64bitint(resulttype.def) then if is_64bitint(resulttype.def) then
begin begin
{ this code valid for 64-bit cpu's only , { this code valid for 64-bit cpu's only ,
otherwise helpers are called in pass_1 otherwise helpers are called in pass_1
} }
location_force_reg(exprasmlist,location,OS_64,false); location_force_reg(exprasmlist,location,OS_64,false);
location_copy(location,left.location); location_copy(location,left.location);
location_force_reg(exprasmlist,right.location,OS_64,false); location_force_reg(exprasmlist,right.location,OS_64,false);
@ -301,7 +301,7 @@ implementation
else else
cg.a_op_const_reg(exprasmlist,OP_ADD, cg.a_op_const_reg(exprasmlist,OP_ADD,
tordconstnode(right).value-1,hreg1); tordconstnode(right).value-1,hreg1);
cg.a_label(exprasmlist,hl); cg.a_label(exprasmlist,hl);
cg.a_op_const_reg(exprasmlist,OP_SAR,power,hreg1); cg.a_op_const_reg(exprasmlist,OP_SAR,power,hreg1);
End End
Else { not signed } Else { not signed }
@ -362,13 +362,13 @@ implementation
shln: op:=OP_SHL; shln: op:=OP_SHL;
shrn: op:=OP_SHR; shrn: op:=OP_SHR;
end; end;
if is_64bitint(left.resulttype.def) then if is_64bitint(left.resulttype.def) then
begin begin
{ already hanled in 1st pass } { already hanled in 1st pass }
internalerror(2002081501); internalerror(2002081501);
(* Normally for 64-bit cpu's this here should be here, (* Normally for 64-bit cpu's this here should be here,
and only pass_1 need to be overriden, but dunno how to and only pass_1 need to be overriden, but dunno how to
do that! do that!
location_reset(location,LOC_REGISTER,OS_64); location_reset(location,LOC_REGISTER,OS_64);
@ -385,7 +385,7 @@ implementation
begin begin
{ this should be handled in pass_1 } { this should be handled in pass_1 }
internalerror(2002081501); internalerror(2002081501);
if right.location.loc<>LOC_REGISTER then if right.location.loc<>LOC_REGISTER then
begin begin
if right.location.loc<>LOC_CREGISTER then if right.location.loc<>LOC_CREGISTER then
@ -424,7 +424,7 @@ implementation
end end
else else
begin begin
{ load right operators in a register - this { load right operators in a register - this
is done since most target cpu which will use this is done since most target cpu which will use this
node do not support a shift count in a mem. location (cec) node do not support a shift count in a mem. location (cec)
} }
@ -454,7 +454,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.2 2002-08-15 15:15:55 carl Revision 1.3 2002-08-23 16:14:48 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.2 2002/08/15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should) * jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths * more generic nodes for maths
* several fixes for better m68k support * several fixes for better m68k support

View File

@ -299,7 +299,7 @@ implementation
end end
else if is_interfacecom(left.resulttype.def) then else if is_interfacecom(left.resulttype.def) then
begin begin
tg.gettempintfcomreference(exprasmlist,location.reference); tg.GetTemp(exprasmlist,pointer_size,tt_interfacecom,location.reference);
cg.a_load_loc_ref(exprasmlist,left.location,location.reference); cg.a_load_loc_ref(exprasmlist,left.location,location.reference);
end end
else else
@ -392,7 +392,7 @@ implementation
if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) and if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) and
tg.istemp(left.location.reference) then tg.istemp(left.location.reference) then
begin begin
tg.normaltemptopersistant(left.location.reference.offset); tg.ChangeTempType(left.location.reference,tt_persistant);
with_expr_in_temp:=true; with_expr_in_temp:=true;
end end
else else
@ -401,8 +401,7 @@ implementation
{ if usetemp is set the value must be in tmpreg } { if usetemp is set the value must be in tmpreg }
if usetemp then if usetemp then
begin begin
tg.gettempofsizereference(exprasmlist,pointer_size,withreference); tg.GetTemp(exprasmlist,pointer_size,tt_persistant,withreference);
tg.normaltemptopersistant(withreference.offset);
{ move to temp reference } { move to temp reference }
cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,withreference); cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,withreference);
cg.free_scratch_reg(exprasmlist,tmpreg); cg.free_scratch_reg(exprasmlist,tmpreg);
@ -436,7 +435,7 @@ implementation
if usetemp then if usetemp then
begin begin
tg.ungetpersistanttemp(exprasmlist,withreference.offset); tg.UnGetTemp(exprasmlist,withreference);
{$ifdef GDB} {$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then if (cs_debuginfo in aktmoduleswitches) then
begin begin
@ -455,7 +454,7 @@ implementation
end; end;
if with_expr_in_temp then if with_expr_in_temp then
tg.ungetpersistanttemp(exprasmlist,left.location.reference.offset); tg.UnGetTemp(exprasmlist,left.location.reference);
reference_reset(withreference); reference_reset(withreference);
end; end;
@ -878,7 +877,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.24 2002-08-15 08:13:54 carl Revision 1.25 2002-08-23 16:14:48 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.24 2002/08/15 08:13:54 carl
- a_load_sym_ofs_reg removed - a_load_sym_ofs_reg removed
* loadvmt now calls loadaddr_ref_reg instead * loadvmt now calls loadaddr_ref_reg instead

View File

@ -528,7 +528,7 @@ implementation
LOC_FPUREGISTER, LOC_FPUREGISTER,
LOC_CFPUREGISTER : LOC_CFPUREGISTER :
begin begin
tg.gettempofsizereference(list,TCGSize2Size[l.size],r); tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
cg.a_loadfpu_reg_ref(list,l.size,l.register,r); cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
location_reset(l,LOC_REFERENCE,l.size); location_reset(l,LOC_REFERENCE,l.size);
l.reference:=r; l.reference:=r;
@ -537,7 +537,7 @@ implementation
LOC_REGISTER, LOC_REGISTER,
LOC_CREGISTER : LOC_CREGISTER :
begin begin
tg.gettempofsizereference(list,TCGSize2Size[l.size],r); tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
if l.size in [OS_64,OS_S64] then if l.size in [OS_64,OS_S64] then
cg64.a_load64_loc_ref(list,l,r) cg64.a_load64_loc_ref(list,l,r)
else else
@ -572,12 +572,12 @@ implementation
begin begin
if l.size in [OS_64,OS_S64] then if l.size in [OS_64,OS_S64] then
begin begin
tg.gettempofsizereference(exprasmlist,8,s.ref); tg.GetTemp(exprasmlist,8,tt_normal,s.ref);
cg64.a_load64_reg_ref(exprasmlist,joinreg64(l.registerlow,l.registerhigh),s.ref); cg64.a_load64_reg_ref(exprasmlist,joinreg64(l.registerlow,l.registerhigh),s.ref);
end end
else else
begin begin
tg.gettempofsizereference(exprasmlist,TCGSize2Size[l.size],s.ref); tg.GetTemp(exprasmlist,TCGSize2Size[l.size],tt_normal,s.ref);
cg.a_load_reg_ref(exprasmlist,l.size,l.register,s.ref); cg.a_load_reg_ref(exprasmlist,l.size,l.register,s.ref);
end; end;
location_release(exprasmlist,l); location_release(exprasmlist,l);
@ -592,7 +592,7 @@ implementation
{ load address into a single base register } { load address into a single base register }
cg.a_loadaddr_ref_reg(list,l.reference,l.reference.base); cg.a_loadaddr_ref_reg(list,l.reference,l.reference.base);
{ save base register } { save base register }
tg.gettempofsizereference(exprasmlist,TCGSize2Size[OS_ADDR],s.ref); tg.GetTemp(exprasmlist,TCGSize2Size[OS_ADDR],tt_normal,s.ref);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,l.reference.base,s.ref); cg.a_load_reg_ref(exprasmlist,OS_ADDR,l.reference.base,s.ref);
{ release } { release }
location_release(exprasmlist,l); location_release(exprasmlist,l);
@ -991,7 +991,7 @@ implementation
begin begin
if hp^.temptype in [tt_ansistring,tt_freeansistring, if hp^.temptype in [tt_ansistring,tt_freeansistring,
tt_widestring,tt_freewidestring, tt_widestring,tt_freewidestring,
tt_interfacecom] then tt_interfacecom,tt_freeinterfacecom] then
begin begin
procinfo.flags:=procinfo.flags or pi_needs_implicit_finally; procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
reference_reset_base(href,procinfo.framepointer,hp^.pos); reference_reset_base(href,procinfo.framepointer,hp^.pos);
@ -1133,7 +1133,6 @@ implementation
hs : string; hs : string;
href : treference; href : treference;
p : tsymtable; p : tsymtable;
tmpreg : tregister;
stackalloclist : taasmoutput; stackalloclist : taasmoutput;
hp : tparaitem; hp : tparaitem;
@ -1276,9 +1275,9 @@ implementation
not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
begin begin
include(rg.usedinproc,accumulator); include(rg.usedinproc,accumulator);
tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,procinfo.exception_jmp_ref); tg.GetTemp(list,JMP_BUF_SIZE,tt_persistant,procinfo.exception_jmp_ref);
tg.gettempofsizereferencepersistant(list,12,procinfo.exception_env_ref); tg.GetTemp(list,12,tt_persistant,procinfo.exception_env_ref);
tg.gettempofsizereferencepersistant(list,sizeof(aword),procinfo.exception_result_ref); tg.GetTemp(list,sizeof(aword),tt_persistant,procinfo.exception_result_ref);
new_exception(list,procinfo.exception_jmp_ref, new_exception(list,procinfo.exception_jmp_ref,
procinfo.exception_env_ref, procinfo.exception_env_ref,
procinfo.exception_result_ref,1,aktexitlabel); procinfo.exception_result_ref,1,aktexitlabel);
@ -1446,8 +1445,11 @@ implementation
free_exception(list, free_exception(list,
procinfo.exception_jmp_ref, procinfo.exception_jmp_ref,
procinfo.exception_env_ref, procinfo.exception_env_ref,
procinfo.exception_result_ref,0 procinfo.exception_result_ref,0,
,noreraiselabel,false); noreraiselabel,false);
tg.Ungettemp(list,procinfo.exception_jmp_ref);
tg.Ungettemp(list,procinfo.exception_env_ref);
tg.Ungettemp(list,procinfo.exception_result_ref);
if (aktprocdef.proctypeoption=potype_constructor) then if (aktprocdef.proctypeoption=potype_constructor) then
begin begin
@ -1730,7 +1732,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.40 2002-08-18 10:42:37 florian Revision 1.41 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.40 2002/08/18 10:42:37 florian
* remaining assembler writer bugs fixed, the errors in the * remaining assembler writer bugs fixed, the errors in the
system unit are inline assembler problems system unit are inline assembler problems

View File

@ -1975,6 +1975,7 @@ implementation
var var
procname: string; procname: string;
begin begin
result:=nil;
if not assigned(call) then if not assigned(call) then
begin begin
if is_class(left.resulttype.def) and if is_class(left.resulttype.def) and
@ -2004,7 +2005,6 @@ implementation
registersmmx:=call.registersmmx; registersmmx:=call.registersmmx;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
end; end;
result:=nil;
end; end;
@ -2015,7 +2015,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.72 2002-08-20 18:23:33 jonas Revision 1.73 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.72 2002/08/20 18:23:33 jonas
* the as node again uses a compilerproc * the as node again uses a compilerproc
+ (untested) support for interface "as" statements + (untested) support for interface "as" statements

View File

@ -168,6 +168,8 @@ implementation
oldloc : tloc; oldloc : tloc;
{$endif EXTDEBUG} {$endif EXTDEBUG}
begin begin
if not assigned(p) then
internalerror(200208221);
if not(nf_error in p.flags) then if not(nf_error in p.flags) then
begin begin
oldcodegenerror:=codegenerror; oldcodegenerror:=codegenerror;
@ -330,7 +332,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.38 2002-08-20 16:55:38 peter Revision 1.39 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.38 2002/08/20 16:55:38 peter
* don't write (stabs)line info when inlining a procedure * don't write (stabs)line info when inlining a procedure
Revision 1.37 2002/08/19 19:36:44 peter Revision 1.37 2002/08/19 19:36:44 peter

View File

@ -187,7 +187,7 @@ implementation
{ stw R3,disp+4(R1) # store lower half } { stw R3,disp+4(R1) # store lower half }
{ lfd FR1,disp(R1) # float load double of value } { lfd FR1,disp(R1) # float load double of value }
{ fsub FR1,FR1,FR2 # subtract 0x4330000000000000 } { fsub FR1,FR1,FR2 # subtract 0x4330000000000000 }
tg.gettempofsizereference(exprasmlist,8,ref); tg.Gettemp(exprasmlist,8,tt_normal,ref);
signed := is_signed(left.resulttype.def); signed := is_signed(left.resulttype.def);
@ -422,7 +422,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.23 2002-08-18 10:34:30 florian Revision 1.24 2002-08-23 16:14:50 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.23 2002/08/18 10:34:30 florian
* more ppc assembling fixes * more ppc assembling fixes
Revision 1.22 2002/08/14 19:30:42 carl Revision 1.22 2002/08/14 19:30:42 carl

View File

@ -582,7 +582,7 @@ unit rgobj;
not(r in unusedregsint) then not(r in unusedregsint) then
begin begin
{ then save it } { then save it }
tg.gettempofsizereferencepersistant(list,sizeof(aword),hr); tg.GetTemp(list,sizeof(aword),tt_persistant,hr);
saved[r].ofs:=hr.offset; saved[r].ofs:=hr.offset;
cg.a_load_reg_ref(list,OS_INT,r,hr); cg.a_load_reg_ref(list,OS_INT,r,hr);
cg.a_reg_dealloc(list,r); cg.a_reg_dealloc(list,r);
@ -605,7 +605,7 @@ unit rgobj;
not(r in unusedregsfpu) then not(r in unusedregsfpu) then
begin begin
{ then save it } { then save it }
tg.gettempofsizereferencepersistant(list,extended_size,hr); tg.GetTemp(list,extended_size,tt_persistant,hr);
saved[r].ofs:=hr.offset; saved[r].ofs:=hr.offset;
cg.a_loadfpu_reg_ref(list,OS_FLOAT,r,hr); cg.a_loadfpu_reg_ref(list,OS_FLOAT,r,hr);
cg.a_reg_dealloc(list,r); cg.a_reg_dealloc(list,r);
@ -627,7 +627,7 @@ unit rgobj;
not(r in unusedregsmm) then not(r in unusedregsmm) then
begin begin
{ then save it } { then save it }
tg.gettempofsizereferencepersistant(list,mmreg_size,hr); tg.GetTemp(list,mmreg_size,tt_persistant,hr);
saved[r].ofs:=hr.offset; saved[r].ofs:=hr.offset;
cg.a_loadmm_reg_ref(list,r,hr); cg.a_loadmm_reg_ref(list,r,hr);
cg.a_reg_dealloc(list,r); cg.a_reg_dealloc(list,r);
@ -667,7 +667,7 @@ unit rgobj;
dec(countunusedregsmm); dec(countunusedregsmm);
exclude(unusedregsmm,r); exclude(unusedregsmm,r);
end; end;
tg.ungetpersistanttemp(list,hr.offset); tg.UnGetTemp(list,hr);
end; end;
end; end;
@ -689,7 +689,7 @@ unit rgobj;
dec(countunusedregsfpu); dec(countunusedregsfpu);
exclude(unusedregsfpu,r); exclude(unusedregsfpu,r);
end; end;
tg.ungetpersistanttemp(list,hr.offset); tg.UnGetTemp(list,hr);
end; end;
end; end;
@ -710,7 +710,7 @@ unit rgobj;
dec(countunusedregsint); dec(countunusedregsint);
exclude(unusedregsint,r); exclude(unusedregsint,r);
end; end;
tg.ungetpersistanttemp(list,hr.offset); tg.UnGetTemp(list,hr);
end; end;
end; end;
{$ifdef TEMPREGDEBUG} {$ifdef TEMPREGDEBUG}
@ -993,7 +993,11 @@ end.
{ {
$Log$ $Log$
Revision 1.18 2002-08-17 22:09:47 florian Revision 1.19 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.18 2002/08/17 22:09:47 florian
* result type handling in tcgcal.pass_2 overhauled * result type handling in tcgcal.pass_2 overhauled
* better tnode.dowrite * better tnode.dowrite
* some ppc stuff fixed * some ppc stuff fixed

View File

@ -39,10 +39,12 @@ unit tgobj;
cclasses,globtype,cgbase,aasmbase,aasmtai,aasmcpu; cclasses,globtype,cgbase,aasmbase,aasmtai,aasmcpu;
type type
ttemptype = (tt_none,tt_free,tt_normal,tt_persistant, ttemptype = (tt_none,
tt_ansistring,tt_freeansistring,tt_widestring,tt_freewidestring, tt_free,tt_normal,tt_persistant,
tt_noreuse,tt_freenoreuse,
tt_ansistring,tt_freeansistring,
tt_widestring,tt_freewidestring,
tt_interfacecom,tt_freeinterfacecom); tt_interfacecom,tt_freeinterfacecom);
ttemptypeset = set of ttemptype; ttemptypeset = set of ttemptype;
ptemprecord = ^ttemprecord; ptemprecord = ^ttemprecord;
@ -61,19 +63,18 @@ unit tgobj;
{# Generates temporary variables } {# Generates temporary variables }
ttgobj = class ttgobj = class
{ contains all temps } private
templist : ptemprecord;
{ contains all free temps using nextfree links } { contains all free temps using nextfree links }
tempfreelist : ptemprecord; tempfreelist : ptemprecord;
function AllocTemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
procedure FreeTemp(list: taasmoutput; pos:longint;temptypes:ttemptypeset);
public
{ contains all temps }
templist : ptemprecord;
{ Offsets of the first/last temp } { Offsets of the first/last temp }
firsttemp, firsttemp,
lasttemp : longint; lasttemp : longint;
lasttempofsize : ptemprecord;
{ tries to hold the amount of times which the current tree is processed }
t_times: longint;
constructor create; constructor create;
{# Clear and free the complete linked list of temporary memory {# Clear and free the complete linked list of temporary memory
locations. The list is set to nil.} locations. The list is set to nil.}
procedure resettempgen; procedure resettempgen;
@ -85,39 +86,13 @@ unit tgobj;
} }
procedure setfirsttemp(l : longint); procedure setfirsttemp(l : longint);
function gettempsize : longint; function gettempsize : longint;
{ special call for inlined procedures }
function gettempofsizepersistant(list: taasmoutput; size : longint) : longint;
procedure gettempofsizereferencepersistant(list: taasmoutput; l : longint;var ref : treference);
procedure gettemppointerreferencefortype(list: taasmoutput; var ref : treference; const usedtype, freetype: ttemptype); procedure GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
function ungettemppointeriftype(list: taasmoutput; const ref : treference; const usedtype, freetype: ttemptype) : boolean; procedure UnGetTemp(list: taasmoutput; const ref : treference);
{ for parameter func returns } function SizeOfTemp(const ref: treference): longint;
procedure normaltemptopersistant(pos : longint); procedure ChangeTempType(const ref:treference;temptype:ttemptype);
{# Searches the list of currently allocated persistent memory space
as the specified address @var(pos) , and if found, converts this memory
space to normal volatile memory space which can be freed and reused.
@param(pos offset from current frame pointer to memory area to convert)
}
procedure persistanttemptonormal(pos : longint);
{procedure ungettemp(pos : longint;size : longint);}
procedure ungetpersistanttemp(list: taasmoutput; pos : longint);
procedure ungetpersistanttempreference(list: taasmoutput; const ref : treference);
{# This routine is used to assign and allocate extra temporary volatile memory space
on the stack from a reference. @var(l) is the size of the persistent memory space to
allocate, while @var(ref) is a reference entry which will be set to the correct offset
and correct base register (which is the current @var(procinfo^.framepointer)) register.
The offset and base fields of ref will be set appropriately in this routine, and can be
considered valid on exit of this routine.
@param(l size of the area to allocate)
@param(ref allocated reference)
}
procedure gettempofsizereference(list: taasmoutput; l : longint;var ref : treference);
{# Returns TRUE if the reference ref is allocated in temporary volatile memory space, {# Returns TRUE if the reference ref is allocated in temporary volatile memory space,
otherwise returns FALSE. otherwise returns FALSE.
@ -129,21 +104,6 @@ unit tgobj;
is not in the temporary memory, it is simply not freed. is not in the temporary memory, it is simply not freed.
} }
procedure ungetiftemp(list: taasmoutput; const ref : treference); procedure ungetiftemp(list: taasmoutput; const ref : treference);
function getsizeoftemp(const ref: treference): longint;
function ungetiftempansi(list: taasmoutput; const ref : treference) : boolean;
procedure gettempansistringreference(list: taasmoutput; var ref : treference);
function ungetiftempwidestr(list: taasmoutput; const ref : treference) : boolean;
procedure gettempwidestringreference(list: taasmoutput; var ref : treference);
function ungetiftempintfcom(list: taasmoutput; const ref : treference) : boolean;
procedure gettempintfcomreference(list: taasmoutput; var ref : treference);
private
function ungettemp(list: taasmoutput; pos:longint;allowtype:ttemptype):ttemptype;
function newtempofsize(size : longint) : longint;
function gettempofsize(list: taasmoutput; size : longint) : longint;
end; end;
var var
@ -156,12 +116,40 @@ unit tgobj;
systems, systems,
verbose,cutils; verbose,cutils;
const
FreeTempTypes = [tt_free,tt_freenoreuse,tt_freeansistring,
tt_freewidestring,tt_freeinterfacecom];
{$ifdef EXTDEBUG}
TempTypeStr : array[ttemptype] of string[18] = (
'<none>',
'free','normal','persistant',
'noreuse','freenoreuse',
'ansistring','freeansistring',
'widestring','freewidestring',
'interfacecom','freeinterfacecom'
);
{$endif EXTDEBUG}
Used2Free : array[ttemptype] of ttemptype = (
tt_none,
tt_none,tt_free,tt_free,
tt_freenoreuse,tt_none,
tt_freeansistring,tt_none,
tt_freewidestring,tt_none,
tt_freeinterfacecom,tt_none);
{*****************************************************************************
TTGOBJ
*****************************************************************************}
constructor ttgobj.create; constructor ttgobj.create;
begin begin
tempfreelist:=nil; tempfreelist:=nil;
templist:=nil; templist:=nil;
lasttempofsize := nil;
end; end;
@ -173,27 +161,13 @@ unit tgobj;
while assigned(templist) do while assigned(templist) do
begin begin
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
case templist^.temptype of if not(templist^.temptype in FreeTempTypes) then
tt_normal, begin
tt_persistant : Comment(V_Warning,'temp at pos '+tostr(templist^.pos)+
Comment(V_Warning,'temporary assignment of size '+ ' with size '+tostr(templist^.size)+' and type '+TempTypeStr[templist^.temptype]+
tostr(templist^.size)+' from pos '+tostr(templist^.posinfo.line)+ ' from pos '+tostr(templist^.posinfo.line)+':'+tostr(templist^.posinfo.column)+
':'+tostr(templist^.posinfo.column)+ ' not freed at the end of the procedure');
' at pos '+tostr(templist^.pos)+ end;
' not freed at the end of the procedure');
tt_ansistring :
Comment(V_Warning,'temporary ANSI assignment of size '+
tostr(templist^.size)+' from pos '+tostr(templist^.posinfo.line)+
':'+tostr(templist^.posinfo.column)+
' at pos '+tostr(templist^.pos)+
' not freed at the end of the procedure');
tt_widestring :
Comment(V_Warning,'temporary WIDE assignment of size '+
tostr(templist^.size)+' from pos '+tostr(templist^.posinfo.line)+
':'+tostr(templist^.posinfo.column)+
' at pos '+tostr(templist^.pos)+
' not freed at the end of the procedure');
end;
{$endif} {$endif}
hp:=templist; hp:=templist;
templist:=hp^.next; templist:=hp^.next;
@ -210,60 +184,66 @@ unit tgobj;
begin begin
{ this is a negative value normally } { this is a negative value normally }
if l <= 0 then if l <= 0 then
Begin begin
if odd(l) then if odd(l) then
Dec(l); dec(l);
end end
else else
internalerror(20020422); internalerror(200204221);
firsttemp:=l; firsttemp:=l;
lasttemp:=l; lasttemp:=l;
end; end;
function ttgobj.newtempofsize(size : longint) : longint; function ttgobj.gettempsize : longint;
var var
tl : ptemprecord; _align : longint;
begin begin
{ we need to allocate at least a minimum of 4 bytes, else { align to 4 bytes at least
we get two temps at the same position resulting in problems otherwise all those subl $2,%esp are meaningless PM }
when finding the corresponding temprecord } _align:=target_info.alignment.localalignmin;
if size=0 then if _align<4 then
size:=4; _align:=4;
{ Just extend the temp, everything below has been use {$ifdef testtemp}
already } if firsttemp <> lasttemp then
dec(lasttemp,size); gettempsize:=Align(-(lasttemp-firsttemp),_align)
{ now we can create the templist entry } else
new(tl); gettempsize := 0;
tl^.temptype:=tt_normal; {$else}
tl^.pos:=lasttemp; gettempsize:=Align(-lasttemp,_align);
tl^.size:=size; {$endif}
tl^.next:=templist;
tl^.nextfree:=nil;
templist:=tl;
newtempofsize:=tl^.pos;
end; end;
function ttgobj.gettempofsize(list: taasmoutput; size : longint) : longint;
function ttgobj.AllocTemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
var var
tl, tl,
bestslot,bestprev, bestslot,bestprev,
hprev,hp : ptemprecord; hprev,hp : ptemprecord;
bestsize,ofs : longint; bestsize : longint;
freetype : ttemptype;
begin begin
AllocTemp:=0;
bestprev:=nil; bestprev:=nil;
bestslot:=nil; bestslot:=nil;
tl:=nil; tl:=nil;
bestsize:=0; bestsize:=0;
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
if size=0 then if size=0 then
Comment(V_Warning,'Temp of size 0 requested'); begin
Comment(V_Warning,'Temp of size 0 requested');
size:=4;
end;
{$endif} {$endif}
freetype:=Used2Free[temptype];
if freetype=tt_none then
internalerror(200208201);
{ Align needed size on 4 bytes } { Align needed size on 4 bytes }
if (size mod 4)<>0 then size:=Align(size,4);
size:=size+(4-(size mod 4)); { First check the tmpfreelist, but not when
{ First check the tmpfreelist } we don't want to reuse an already allocated block }
if assigned(tempfreelist) then if assigned(tempfreelist) and
(temptype<>tt_noreuse) then
begin begin
{ Check for a slot with the same size first } { Check for a slot with the same size first }
hprev:=nil; hprev:=nil;
@ -271,10 +251,11 @@ unit tgobj;
while assigned(hp) do while assigned(hp) do
begin begin
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
if hp^.temptype<>tt_free then if not(hp^.temptype in FreeTempTypes) then
Comment(V_Warning,'Temp in freelist is not set to tt_free'); Comment(V_Warning,'Temp in freelist is not set to tt_free');
{$endif} {$endif}
if hp^.size>=size then if (hp^.temptype=freetype) and
(hp^.size>=size) then
begin begin
{ Slot is the same size, then leave immediatly } { Slot is the same size, then leave immediatly }
if hp^.size=size then if hp^.size=size then
@ -303,14 +284,14 @@ unit tgobj;
begin begin
if bestsize=size then if bestsize=size then
begin begin
bestslot^.temptype:=tt_normal;
ofs:=bestslot^.pos;
tl:=bestslot; tl:=bestslot;
tl^.temptype:=tt_normal;
{ Remove from the tempfreelist } { Remove from the tempfreelist }
if assigned(bestprev) then if assigned(bestprev) then
bestprev^.nextfree:=bestslot^.nextfree bestprev^.nextfree:=tl^.nextfree
else else
tempfreelist:=bestslot^.nextfree; tempfreelist:=tl^.nextfree;
tl^.nextfree:=nil;
end end
else else
begin begin
@ -320,7 +301,6 @@ unit tgobj;
new(tl); new(tl);
tl^.temptype:=tt_normal; tl^.temptype:=tt_normal;
tl^.pos:=bestslot^.pos+bestslot^.size; tl^.pos:=bestslot^.pos+bestslot^.size;
ofs:=tl^.pos;
tl^.size:=size; tl^.size:=size;
tl^.nextfree:=nil; tl^.nextfree:=nil;
{ link the new block } { link the new block }
@ -330,234 +310,34 @@ unit tgobj;
end end
else else
begin begin
ofs:=newtempofsize(size); { create a new temp, we need to allocate at least a minimum of
tl:=templist; 4 bytes, else we get two temps at the same position resulting
in problems when finding the corresponding temprecord }
if size<4 then
size:=4;
{ Extend the temp }
dec(lasttemp,size);
{ now we can create the templist entry }
new(tl);
tl^.temptype:=temptype;
tl^.pos:=lasttemp;
tl^.size:=size;
tl^.next:=templist;
tl^.nextfree:=nil;
templist:=tl;
end; end;
lasttempofsize:=tl;
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
tl^.posinfo:=aktfilepos; tl^.posinfo:=aktfilepos;
{$endif} {$endif}
list.concat(tai_tempalloc.alloc(ofs,size)); list.concat(tai_tempalloc.alloc(tl^.pos,tl^.size));
gettempofsize:=ofs; AllocTemp:=tl^.pos;
end; end;
function ttgobj.gettempofsizepersistant(list: taasmoutput; size : longint) : longint; procedure ttgobj.FreeTemp(list: taasmoutput; pos:longint;temptypes:ttemptypeset);
var
l : longint;
begin
l:=gettempofsize(list, size);
lasttempofsize^.temptype:=tt_persistant;
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp managment : call to gettempofsizepersistant()'+
' with size '+tostr(size)+' returned '+tostr(l));
{$endif}
gettempofsizepersistant:=l;
end;
function ttgobj.gettempsize : longint;
var
_align : longint;
begin
{ align to 4 bytes at least
otherwise all those subl $2,%esp are meaningless PM }
_align:=target_info.alignment.localalignmin;
if _align<4 then
_align:=4;
{$ifdef testtemp}
if firsttemp <> lasttemp then
gettempsize:=Align(-(lasttemp-firsttemp),_align)
else
gettempsize := 0;
{$else}
gettempsize:=Align(-lasttemp,_align);
{$endif}
end;
procedure ttgobj.gettempofsizereference(list: taasmoutput; l : longint;var ref : treference);
begin
{ do a reset, because the reference isn't used }
FillChar(ref,sizeof(treference),0);
ref.offset:=gettempofsize(list,l);
ref.base:=procinfo.framepointer;
end;
procedure ttgobj.gettempofsizereferencepersistant(list: taasmoutput; l : longint;var ref : treference);
begin
{ do a reset, because the reference isn't used }
FillChar(ref,sizeof(treference),0);
ref.offset:=gettempofsizepersistant(list,l);
ref.base:=procinfo.framepointer;
end;
procedure ttgobj.gettemppointerreferencefortype(list: taasmoutput; var ref : treference; const usedtype, freetype: ttemptype);
var
foundslot,tl : ptemprecord;
begin
{ do a reset, because the reference isn't used }
FillChar(ref,sizeof(treference),0);
ref.base:=procinfo.framepointer;
{ Reuse old slot ? }
foundslot:=nil;
tl:=templist;
while assigned(tl) do
begin
if tl^.temptype=freetype then
begin
foundslot:=tl;
{$ifdef EXTDEBUG}
tl^.posinfo:=aktfilepos;
{$endif}
break;
end;
tl:=tl^.next;
end;
if assigned(foundslot) then
begin
foundslot^.temptype:=usedtype;
ref.offset:=foundslot^.pos;
end
else
begin
ref.offset:=newtempofsize(pointer_size);
{$ifdef EXTDEBUG}
templist^.posinfo:=aktfilepos;
{$endif}
templist^.temptype:=usedtype;
end;
list.concat(tai_tempalloc.alloc(ref.offset,pointer_size));
end;
function ttgobj.ungettemppointeriftype(list: taasmoutput; const ref : treference; const usedtype, freetype: ttemptype) : boolean;
var
tl : ptemprecord;
begin
ungettemppointeriftype:=false;
tl:=templist;
while assigned(tl) do
begin
if tl^.pos=ref.offset then
begin
if tl^.temptype=usedtype then
begin
tl^.temptype:=freetype;
ungettemppointeriftype:=true;
list.concat(tai_tempalloc.dealloc(tl^.pos,tl^.size));
exit;
{$ifdef EXTDEBUG}
end
else if (tl^.temptype=freetype) then
begin
Comment(V_Debug,'temp managment problem : ungettemppointeriftype()'+
' at pos '+tostr(ref.offset)+ ' already free !');
{$endif}
end;
end;
tl:=tl^.next;
end;
end;
procedure ttgobj.gettempansistringreference(list: taasmoutput; var ref : treference);
begin
gettemppointerreferencefortype(list,ref,tt_ansistring,tt_freeansistring);
end;
procedure ttgobj.gettempwidestringreference(list: taasmoutput; var ref : treference);
begin
gettemppointerreferencefortype(list,ref,tt_widestring,tt_freewidestring);
end;
function ttgobj.ungetiftempansi(list: taasmoutput; const ref : treference) : boolean;
begin
ungetiftempansi:=ungettemppointeriftype(list,ref,tt_ansistring,tt_freeansistring);
end;
function ttgobj.ungetiftempwidestr(list: taasmoutput; const ref : treference) : boolean;
begin
ungetiftempwidestr:=ungettemppointeriftype(list,ref,tt_widestring,tt_freewidestring);
end;
procedure ttgobj.gettempintfcomreference(list: taasmoutput; var ref : treference);
begin
gettemppointerreferencefortype(list,ref,tt_interfacecom,tt_freeinterfacecom);
end;
function ttgobj.ungetiftempintfcom(list: taasmoutput; const ref : treference) : boolean;
begin
ungetiftempintfcom:=ungettemppointeriftype(list,ref,tt_ansistring,tt_freeansistring);
end;
function ttgobj.istemp(const ref : treference) : boolean;
begin
{ ref.index = R_NO was missing
led to problems with local arrays
with lower bound > 0 (PM) }
istemp:=((ref.base=procinfo.framepointer) and
(ref.index=R_NO) and
(ref.offset<firsttemp));
end;
procedure ttgobj.persistanttemptonormal(pos : longint);
var
hp : ptemprecord;
begin
hp:=templist;
while assigned(hp) do
if (hp^.pos=pos) and (hp^.temptype=tt_persistant) then
begin
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp managment : persistanttemptonormal()'+
' at pos '+tostr(pos)+ ' found !');
{$endif}
hp^.temptype:=tt_normal;
exit;
end
else
hp:=hp^.next;
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp managment problem : persistanttemptonormal()'+
' at pos '+tostr(pos)+ ' not found !');
{$endif}
end;
procedure ttgobj.normaltemptopersistant(pos : longint);
var
hp : ptemprecord;
begin
hp:=templist;
while assigned(hp) do
if (hp^.pos=pos) and (hp^.temptype=tt_normal) then
begin
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp managment : normaltemptopersistant()'+
' at pos '+tostr(pos)+ ' found !');
{$endif}
hp^.temptype:=tt_persistant;
exit;
end
else
hp:=hp^.next;
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp managment problem : normaltemptopersistant()'+
' at pos '+tostr(pos)+ ' not found !');
{$endif}
end;
function ttgobj.ungettemp(list: taasmoutput; pos:longint;allowtype:ttemptype):ttemptype;
var var
hp,hnext,hprev,hprevfree : ptemprecord; hp,hnext,hprev,hprevfree : ptemprecord;
begin begin
ungettemp:=tt_none;
hp:=templist; hp:=templist;
hprev:=nil; hprev:=nil;
hprevfree:=nil; hprevfree:=nil;
@ -565,20 +345,32 @@ unit tgobj;
begin begin
if (hp^.pos=pos) then if (hp^.pos=pos) then
begin begin
{ check type } { check if already freed }
ungettemp:=hp^.temptype; if hp^.temptype in FreeTempTypes then
if hp^.temptype<>allowtype then
begin begin
{$ifdef EXTDEBUG}
Comment(V_Warning,'temp managment : (FreeTemp) temp at pos '+tostr(pos)+ ' is already free !');
{$endif}
exit;
end;
{ check type that are allowed to be released }
if not(hp^.temptype in temptypes) then
begin
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp managment : (Freetemp) temp at pos '+tostr(pos)+ ' has wrong type !');
{$endif}
exit; exit;
end; end;
list.concat(tai_tempalloc.dealloc(hp^.pos,hp^.size)); list.concat(tai_tempalloc.dealloc(hp^.pos,hp^.size));
{ set this block to free } { set this block to free }
hp^.temptype:=tt_free; hp^.temptype:=Used2Free[hp^.temptype];
{ Update tempfreelist } { Update tempfreelist }
if assigned(hprevfree) then if assigned(hprevfree) then
begin begin
{ Connect with previous? } { Connect With previous tt_free block? }
if assigned(hprev) and (hprev^.temptype=tt_free) then if assigned(hprev) and
(hp^.temptype=tt_free) and
(hprev^.temptype=tt_free) then
begin begin
inc(hprev^.size,hp^.size); inc(hprev^.size,hp^.size);
hprev^.next:=hp^.next; hprev^.next:=hp^.next;
@ -593,82 +385,114 @@ unit tgobj;
hp^.nextfree:=tempfreelist; hp^.nextfree:=tempfreelist;
tempfreelist:=hp; tempfreelist:=hp;
end; end;
{ Next block free ? Yes, then concat } { Next block tt_free ? Yes, then concat }
hnext:=hp^.next; hnext:=hp^.next;
if assigned(hnext) and (hnext^.temptype=tt_free) then if assigned(hnext) and
(hp^.temptype=tt_free) and
(hnext^.temptype=tt_free) then
begin begin
inc(hp^.size,hnext^.size); inc(hp^.size,hnext^.size);
hp^.nextfree:=hnext^.nextfree; hp^.nextfree:=hnext^.nextfree;
hp^.next:=hnext^.next; hp^.next:=hnext^.next;
dispose(hnext); dispose(hnext);
end; end;
{ Stop }
exit; exit;
end; end;
if (hp^.temptype=tt_free) then if (hp^.temptype=tt_free) then
hprevfree:=hp; hprevfree:=hp;
hprev:=hp; hprev:=hp;
hp:=hp^.next; hp:=hp^.next;
end; end;
ungettemp:=tt_none;
end; end;
function ttgobj.getsizeoftemp(const ref: treference): longint;
procedure ttgobj.GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
begin
FillChar(ref,sizeof(treference),0);
ref.base:=procinfo.framepointer;
ref.offset:=AllocTemp(list,size,temptype);
end;
function ttgobj.istemp(const ref : treference) : boolean;
begin
{ ref.index = R_NO was missing
led to problems with local arrays
with lower bound > 0 (PM) }
istemp:=((ref.base=procinfo.framepointer) and
(ref.index=R_NO) and
(ref.offset<firsttemp));
end;
function ttgobj.SizeOfTemp(const ref: treference): longint;
var var
hp : ptemprecord; hp : ptemprecord;
begin begin
hp:=templist; SizeOfTemp := -1;
while assigned(hp) do hp:=templist;
while assigned(hp) do
begin
if (hp^.pos=ref.offset) then
begin
SizeOfTemp := hp^.size;
exit;
end;
hp := hp^.next;
end;
{$ifdef EXTDEBUG}
Comment(V_Warning,'temp managment : SizeOfTemp temp at pos '+tostr(ref.offset)+ ' not found !');
{$endif}
end;
procedure ttgobj.ChangeTempType(const ref:treference;temptype:ttemptype);
var
hp : ptemprecord;
begin
hp:=templist;
while assigned(hp) do
begin begin
if (hp^.pos=ref.offset) then if (hp^.pos=ref.offset) then
begin begin
getsizeoftemp := hp^.size; if not(hp^.temptype in [tt_free,tt_freeansistring,tt_freewidestring,tt_freeinterfacecom]) then
exit; begin
end; {$ifdef EXTDEBUG}
hp := hp^.next; if hp^.temptype=temptype then
Comment(V_Warning,'temp managment : ChangeTempType temp'+
' at pos '+tostr(ref.offset)+ ' is already of the correct type !');
{$endif}
hp^.temptype:=temptype;
end
else
begin
{$ifdef EXTDEBUG}
Comment(V_Warning,'temp managment : ChangeTempType temp'+
' at pos '+tostr(ref.offset)+ ' is already freed !');
{$endif}
end;
exit;
end;
hp:=hp^.next;
end; end;
getsizeoftemp := -1;
end;
procedure ttgobj.ungetpersistanttemp(list: taasmoutput; pos : longint);
begin
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
if ungettemp(list,pos,tt_persistant)<>tt_persistant then Comment(V_Warning,'temp managment : ChangeTempType temp'+
Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+ ' at pos '+tostr(ref.offset)+ ' not found !');
' at pos '+tostr(pos)+ ' not found !');
{$else}
ungettemp(list,pos,tt_persistant);
{$endif} {$endif}
end; end;
procedure ttgobj.ungetpersistanttempreference(list: taasmoutput; const ref : treference);
procedure ttgobj.UnGetTemp(list: taasmoutput; const ref : treference);
begin begin
ungetpersistanttemp(list, ref.offset); FreeTemp(list,ref.offset,[tt_normal,tt_persistant,tt_ansistring,tt_widestring,tt_interfacecom]);
end; end;
procedure ttgobj.ungetiftemp(list: taasmoutput; const ref : treference);
{$ifdef EXTDEBUG} procedure ttgobj.UnGetIfTemp(list: taasmoutput; const ref : treference);
var
tt : ttemptype;
{$endif}
begin begin
if istemp(ref) then if istemp(ref) then
begin FreeTemp(list,ref.offset,[tt_normal,tt_ansistring,tt_widestring,tt_interfacecom]);
{ first check if ansistring }
if ungetiftempansi(list,ref) or
ungetiftempwidestr(list,ref) or
ungetiftempintfcom(list,ref) then
exit;
{$ifndef EXTDEBUG}
ungettemp(list,ref.offset,tt_normal);
{$else}
tt:=ungettemp(list,ref.offset,tt_normal);
if tt=tt_persistant then
Comment(V_Debug,'temp at pos '+tostr(ref.offset)+ ' not released because persistant!');
if tt=tt_none then
Comment(V_Warning,'temp not found for release at offset '+tostr(ref.offset));
{$endif}
end;
end; end;
@ -679,7 +503,11 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.11 2002-08-17 09:23:44 florian Revision 1.12 2002-08-23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.11 2002/08/17 09:23:44 florian
* first part of procinfo rewrite * first part of procinfo rewrite
Revision 1.10 2002/07/01 18:46:29 peter Revision 1.10 2002/07/01 18:46:29 peter