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

* tempgen cleanup

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
compiler/i386/cpunode.pas
View File

@ -30,7 +30,16 @@ unit cpunode;
uses
{ 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,
the processor specific nodes must be included
after the generic one (FK)
@ -52,7 +61,11 @@ unit cpunode;
end.
{
$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
* renamed write/load to ppuwrite/ppuload
* tnode storing in ppu

10
compiler/i386/n386add.pas
View File

@ -357,10 +357,10 @@ interface
{ or a function result, so simply check for a }
{ temp of 256 bytes(JM) }
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
begin
tg.gettempofsizereference(exprasmlist,256,href);
tg.GetTemp(exprasmlist,256,tt_normal,href);
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
{ location is released by copyshortstring }
location_freetemp(exprasmlist,left.location);
@ -1551,7 +1551,11 @@ begin
end.
{
$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
on the endianess of the host operating system -> difficult to get
right. Use lo/hi(location.valueqword) instead (remember to use

36
compiler/i386/n386cal.pas
View File

@ -225,7 +225,7 @@ implementation
(left.resulttype.def.deftype=procvardef) and
(ttypeconvnode(left).left.nodetype=niln) then
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);
location_reset(left.location,LOC_REFERENCE,left.location.size);
left.location.reference:=href;
@ -318,6 +318,8 @@ implementation
pop_allowed : boolean;
release_tmpreg : boolean;
constructorfailed : tasmlabel;
returnref,
pararef : treference;
label
dont_call;
@ -335,12 +337,12 @@ implementation
{ already here, we avoid later a push/pop }
if is_widestring(resulttype.def) then
begin
tg.gettempwidestringreference(exprasmlist,refcountedtemp);
tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
end
else if is_ansistring(resulttype.def) then
begin
tg.gettempansistringreference(exprasmlist,refcountedtemp);
tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
end;
@ -366,7 +368,10 @@ implementation
the para's are stored there }
tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
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;
tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
{$ifdef extdebug}
@ -500,7 +505,10 @@ implementation
{ Allocate return value for inlined routines }
if inlined and
(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 }
if paramanager.ret_in_param(resulttype.def) then
@ -518,9 +526,7 @@ implementation
begin
if inlined then
begin
reference_reset(funcretref);
funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
funcretref.base:=procinfo.framepointer;
tg.GetTemp(exprasmlist,resulttype.def.size,tt_persistant,funcretref);
{$ifdef extdebug}
Comment(V_debug,'function return value is at offset '
+tostr(funcretref.offset));
@ -530,7 +536,7 @@ implementation
{$endif extdebug}
end
else
tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref);
tg.GetTemp(exprasmlist,resulttype.def.size,tt_normal,funcretref);
end;
{ This must not be counted for C code
@ -987,7 +993,7 @@ implementation
secondpass(inlinecode);
{ free the args }
if tprocdef(procdefinition).parast.datasize>0 then
tg.ungetpersistanttemp(exprasmlist,tprocdef(procdefinition).parast.address_fixup);
tg.UnGetTemp(exprasmlist,pararef);
end;
end
else
@ -1269,7 +1275,7 @@ implementation
end;
if inlined then
begin
tg.ungetpersistanttemp(exprasmlist,inlinecode.retoffset);
tg.UnGetTemp(exprasmlist,returnref);
tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
right:=inlinecode;
end;
@ -1278,7 +1284,7 @@ implementation
{ from now on the result can be freed normally }
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 (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
@ -1309,7 +1315,11 @@ begin
end.
{
$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
* renamed write/load to ppuwrite/ppuload
* tnode storing in ppu

40
compiler/i386/n386flw.pas
View File

@ -200,8 +200,8 @@ implementation
objectlibrary.getlabel(endexceptlabel);
objectlibrary.getlabel(lastonlabel);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
tg.GetTemp(exprasmlist,JMP_BUF_SIZE,tt_persistant,tempbuf);
tg.GetTemp(exprasmlist,12,tt_persistant,tempaddr);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
{ push type of exceptionframe }
@ -236,8 +236,8 @@ implementation
cg.a_label(exprasmlist,exceptlabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
tg.ungetpersistanttempreference(exprasmlist,tempaddr);
tg.ungetpersistanttempreference(exprasmlist,tempbuf);
tg.UnGetTemp(exprasmlist,tempaddr);
tg.UnGetTemp(exprasmlist,tempbuf);
exprasmList.concat(tai_regalloc.Alloc(R_EAX));
emit_reg(A_POP,S_L,R_EAX);
@ -278,8 +278,8 @@ implementation
objectlibrary.getlabel(doobjectdestroy);
objectlibrary.getlabel(doobjectdestroyandreraise);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
tg.GetTemp(exprasmlist,JMP_BUF_SIZE,tt_persistant,tempbuf);
tg.GetTemp(exprasmlist,12,tt_persistant,tempaddr);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
{ push type of exceptionframe }
@ -303,8 +303,8 @@ implementation
cg.a_label(exprasmlist,doobjectdestroyandreraise);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
tg.ungetpersistanttempreference(exprasmlist,tempaddr);
tg.ungetpersistanttempreference(exprasmlist,tempbuf);
tg.Ungettemp(exprasmlist,tempaddr);
tg.Ungettemp(exprasmlist,tempbuf);
exprasmList.concat(tai_regalloc.Alloc(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);
emitjmp(C_E,nextonlabel);
ref.symbol:=nil;
tg.gettempofsizereference(exprasmlist,4,ref);
tg.GetTemp(exprasmlist,4,tt_normal,ref);
{ what a hack ! }
if assigned(exceptsymtable) then
@ -447,8 +447,8 @@ implementation
{ we've to destroy the old one }
objectlibrary.getlabel(doobjectdestroyandreraise);
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
tg.GetTemp(exprasmlist,12,tt_persistant,tempaddr);
tg.GetTemp(exprasmlist,JMP_BUF_SIZE,tt_persistant,tempbuf);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
@ -488,8 +488,8 @@ implementation
objectlibrary.getlabel(doobjectdestroy);
cg.a_label(exprasmlist,doobjectdestroyandreraise);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
tg.ungetpersistanttempreference(exprasmlist,tempaddr);
tg.ungetpersistanttempreference(exprasmlist,tempbuf);
tg.Ungettemp(exprasmlist,tempaddr);
tg.Ungettemp(exprasmlist,tempbuf);
exprasmList.concat(tai_regalloc.Alloc(R_EAX));
exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX));
@ -601,8 +601,8 @@ implementation
aktbreaklabel:=breakfinallylabel;
end;
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
tg.Gettemp(exprasmlist,12,tt_persistant,tempaddr);
tg.Gettemp(exprasmlist,JMP_BUF_SIZE,tt_persistant,tempbuf);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
{ Type of stack-frame must be pushed}
@ -630,8 +630,8 @@ implementation
cg.a_label(exprasmlist,finallylabel);
cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
tg.ungetpersistanttempreference(exprasmlist,tempaddr);
tg.ungetpersistanttempreference(exprasmlist,tempbuf);
tg.Ungettemp(exprasmlist,tempaddr);
tg.Ungettemp(exprasmlist,tempbuf);
{ finally code }
flowcontrol:=[];
@ -726,7 +726,11 @@ begin
end.
{
$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)
* more generic nodes for maths
* several fixes for better m68k support

14
compiler/i386/n386opt.pas
View File

@ -97,10 +97,10 @@ begin
{ ti386addnode.pass_2 }
secondpass(left);
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
begin
tg.gettempofsizereference(exprasmlist,256,href);
tg.Gettemp(exprasmlist,256,tt_normal,href);
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
{ location is released by copyshortstring }
location_freetemp(exprasmlist,left.location);
@ -205,10 +205,10 @@ begin
{ ti386addnode.pass_2 }
secondpass(left);
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
begin
tg.gettempofsizereference(exprasmlist,256,href);
tg.GetTemp(exprasmlist,256,tt_normal,href);
cg.g_copyshortstring(exprasmlist,left.location.reference,href,255,true,false);
{ release the registers }
location_freetemp(exprasmlist,left.location);
@ -248,7 +248,11 @@ end.
{
$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
Revision 1.22 2002/08/11 13:24:17 peter

10
compiler/m68k/rgcpu.pas
View File

@ -109,7 +109,7 @@ unit rgcpu;
dec(countunusedregsint);
exclude(unusedregsint,r);
end;
tg.ungetpersistanttemp(list,hr.offset);
tg.ungettemp(list,hr);
end;
end;
end;
@ -133,7 +133,7 @@ unit rgcpu;
not(r in unusedregsaddr) then
begin
{ then save it }
tg.gettempofsizereferencepersistant(list,pointer_size,hr);
tg.gettemp(list,pointer_size,tt_persistant,hr);
saved[r].ofs:=hr.offset;
cg.a_load_reg_ref(list,OS_ADDR,r,hr);
cg.a_reg_dealloc(list,r);
@ -151,7 +151,11 @@ end.
{
$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)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

17
compiler/ncgbas.pas
View File

@ -240,6 +240,8 @@ interface
*****************************************************************************}
procedure tcgtempcreatenode.pass_2;
var
temptype : ttemptype;
begin
{ if we're secondpassing the same tcgtempcreatenode twice, we have a bug }
if tempinfo^.valid then
@ -247,9 +249,10 @@ interface
{ get a (persistent) temp }
if persistent then
tg.gettempofsizereferencepersistant(exprasmlist,size,tempinfo^.ref)
temptype:=tt_persistant
else
tg.gettempofsizereference(exprasmlist,size,tempinfo^.ref);
temptype:=tt_normal;
tg.GetTemp(exprasmlist,size,temptype,tempinfo^.ref);
tempinfo^.valid := true;
end;
@ -276,9 +279,9 @@ interface
procedure tcgtempdeletenode.pass_2;
begin
if release_to_normal then
tg.persistanttemptonormal(tempinfo^.ref.offset)
tg.ChangeTempType(tempinfo^.ref,tt_normal)
else
tg.ungetpersistanttempreference(exprasmlist,tempinfo^.ref);
tg.UnGetTemp(exprasmlist,tempinfo^.ref);
end;
@ -293,7 +296,11 @@ begin
end.
{
$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
Revision 1.21 2002/08/11 13:24:11 peter

47
compiler/ncgcal.pas
View File

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

8
compiler/ncgcnv.pas
View File

@ -233,7 +233,7 @@ interface
case tstringdef(resulttype.def).string_typ of
st_shortstring :
begin
tg.gettempofsizereference(exprasmlist,256,location.reference);
tg.GetTemp(exprasmlist,256,tt_normal,location.reference);
cg.a_load_loc_ref(exprasmlist,left.location,
location.reference);
location_release(exprasmlist,left.location);
@ -487,7 +487,11 @@ end.
{
$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
+ (untested) support for interface "as" statements

21
compiler/ncgflw.pas
View File

@ -324,8 +324,7 @@ implementation
{ load into temporary variable }
if right.nodetype<>ordconstn then
begin
temp1.symbol:=nil;
tg.gettempofsizereference(exprasmlist,hs,temp1);
tg.GetTemp(exprasmlist,hs,tt_normal,temp1);
temptovalue:=true;
if (right.location.loc=LOC_REGISTER) or
(right.location.loc=LOC_CREGISTER) then
@ -695,9 +694,9 @@ do_jmp:
procedure try_new_exception(list : taasmoutput;var jmpbuf,envbuf, href : treference;
a : aword; exceptlabel : tasmlabel);
begin
tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,jmpbuf);
tg.gettempofsizereferencepersistant(list,12,envbuf);
tg.gettempofsizereferencepersistant(list,sizeof(aword),href);
tg.GetTemp(list,JMP_BUF_SIZE,tt_persistant,jmpbuf);
tg.GetTemp(list,12,tt_persistant,envbuf);
tg.GetTemp(list,sizeof(aword),tt_persistant,href);
new_exception(list, jmpbuf,envbuf, href, a, exceptlabel);
end;
@ -706,8 +705,8 @@ do_jmp:
a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
begin
free_exception(list, jmpbuf, envbuf, href, a, endexceptlabel, onlyfree);
tg.ungetpersistanttempreference(list,jmpbuf);
tg.ungetpersistanttempreference(list,envbuf);
tg.Ungettemp(list,jmpbuf);
tg.ungettemp(list,envbuf);
end;
@ -975,7 +974,7 @@ do_jmp:
{ is it this catch? No. go to next onlabel }
cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,accumulator,nextonlabel);
ref.symbol:=nil;
tg.gettempofsizereference(exprasmlist,pointer_size,ref);
tg.GetTemp(exprasmlist,pointer_size,tt_normal,ref);
{ what a hack ! }
if assigned(exceptsymtable) then
@ -1225,7 +1224,11 @@ begin
end.
{
$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
* Moved pocall_internconst to po_internconst because it is not a
calling type at all and it conflicted when inlining of these small

16
compiler/ncgld.pas
View File

@ -82,7 +82,6 @@ implementation
absolutesym :
begin
{ this is only for toasm and toaddr }
location.reference.symbol:=nil;
if (tabsolutesym(symtableentry).abstyp=toaddr) then
begin
{$ifdef i386}
@ -119,8 +118,7 @@ implementation
hregister:=rg.getaddressregister(exprasmlist);
location.reference.symbol:=objectlibrary.newasmsymbol(tvarsym(symtableentry).mangledname);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,location.reference,hregister);
location.reference.symbol:=nil;
location.reference.base:=hregister;
reference_reset_base(location.reference,hregister,0);
end
{ external variable }
else if (vo_is_external in tvarsym(symtableentry).varoptions) then
@ -282,7 +280,7 @@ implementation
location_reset(location,LOC_CREFERENCE,OS_64)
else
internalerror(20020520);
tg.gettempofsizereference(exprasmlist,2*POINTER_SIZE,location.reference);
tg.GetTemp(exprasmlist,2*POINTER_SIZE,tt_normal,location.reference);
freereg:=false;
{ 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
be sure that location is valid (PFV) }
if tarraydef(resulttype.def).highrange=-1 then
tg.gettempofsizereference(exprasmlist,elesize,location.reference)
tg.GetTemp(exprasmlist,elesize,tt_normal,location.reference)
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;
end;
hp:=self;
@ -942,7 +940,11 @@ begin
end.
{
$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
Revision 1.23 2002/08/14 18:13:28 jonas

84
compiler/ncgmat.pas
View File

@ -33,66 +33,66 @@ type
tcgunaryminusnode = class(tunaryminusnode)
procedure pass_2;override;
protected
{ This routine is called to change the sign of the
floating point value in the floating point
{ This routine is called to change the sign of the
floating point value in the floating point
register r.
This routine should be overriden, since
the generic version is not optimal at all. The
generic version assumes that floating
point values are stored in the register
in IEEE-754 format.
}
}
procedure emit_float_sign_change(r: tregister; _size : tcgsize);virtual;
end;
tcgmoddivnode = class(tmoddivnode)
procedure pass_2;override;
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
@var(num) register.
@var(num) register.
@param(signed Indicates if the division must be signed)
@param(denum Register containing the denominator
@param(num Register containing the numerator, will also receive result)
The actual optimizations regarding shifts have already
been done and emitted, so this should really a do a divide.
}
}
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
@var(num) register.
@var(num) register.
@param(signed Indicates if the modulo must be signed)
@param(denum Register containing the denominator
@param(num Register containing the numerator, will also receive result)
The actual optimizations regarding shifts have already
been done and emitted, so this should really a do a modulo.
}
}
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
@var(num) register.
@var(num) register.
@param(signed Indicates if the division must be signed)
@param(denum Register containing the denominator
@param(num Register containing the numerator, will also receive result)
The actual optimizations regarding shifts have already
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.
}
}
procedure emit64_div_reg_reg(signed: boolean;denum,num : tregister64);virtual;
end;
tcgshlshrnode = class(tshlshrnode)
procedure pass_2;override;
end;
implementation
@ -116,7 +116,7 @@ implementation
{ get a temporary memory reference to store the floating
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 }
cg.a_loadfpu_reg_ref(exprasmlist,_size,r,href);
{ only single and double ieee are supported }
@ -124,11 +124,11 @@ implementation
begin
{ on little-endian machine the most significant
32-bit value is stored at the highest address
}
}
if target_info.endian = endian_little then
inc(href.offset,4);
end
else
else
if _size <> OS_F32 then
internalerror(20020814);
hreg := rg.getregisterint(exprasmlist);
@ -146,7 +146,7 @@ implementation
begin
{ on little-endian machine the most significant
32-bit value is stored at the highest address
}
}
if target_info.endian = endian_little then
dec(href.offset,4);
end;
@ -198,14 +198,14 @@ implementation
cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
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
else
begin
location.register:=rg.getregisterint(exprasmlist);
{ why is the size is OS_INT, since in pass_1 we convert
everything to a signed natural value anyways
}
}
cg.a_load_ref_reg(exprasmlist,OS_INT,
left.location.reference,location.register);
cg.a_op_reg_reg(exprasmlist,OP_NEG,OS_INT,location.register,
@ -216,14 +216,14 @@ implementation
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
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;
LOC_CFPUREGISTER:
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
location.register:=rg.getregisterfpu(exprasmlist);
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;
else
internalerror(200203225);
@ -238,9 +238,9 @@ implementation
procedure tcgmoddivnode.emit64_div_reg_reg(signed: boolean; denum,num:tregister64);
begin
{ handled in pass_1 already, unless pass_1 is
{ handled in pass_1 already, unless pass_1 is
overriden
}
}
{ should be handled in pass_1 (JM) }
internalerror(200109052);
end;
@ -267,10 +267,10 @@ implementation
location_copy(location,left.location);
if is_64bitint(resulttype.def) then
begin
begin
{ this code valid for 64-bit cpu's only ,
otherwise helpers are called in pass_1
}
}
location_force_reg(exprasmlist,location,OS_64,false);
location_copy(location,left.location);
location_force_reg(exprasmlist,right.location,OS_64,false);
@ -301,7 +301,7 @@ implementation
else
cg.a_op_const_reg(exprasmlist,OP_ADD,
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);
End
Else { not signed }
@ -362,13 +362,13 @@ implementation
shln: op:=OP_SHL;
shrn: op:=OP_SHR;
end;
if is_64bitint(left.resulttype.def) then
begin
{ already hanled in 1st pass }
internalerror(2002081501);
(* 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!
location_reset(location,LOC_REGISTER,OS_64);
@ -385,7 +385,7 @@ implementation
begin
{ this should be handled in pass_1 }
internalerror(2002081501);
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
@ -424,7 +424,7 @@ implementation
end
else
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
node do not support a shift count in a mem. location (cec)
}
@ -454,7 +454,11 @@ begin
end.
{
$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)
* more generic nodes for maths
* several fixes for better m68k support

17
compiler/ncgmem.pas
View File

@ -299,7 +299,7 @@ implementation
end
else if is_interfacecom(left.resulttype.def) then
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);
end
else
@ -392,7 +392,7 @@ implementation
if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) and
tg.istemp(left.location.reference) then
begin
tg.normaltemptopersistant(left.location.reference.offset);
tg.ChangeTempType(left.location.reference,tt_persistant);
with_expr_in_temp:=true;
end
else
@ -401,8 +401,7 @@ implementation
{ if usetemp is set the value must be in tmpreg }
if usetemp then
begin
tg.gettempofsizereference(exprasmlist,pointer_size,withreference);
tg.normaltemptopersistant(withreference.offset);
tg.GetTemp(exprasmlist,pointer_size,tt_persistant,withreference);
{ move to temp reference }
cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,withreference);
cg.free_scratch_reg(exprasmlist,tmpreg);
@ -436,7 +435,7 @@ implementation
if usetemp then
begin
tg.ungetpersistanttemp(exprasmlist,withreference.offset);
tg.UnGetTemp(exprasmlist,withreference);
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
@ -455,7 +454,7 @@ implementation
end;
if with_expr_in_temp then
tg.ungetpersistanttemp(exprasmlist,left.location.reference.offset);
tg.UnGetTemp(exprasmlist,left.location.reference);
reference_reset(withreference);
end;
@ -878,7 +877,11 @@ begin
end.
{
$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
* loadvmt now calls loadaddr_ref_reg instead

32
compiler/ncgutil.pas
View File

@ -528,7 +528,7 @@ implementation
LOC_FPUREGISTER,
LOC_CFPUREGISTER :
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);
location_reset(l,LOC_REFERENCE,l.size);
l.reference:=r;
@ -537,7 +537,7 @@ implementation
LOC_REGISTER,
LOC_CREGISTER :
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
cg64.a_load64_loc_ref(list,l,r)
else
@ -572,12 +572,12 @@ implementation
begin
if l.size in [OS_64,OS_S64] then
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);
end
else
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);
end;
location_release(exprasmlist,l);
@ -592,7 +592,7 @@ implementation
{ load address into a single base register }
cg.a_loadaddr_ref_reg(list,l.reference,l.reference.base);
{ 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);
{ release }
location_release(exprasmlist,l);
@ -991,7 +991,7 @@ implementation
begin
if hp^.temptype in [tt_ansistring,tt_freeansistring,
tt_widestring,tt_freewidestring,
tt_interfacecom] then
tt_interfacecom,tt_freeinterfacecom] then
begin
procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
reference_reset_base(href,procinfo.framepointer,hp^.pos);
@ -1133,7 +1133,6 @@ implementation
hs : string;
href : treference;
p : tsymtable;
tmpreg : tregister;
stackalloclist : taasmoutput;
hp : tparaitem;
@ -1276,9 +1275,9 @@ implementation
not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
begin
include(rg.usedinproc,accumulator);
tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,procinfo.exception_jmp_ref);
tg.gettempofsizereferencepersistant(list,12,procinfo.exception_env_ref);
tg.gettempofsizereferencepersistant(list,sizeof(aword),procinfo.exception_result_ref);
tg.GetTemp(list,JMP_BUF_SIZE,tt_persistant,procinfo.exception_jmp_ref);
tg.GetTemp(list,12,tt_persistant,procinfo.exception_env_ref);
tg.GetTemp(list,sizeof(aword),tt_persistant,procinfo.exception_result_ref);
new_exception(list,procinfo.exception_jmp_ref,
procinfo.exception_env_ref,
procinfo.exception_result_ref,1,aktexitlabel);
@ -1446,8 +1445,11 @@ implementation
free_exception(list,
procinfo.exception_jmp_ref,
procinfo.exception_env_ref,
procinfo.exception_result_ref,0
,noreraiselabel,false);
procinfo.exception_result_ref,0,
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
begin
@ -1730,7 +1732,11 @@ implementation
end.
{
$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
system unit are inline assembler problems

8
compiler/ncnv.pas
View File

@ -1975,6 +1975,7 @@ implementation
var
procname: string;
begin
result:=nil;
if not assigned(call) then
begin
if is_class(left.resulttype.def) and
@ -2004,7 +2005,6 @@ implementation
registersmmx:=call.registersmmx;
{$endif SUPPORT_MMX}
end;
result:=nil;
end;
@ -2015,7 +2015,11 @@ begin
end.
{
$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
+ (untested) support for interface "as" statements

8
compiler/pass_2.pas
View File

@ -168,6 +168,8 @@ implementation
oldloc : tloc;
{$endif EXTDEBUG}
begin
if not assigned(p) then
internalerror(200208221);
if not(nf_error in p.flags) then
begin
oldcodegenerror:=codegenerror;
@ -330,7 +332,11 @@ implementation
end.
{
$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
Revision 1.37 2002/08/19 19:36:44 peter

8
compiler/powerpc/nppccnv.pas
View File

@ -187,7 +187,7 @@ implementation
{ stw R3,disp+4(R1) # store lower half }
{ lfd FR1,disp(R1) # float load double of value }
{ fsub FR1,FR1,FR2 # subtract 0x4330000000000000 }
tg.gettempofsizereference(exprasmlist,8,ref);
tg.Gettemp(exprasmlist,8,tt_normal,ref);
signed := is_signed(left.resulttype.def);
@ -422,7 +422,11 @@ begin
end.
{
$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
Revision 1.22 2002/08/14 19:30:42 carl

18
compiler/rgobj.pas
View File

@ -582,7 +582,7 @@ unit rgobj;
not(r in unusedregsint) then
begin
{ then save it }
tg.gettempofsizereferencepersistant(list,sizeof(aword),hr);
tg.GetTemp(list,sizeof(aword),tt_persistant,hr);
saved[r].ofs:=hr.offset;
cg.a_load_reg_ref(list,OS_INT,r,hr);
cg.a_reg_dealloc(list,r);
@ -605,7 +605,7 @@ unit rgobj;
not(r in unusedregsfpu) then
begin
{ then save it }
tg.gettempofsizereferencepersistant(list,extended_size,hr);
tg.GetTemp(list,extended_size,tt_persistant,hr);
saved[r].ofs:=hr.offset;
cg.a_loadfpu_reg_ref(list,OS_FLOAT,r,hr);
cg.a_reg_dealloc(list,r);
@ -627,7 +627,7 @@ unit rgobj;
not(r in unusedregsmm) then
begin
{ then save it }
tg.gettempofsizereferencepersistant(list,mmreg_size,hr);
tg.GetTemp(list,mmreg_size,tt_persistant,hr);
saved[r].ofs:=hr.offset;
cg.a_loadmm_reg_ref(list,r,hr);
cg.a_reg_dealloc(list,r);
@ -667,7 +667,7 @@ unit rgobj;
dec(countunusedregsmm);
exclude(unusedregsmm,r);
end;
tg.ungetpersistanttemp(list,hr.offset);
tg.UnGetTemp(list,hr);
end;
end;
@ -689,7 +689,7 @@ unit rgobj;
dec(countunusedregsfpu);
exclude(unusedregsfpu,r);
end;
tg.ungetpersistanttemp(list,hr.offset);
tg.UnGetTemp(list,hr);
end;
end;
@ -710,7 +710,7 @@ unit rgobj;
dec(countunusedregsint);
exclude(unusedregsint,r);
end;
tg.ungetpersistanttemp(list,hr.offset);
tg.UnGetTemp(list,hr);
end;
end;
{$ifdef TEMPREGDEBUG}
@ -993,7 +993,11 @@ end.
{
$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
* better tnode.dowrite
* some ppc stuff fixed

596
compiler/tgobj.pas
View File

@ -39,10 +39,12 @@ unit tgobj;
cclasses,globtype,cgbase,aasmbase,aasmtai,aasmcpu;
type
ttemptype = (tt_none,tt_free,tt_normal,tt_persistant,
tt_ansistring,tt_freeansistring,tt_widestring,tt_freewidestring,
ttemptype = (tt_none,
tt_free,tt_normal,tt_persistant,
tt_noreuse,tt_freenoreuse,
tt_ansistring,tt_freeansistring,
tt_widestring,tt_freewidestring,
tt_interfacecom,tt_freeinterfacecom);
ttemptypeset = set of ttemptype;
ptemprecord = ^ttemprecord;
@ -61,19 +63,18 @@ unit tgobj;
{# Generates temporary variables }
ttgobj = class
{ contains all temps }
templist : ptemprecord;
private
{ contains all free temps using nextfree links }
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 }
firsttemp,
lasttemp : longint;
lasttempofsize : ptemprecord;
{ tries to hold the amount of times which the current tree is processed }
t_times: longint;
constructor create;
{# Clear and free the complete linked list of temporary memory
locations. The list is set to nil.}
procedure resettempgen;
@ -85,39 +86,13 @@ unit tgobj;
}
procedure setfirsttemp(l : 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);
function ungettemppointeriftype(list: taasmoutput; const ref : treference; const usedtype, freetype: ttemptype) : boolean;
procedure GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
procedure UnGetTemp(list: taasmoutput; const ref : treference);
{ for parameter func returns }
procedure normaltemptopersistant(pos : longint);
function SizeOfTemp(const ref: treference): 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,
otherwise returns FALSE.
@ -129,21 +104,6 @@ unit tgobj;
is not in the temporary memory, it is simply not freed.
}
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;
var
@ -156,12 +116,40 @@ unit tgobj;
systems,
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;
begin
tempfreelist:=nil;
templist:=nil;
lasttempofsize := nil;
end;
@ -173,27 +161,13 @@ unit tgobj;
while assigned(templist) do
begin
{$ifdef EXTDEBUG}
case templist^.temptype of
tt_normal,
tt_persistant :
Comment(V_Warning,'temporary 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_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;
if not(templist^.temptype in FreeTempTypes) then
begin
Comment(V_Warning,'temp at pos '+tostr(templist^.pos)+
' with size '+tostr(templist^.size)+' and type '+TempTypeStr[templist^.temptype]+
' from pos '+tostr(templist^.posinfo.line)+':'+tostr(templist^.posinfo.column)+
' not freed at the end of the procedure');
end;
{$endif}
hp:=templist;
templist:=hp^.next;
@ -210,60 +184,66 @@ unit tgobj;
begin
{ this is a negative value normally }
if l <= 0 then
Begin
begin
if odd(l) then
Dec(l);
dec(l);
end
else
internalerror(20020422);
internalerror(200204221);
firsttemp:=l;
lasttemp:=l;
end;
function ttgobj.newtempofsize(size : longint) : longint;
function ttgobj.gettempsize : longint;
var
tl : ptemprecord;
_align : longint;
begin
{ we need to allocate at least a minimum of 4 bytes, else
we get two temps at the same position resulting in problems
when finding the corresponding temprecord }
if size=0 then
size:=4;
{ Just extend the temp, everything below has been use
already }
dec(lasttemp,size);
{ now we can create the templist entry }
new(tl);
tl^.temptype:=tt_normal;
tl^.pos:=lasttemp;
tl^.size:=size;
tl^.next:=templist;
tl^.nextfree:=nil;
templist:=tl;
newtempofsize:=tl^.pos;
{ 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;
function ttgobj.gettempofsize(list: taasmoutput; size : longint) : longint;
function ttgobj.AllocTemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
var
tl,
bestslot,bestprev,
hprev,hp : ptemprecord;
bestsize,ofs : longint;
bestsize : longint;
freetype : ttemptype;
begin
AllocTemp:=0;
bestprev:=nil;
bestslot:=nil;
tl:=nil;
bestsize:=0;
{$ifdef EXTDEBUG}
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}
freetype:=Used2Free[temptype];
if freetype=tt_none then
internalerror(200208201);
{ Align needed size on 4 bytes }
if (size mod 4)<>0 then
size:=size+(4-(size mod 4));
{ First check the tmpfreelist }
if assigned(tempfreelist) then
size:=Align(size,4);
{ First check the tmpfreelist, but not when
we don't want to reuse an already allocated block }
if assigned(tempfreelist) and
(temptype<>tt_noreuse) then
begin
{ Check for a slot with the same size first }
hprev:=nil;
@ -271,10 +251,11 @@ unit tgobj;
while assigned(hp) do
begin
{$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');
{$endif}
if hp^.size>=size then
if (hp^.temptype=freetype) and
(hp^.size>=size) then
begin
{ Slot is the same size, then leave immediatly }
if hp^.size=size then
@ -303,14 +284,14 @@ unit tgobj;
begin
if bestsize=size then
begin
bestslot^.temptype:=tt_normal;
ofs:=bestslot^.pos;
tl:=bestslot;
tl^.temptype:=tt_normal;
{ Remove from the tempfreelist }
if assigned(bestprev) then
bestprev^.nextfree:=bestslot^.nextfree
bestprev^.nextfree:=tl^.nextfree
else
tempfreelist:=bestslot^.nextfree;
tempfreelist:=tl^.nextfree;
tl^.nextfree:=nil;
end
else
begin
@ -320,7 +301,6 @@ unit tgobj;
new(tl);
tl^.temptype:=tt_normal;
tl^.pos:=bestslot^.pos+bestslot^.size;
ofs:=tl^.pos;
tl^.size:=size;
tl^.nextfree:=nil;
{ link the new block }
@ -330,234 +310,34 @@ unit tgobj;
end
else
begin
ofs:=newtempofsize(size);
tl:=templist;
{ create a new temp, we need to allocate at least a minimum of
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;
lasttempofsize:=tl;
{$ifdef EXTDEBUG}
tl^.posinfo:=aktfilepos;
{$endif}
list.concat(tai_tempalloc.alloc(ofs,size));
gettempofsize:=ofs;
list.concat(tai_tempalloc.alloc(tl^.pos,tl^.size));
AllocTemp:=tl^.pos;
end;
function ttgobj.gettempofsizepersistant(list: taasmoutput; size : longint) : longint;
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;
procedure ttgobj.FreeTemp(list: taasmoutput; pos:longint;temptypes:ttemptypeset);
var
hp,hnext,hprev,hprevfree : ptemprecord;
begin
ungettemp:=tt_none;
hp:=templist;
hprev:=nil;
hprevfree:=nil;
@ -565,20 +345,32 @@ unit tgobj;
begin
if (hp^.pos=pos) then
begin
{ check type }
ungettemp:=hp^.temptype;
if hp^.temptype<>allowtype then
{ check if already freed }
if hp^.temptype in FreeTempTypes then
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;
end;
list.concat(tai_tempalloc.dealloc(hp^.pos,hp^.size));
{ set this block to free }
hp^.temptype:=tt_free;
hp^.temptype:=Used2Free[hp^.temptype];
{ Update tempfreelist }
if assigned(hprevfree) then
begin
{ Connect with previous? }
if assigned(hprev) and (hprev^.temptype=tt_free) then
{ Connect With previous tt_free block? }
if assigned(hprev) and
(hp^.temptype=tt_free) and
(hprev^.temptype=tt_free) then
begin
inc(hprev^.size,hp^.size);
hprev^.next:=hp^.next;
@ -593,82 +385,114 @@ unit tgobj;
hp^.nextfree:=tempfreelist;
tempfreelist:=hp;
end;
{ Next block free ? Yes, then concat }
{ Next block tt_free ? Yes, then concat }
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
inc(hp^.size,hnext^.size);
hp^.nextfree:=hnext^.nextfree;
hp^.next:=hnext^.next;
dispose(hnext);
end;
{ Stop }
exit;
end;
if (hp^.temptype=tt_free) then
hprevfree:=hp;
hprevfree:=hp;
hprev:=hp;
hp:=hp^.next;
end;
ungettemp:=tt_none;
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
hp : ptemprecord;
begin
hp:=templist;
while assigned(hp) do
SizeOfTemp := -1;
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
if (hp^.pos=ref.offset) then
begin
getsizeoftemp := hp^.size;
exit;
end;
hp := hp^.next;
begin
if not(hp^.temptype in [tt_free,tt_freeansistring,tt_freewidestring,tt_freeinterfacecom]) then
begin
{$ifdef EXTDEBUG}
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;
getsizeoftemp := -1;
end;
procedure ttgobj.ungetpersistanttemp(list: taasmoutput; pos : longint);
begin
{$ifdef EXTDEBUG}
if ungettemp(list,pos,tt_persistant)<>tt_persistant then
Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+
' at pos '+tostr(pos)+ ' not found !');
{$else}
ungettemp(list,pos,tt_persistant);
Comment(V_Warning,'temp managment : ChangeTempType temp'+
' at pos '+tostr(ref.offset)+ ' not found !');
{$endif}
end;
procedure ttgobj.ungetpersistanttempreference(list: taasmoutput; const ref : treference);
procedure ttgobj.UnGetTemp(list: taasmoutput; const ref : treference);
begin
ungetpersistanttemp(list, ref.offset);
FreeTemp(list,ref.offset,[tt_normal,tt_persistant,tt_ansistring,tt_widestring,tt_interfacecom]);
end;
procedure ttgobj.ungetiftemp(list: taasmoutput; const ref : treference);
{$ifdef EXTDEBUG}
var
tt : ttemptype;
{$endif}
procedure ttgobj.UnGetIfTemp(list: taasmoutput; const ref : treference);
begin
if istemp(ref) then
begin
{ 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;
if istemp(ref) then
FreeTemp(list,ref.offset,[tt_normal,tt_ansistring,tt_widestring,tt_interfacecom]);
end;
@ -679,7 +503,11 @@ finalization
end.
{
$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
Revision 1.10 2002/07/01 18:46:29 peter