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

* regvar fixes

Browse Source
This commit is contained in:
peter 2003-05-16 14:33:31 +00:00
parent 1d3a842c07
commit abca40f041
12 changed files with 373 additions and 222 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
compiler/i386/cpubase.inc
View File

@ -63,6 +63,10 @@
'xmm0','xmm1','xmm2','xmm3','xmm4','xmm5','xmm6','xmm7'
);
{*****************************************************************************
Constants
*****************************************************************************}
firstsaveintreg = RS_EAX;
lastsaveintreg = RS_EDX;
firstsavefpureg = R_NO;
@ -70,6 +74,34 @@
firstsavemmreg = R_MM0;
lastsavemmreg = R_MM7;
general_registers = [R_EAX,R_EBX,R_ECX,R_EDX];
general_superregisters = [RS_EAX,RS_EBX,RS_ECX,RS_EDX];
{$ifdef newra}
usableregsint = [first_imreg..last_imreg];
{$else}
usableregsint = [RS_EAX,RS_EBX,RS_ECX,RS_EDX];
{$endif}
c_countusableregsint = 4;
maxaddrregs = 1;
addrregs = [R_ESI];
usableregsaddr = [RS_ESI];
c_countusableregsaddr = 1;
maxvarregs = 4;
varregs : array[1..maxvarregs] of tnewregister =
(RS_EBX,RS_EDX,RS_ECX,RS_EAX);
maxfpuvarregs = 8;
{# Registers which are defined as scratch and no need to save across
routine calls or in assembler blocks.
}
{$ifndef newra}
max_scratch_regs = 1;
scratch_regs : array[1..max_scratch_regs] of Tsuperregister = (RS_EDI);
{$endif}
{*****************************************************************************
GDB Information
*****************************************************************************}
@ -170,7 +202,13 @@
{
$Log$
Revision 1.1 2003-04-25 11:12:09 florian
Revision 1.3 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.2 2002/04/25 16:12:09 florian
* fixed more problems with cpubase and x86-64
Revision 1.1 2003/04/25 11:12:09 florian
* merged i386/cpubase and x86_64/cpubase to x86/cpubase;
different stuff went to cpubase.inc
}
}

9
compiler/i386/csopt386.pas
View File

