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

+ new integer regvar handling, should be much more efficient

Browse Source
This commit is contained in:
Jonas Maebe 2000-12-05 11:44:32 +00:00
parent 72bc010795
commit a8af566cd7
13 changed files with 352 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/i386/cgai386.pas
View File

@ -982,6 +982,7 @@ implementation
begin begin
pushusedregisters(pushedregs,$ff); pushusedregisters(pushedregs,$ff);
emit_ref(A_PUSH,S_L,newreference(ref)); emit_ref(A_PUSH,S_L,newreference(ref));
saveregvars($ff);
if is_interfacecom(t) then if is_interfacecom(t) then
emitcall('FPC_INTF_INCR_REF') emitcall('FPC_INTF_INCR_REF')
else else
@ -998,6 +999,7 @@ implementation
begin begin
pushusedregisters(pushedregs,$ff); pushusedregisters(pushedregs,$ff);
emitpushreferenceaddr(ref); emitpushreferenceaddr(ref);
saveregvars($ff);
if is_interfacecom(t) then if is_interfacecom(t) then
begin begin
emitcall('FPC_INTF_DECR_REF'); emitcall('FPC_INTF_DECR_REF');
@ -1033,6 +1035,7 @@ implementation
else else
emitpushreferenceaddr(sref); emitpushreferenceaddr(sref);
push_int(len); push_int(len);
saveregvars($ff);
emitcall('FPC_LONGSTR_COPY'); emitcall('FPC_LONGSTR_COPY');
maybe_loadesi; maybe_loadesi;
end; end;
@ -1046,6 +1049,7 @@ implementation
begin begin
pushusedregisters(pushedregs,$ff); pushusedregisters(pushedregs,$ff);
emitpushreferenceaddr(ref); emitpushreferenceaddr(ref);
saveregvars($ff);
if is_ansistring(t) then if is_ansistring(t) then
begin begin
emitcall('FPC_ANSISTR_INCR_REF'); emitcall('FPC_ANSISTR_INCR_REF');
@ -1067,6 +1071,7 @@ implementation
begin begin
pushusedregisters(pushedregs,$ff); pushusedregisters(pushedregs,$ff);
emitpushreferenceaddr(ref); emitpushreferenceaddr(ref);
saveregvars($ff);
if is_ansistring(t) then if is_ansistring(t) then
begin begin
emitcall('FPC_ANSISTR_DECR_REF'); emitcall('FPC_ANSISTR_DECR_REF');
@ -1608,6 +1613,7 @@ implementation
reset_reference(hr); reset_reference(hr);
hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname); hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
emitpushreferenceaddr(hr); emitpushreferenceaddr(hr);
saveregvars($ff);
emitcall('FPC_INIT_THREADVAR'); emitcall('FPC_INIT_THREADVAR');
end; end;
end; end;
@ -2949,7 +2955,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.14 2000-11-29 00:30:43 florian Revision 1.15 2000-12-05 11:44:32 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.14 2000/11/29 00:30:43 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

16
compiler/i386/n386add.pas
View File

@ -175,6 +175,7 @@ interface
emitpushreferenceaddr(location.reference); emitpushreferenceaddr(location.reference);
emit_push_loc(right.location); emit_push_loc(right.location);
emit_push_loc(left.location); emit_push_loc(left.location);
saveregvars($ff);
emitcall('FPC_ANSISTR_CONCAT'); emitcall('FPC_ANSISTR_CONCAT');
popusedregisters(pushedregs); popusedregisters(pushedregs);
maybe_loadesi; maybe_loadesi;
@ -244,6 +245,7 @@ interface
LOC_REGISTER,LOC_CREGISTER: LOC_REGISTER,LOC_CREGISTER:
emit_reg(A_PUSH,S_L,left.location.register); emit_reg(A_PUSH,S_L,left.location.register);
end; end;
saveregvars($ff);
emitcall('FPC_ANSISTR_COMPARE'); emitcall('FPC_ANSISTR_COMPARE');
emit_reg_reg(A_OR,S_L,R_EAX,R_EAX); emit_reg_reg(A_OR,S_L,R_EAX,R_EAX);
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -394,6 +396,7 @@ interface
{ the pushref needs a "lea (..),edi; push edi") } { the pushref needs a "lea (..),edi; push edi") }
del_reference(right.location.reference); del_reference(right.location.reference);
emitpushreferenceaddr(right.location.reference); emitpushreferenceaddr(right.location.reference);
saveregvars(regstopush);
{$ifdef newoptimizations2} {$ifdef newoptimizations2}
emitcall('FPC_SHORTSTR_CONCAT_LEN'); emitcall('FPC_SHORTSTR_CONCAT_LEN');
{$else newoptimizations2} {$else newoptimizations2}
@ -443,6 +446,7 @@ interface
secondpass(right); secondpass(right);
emitpushreferenceaddr(right.location.reference); emitpushreferenceaddr(right.location.reference);
del_reference(right.location.reference); del_reference(right.location.reference);
saveregvars($ff);
emitcall('FPC_SHORTSTR_COMPARE'); emitcall('FPC_SHORTSTR_COMPARE');
maybe_loadesi; maybe_loadesi;
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -526,6 +530,7 @@ interface
emitpushreferenceaddr(left.location.reference); emitpushreferenceaddr(left.location.reference);
emitpushreferenceaddr(right.location.reference); emitpushreferenceaddr(right.location.reference);
End; End;
saveregvars($ff);
Case nodetype of Case nodetype of
equaln, unequaln: equaln, unequaln:
{$EndIf NoSetInclusion} {$EndIf NoSetInclusion}
@ -573,6 +578,7 @@ interface
begin begin
pushsetelement(tunarynode(right).left); pushsetelement(tunarynode(right).left);
emitpushreferenceaddr(href); emitpushreferenceaddr(href);
saveregvars(regstopush);
emitcall('FPC_SET_CREATE_ELEMENT'); emitcall('FPC_SET_CREATE_ELEMENT');
end end
else else
@ -590,12 +596,14 @@ interface
pushsetelement(tbinarynode(right).right); pushsetelement(tbinarynode(right).right);
pushsetelement(tunarynode(right).left); pushsetelement(tunarynode(right).left);
emitpushreferenceaddr(href); emitpushreferenceaddr(href);
saveregvars(regstopush);
emitcall('FPC_SET_SET_RANGE'); emitcall('FPC_SET_SET_RANGE');
end end
else else
begin begin
pushsetelement(tunarynode(right).left); pushsetelement(tunarynode(right).left);
emitpushreferenceaddr(href); emitpushreferenceaddr(href);
saveregvars(regstopush);
emitcall('FPC_SET_SET_BYTE'); emitcall('FPC_SET_SET_BYTE');
end; end;
end end
@ -611,6 +619,7 @@ interface
{$IfDef regallocfix} {$IfDef regallocfix}
del_location(left.location); del_location(left.location);
{$EndIf regallocfix} {$EndIf regallocfix}
saveregvars(regstopush);
emitcall('FPC_SET_ADD_SETS'); emitcall('FPC_SET_ADD_SETS');
end; end;
end; end;
@ -641,6 +650,7 @@ interface
{ The same here } { The same here }
del_location(left.location); del_location(left.location);
emitpushreferenceaddr(left.location.reference); emitpushreferenceaddr(left.location.reference);
saveregvars(regstopush);
case nodetype of case nodetype of
subn : emitcall('FPC_SET_SUB_SETS'); subn : emitcall('FPC_SET_SUB_SETS');
symdifn : emitcall('FPC_SET_SYMDIF_SETS'); symdifn : emitcall('FPC_SET_SYMDIF_SETS');
@ -1672,6 +1682,7 @@ interface
emit_pushq_loc(hloc); emit_pushq_loc(hloc);
clear_location(hloc); clear_location(hloc);
emit_pushq_loc(right.location); emit_pushq_loc(right.location);
saveregvars($ff);
if porddef(resulttype)^.typ=u64bit then if porddef(resulttype)^.typ=u64bit then
emitcall('FPC_MUL_QWORD') emitcall('FPC_MUL_QWORD')
else else
@ -2288,7 +2299,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.5 2000-11-29 00:30:45 florian Revision 1.6 2000-12-05 11:44:32 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.5 2000/11/29 00:30:45 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