@ -105,7 +105,7 @@ begin
if (p.ops = 1) then
begin
r.enum:=R_EDX;
if rg.is_reg_var[R_EDX] and
if (RS_EDX in rg.is_reg_var_int) and
(not getNextInstruction(p,hp) or
not((hp.typ = ait_instruction) and
(hp.opcode = A_MOV) and
@ -125,7 +125,7 @@ begin
else
{ only possible for imul }
{ last operand is always destination }
if rg.is_reg_var[reg32(p.oper[p.ops-1].reg).enum] then
if ((p.oper[p.ops-1].reg.number shr 8) in rg.is_reg_var_int) then
for regCounter.enum := R_EAX to R_EDI do
begin
if writeDestroysContents(p.oper[p.ops-1],regCounter,c[regCounter.enum]) then
@ -1997,7 +1997,10 @@ End.
{
$Log$
Revision 1.44 2003-04-27 11:21:35 peter
Revision 1.45 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.44 2003/04/27 11:21:35 peter
* aktprocdef renamed to current_procdef
* procinfo renamed to current_procinfo
* procinfo will now be stored in current_module so it can be

23
compiler/i386/rgcpu.pas
View File

@ -64,7 +64,7 @@ unit rgcpu;
const s:Tsupregset);
{$ifdef SUPPORT_MMX}
procedure pushusedotherregisters(list:Taasmoutput;
var pushed:Tpushedsaved;
var pushed:Tpushedsavedother;
const s:Tregisterset);
{$endif SUPPORT_MMX}
@ -72,19 +72,19 @@ unit rgcpu;
const pushed:Tpushedsavedint);
{$ifdef SUPPORT_MMX}
procedure popusedotherregisters(list:Taasmoutput;
const pushed:Tpushedsaved);
const pushed:Tpushedsavedother);
{$endif SUPPORT_MMX}
procedure saveusedintregisters(list:Taasmoutput;
var saved:Tpushedsavedint;
const s:Tsupregset);override;
procedure saveusedotherregisters(list:Taasmoutput;
var saved:Tpushedsaved;
var saved:Tpushedsavedother;
const s:Tregisterset);override;
procedure restoreusedintregisters(list:Taasmoutput;
const saved:Tpushedsavedint);override;
procedure restoreusedotherregisters(list:Taasmoutput;
const saved:Tpushedsaved);override;
const saved:Tpushedsavedother);override;
procedure resetusableregisters;override;
@ -386,7 +386,7 @@ unit rgcpu;
{$ifdef SUPPORT_MMX}
procedure trgcpu.pushusedotherregisters(list:Taasmoutput;
var pushed:Tpushedsaved;
var pushed:Tpushedsavedother;
const s:Tregisterset);
var r:Toldregister;
@ -399,7 +399,7 @@ unit rgcpu;
begin
pushed[r].pushed:=false;
{ if the register is used by the calling subroutine }
if not is_reg_var[r] and
if not is_reg_var_other[r] and
(r in s) and
{ and is present in use }
not(r in unusedregsmm) then
@ -451,7 +451,7 @@ unit rgcpu;
{$ifdef SUPPORT_MMX}
procedure trgcpu.popusedotherregisters(list:Taasmoutput;
const pushed:Tpushedsaved);
const pushed:Tpushedsavedother);
var r:Toldregister;
r2,r3:Tregister;
@ -495,7 +495,7 @@ unit rgcpu;
end;
procedure trgcpu.saveusedotherregisters(list:Taasmoutput;var saved:Tpushedsaved;
procedure trgcpu.saveusedotherregisters(list:Taasmoutput;var saved:Tpushedsavedother;
const s:tregisterset);
begin
@ -521,7 +521,7 @@ unit rgcpu;
end;
procedure trgcpu.restoreusedotherregisters(list:Taasmoutput;
const saved:tpushedsaved);
const saved:tpushedsavedother);
begin
{$ifdef SUPPORT_MMX}
@ -581,7 +581,10 @@ end.
{
$Log$
Revision 1.21 2003-04-25 08:25:26 daniel
Revision 1.22 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.21 2003/04/25 08:25:26 daniel
* Ifdefs around a lot of calls to cleartempgen
* Fixed registers that are allocated but not freed in several nodes
* Tweak to register allocator to cause less spills

37
compiler/ncal.pas
View File

@ -174,8 +174,6 @@ interface
end;
tprocinlinenodeclass = class of tprocinlinenode;
function initialize_data_node(p:tnode):tnode;
function finalize_data_node(p:tnode):tnode;
function reverseparameters(p: tcallparanode): tcallparanode;
@ -225,36 +223,6 @@ type
end;
function initialize_data_node(p:tnode):tnode;
begin
result:=ccallnode.createintern('fpc_initialize',
ccallparanode.create(
caddrnode.create(
crttinode.create(
tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
ccallparanode.create(
p,
nil)));
end;
function finalize_data_node(p:tnode):tnode;
begin
if not assigned(p.resulttype.def) then
resulttypepass(p);
if p.resulttype.def.deftype<>pointerdef then
internalerror(2003051010);
result:=ccallnode.createintern('fpc_finalize',
ccallparanode.create(
caddrnode.create(
crttinode.create(
tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
ccallparanode.create(
p,
nil)));
end;
function gen_high_tree(p:tnode;openstring:boolean):tnode;
var
temp: tnode;
@ -2744,7 +2712,10 @@ begin
end.
{
$Log$
Revision 1.154 2003-05-14 19:35:50 jonas
Revision 1.155 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.154 2003/05/14 19:35:50 jonas
* fixed callparatemp so it works with vs_var, vs_out and formal const
parameters

13
compiler/ncgcal.pas
View File

@ -539,7 +539,7 @@ implementation
regs_to_push_int : Tsupregset;
regs_to_push_other : tregisterset;
unusedstate: pointer;
pushed : tpushedsaved;
pushedother : tpushedsavedother;
pushedint : tpushedsavedint;
oldpushedparasize : longint;
{ adress returned from an I/O-error }
@ -642,7 +642,7 @@ implementation
{$endif cpu64bit}
end;
rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);
rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
{ give used registers through }
rg.usedintinproc:=rg.usedintinproc + tprocdef(procdefinition).usedintregisters;
@ -653,7 +653,7 @@ implementation
regs_to_push_int := all_intregisters;
regs_to_push_other := all_registers;
rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
rg.saveusedotherregisters(exprasmlist,pushed,regs_to_push_other);
rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
rg.usedinproc:=all_registers;
{ no IO check for methods and procedure variables }
iolabel:=nil;
@ -871,7 +871,7 @@ implementation
end;
{ restore registers }
rg.restoreusedotherregisters(exprasmlist,pushed);
rg.restoreusedotherregisters(exprasmlist,pushedother);
rg.restoreusedintregisters(exprasmlist,pushedint);
{ Release temps from parameters }
@ -1128,7 +1128,10 @@ begin
end.
{
$Log$
Revision 1.65 2003-05-15 18:58:53 peter
Revision 1.66 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.65 2003/05/15 18:58:53 peter
* removed selfpointer_offset, vmtpointer_offset
* tvarsym.adjusted_address
* address in localsymtable is now in the real direction

49
compiler/ncgflw.pas
View File

@ -180,9 +180,12 @@ implementation
var
hl,otlabel,oflabel : tasmlabel;
org_regvar_loaded,
then_regvar_loaded,
else_regvar_loaded : regvar_booleanarray;
org_regvar_loaded_other,
then_regvar_loaded_other,
else_regvar_loaded_other : regvarother_booleanarray;
org_regvar_loaded_int,
then_regvar_loaded_int,
else_regvar_loaded_int : Tsupregset;
org_list,
then_list,
else_list : taasmoutput;
@ -210,7 +213,10 @@ implementation
maketojumpbool(exprasmlist,left,lr_dont_load_regvars);
if cs_regalloc in aktglobalswitches then
org_regvar_loaded := rg.regvar_loaded;
begin
org_regvar_loaded_int := rg.regvar_loaded_int;
org_regvar_loaded_other := rg.regvar_loaded_other;
end;
if assigned(right) then
begin
@ -225,8 +231,10 @@ implementation
{ loaded regvar state and create new clean ones }
if cs_regalloc in aktglobalswitches then
begin
then_regvar_loaded := rg.regvar_loaded;
rg.regvar_loaded := org_regvar_loaded;
then_regvar_loaded_int := rg.regvar_loaded_int;
then_regvar_loaded_other := rg.regvar_loaded_other;
rg.regvar_loaded_int := org_regvar_loaded_int;
rg.regvar_loaded_other := org_regvar_loaded_other;
then_list := exprasmlist;
exprasmlist := taasmoutput.create;
end;
@ -252,7 +260,8 @@ implementation
{ and loaded regvar state and create a new clean list }
if cs_regalloc in aktglobalswitches then
begin
else_regvar_loaded := rg.regvar_loaded;
else_regvar_loaded_int := rg.regvar_loaded_int;
else_regvar_loaded_other := rg.regvar_loaded_other;
else_list := exprasmlist;
exprasmlist := taasmoutput.create;
end;
@ -263,7 +272,8 @@ implementation
begin
if cs_regalloc in aktglobalswitches then
begin
else_regvar_loaded := rg.regvar_loaded;
else_regvar_loaded_int := rg.regvar_loaded_int;
else_regvar_loaded_other := rg.regvar_loaded_other;
else_list := exprasmlist;
exprasmlist := taasmoutput.create;
end;
@ -281,16 +291,22 @@ implementation
{ no else block? }
if not assigned(t1) then
sync_regvars(org_list,then_list,org_regvar_loaded,
then_regvar_loaded)
begin
sync_regvars_int(org_list,then_list,org_regvar_loaded_int,then_regvar_loaded_int);
sync_regvars_other(org_list,then_list,org_regvar_loaded_other,then_regvar_loaded_other);
end
{ no then block? }
else if not assigned(right) then
sync_regvars(org_list,else_list,org_regvar_loaded,
else_regvar_loaded)
begin
sync_regvars_int(org_list,else_list,org_regvar_loaded_int,else_regvar_loaded_int);
sync_regvars_other(org_list,else_list,org_regvar_loaded_other,else_regvar_loaded_other);
end
{ both else and then blocks }
else
sync_regvars(then_list,else_list,then_regvar_loaded,
else_regvar_loaded);
begin
sync_regvars_int(then_list,else_list,then_regvar_loaded_int,else_regvar_loaded_int);
sync_regvars_other(then_list,else_list,then_regvar_loaded_other,else_regvar_loaded_other);
end;
{ add all lists together }
org_list.concatlist(then_list);
then_list.free;
@ -1538,7 +1554,10 @@ begin
end.
{
$Log$
Revision 1.60 2003-05-13 19:14:41 peter
Revision 1.61 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.60 2003/05/13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr

39
compiler/nutils.pas
View File

@ -51,6 +51,8 @@ interface
function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
function call_fail_node:tnode;
function initialize_data_node(p:tnode):tnode;
function finalize_data_node(p:tnode):tnode;
implementation
@ -58,7 +60,8 @@ implementation
uses
verbose,
symconst,symsym,symtype,symdef,symtable,
nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd;
nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,
pass_1;
function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
begin
@ -213,12 +216,44 @@ implementation
end;
function initialize_data_node(p:tnode):tnode;
begin
if not assigned(p.resulttype.def) then
resulttypepass(p);
result:=ccallnode.createintern('fpc_initialize',
ccallparanode.create(
caddrnode.create(
crttinode.create(
tstoreddef(p.resulttype.def),initrtti)),
ccallparanode.create(
caddrnode.create(p),
nil)));
end;
function finalize_data_node(p:tnode):tnode;
begin
if not assigned(p.resulttype.def) then
resulttypepass(p);
result:=ccallnode.createintern('fpc_finalize',
ccallparanode.create(
caddrnode.create(
crttinode.create(
tstoreddef(p.resulttype.def),initrtti)),
ccallparanode.create(
caddrnode.create(p),
nil)));
end;
end.
{
$Log$
Revision 1.3 2003-05-13 20:54:06 peter
Revision 1.4 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.3 2003/05/13 20:54:06 peter
* fail checks vmt value before calling dispose
Revision 1.2 2003/05/13 19:14:41 peter

30
compiler/pinline.pas
View File

@ -55,7 +55,7 @@ implementation
symconst,symdef,symsym,symtable,defutil,
{ pass 1 }
pass_1,htypechk,
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
{ parser }
scanner,
pbase,pexpr,
@ -243,13 +243,7 @@ implementation
{ create call to fpc_initialize }
if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
begin
para := ccallparanode.create(caddrnode.create(crttinode.create(
tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
ccallparanode.create(ctemprefnode.create
(temp),nil));
addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
end;
addstatement(newstatement,initialize_data_node(ctemprefnode.create(temp)));
{ copy the temp to the destination }
addstatement(newstatement,cassignmentnode.create(
@ -263,13 +257,7 @@ implementation
begin
{ create call to fpc_finalize }
if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
begin
{ we need to use a copy of p here }
para := ccallparanode.create(caddrnode.create(crttinode.create
(tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
ccallparanode.create(p.getcopy,nil));
addstatement(newstatement,ccallnode.createintern('fpc_finalize',para));
end;
addstatement(newstatement,finalize_data_node(cderefnode.create(p.getcopy)));
{ create call to fpc_freemem }
para := ccallparanode.create(p,nil);
@ -578,12 +566,7 @@ implementation
end
else
begin
{ create call to fpc_finalize }
npara:=ccallparanode.create(caddrnode.create
(crttinode.create(tstoreddef(ppn.left.resulttype.def),initrtti)),
ccallparanode.create(caddrnode.create
(ppn.left),nil));
newblock:=ccallnode.createintern('fpc_finalize',npara);
newblock:=finalize_data_node(ppn.left);
ppn.left:=nil;
end;
paras.free;
@ -699,7 +682,10 @@ implementation
end.
{
$Log$
Revision 1.13 2003-05-09 17:47:03 peter
Revision 1.14 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.13 2003/05/09 17:47:03 peter
* self moved to hidden parameter
* removed hdisposen,hnewn,selfn

10
compiler/psub.pas
View File

@ -396,6 +396,9 @@ implementation
else
if is_object(current_procdef._class) then
begin
{ finalize object data }
if current_procdef._class.needs_inittable then
addstatement(newstatement,finalize_data_node(load_self_node));
{ parameter 3 : vmt_offset }
{ parameter 2 : pointer to vmt }
{ parameter 1 : self pointer }
@ -451,7 +454,7 @@ implementation
if (not is_void(current_procdef.rettype.def)) and
(current_procdef.rettype.def.needs_inittable) and
(not is_class(current_procdef.rettype.def)) then
finalize_data_node(caddrnode.create(load_result_node));
finalize_data_node(load_result_node);
end;
end;
@ -1127,7 +1130,10 @@ implementation
end.
{
$Log$
Revision 1.112 2003-05-13 21:26:38 peter
Revision 1.113 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.112 2003/05/13 21:26:38 peter
* only call destructor in except block when there is a destructor
available

244
compiler/regvars.pas
View File

@ -35,14 +35,15 @@ interface
procedure assign_regvars(p: tnode);
procedure load_regvars(asml: TAAsmoutput; p: tnode);
procedure cleanup_regvars(asml: TAAsmoutput);
procedure store_regvar_int(asml:Taasmoutput;reg:Tsuperregister);
procedure store_regvar(asml: TAAsmoutput; reg: tregister);
procedure load_regvar(asml: TAAsmoutput; vsym: tvarsym);
procedure load_regvar_reg(asml: TAAsmoutput; reg: tregister);
procedure load_all_regvars(asml: TAAsmoutput);
procedure sync_regvars(list1, list2: taasmoutput; const regvarsloaded1,
regvarsloaded2: regvar_booleanarray);
procedure sync_regvars_other(list1, list2: taasmoutput; const regvarsloaded1,
regvarsloaded2: regvarother_booleanarray);
procedure sync_regvars_int(list1, list2: taasmoutput; const regvarsloaded1,
regvarsloaded2: Tsupregset);
implementation
@ -141,6 +142,7 @@ implementation
i: longint;
parasym : boolean;
r : Tregister;
siz : tcgsize;
begin
{ max. optimizations }
{ only if no asm is used }
@ -169,48 +171,34 @@ implementation
for i:=1 to maxvarregs-p.registers32 do
begin
if assigned(regvarinfo^.regvars[i]) and
(rg.reg_pushes[varregs[i]] < regvarinfo^.regvars[i].refs) then
(rg.reg_pushes_int[varregs[i]] < regvarinfo^.regvars[i].refs) then
begin
{ register is no longer available for }
{ expressions }
{ search the register which is the most }
{ unused }
r.enum:=varregs[i];
if r.enum=R_INTREGISTER then
rg.makeregvarint(r.number)
else
rg.makeregvarother(r);
rg.makeregvarint(varregs[i]);
{ possibly no 32 bit register are needed }
{ call by reference/const ? }
if (regvarinfo^.regvars[i].varspez in [vs_var,vs_out]) or
((regvarinfo^.regvars[i].varspez=vs_const) and
paramanager.push_addr_param(regvarinfo^.regvars[i].vartype.def,current_procdef.proccalloption)) then
begin
r.enum:=varregs[i];
regvarinfo^.regvars[i].reg:=r;
end
siz:=OS_32
else
if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and
(regvarinfo^.regvars[i].vartype.def.size=1) then
begin
r.enum:=varregs[i];
regvarinfo^.regvars[i].reg:=rg.makeregsize(r,OS_8);
end
siz:=OS_8
else
if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and
(regvarinfo^.regvars[i].vartype.def.size=2) then
begin
r.enum:=varregs[i];
regvarinfo^.regvars[i].reg:=rg.makeregsize(r,OS_16);
end
siz:=OS_16
else
begin
r.enum:=varregs[i];
regvarinfo^.regvars[i].reg:=r;
end;
siz:=OS_32;
regvarinfo^.regvars[i].reg.enum:=R_INTREGISTER;
regvarinfo^.regvars[i].reg.number:=(varregs[i] shl 8) or cgsize2subreg(siz);
{ procedure uses this register }
include(rg.usedinproc,varregs[i]);
include(rg.usedintinproc,varregs[i]);
end
else
begin
@ -274,66 +262,107 @@ implementation
end;
procedure store_regvar_int(asml:Taasmoutput;reg:Tsuperregister);
begin
internalerror(200301104);
end;
procedure store_regvar(asml: TAAsmoutput; reg: tregister);
var
i: longint;
r : tregister;
hr: treference;
regvarinfo: pregvarinfo;
vsym: tvarsym;
begin
if reg.enum>lastreg then
internalerror(200301081);
regvarinfo := pregvarinfo(current_procdef.regvarinfo);
if not assigned(regvarinfo) then
exit;
for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) and
(rg.makeregsize(regvarinfo^.regvars[i].reg,OS_INT).enum = reg.enum) then
begin
if rg.regvar_loaded[rg.makeregsize(reg,OS_INT).enum] then
if reg.enum=R_INTREGISTER then
begin
for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) and
(regvarinfo^.regvars[i].reg.number shr 8 = reg.number shr 8) then
begin
vsym := tvarsym(regvarinfo^.regvars[i]);
{ we only have to store the regvar back to memory if it's }
{ possible that it's been modified (JM) }
if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
if (reg.number shr 8) in rg.regvar_loaded_int then
begin
reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
cg.a_load_reg_ref(asml,def_cgsize(vsym.vartype.def),vsym.reg,hr);
vsym := tvarsym(regvarinfo^.regvars[i]);
{ we only have to store the regvar back to memory if it's }
{ possible that it's been modified (JM) }
if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
begin
reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
cg.a_load_reg_ref(asml,def_cgsize(vsym.vartype.def),vsym.reg,hr);
end;
asml.concat(tai_regalloc.dealloc(vsym.reg));
exclude(rg.regvar_loaded_int,reg.number shr 8);
end;
asml.concat(tai_regalloc.dealloc(rg.makeregsize(reg,OS_INT)));
rg.regvar_loaded[rg.makeregsize(reg,OS_INT).enum] := false;
break;
end;
break;
end;
end
else
begin
for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) then
begin
r:=rg.makeregsize(regvarinfo^.regvars[i].reg,OS_INT);
if (r.enum = reg.enum) then
begin
if rg.regvar_loaded_other[r.enum] then
begin
vsym := tvarsym(regvarinfo^.regvars[i]);
{ we only have to store the regvar back to memory if it's }
{ possible that it's been modified (JM) }
if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
begin
reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
cg.a_load_reg_ref(asml,def_cgsize(vsym.vartype.def),vsym.reg,hr);
end;
asml.concat(tai_regalloc.dealloc(vsym.reg));
rg.regvar_loaded_other[r.enum] := false;
end;
break;
end;
end;
end;
end;
procedure load_regvar(asml: TAAsmoutput; vsym: tvarsym);
var
hr: treference;
opsize: tcgsize;
r,
reg : tregister;
begin
reg:=rg.makeregsize(vsym.reg,OS_INT);
if reg.enum>lastreg then
internalerror(200301081);
if not rg.regvar_loaded[reg.enum] then
reg:=vsym.reg;
if reg.enum=R_INTREGISTER then
begin
asml.concat(tai_regalloc.alloc(reg));
reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
if (vsym.varspez in [vs_var,vs_out]) or
((vsym.varspez=vs_const) and
paramanager.push_addr_param(vsym.vartype.def,current_procdef.proccalloption)) then
opsize := OS_ADDR
else
opsize := def_cgsize(vsym.vartype.def);
cg.a_load_ref_reg(asml,opsize,hr,reg);
rg.regvar_loaded[reg.enum] := true;
if not((reg.number shr 8) in rg.regvar_loaded_int) then
begin
asml.concat(tai_regalloc.alloc(reg));
reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
if (vsym.varspez in [vs_var,vs_out]) or
((vsym.varspez=vs_const) and
paramanager.push_addr_param(vsym.vartype.def,current_procdef.proccalloption)) then
opsize := OS_ADDR
else
opsize := def_cgsize(vsym.vartype.def);
cg.a_load_ref_reg(asml,opsize,hr,reg);
include(rg.regvar_loaded_int,reg.number shr 8);
end;
end
else
begin
r:=rg.makeregsize(reg,OS_INT);
if not rg.regvar_loaded_other[r.enum] then
begin
asml.concat(tai_regalloc.alloc(reg));
reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
if (vsym.varspez in [vs_var,vs_out]) or
((vsym.varspez=vs_const) and
paramanager.push_addr_param(vsym.vartype.def,current_procdef.proccalloption)) then
opsize := OS_ADDR
else
opsize := def_cgsize(vsym.vartype.def);
cg.a_load_ref_reg(asml,opsize,hr,reg);
rg.regvar_loaded_other[r.enum] := true;
end;
end;
end;
@ -346,13 +375,23 @@ implementation
regvarinfo := pregvarinfo(current_procdef.regvarinfo);
if not assigned(regvarinfo) then
exit;
reg_spare := rg.makeregsize(reg,OS_INT);
if reg_spare.enum>lastreg then
internalerror(2003010801);
for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) and
(rg.makeregsize(regvarinfo^.regvars[i].reg,OS_INT).enum = reg_spare.enum) then
load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
if reg.enum=R_INTREGISTER then
begin
for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) and
(regvarinfo^.regvars[i].reg.number shr 8 = reg.number shr 8) then
load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
end
else
begin
reg_spare := rg.makeregsize(reg,OS_INT);
if reg_spare.enum>lastreg then
internalerror(2003010801);
for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) and
(rg.makeregsize(regvarinfo^.regvars[i].reg,OS_INT).enum = reg_spare.enum) then
load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
end;
end;
procedure load_all_regvars(asml: TAAsmoutput);
@ -364,8 +403,7 @@ implementation
if not assigned(regvarinfo) then
exit;
for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) {and
(makereg32(regvarinfo^.regvars[i].reg) in [R_EAX,R_EBX,R_ECX,R_EDX])} then
if assigned(regvarinfo^.regvars[i]) then
load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
end;
@ -388,12 +426,13 @@ implementation
begin
if assigned(regvarinfo^.regvars[i]) then
begin
r:=regvarinfo^.regvars[i].reg;
convert_register_to_enum(r);
if cs_asm_source in aktglobalswitches then
asml.insert(tai_comment.Create(strpnew(regvarinfo^.regvars[i].name+
' with weight '+tostr(regvarinfo^.regvars[i].refs)+' assigned to register '+
std_reg2str[regvarinfo^.regvars[i].reg.enum])));
if (status.verbosity and v_debug)=v_debug then
Message3(cg_d_register_weight,std_reg2str[regvarinfo^.regvars[i].reg.enum],
std_reg2str[r.enum])));
Message3(cg_d_register_weight,std_reg2str[r.enum],
tostr(regvarinfo^.regvars[i].refs),regvarinfo^.regvars[i].name);
end;
end;
@ -434,14 +473,14 @@ implementation
end;
procedure sync_regvars(list1, list2: taasmoutput; const regvarsloaded1,
regvarsloaded2: regvar_booleanarray);
procedure sync_regvars_other(list1, list2: taasmoutput; const regvarsloaded1,
regvarsloaded2: regvarother_booleanarray);
var
counter: tregister;
begin
for counter.enum := low(rg.regvar_loaded) to high(rg.regvar_loaded) do
for counter.enum := low(rg.regvar_loaded_other) to high(rg.regvar_loaded_other) do
begin
rg.regvar_loaded[counter.enum] := regvarsloaded1[counter.enum] and
rg.regvar_loaded_other[counter.enum] := regvarsloaded1[counter.enum] and
regvarsloaded2[counter.enum];
if regvarsloaded1[counter.enum] xor regvarsloaded2[counter.enum] then
if regvarsloaded1[counter.enum] then
@ -452,6 +491,27 @@ implementation
end;
procedure sync_regvars_int(list1, list2: taasmoutput; const regvarsloaded1,
regvarsloaded2: Tsupregset);
var
i : longint;
r : tregister;
begin
for i:=1 to maxvarregs do
begin
r.enum:=R_INTREGISTER;
r.number:=varregs[i] shl 8;
if (varregs[i] in regvarsloaded1) and
not(varregs[i] in regvarsloaded2) then
load_regvar_reg(list2,r)
else
if (varregs[i] in regvarsloaded2) and
not(varregs[i] in regvarsloaded1) then
load_regvar_reg(list1,r);
end;
end;
procedure cleanup_regvars(asml: TAAsmoutput);
var
i: longint;
@ -476,11 +536,22 @@ implementation
begin
if assigned(regvars[i]) then
begin
reg:=rg.makeregsize(regvars[i].reg,OS_INT);
if reg.enum>lastreg then
internalerror(200201081);
if (rg.regvar_loaded[reg.enum]) then
asml.concat(tai_regalloc.dealloc(reg));
reg:=regvars[i].reg;
if reg.enum=R_INTREGISTER then
begin
if (reg.number shr 8 in rg.regvar_loaded_int) then
asml.concat(tai_regalloc.dealloc(reg));
end
else
begin
reg.number:=(r.number and not $ff) or cgsize2subreg(OS_INT);
r:=reg;
convert_register_to_enum(r);
if r.enum>lastreg then
internalerror(200201081);
if (rg.regvar_loaded_other[r.enum]) then
asml.concat(tai_regalloc.dealloc(reg));
end;
end;
end;
end;
@ -490,7 +561,10 @@ end.
{
$Log$
Revision 1.49 2003-05-15 18:58:53 peter
Revision 1.50 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.49 2003/05/15 18:58:53 peter
* removed selfpointer_offset, vmtpointer_offset
* tvarsym.adjusted_address
* address in localsymtable is now in the real direction

92
compiler/rgobj.pas
View File

@ -89,10 +89,10 @@ unit rgobj;
type
regvar_longintarray = array[firstreg..lastreg] of longint;
regvarother_longintarray = array[firstreg..lastreg] of longint;
regvarother_booleanarray = array[firstreg..lastreg] of boolean;
regvarint_longintarray = array[first_supreg..last_supreg] of longint;
regvar_booleanarray = array[firstreg..lastreg] of boolean;
regvar_ptreearray = array[firstreg..lastreg] of tnode;
regvarint_ptreearray = array[first_supreg..last_supreg] of tnode;
tpushedsavedloc = record
case byte of
@ -100,7 +100,7 @@ unit rgobj;
1: (ofs: longint);
end;
tpushedsaved = array[firstreg..lastreg] of tpushedsavedloc;
tpushedsavedother = array[firstreg..lastreg] of tpushedsavedloc;
Tpushedsavedint = array[first_supreg..last_supreg] of Tpushedsavedloc;
Tinterferencebitmap=array[Tsuperregister] of set of Tsuperregister;
@ -173,11 +173,11 @@ unit rgobj;
usedintinproc,
usedaddrinproc:Tsupregset;
reg_pushes : regvar_longintarray;
reg_pushes_other : regvarother_longintarray;
reg_pushes_int : regvarint_longintarray;
is_reg_var : regvar_booleanarray;
is_reg_var_other : regvarother_booleanarray;
is_reg_var_int:Tsupregset;
regvar_loaded: regvar_booleanarray;
regvar_loaded_other: regvarother_booleanarray;
regvar_loaded_int: Tsupregset;
{$ifdef newra}
colour:array[Tsuperregister] of Tsuperregister;
@ -297,7 +297,7 @@ unit rgobj;
var saved:Tpushedsavedint;
const s:Tsupregset);virtual;
procedure saveusedotherregisters(list:Taasmoutput;
var saved:Tpushedsaved;
var saved:Tpushedsavedother;
const s:Tregisterset);virtual;
{# Restores the registers which were saved with a call
to @var(saveusedregisters).
@ -308,7 +308,7 @@ unit rgobj;
procedure restoreusedintregisters(list:Taasmoutput;
const saved:Tpushedsavedint);virtual;
procedure restoreusedotherregisters(list:Taasmoutput;
const saved:Tpushedsaved);virtual;
const saved:Tpushedsavedother);virtual;
{ used when deciding which registers to use for regvars }
procedure incrementintregisterpushed(const s:Tsupregset);
@ -316,7 +316,7 @@ unit rgobj;
procedure clearregistercount;
procedure resetusableregisters;virtual;
procedure makeregvarint(reg:Tnewregister);
procedure makeregvarint(reg:Tsuperregister);
procedure makeregvarother(reg:Tregister);
procedure saveStateForInline(var state: pointer);virtual;
@ -443,10 +443,11 @@ unit rgobj;
{ contains the registers which are really used by the proc itself }
usedbyproc,
usedinproc : tregisterset;
reg_pushes : regvar_longintarray;
is_reg_var : regvar_booleanarray;
reg_pushes_other : regvarother_longintarray;
reg_pushes_int : regvarint_longintarray;
is_reg_var_other : regvarother_booleanarray;
is_reg_var_int : Tsupregset;
regvar_loaded: regvar_booleanarray;
regvar_loaded_other: regvarother_booleanarray;
regvar_loaded_int: Tsupregset;
{$ifdef TEMPREGDEBUG}
reg_user : regvar_ptreearray;
@ -787,6 +788,7 @@ unit rgobj;
function trgobj.isaddressregister(reg: tregister): boolean;
begin
if reg.number<>0 then; { remove warning }
result := true;
end;
@ -860,14 +862,18 @@ unit rgobj;
procedure trgobj.saveintregvars(list:Taasmoutput;const s:Tsupregset);
var r:Tsuperregister;
hr: tregister;
begin
if not(cs_regalloc in aktglobalswitches) then
exit;
for r:=firstsaveintreg to lastsaveintreg do
if (r in is_reg_var_int) and
(r in s) then
store_regvar_int(list,r);
begin
hr.number:=r shl 8;
hr.enum:=R_INTREGISTER;
store_regvar(list,hr);
end;
end;
procedure trgobj.saveotherregvars(list: taasmoutput; const s: tregisterset);
@ -878,12 +884,12 @@ unit rgobj;
exit;
if firstsavefpureg <> R_NO then
for r.enum := firstsavefpureg to lastsavefpureg do
if is_reg_var[r.enum] and
if is_reg_var_other[r.enum] and
(r.enum in s) then
store_regvar(list,r);
if firstsavemmreg <> R_NO then
for r.enum := firstsavemmreg to lastsavemmreg do
if is_reg_var[r.enum] and
if is_reg_var_other[r.enum] and
(r.enum in s) then
store_regvar(list,r);
end;
@ -928,7 +934,7 @@ unit rgobj;
end;
procedure trgobj.saveusedotherregisters(list: taasmoutput;
var saved : tpushedsaved; const s: tregisterset);
var saved : tpushedsavedother; const s: tregisterset);
var
r : tregister;
@ -945,7 +951,7 @@ unit rgobj;
saved[r.enum].ofs:=reg_not_saved;
{ if the register is used by the calling subroutine and if }
{ it's not a regvar (those are handled separately) }
if not is_reg_var[r.enum] and
if not is_reg_var_other[r.enum] and
(r.enum in s) and
{ and is present in use }
not(r.enum in unusedregsfpu) then
@ -967,7 +973,7 @@ unit rgobj;
saved[r.enum].ofs:=reg_not_saved;
{ if the register is in use and if it's not a regvar (those }
{ are handled separately), save it }
if not is_reg_var[r.enum] and
if not is_reg_var_other[r.enum] and
(r.enum in s) and
{ and is present in use }
not(r.enum in unusedregsmm) then
@ -1027,7 +1033,7 @@ unit rgobj;
end;
procedure trgobj.restoreusedotherregisters(list : taasmoutput;
const saved : tpushedsaved);
const saved : tpushedsavedother);
var
r,r2 : tregister;
@ -1109,13 +1115,13 @@ unit rgobj;
for regi:=firstsavefpureg to lastsavefpureg do
begin
if (regi in s) then
inc(reg_pushes[regi],t_times*2);
inc(reg_pushes_other[regi],t_times*2);
end;
if firstsavemmreg <> R_NO then
for regi:=firstsavemmreg to lastsavemmreg do
begin
if (regi in s) then
inc(reg_pushes[regi],t_times*2);
inc(reg_pushes_other[regi],t_times*2);
end;
end;
@ -1123,10 +1129,11 @@ unit rgobj;
procedure trgobj.clearregistercount;
begin
fillchar(reg_pushes,sizeof(reg_pushes),0);
fillchar(is_reg_var,sizeof(is_reg_var),false);
fillchar(reg_pushes_int,sizeof(reg_pushes_int),0);
fillchar(reg_pushes_other,sizeof(reg_pushes_other),0);
fillchar(is_reg_var_other,sizeof(is_reg_var_other),false);
is_reg_var_int:=[];
fillchar(regvar_loaded,sizeof(regvar_loaded),false);
fillchar(regvar_loaded_other,sizeof(regvar_loaded_other),false);
regvar_loaded_int:=[];
end;
@ -1145,19 +1152,15 @@ unit rgobj;
end;
procedure trgobj.makeregvarint(reg:Tnewregister);
var supreg:Tsuperregister;
procedure trgobj.makeregvarint(reg:Tsuperregister);
begin
supreg:=reg shr 8;
dec(countusableregsint);
{$ifndef newra}
dec(countunusedregsint);
{$endif}
exclude(usableregsint,reg);
exclude(unusedregsint,reg);
include(is_reg_var_int,supreg);
exclude(usableregsint,reg shl 8);
exclude(unusedregsint,reg shl 8);
include(is_reg_var_int,reg);
end;
procedure trgobj.makeregvarother(reg: tregister);
@ -1180,7 +1183,7 @@ unit rgobj;
exclude(usableregsmm,reg.enum);
exclude(unusedregsmm,reg.enum);
end;
is_reg_var[reg.enum]:=true;
is_reg_var_other[reg.enum]:=true;
end;
@ -1218,11 +1221,12 @@ unit rgobj;
psavedstate(state)^.countusableregsmm := countusableregsmm;
psavedstate(state)^.usedinproc := usedinproc;
psavedstate(state)^.usedbyproc := usedbyproc;
psavedstate(state)^.reg_pushes := reg_pushes;
psavedstate(state)^.is_reg_var := is_reg_var;
psavedstate(state)^.reg_pushes_int := reg_pushes_int;
psavedstate(state)^.reg_pushes_other := reg_pushes_other;
psavedstate(state)^.is_reg_var_int := is_reg_var_int;
psavedstate(state)^.regvar_loaded := regvar_loaded;
psavedstate(state)^.is_reg_var_other := is_reg_var_other;
psavedstate(state)^.regvar_loaded_int := regvar_loaded_int;
psavedstate(state)^.regvar_loaded_other := regvar_loaded_other;
{$ifdef TEMPREGDEBUG}
psavedstate(state)^.reg_user := reg_user;
psavedstate(state)^.reg_releaser := reg_releaser;
@ -1248,10 +1252,11 @@ unit rgobj;
countusableregsmm := psavedstate(state)^.countusableregsmm;
usedinproc := psavedstate(state)^.usedinproc;
usedbyproc := psavedstate(state)^.usedbyproc;
reg_pushes := psavedstate(state)^.reg_pushes;
is_reg_var := psavedstate(state)^.is_reg_var;
reg_pushes_int := psavedstate(state)^.reg_pushes_int;
reg_pushes_other := psavedstate(state)^.reg_pushes_other;
is_reg_var_int := psavedstate(state)^.is_reg_var_int;
regvar_loaded := psavedstate(state)^.regvar_loaded;
is_reg_var_other := psavedstate(state)^.is_reg_var_other;
regvar_loaded_other := psavedstate(state)^.regvar_loaded_other;
regvar_loaded_int := psavedstate(state)^.regvar_loaded_int;
{$ifdef TEMPREGDEBUG}
reg_user := psavedstate(state)^.reg_user;
@ -2022,7 +2027,10 @@ end.
{
$Log$
Revision 1.42 2003-04-26 20:03:49 daniel
Revision 1.43 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.42 2003/04/26 20:03:49 daniel
* Bug fix in simplify
Revision 1.41 2003/04/25 20:59:35 peter

7
compiler/x86/cgx86.pas
View File

@ -1697,6 +1697,8 @@ unit cgx86;
r.number:=NR_EDX;
list.concat(Taicpu.Op_reg(A_POP,S_L,r));
end;
r.number:=NR_ESI;
list.concat(Taicpu.Op_reg(A_POP,S_L,r));
r.number:=NR_EDI;
list.concat(Taicpu.Op_reg(A_POP,S_L,r));
{ .... also the segment registers }
@ -1939,7 +1941,10 @@ unit cgx86;
end.
{
$Log$
Revision 1.45 2003-05-15 18:58:54 peter
Revision 1.46 2003-05-16 14:33:31 peter
* regvar fixes
Revision 1.45 2003/05/15 18:58:54 peter
* removed selfpointer_offset, vmtpointer_offset
* tvarsym.adjusted_address
* address in localsymtable is now in the real direction