60
compiler/i386/n386cal.pas
View File

@ -63,7 +63,7 @@ implementation
hcodegen,temp_gen,pass_2, hcodegen,temp_gen,pass_2,
cpubase,cpuasm, cpubase,cpuasm,
nmem,nld, nmem,nld,
cgai386,tgcpu,n386ld,n386util; cgai386,tgcpu,n386ld,n386util,regvars;
{***************************************************************************** {*****************************************************************************
TI386CALLPARANODE TI386CALLPARANODE
@ -266,10 +266,10 @@ implementation
{ we must pop this size also after !! } { we must pop this size also after !! }
{ must_pop : boolean; } { must_pop : boolean; }
pop_size : longint; pop_size : longint;
pop_allowed : boolean;
pop_esp : boolean;
push_size : longint; push_size : longint;
pop_esp : boolean;
pop_allowed : boolean;
regs_to_push : byte;
label label
dont_call; dont_call;
@ -341,14 +341,16 @@ implementation
iolabel:=nil; iolabel:=nil;
{ save all used registers } { save all used registers }
pushusedregisters(pushed,pprocdef(procdefinition)^.usedregisters); regs_to_push := pprocdef(procdefinition)^.usedregisters;
pushusedregisters(pushed,regs_to_push);
{ give used registers through } { give used registers through }
usedinproc:=usedinproc or pprocdef(procdefinition)^.usedregisters; usedinproc:=usedinproc or pprocdef(procdefinition)^.usedregisters;
end end
else else
begin begin
pushusedregisters(pushed,$ff); regs_to_push := $ff;
pushusedregisters(pushed,regs_to_push);
usedinproc:=$ff; usedinproc:=$ff;
{ no IO check for methods and procedure variables } { no IO check for methods and procedure variables }
iolabel:=nil; iolabel:=nil;
@ -876,6 +878,8 @@ implementation
internalerror(25000); internalerror(25000);
end; end;
saveregvars(regs_to_push);
if (po_virtualmethod in procdefinition^.procoptions) and if (po_virtualmethod in procdefinition^.procoptions) and
not(no_virtual_call) then not(no_virtual_call) then
begin begin
@ -1020,6 +1024,7 @@ implementation
emit_reg(A_PUSH,S_L,R_ESI); emit_reg(A_PUSH,S_L,R_ESI);
end; end;
saveregvars($ff);
if hregister=R_NO then if hregister=R_NO then
emit_ref(A_CALL,S_NO,newreference(right.location.reference)) emit_ref(A_CALL,S_NO,newreference(right.location.reference))
else else
@ -1039,6 +1044,7 @@ implementation
end end
else else
begin begin
saveregvars($ff);
case right.location.loc of case right.location.loc of
LOC_REGISTER,LOC_CREGISTER: LOC_REGISTER,LOC_CREGISTER:
begin begin
@ -1393,6 +1399,7 @@ implementation
oldunused,oldusableregs : tregisterset; oldunused,oldusableregs : tregisterset;
oldc_usableregs : longint; oldc_usableregs : longint;
oldreg_pushes : regvar_longintarray; oldreg_pushes : regvar_longintarray;
oldregvar_loaded,
oldis_reg_var : regvar_booleanarray; oldis_reg_var : regvar_booleanarray;
{$ifdef TEMPREGDEBUG} {$ifdef TEMPREGDEBUG}
oldreg_user : regvar_ptreearray; oldreg_user : regvar_ptreearray;
@ -1410,19 +1417,13 @@ implementation
with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
for i := 1 to maxvarregs do for i := 1 to maxvarregs do
if assigned(regvars[i]) then if assigned(regvars[i]) then
begin store_regvar(exprasmlist,regvars[i]^.reg);
case regsize(regvars[i]^.reg) of
S_B: tmpreg := reg8toreg32(regvars[i]^.reg);
S_W: tmpreg := reg16toreg32(regvars[i]^.reg);
S_L: tmpreg := regvars[i]^.reg;
end;
exprasmlist^.concat(new(pairegalloc,dealloc(tmpreg)));
end;
oldunused := unused; oldunused := unused;
oldusableregs := usableregs; oldusableregs := usableregs;
oldc_usableregs := c_usableregs; oldc_usableregs := c_usableregs;
oldreg_pushes := reg_pushes; oldreg_pushes := reg_pushes;
oldis_reg_var := is_reg_var; oldis_reg_var := is_reg_var;
oldregvar_loaded := regvar_loaded;
{$ifdef TEMPREGDEBUG} {$ifdef TEMPREGDEBUG}
oldreg_user := reg_user; oldreg_user := reg_user;
oldreg_releaser := reg_releaser; oldreg_releaser := reg_releaser;
@ -1566,25 +1567,15 @@ implementation
{ procedure (JM) } { procedure (JM) }
if assigned(aktprocsym^.definition^.regvarinfo) then if assigned(aktprocsym^.definition^.regvarinfo) then
begin begin
with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do unused := oldunused;
for i := 1 to maxvarregs do usableregs := oldusableregs;
if assigned(regvars[i]) then c_usableregs := oldc_usableregs;
begin reg_pushes := oldreg_pushes;
case regsize(regvars[i]^.reg) of is_reg_var := oldis_reg_var;
S_B: tmpreg := reg8toreg32(regvars[i]^.reg); regvar_loaded := oldregvar_loaded;
S_W: tmpreg := reg16toreg32(regvars[i]^.reg);
S_L: tmpreg := regvars[i]^.reg;
end;
exprasmlist^.concat(new(pairegalloc,alloc(tmpreg)));
end;
oldunused := oldunused;
oldusableregs := oldusableregs;
oldc_usableregs := oldc_usableregs;
oldreg_pushes := oldreg_pushes;
oldis_reg_var := oldis_reg_var;
{$ifdef TEMPREGDEBUG} {$ifdef TEMPREGDEBUG}
oldreg_user := oldreg_user; reg_user := oldreg_user;
oldreg_releaser := oldreg_releaser; reg_releaser := oldreg_releaser;
{$endif TEMPREGDEBUG} {$endif TEMPREGDEBUG}
end; end;
end; end;
@ -1597,7 +1588,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.12 2000-12-03 22:26:54 florian Revision 1.13 2000-12-05 11:44:33 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.12 2000/12/03 22:26:54 florian
* fixed web buzg 1275: problem with int64 functions results * fixed web buzg 1275: problem with int64 functions results
Revision 1.11 2000/11/29 00:30:46 florian Revision 1.11 2000/11/29 00:30:46 florian

15
compiler/i386/n386cnv.pas
View File

@ -279,6 +279,7 @@ implementation
release_loc(left.location); release_loc(left.location);
emit_push_lea_loc(left.location,true); emit_push_lea_loc(left.location,true);
emit_push_lea_loc(location,false); emit_push_lea_loc(location,false);
saveregvars(regs_to_push);
emitcall('FPC_SHORTSTR_TO_ANSISTR'); emitcall('FPC_SHORTSTR_TO_ANSISTR');
maybe_loadesi; maybe_loadesi;
popusedregisters(pushed); popusedregisters(pushed);
@ -440,6 +441,7 @@ implementation
end; end;
push_int(arrsize); push_int(arrsize);
push_int(strtype); push_int(strtype);
saveregvars(regstopush);
emitcall('FPC_STR_TO_CHARARRAY'); emitcall('FPC_STR_TO_CHARARRAY');
popusedregisters(pushedregs); popusedregisters(pushedregs);
end; end;
@ -517,6 +519,7 @@ implementation
emit_push_lea_loc(left.location,true); emit_push_lea_loc(left.location,true);
del_reference(left.location.reference); del_reference(left.location.reference);
emitpushreferenceaddr(location.reference); emitpushreferenceaddr(location.reference);
saveregvars(regstopush);
emitcall('FPC_CHARARRAY_TO_SHORTSTR'); emitcall('FPC_CHARARRAY_TO_SHORTSTR');
maybe_loadesi; maybe_loadesi;
popusedregisters(pushed); popusedregisters(pushed);
@ -532,6 +535,7 @@ implementation
emitpushreferenceaddr(left.location.reference); emitpushreferenceaddr(left.location.reference);
release_loc(left.location); release_loc(left.location);
emitpushreferenceaddr(location.reference); emitpushreferenceaddr(location.reference);
saveregvars(regstopush);
emitcall('FPC_CHARARRAY_TO_ANSISTR'); emitcall('FPC_CHARARRAY_TO_ANSISTR');
popusedregisters(pushed); popusedregisters(pushed);
maybe_loadesi; maybe_loadesi;
@ -571,6 +575,7 @@ implementation
pushusedregisters(pushed,$ff); pushusedregisters(pushed,$ff);
emit_pushw_loc(left.location); emit_pushw_loc(left.location);
emitpushreferenceaddr(location.reference); emitpushreferenceaddr(location.reference);
saveregvars($ff);
emitcall('FPC_CHAR_TO_ANSISTR'); emitcall('FPC_CHAR_TO_ANSISTR');
popusedregisters(pushed); popusedregisters(pushed);
maybe_loadesi; maybe_loadesi;
@ -1102,6 +1107,7 @@ implementation
gettempofsizereference(32,href); gettempofsizereference(32,href);
emit_push_mem_size(left.location.reference,4); emit_push_mem_size(left.location.reference,4);
emitpushreferenceaddr(href); emitpushreferenceaddr(href);
saveregvars($ff);
emitcall('FPC_SET_LOAD_SMALL'); emitcall('FPC_SET_LOAD_SMALL');
maybe_loadesi; maybe_loadesi;
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -1166,6 +1172,7 @@ implementation
end; end;
end; end;
emitpushreferenceaddr(location.reference); emitpushreferenceaddr(location.reference);
saveregvars($ff);
emitcall('FPC_PCHAR_TO_SHORTSTR'); emitcall('FPC_PCHAR_TO_SHORTSTR');
maybe_loadesi; maybe_loadesi;
popusedregisters(pushed); popusedregisters(pushed);
@ -1196,6 +1203,7 @@ implementation
end; end;
end; end;
emitpushreferenceaddr(location.reference); emitpushreferenceaddr(location.reference);
saveregvars(regs_to_push);
emitcall('FPC_PCHAR_TO_ANSISTR'); emitcall('FPC_PCHAR_TO_ANSISTR');
maybe_loadesi; maybe_loadesi;
popusedregisters(pushed); popusedregisters(pushed);
@ -1419,6 +1427,7 @@ implementation
end; end;
else internalerror(100); else internalerror(100);
end; end;
saveregvars($ff);
emitcall('FPC_DO_IS'); emitcall('FPC_DO_IS');
emit_reg_reg(A_OR,S_B,R_AL,R_AL); emit_reg_reg(A_OR,S_B,R_AL,R_AL);
popusedregisters(pushed); popusedregisters(pushed);
@ -1469,6 +1478,7 @@ implementation
end; end;
else internalerror(100); else internalerror(100);
end; end;
saveregvars($ff);
emitcall('FPC_DO_AS'); emitcall('FPC_DO_AS');
{ restore register, this restores automatically the } { restore register, this restores automatically the }
{ result } { result }
@ -1483,7 +1493,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.8 2000-11-29 00:30:46 florian Revision 1.9 2000-12-05 11:44:33 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.8 2000/11/29 00:30:46 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

39
compiler/i386/n386flw.pas
View File

@ -90,7 +90,7 @@ implementation
hcodegen,temp_gen,pass_2, hcodegen,temp_gen,pass_2,
cpubase,cpuasm, cpubase,cpuasm,
pass_1,nld,ncon, pass_1,nld,ncon,
cgai386,tgcpu,n386util; cgai386,tgcpu,n386util,regvars;
{***************************************************************************** {*****************************************************************************
Second_While_RepeatN Second_While_RepeatN
@ -102,6 +102,9 @@ implementation
oldclabel,oldblabel : pasmlabel; oldclabel,oldblabel : pasmlabel;
otlabel,oflabel : pasmlabel; otlabel,oflabel : pasmlabel;
start_regvars_loaded,
then_regvars_loaded: regvar_booleanarray;
begin begin
getlabel(lloop); getlabel(lloop);
getlabel(lcont); getlabel(lcont);
@ -110,6 +113,7 @@ implementation
oldclabel:=aktcontinuelabel; oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel; oldblabel:=aktbreaklabel;
load_all_regvars(exprasmlist);
{ handling code at the end as it is much more efficient, and makes { handling code at the end as it is much more efficient, and makes
while equal to repeat loop, only the end true/false is swapped (PFV) } while equal to repeat loop, only the end true/false is swapped (PFV) }
if nodetype=whilen then if nodetype=whilen then
@ -122,6 +126,9 @@ implementation
cleartempgen; cleartempgen;
if assigned(right) then if assigned(right) then
secondpass(right); secondpass(right);
load_all_regvars(exprasmlist);
emitlab(lcont); emitlab(lcont);
otlabel:=truelabel; otlabel:=truelabel;
oflabel:=falselabel; oflabel:=falselabel;
@ -138,11 +145,15 @@ implementation
end; end;
cleartempgen; cleartempgen;
secondpass(left); secondpass(left);
load_all_regvars(exprasmlist);
maketojumpbool(left); maketojumpbool(left);
emitlab(lbreak); emitlab(lbreak);
truelabel:=otlabel; truelabel:=otlabel;
falselabel:=oflabel; falselabel:=oflabel;
aktcontinuelabel:=oldclabel; aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel; aktbreaklabel:=oldblabel;
{ a break/continue in a while/repeat block can't be seen outside } { a break/continue in a while/repeat block can't be seen outside }
@ -166,12 +177,15 @@ implementation
getlabel(falselabel); getlabel(falselabel);
cleartempgen; cleartempgen;
secondpass(left); secondpass(left);
load_all_regvars(exprasmlist);
maketojumpbool(left); maketojumpbool(left);
if assigned(right) then if assigned(right) then
begin begin
emitlab(truelabel); emitlab(truelabel);
cleartempgen; cleartempgen;
secondpass(right); secondpass(right);
{ automatically done for blocks, but not for statements (JM) }
load_all_regvars(exprasmlist);
end; end;
if assigned(t1) then if assigned(t1) then
begin begin
@ -185,6 +199,7 @@ implementation
emitlab(falselabel); emitlab(falselabel);
cleartempgen; cleartempgen;
secondpass(t1); secondpass(t1);
load_all_regvars(exprasmlist);
if assigned(right) then if assigned(right) then
emitlab(hl); emitlab(hl);
end end
@ -324,6 +339,8 @@ implementation
else else
hcond:=C_A; hcond:=C_A;
load_all_regvars(exprasmlist);
if not(omitfirstcomp) or temptovalue then if not(omitfirstcomp) or temptovalue then
emitjmp(hcond,aktbreaklabel); emitjmp(hcond,aktbreaklabel);
@ -336,7 +353,10 @@ implementation
{ help register must not be in instruction block } { help register must not be in instruction block }
cleartempgen; cleartempgen;
if assigned(t1) then if assigned(t1) then
begin
secondpass(t1); secondpass(t1);
load_all_regvars(exprasmlist);
end;
emitlab(aktcontinuelabel); emitlab(aktcontinuelabel);
@ -390,6 +410,7 @@ implementation
hcond:=C_GE hcond:=C_GE
else else
hcond:=C_AE; hcond:=C_AE;
load_all_regvars(exprasmlist);
emitjmp(hcond,aktbreaklabel); emitjmp(hcond,aktbreaklabel);
{ according to count direction DEC or INC... } { according to count direction DEC or INC... }
{ must be after the test because of 0 to 255 for bytes !! } { must be after the test because of 0 to 255 for bytes !! }
@ -434,6 +455,7 @@ implementation
label label
do_jmp; do_jmp;
begin begin
load_all_regvars(exprasmlist);
include(flowcontrol,fc_exit); include(flowcontrol,fc_exit);
if assigned(left) then if assigned(left) then
if left.nodetype=assignn then if left.nodetype=assignn then
@ -541,10 +563,8 @@ do_jmp:
emitjmp(C_None,aktexit2label); emitjmp(C_None,aktexit2label);
end end
else else
begin
emitjmp(C_None,aktexitlabel); emitjmp(C_None,aktexitlabel);
end; end;
end;
{***************************************************************************** {*****************************************************************************
@ -555,7 +575,10 @@ do_jmp:
begin begin
include(flowcontrol,fc_break); include(flowcontrol,fc_break);
if aktbreaklabel<>nil then if aktbreaklabel<>nil then
begin
load_all_regvars(exprasmlist);
emitjmp(C_None,aktbreaklabel) emitjmp(C_None,aktbreaklabel)
end
else else
CGMessage(cg_e_break_not_allowed); CGMessage(cg_e_break_not_allowed);
end; end;
@ -569,7 +592,10 @@ do_jmp:
begin begin
include(flowcontrol,fc_continue); include(flowcontrol,fc_continue);
if aktcontinuelabel<>nil then if aktcontinuelabel<>nil then
begin
load_all_regvars(exprasmlist);
emitjmp(C_None,aktcontinuelabel) emitjmp(C_None,aktcontinuelabel)
end
else else
CGMessage(cg_e_continue_not_allowed); CGMessage(cg_e_continue_not_allowed);
end; end;
@ -582,6 +608,7 @@ do_jmp:
procedure ti386gotonode.pass_2; procedure ti386gotonode.pass_2;
begin begin
load_all_regvars(exprasmlist);
emitjmp(C_None,labelnr); emitjmp(C_None,labelnr);
{ the assigned avoids only crashes if the label isn't defined } { the assigned avoids only crashes if the label isn't defined }
if assigned(labsym) and if assigned(labsym) and
@ -597,6 +624,7 @@ do_jmp:
procedure ti386labelnode.pass_2; procedure ti386labelnode.pass_2;
begin begin
load_all_regvars(exprasmlist);
emitlab(labelnr); emitlab(labelnr);
cleartempgen; cleartempgen;
secondpass(left); secondpass(left);
@ -1284,7 +1312,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.3 2000-11-29 00:30:47 florian Revision 1.4 2000-12-05 11:44:33 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.3 2000/11/29 00:30:47 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

22
compiler/i386/n386inl.pas
View File

@ -379,6 +379,7 @@ implementation
{ reset and rewrite to the inline list a call } { reset and rewrite to the inline list a call }
{ allways read only one record by element } { allways read only one record by element }
push_int(typedtyp^.size); push_int(typedtyp^.size);
saveregvars($ff);
if doread then if doread then
emitcall('FPC_TYPED_READ') emitcall('FPC_TYPED_READ')
else else
@ -434,6 +435,7 @@ implementation
if pararesult^.deftype=floatdef then if pararesult^.deftype=floatdef then
push_int(ord(orgfloattype)); push_int(ord(orgfloattype));
end; end;
saveregvars($ff);
case pararesult^.deftype of case pararesult^.deftype of
stringdef : stringdef :
begin begin
@ -501,6 +503,7 @@ implementation
begin begin
pushusedregisters(pushed,$ff); pushusedregisters(pushed,$ff);
emit_push_mem(aktfile); emit_push_mem(aktfile);
saveregvars($ff);
if doread then if doread then
begin begin
if doln then if doln then
@ -649,6 +652,7 @@ implementation
if codegenerror then if codegenerror then
exit; exit;
saveregvars($ff);
if is_real then if is_real then
emitcall(procedureprefix+'FLOAT') emitcall(procedureprefix+'FLOAT')
else else
@ -778,6 +782,8 @@ implementation
procedureprefix := 'FPC_VAL_UINT_'; procedureprefix := 'FPC_VAL_UINT_';
end; end;
End; End;
saveregvars($ff);
emitcall(procedureprefix+pstringdef(node.resulttype)^.stringtypname); emitcall(procedureprefix+pstringdef(node.resulttype)^.stringtypname);
{ before disposing node we need to ungettemp !! PM } { before disposing node we need to ungettemp !! PM }
if node.left.location.loc in [LOC_REFERENCE,LOC_MEM] then if node.left.location.loc in [LOC_REFERENCE,LOC_MEM] then
@ -1341,6 +1347,7 @@ implementation
if codegenerror then if codegenerror then
exit; exit;
emitpushreferenceaddr(tcallparanode(left).left.location.reference); emitpushreferenceaddr(tcallparanode(left).left.location.reference);
saveregvars($ff);
if assigned(tcallparanode(left).right) then if assigned(tcallparanode(left).right) then
emitcall('FPC_FINALIZEARRAY') emitcall('FPC_FINALIZEARRAY')
else else
@ -1373,6 +1380,7 @@ implementation
emit_const(A_PUSH,S_L,pfiledef(left.resulttype)^.typedfiletype.def^.size); emit_const(A_PUSH,S_L,pfiledef(left.resulttype)^.typedfiletype.def^.size);
secondpass(left); secondpass(left);
emitpushreferenceaddr(left.location.reference); emitpushreferenceaddr(left.location.reference);
saveregvars($ff);
if inlinenumber=in_reset_typedfile then if inlinenumber=in_reset_typedfile then
emitcall('FPC_RESET_TYPED') emitcall('FPC_RESET_TYPED')
else else
@ -1436,6 +1444,7 @@ implementation
hr2.symbol:=pstoreddef(def)^.get_inittable_label; hr2.symbol:=pstoreddef(def)^.get_inittable_label;
emitpushreferenceaddr(hr2); emitpushreferenceaddr(hr2);
emitpushreferenceaddr(tcallparanode(hp).left.location.reference); emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
saveregvars($ff);
emitcall('FPC_DYNARR_SETLENGTH'); emitcall('FPC_DYNARR_SETLENGTH');
ungetiftemp(hr); ungetiftemp(hr);
end end
@ -1446,17 +1455,22 @@ implementation
st_widestring: st_widestring:
begin begin
emitpushreferenceaddr(tcallparanode(hp).left.location.reference); emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
saveregvars($ff);
emitcall('FPC_WIDESTR_SETLENGTH'); emitcall('FPC_WIDESTR_SETLENGTH');
end; end;
st_ansistring: st_ansistring:
begin begin
emitpushreferenceaddr(tcallparanode(hp).left.location.reference); emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
saveregvars($ff);
emitcall('FPC_ANSISTR_SETLENGTH'); emitcall('FPC_ANSISTR_SETLENGTH');
end; end;
st_shortstring: st_shortstring:
begin
saveregvars($ff);
emitcall('FPC_SHORTSTR_SETLENGTH'); emitcall('FPC_SHORTSTR_SETLENGTH');
end; end;
end; end;
end;
popusedregisters(pushed); popusedregisters(pushed);
end; end;
in_write_x : in_write_x :
@ -1503,8 +1517,11 @@ implementation
end end
else else
{ LOC_CREGISTER } { LOC_CREGISTER }
begin
secondpass(tcallparanode(left).left);
emit_const_reg(asmop,S_L, emit_const_reg(asmop,S_L,
l,tcallparanode(left).left.location.register); l,tcallparanode(left).left.location.register);
end;
end end
else else
begin begin
@ -1665,7 +1682,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.7 2000-11-29 00:30:47 florian Revision 1.8 2000-12-05 11:44:33 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.7 2000/11/29 00:30:47 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

20
compiler/i386/n386ld.pas
View File

@ -55,7 +55,7 @@ implementation
hcodegen,temp_gen,pass_2, hcodegen,temp_gen,pass_2,
nmem,ncon,ncnv, nmem,ncon,ncnv,
cpubase,cpuasm, cpubase,cpuasm,
cgai386,tgcpu,n386cnv,n386util; cgai386,tgcpu,n386cnv,n386util,regvars;
{***************************************************************************** {*****************************************************************************
SecondLoad SecondLoad
@ -154,11 +154,20 @@ implementation
location.register:=pvarsym(symtableentry)^.reg; location.register:=pvarsym(symtableentry)^.reg;
end end
else else
if not(makereg32(pvarsym(symtableentry)^.reg) in [R_EAX..R_EBX]) or
regvar_loaded[pvarsym(symtableentry)^.reg] then
begin begin
location.loc:=LOC_CREGISTER; location.loc:=LOC_CREGISTER;
location.register:=pvarsym(symtableentry)^.reg; location.register:=pvarsym(symtableentry)^.reg;
unused:=unused-[pvarsym(symtableentry)^.reg]; unused:=unused-[pvarsym(symtableentry)^.reg];
end; end
else
begin
load_regvar(exprasmlist,pvarsym(symtableentry));
location.loc:=LOC_CREGISTER;
location.register:=pvarsym(symtableentry)^.reg;
unused:=unused-[pvarsym(symtableentry)^.reg];
end
end end
else else
begin begin
@ -407,6 +416,7 @@ implementation
getlabel(truelabel); getlabel(truelabel);
getlabel(falselabel); getlabel(falselabel);
{ calculate left sides } { calculate left sides }
{ don't do it yet if it's a crgister (JM) }
if not(nf_concat_string in flags) then if not(nf_concat_string in flags) then
secondpass(left); secondpass(left);
@ -498,6 +508,7 @@ implementation
end; end;
emitpushreferenceaddr(left.location.reference); emitpushreferenceaddr(left.location.reference);
del_reference(left.location.reference); del_reference(left.location.reference);
saveregvars($ff);
emitcall('FPC_ANSISTR_ASSIGN'); emitcall('FPC_ANSISTR_ASSIGN');
maybe_loadesi; maybe_loadesi;
popusedregisters(regspushed); popusedregisters(regspushed);
@ -1050,7 +1061,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.9 2000-11-29 00:30:48 florian Revision 1.10 2000-12-05 11:44:33 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.9 2000/11/29 00:30:48 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

6
compiler/i386/n386mat.pas
View File

@ -110,6 +110,7 @@ implementation
opname:='DIV_' opname:='DIV_'
else else
opname:='MOD_'; opname:='MOD_';
saveregvars($ff);
emitcall('FPC_'+opname+typename); emitcall('FPC_'+opname+typename);
emit_reg_reg(A_MOV,S_L,R_EAX,location.registerlow); emit_reg_reg(A_MOV,S_L,R_EAX,location.registerlow);
@ -995,7 +996,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.7 2000-11-29 00:30:48 florian Revision 1.8 2000-12-05 11:44:33 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.7 2000/11/29 00:30:48 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

12
compiler/i386/n386mem.pas
View File

@ -142,6 +142,7 @@ implementation
{ determines the size of the mem block } { determines the size of the mem block }
push_int(ppointerdef(resulttype)^.pointertype.def^.size); push_int(ppointerdef(resulttype)^.pointertype.def^.size);
emit_push_lea_loc(location,false); emit_push_lea_loc(location,false);
saveregvars($ff);
emitcall('FPC_GETMEM'); emitcall('FPC_GETMEM');
if ppointerdef(resulttype)^.pointertype.def^.needs_inittable then if ppointerdef(resulttype)^.pointertype.def^.needs_inittable then
@ -212,6 +213,7 @@ implementation
exit; exit;
pushusedregisters(pushed,$ff); pushusedregisters(pushed,$ff);
saveregvars($ff);
{ call the mem handling procedures } { call the mem handling procedures }
case nodetype of case nodetype of
@ -481,6 +483,7 @@ implementation
end; end;
pushusedregisters(pushed,$ff); pushusedregisters(pushed,$ff);
emitpushreferenceaddr(left.location.reference); emitpushreferenceaddr(left.location.reference);
saveregvars($ff);
if is_ansistring(left.resulttype) then if is_ansistring(left.resulttype) then
emitcall('FPC_ANSISTR_UNIQUE') emitcall('FPC_ANSISTR_UNIQUE')
else else
@ -508,6 +511,7 @@ implementation
begin begin
pushusedregisters(pushed,$ff); pushusedregisters(pushed,$ff);
emit_reg(A_PUSH,S_L,location.reference.base); emit_reg(A_PUSH,S_L,location.reference.base);
saveregvars($ff);
emitcall('FPC_ANSISTR_CHECKZERO'); emitcall('FPC_ANSISTR_CHECKZERO');
maybe_loadesi; maybe_loadesi;
popusedregisters(pushed); popusedregisters(pushed);
@ -552,6 +556,7 @@ implementation
begin begin
pushusedregisters(pushed,$ff); pushusedregisters(pushed,$ff);
emit_reg(A_PUSH,S_L,location.reference.base); emit_reg(A_PUSH,S_L,location.reference.base);
saveregvars($ff);
emitcall('FPC_ANSISTR_CHECKZERO'); emitcall('FPC_ANSISTR_CHECKZERO');
maybe_loadesi; maybe_loadesi;
popusedregisters(pushed); popusedregisters(pushed);
@ -612,6 +617,7 @@ implementation
hp:=newreference(location.reference); hp:=newreference(location.reference);
dec(hp^.offset,7); dec(hp^.offset,7);
emit_ref(A_PUSH,S_L,hp); emit_ref(A_PUSH,S_L,hp);
saveregvars($ff);
emitcall('FPC_ANSISTR_RANGECHECK'); emitcall('FPC_ANSISTR_RANGECHECK');
popusedregisters(pushed); popusedregisters(pushed);
maybe_loadesi; maybe_loadesi;
@ -834,6 +840,7 @@ implementation
hp:=newreference(location.reference); hp:=newreference(location.reference);
dec(hp^.offset,7); dec(hp^.offset,7);
emit_ref(A_PUSH,S_L,hp); emit_ref(A_PUSH,S_L,hp);
saveregvars($ff);
emitcall('FPC_ANSISTR_RANGECHECK'); emitcall('FPC_ANSISTR_RANGECHECK');
popusedregisters(pushed); popusedregisters(pushed);
maybe_loadesi; maybe_loadesi;
@ -1053,7 +1060,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.6 2000-11-29 00:30:48 florian Revision 1.7 2000-12-05 11:44:33 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.6 2000/11/29 00:30:48 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

11
compiler/i386/n386set.pas
View File

@ -50,7 +50,7 @@ implementation
hcodegen,temp_gen,pass_2, hcodegen,temp_gen,pass_2,
ncon, ncon,
cpubase, cpubase,
cgai386,tgcpu,n386util; cgai386,tgcpu,n386util,regvars;
const const
bytes2Sxx:array[1..8] of Topsize=(S_B,S_W,S_NO,S_L,S_NO,S_NO,S_NO,S_Q); bytes2Sxx:array[1..8] of Topsize=(S_B,S_W,S_NO,S_L,S_NO,S_NO,S_NO,S_Q);
@ -950,6 +950,8 @@ implementation
{ we need the min_label always to choose between } { we need the min_label always to choose between }
{ cmps and subs/decs } { cmps and subs/decs }
min_label:=case_get_min(nodes); min_label:=case_get_min(nodes);
load_all_regvars(exprasmlist);
{ now generate the jumps } { now generate the jumps }
if opsize=S_Q then if opsize=S_Q then
genlinearcmplist(nodes) genlinearcmplist(nodes)
@ -1046,6 +1048,7 @@ implementation
secondpass(tbinarynode(hp).right); secondpass(tbinarynode(hp).right);
{ don't come back to case line } { don't come back to case line }
aktfilepos:=exprasmlist^.getlasttaifilepos^; aktfilepos:=exprasmlist^.getlasttaifilepos^;
load_all_regvars(exprasmlist);
emitjmp(C_None,endlabel); emitjmp(C_None,endlabel);
hp:=tbinarynode(hp).left; hp:=tbinarynode(hp).left;
end; end;
@ -1055,6 +1058,7 @@ implementation
begin begin
cleartempgen; cleartempgen;
secondpass(elseblock); secondpass(elseblock);
load_all_regvars(exprasmlist);
end; end;
emitlab(endlabel); emitlab(endlabel);
end; end;
@ -1067,7 +1071,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.6 2000-11-29 00:30:49 florian Revision 1.7 2000-12-05 11:44:34 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.6 2000/11/29 00:30:49 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

20
compiler/i386/n386util.pas
View File

@ -64,7 +64,7 @@ implementation
ncon,nld, ncon,nld,
pass_1,pass_2, pass_1,pass_2,
hcodegen,tgcpu,temp_gen, hcodegen,tgcpu,temp_gen,
cgai386; cgai386,regvars;
{***************************************************************************** {*****************************************************************************
@ -79,6 +79,11 @@ implementation
href : treference; href : treference;
{$endif TEMPS_NOT_PUSH} {$endif TEMPS_NOT_PUSH}
begin begin
if p.location.loc = LOC_CREGISTER then
begin
maybe_push := true;
exit;
end;
if needed>usablereg32 then if needed>usablereg32 then
begin begin
if (p.location.loc=LOC_REGISTER) then if (p.location.loc=LOC_REGISTER) then
@ -196,6 +201,11 @@ implementation
href : treference; href : treference;
{$endif TEMPS_NOT_PUSH} {$endif TEMPS_NOT_PUSH}
begin begin
if p.location.loc = LOC_CREGISTER then
begin
load_regvar_reg(exprasmlist,p.location.register);
exit;
end;
hregister:=getregister32; hregister:=getregister32;
{$ifdef TEMPS_NOT_PUSH} {$ifdef TEMPS_NOT_PUSH}
reset_reference(href); reset_reference(href);
@ -857,6 +867,7 @@ implementation
aktfilepos:=p.fileinfo; aktfilepos:=p.fileinfo;
if is_boolean(p.resulttype) then if is_boolean(p.resulttype) then
begin begin
load_all_regvars(exprasmlist);
if is_constboolnode(p) then if is_constboolnode(p) then
begin begin
if tordconstnode(p).value<>0 then if tordconstnode(p).value<>0 then
@ -1416,6 +1427,7 @@ implementation
end; end;
push_shortstring_length(dest); push_shortstring_length(dest);
emitpushreferenceaddr(dest.location.reference); emitpushreferenceaddr(dest.location.reference);
saveregvars($ff);
emitcall('FPC_ANSISTR_TO_SHORTSTR'); emitcall('FPC_ANSISTR_TO_SHORTSTR');
popusedregisters(pushed); popusedregisters(pushed);
maybe_loadesi; maybe_loadesi;
@ -1460,6 +1472,7 @@ implementation
end; end;
emitpushreferenceaddr(p.left.location.reference); emitpushreferenceaddr(p.left.location.reference);
del_reference(p.left.location.reference); del_reference(p.left.location.reference);
saveregvars($ff);
emitcall('FPC_INTF_ASSIGN'); emitcall('FPC_INTF_ASSIGN');
maybe_loadesi; maybe_loadesi;
popusedregisters(pushed); popusedregisters(pushed);
@ -1472,7 +1485,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.5 2000-11-29 00:30:49 florian Revision 1.6 2000-12-05 11:44:34 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.5 2000/11/29 00:30:49 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

31
compiler/i386/tgcpu.pas
View File

@ -75,6 +75,9 @@ interface
procedure pushusedregisters(var pushed : tpushed;b : byte); procedure pushusedregisters(var pushed : tpushed;b : byte);
procedure popusedregisters(const pushed : tpushed); procedure popusedregisters(const pushed : tpushed);
{ saves register variables (restoring happens automatically (JM) }
procedure saveregvars(b: byte);
{ saves and restores used registers to temp. values } { saves and restores used registers to temp. values }
procedure saveusedregisters(var saved : tsaved;b : byte); procedure saveusedregisters(var saved : tsaved;b : byte);
procedure restoreusedregisters(const saved : tsaved); procedure restoreusedregisters(const saved : tsaved);
@ -112,6 +115,8 @@ interface
{ variable } { variable }
reg_pushes : regvar_longintarray; reg_pushes : regvar_longintarray;
is_reg_var : regvar_booleanarray; is_reg_var : regvar_booleanarray;
regvar_loaded: regvar_booleanarray;
{$ifdef TEMPREGDEBUG} {$ifdef TEMPREGDEBUG}
reg_user : regvar_ptreearray; reg_user : regvar_ptreearray;
reg_releaser : regvar_ptreearray; reg_releaser : regvar_ptreearray;
@ -121,7 +126,7 @@ interface
implementation implementation
uses uses
globtype,temp_gen; globtype,temp_gen,regvars;
procedure incrementregisterpushed(b : byte); procedure incrementregisterpushed(b : byte);
@ -152,6 +157,7 @@ implementation
if ((b and ($80 shr byte(r)))<>0) then if ((b and ($80 shr byte(r)))<>0) then
begin begin
{ and is present in use } { and is present in use }
if not is_reg_var[r] then
if not(r in unused) then if not(r in unused) then
begin begin
{ then save it } { then save it }
@ -204,6 +210,22 @@ implementation
{$endif TEMPREGDEBUG} {$endif TEMPREGDEBUG}
end; end;
procedure saveregvars(b: byte);
var
r : tregister;
begin
if not(cs_regalloc in aktglobalswitches) then
exit;
for r:=R_EAX to R_EBX do
{ if the register is used by the calling subroutine }
if ((b and ($80 shr byte(r)))<>0) and is_reg_var[r] then
store_regvar(exprasmlist,r)
end;
procedure saveusedregisters(var saved : tsaved;b : byte); procedure saveusedregisters(var saved : tsaved;b : byte);
var var
@ -645,6 +667,8 @@ implementation
usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX]; usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX];
c_usableregs:=4; c_usableregs:=4;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
fillchar(regvar_loaded,sizeof(regvar_loaded),false);
fillchar(is_reg_var,sizeof(is_reg_var),false);
fpuvaroffset:=0; fpuvaroffset:=0;
end; end;
@ -653,7 +677,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.1 2000-11-29 00:30:51 florian Revision 1.2 2000-12-05 11:44:34 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.1 2000/11/29 00:30:51 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings

175
compiler/regvars.pas
View File

@ -28,20 +28,27 @@ interface
uses uses
aasm, aasm,
node; node,
symsym,
cpubase;
procedure assign_regvars(p: tnode); procedure assign_regvars(p: tnode);
procedure load_regvars(asml: paasmoutput; p: tnode); procedure load_regvars(asml: paasmoutput; p: tnode);
procedure cleanup_regvars(asml: paasmoutput); procedure cleanup_regvars(asml: paasmoutput);
{$ifdef i386}
procedure store_regvar(asml: paasmoutput; reg: tregister);
procedure load_regvar(asml: paasmoutput; vsym: pvarsym);
procedure load_regvar_reg(asml: paasmoutput; reg: tregister);
procedure load_all_regvars(asml: paasmoutput);
{$endif i386}
implementation implementation
uses uses
globtype,systems,comphook, globtype,systems,comphook,
cutils,cobjects,verbose,globals, cutils,cobjects,verbose,globals,
symconst,symbase,symtype,symdef,symsym,types, symconst,symbase,symtype,symdef,types,
hcodegen,cpubase,cpuasm,tgcpu; hcodegen,cpuasm,tgcpu;
var var
@ -278,48 +285,52 @@ implementation
end; end;
procedure load_regvars(asml: paasmoutput; p: tnode); {$ifdef i386}
procedure store_regvar(asml: paasmoutput; reg: tregister);
var var
i: longint; i: longint;
hr: preference; hr: preference;
regvarinfo: pregvarinfo; regvarinfo: pregvarinfo;
{$ifdef i386} vsym: pvarsym;
opsize: topsize;
opcode: tasmop;
signed: boolean;
{$endif i386}
begin
if (cs_regalloc in aktglobalswitches) and
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
begin begin
regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo); regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
{ can happen when inlining assembler procedures (JM) }
if not assigned(regvarinfo) then if not assigned(regvarinfo) then
exit; exit;
for i := 1 to maxvarregs do for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) and
(reg32(regvarinfo^.regvars[i]^.reg) = reg) then
begin begin
{ parameter must be load } if regvar_loaded[reg32(reg)] then
if regvarinfo^.regvars_para[i] then
begin begin
{$ifdef i386} vsym := pvarsym(regvarinfo^.regvars[i]);
asml^.concat(new(pairegalloc,alloc(reg32(regvarinfo^.regvars[i]^.reg))));
{$endif i386}
{ procinfo is there actual, }
{ because we can't never be in a }
{ nested procedure }
{ when loading parameter to reg }
new(hr); new(hr);
reset_reference(hr^); reset_reference(hr^);
hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset; if vsym^.owner^.symtabletype in [inlinelocalsymtable,localsymtable] then
hr^.offset:=-vsym^.address+vsym^.owner^.address_fixup
else hr^.offset:=vsym^.address+vsym^.owner^.address_fixup;
hr^.base:=procinfo^.framepointer; hr^.base:=procinfo^.framepointer;
{$ifdef i386} asml^.concat(new(paicpu,op_reg_ref(A_MOV,regsize(vsym^.reg),vsym^.reg,hr)));
asml^.concat(new(pairegalloc,dealloc(reg32(reg))));
regvar_loaded[reg32(reg)] := false;
end;
break;
end;
end;
procedure load_regvar(asml: paasmoutput; vsym: pvarsym);
var
hr: preference;
opsize: topsize;
opcode: tasmop;
begin
if not regvar_loaded[reg32(vsym^.reg)] then
begin
asml^.concat(new(pairegalloc,alloc(reg32(vsym^.reg))));
{ zero the regvars because the upper 48bits must be clear } { zero the regvars because the upper 48bits must be clear }
{ for 8bits vars when using them with btrl (JM) } { for 8bits vars when using them with btrl }
signed := { don't care about sign extension, since the upper 24/16 }
(pvarsym(regvarinfo^.regvars[i])^.vartype.def^.deftype = { bits won't be adapted when doing maths anyway (JM) }
orddef) and case regsize(vsym^.reg) of
is_signed(pvarsym(regvarinfo^.regvars[i])^.vartype.def);
case regsize(regvarinfo^.regvars[i]^.reg) of
S_L: S_L:
begin begin
opsize := S_L; opsize := S_L;
@ -328,43 +339,95 @@ implementation
S_W: S_W:
begin begin
opsize := S_WL; opsize := S_WL;
if signed then opcode := A_MOVZX;
opcode := A_MOVSX
else opcode := A_MOVZX;
end; end;
S_B: S_B:
begin begin
opsize := S_BL; opsize := S_BL;
if signed then opcode := A_MOVZX;
opcode := A_MOVSX
else opcode := A_MOVZX;
end; end;
end; end;
asml^.concat(new(paicpu,op_ref_reg(opcode,opsize, asml^.concat(new(pairegalloc,alloc(reg32(vsym^.reg))));
hr,reg32(regvarinfo^.regvars[i]^.reg)))); new(hr);
reset_reference(hr^);
if vsym^.owner^.symtabletype in [inlinelocalsymtable,localsymtable] then
hr^.offset:=-vsym^.address+vsym^.owner^.address_fixup
else hr^.offset:=vsym^.address+vsym^.owner^.address_fixup;
hr^.base:=procinfo^.framepointer;
asml^.concat(new(paicpu,op_ref_reg(opcode,opsize,hr,reg32(vsym^.reg))));
regvar_loaded[reg32(vsym^.reg)] := true;
end;
end;
procedure load_regvar_reg(asml: paasmoutput; reg: tregister);
var
i: longint;
regvarinfo: pregvarinfo;
vsym: pvarsym;
begin
regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
if not assigned(regvarinfo) then
exit;
reg := reg32(reg);
for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) and
(reg32(regvarinfo^.regvars[i]^.reg) = reg) then
load_regvar(asml,pvarsym(regvarinfo^.regvars[i]))
end;
procedure load_all_regvars(asml: paasmoutput);
var
i: longint;
regvarinfo: pregvarinfo;
begin
regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
if not assigned(regvarinfo) then
exit;
for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) and
(reg32(regvarinfo^.regvars[i]^.reg) in [R_EAX,R_EBX,R_ECX,R_EDX]) then
load_regvar(asml,pvarsym(regvarinfo^.regvars[i]))
end;
{$endif i386} {$endif i386}
procedure load_regvars(asml: paasmoutput; p: tnode);
var
i: longint;
hr : preference;
regvarinfo: pregvarinfo;
begin
if (cs_regalloc in aktglobalswitches) and
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
begin
regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
{ can happen when inlining assembler procedures (JM) }
if not assigned(regvarinfo) then
exit;
{$ifdef m68k} {$ifdef m68k}
for i:=1 to maxvarregs do
begin
{ parameter must be load }
if regvarinfo^.regvars_para[i] then
begin
{ procinfo is there actual, }
{ because we can't never be in a }
{ nested procedure }
{ when loading parameter to reg }
new(hr);
reset_reference(hr^);
hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
hr^.base:=procinfo^.framepointer;
asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg), asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
hr,regvarinfo^.regvars[i]^.reg))); hr,regvarinfo^.regvars[i]^.reg)));
{$endif m68k}
end end
end; end;
{$endif m68k}
for i:=1 to maxvarregs do for i:=1 to maxvarregs do
begin begin
if assigned(regvarinfo^.regvars[i]) then if assigned(regvarinfo^.regvars[i]) then
begin begin
{$ifdef i386}
if not(regvarinfo^.regvars_para[i]) then
begin
asml^.concat(new(pairegalloc,alloc(reg32(regvarinfo^.regvars[i]^.reg))));
{ zero the regvars because the upper 48bits must be clear }
{ for 8bits vars when using them with btrl (JM) }
if (regsize(regvarinfo^.regvars[i]^.reg) in [S_B,S_W]) then
asml^.concat(new(paicpu,op_reg_reg(A_XOR,S_L,
reg32(regvarinfo^.regvars[i]^.reg),
reg32(regvarinfo^.regvars[i]^.reg))));
end;
{$endif i386}
if cs_asm_source in aktglobalswitches then if cs_asm_source in aktglobalswitches then
asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.regvars[i]^.name+ asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.regvars[i]^.name+
' with weight '+tostr(regvarinfo^.regvars[i]^.refs)+' assigned to register '+ ' with weight '+tostr(regvarinfo^.regvars[i]^.refs)+' assigned to register '+
@ -447,7 +510,8 @@ implementation
{ ... and clean it up } { ... and clean it up }
asml^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0))); asml^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
for i := 1 to maxvarregs do for i := 1 to maxvarregs do
if assigned(regvars[i]) then if assigned(regvars[i]) and
(regvar_loaded[reg32(regvars[i]^.reg)]) then
asml^.concat(new(pairegalloc,dealloc(reg32(regvars[i]^.reg)))); asml^.concat(new(pairegalloc,dealloc(reg32(regvars[i]^.reg))));
end; end;
{$endif i386} {$endif i386}
@ -457,7 +521,10 @@ end.
{ {
$Log$ $Log$
Revision 1.13 2000-11-29 00:30:39 florian Revision 1.14 2000-12-05 11:44:32 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.13 2000/11/29 00:30:39 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings