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

+ allow regvars to be used inside inlined procs, which required the

Browse Source 
following changes:
      + load regvars in genentrycode/free them in genexitcode (cgai386)
      * moved all regvar related code to new regvars unit
      + added pregvarinfo type to hcodegen
      + added regvarinfo field to tprocinfo (symdef/symdefh)
      * deallocate the regvars of the caller in secondprocinline before
        inlining the called procedure and reallocate them afterwards
This commit is contained in:
Jonas Maebe 2000-08-03 13:17:25 +00:00
parent ac16977232
commit c999d3b17d
7 changed files with 590 additions and 351 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
compiler/cg386cal.pas
View File

@ -1376,7 +1376,8 @@ implementation
procedure secondprocinline(var p : ptree);
var st : psymtable;
oldprocsym : pprocsym;
para_size : longint;
para_size, i : longint;
tmpreg: tregister;
oldprocinfo : pprocinfo;
oldinlining_procedure,
nostackframe,make_global : boolean;
@ -1389,6 +1390,19 @@ implementation
mangled_length : longint;
{$endif GDB}
begin
{ deallocate the registers used for the current procedure's regvars }
if assigned(aktprocsym^.definition^.regvarinfo) then
with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
for i := 1 to maxvarregs do
if assigned(regvars[i]) then
begin
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;
oldinlining_procedure:=inlining_procedure;
oldexitlabel:=aktexitlabel;
oldexit2label:=aktexit2label;
@ -1468,7 +1482,7 @@ implementation
exprasmlist^.concat(new(pai_asm_comment,init(strpnew('End of inlined proc'))));
{$endif extdebug}
exprasmlist^.concat(new(Pai_Marker, Init(InlineEnd)));
{we can free the local data now, reset also the fixup address }
if st^.datasize>0 then
begin
@ -1498,6 +1512,22 @@ implementation
aktexit2label:=oldexit2label;
quickexitlabel:=oldquickexitlabel;
inlining_procedure:=oldinlining_procedure;
{ reallocate the registers used for the current procedure's regvars, }
{ since they may have been used and then deallocated in the inlined }
{ procedure (JM) }
if assigned(aktprocsym^.definition^.regvarinfo) then
with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
for i := 1 to maxvarregs do
if assigned(regvars[i]) then
begin
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,alloc(tmpreg)));
end;
end;
@ -1505,7 +1535,17 @@ implementation
end.
{
$Log$
Revision 1.5 2000-07-27 13:03:35 jonas
Revision 1.6 2000-08-03 13:17:26 jonas
+ allow regvars to be used inside inlined procs, which required the
following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386)
* moved all regvar related code to new regvars unit
+ added pregvarinfo type to hcodegen
+ added regvarinfo field to tprocinfo (symdef/symdefh)
* deallocate the regvars of the caller in secondprocinline before
inlining the called procedure and reallocate them afterwards
Revision 1.5 2000/07/27 13:03:35 jonas
* release alignopts
Revision 1.4 2000/07/21 15:14:01 jonas

18
compiler/cgai386.pas
View File

@ -164,7 +164,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
uses
strings,globtype,systems,globals,verbose,files,types,pbase,
tgeni386,temp_gen,hcodegen,ppu
tgeni386,temp_gen,hcodegen,ppu,regvars
{$ifdef GDB}
,gdb
{$endif}
@ -3543,6 +3543,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
if not(cs_littlesize in aktglobalswitches) then
exprasmlist^.insert(new(pai_align,init(16)));
end;
if inlined then
load_regvars(exprasmlist,nil);
exprasmlist:=oldexprasmlist;
end;
@ -3960,6 +3962,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
freemem(p,2*mangled_length+50);
end;
{$endif GDB}
if inlined then
cleanup_regvars(exprasmlist);
exprasmlist:=oldexprasmlist;
end;
@ -4025,7 +4029,17 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end.
{
$Log$
Revision 1.6 2000-08-02 08:05:04 jonas
Revision 1.7 2000-08-03 13:17:25 jonas
+ allow regvars to be used inside inlined procs, which required the
following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386)
* moved all regvar related code to new regvars unit
+ added pregvarinfo type to hcodegen
+ added regvarinfo field to tprocinfo (symdef/symdefh)
* deallocate the regvars of the caller in secondprocinline before
inlining the called procedure and reallocate them afterwards
Revision 1.6 2000/08/02 08:05:04 jonas
* fixed web bug1087
* allocate R_ECX explicitely if it's used
(merged from fixes branch)

24
compiler/hcodegen.pas
View File

@ -110,6 +110,18 @@ implementation
constructor init(const a : treference;p : pdef);
end;
pregvarinfo = ^tregvarinfo;
tregvarinfo = record
regvars : array[1..maxvarregs] of pvarsym;
regvars_para : array[1..maxvarregs] of boolean;
regvars_refs : array[1..maxvarregs] of longint;
fpuregvars : array[1..maxfpuvarregs] of pvarsym;
fpuregvars_para : array[1..maxfpuvarregs] of boolean;
fpuregvars_refs : array[1..maxfpuvarregs] of longint;
end;
var
{ info about the current sub routine }
procinfo : pprocinfo;
@ -450,7 +462,17 @@ end.
{
$Log$
Revision 1.2 2000-07-13 11:32:41 michael
Revision 1.3 2000-08-03 13:17:26 jonas
+ allow regvars to be used inside inlined procs, which required the
following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386)
* moved all regvar related code to new regvars unit
+ added pregvarinfo type to hcodegen
+ added regvarinfo field to tprocinfo (symdef/symdefh)
* deallocate the regvars of the caller in secondprocinline before
inlining the called procedure and reallocate them afterwards
Revision 1.2 2000/07/13 11:32:41 michael
+ removed logs
}

399
compiler/pass_2.pas
View File

@ -47,7 +47,7 @@ implementation
globtype,systems,
cobjects,comphook,verbose,globals,files,
symconst,symtable,types,aasm,scanner,
pass_1,hcodegen,temp_gen,cpubase,cpuasm
pass_1,hcodegen,temp_gen,cpubase,cpuasm,regvars
{$ifndef newcg}
,tcflw
{$endif newcg}
@ -460,90 +460,6 @@ implementation
do_secondpass:=codegenerror;
end;
var
{ the array ranges are overestimated !!! }
{ max(maxvarregs,maxfpuvarregs) would be }
{ enough }
regvars : array[1..maxvarregs+maxfpuvarregs] of pvarsym;
regvars_para : array[1..maxvarregs+maxfpuvarregs] of boolean;
regvars_refs : array[1..maxvarregs+maxfpuvarregs] of longint;
parasym : boolean;
procedure searchregvars(p : pnamedindexobject);
var
i,j,k : longint;
begin
if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
begin
j:=pvarsym(p)^.refs;
{ parameter get a less value }
if parasym then
begin
if cs_littlesize in aktglobalswitches then
dec(j,1)
else
dec(j,100);
end;
{ walk through all momentary register variables }
for i:=1 to maxvarregs do
begin
if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
begin
for k:=maxvarregs-1 downto i do
begin
regvars[k+1]:=regvars[k];
regvars_para[k+1]:=regvars_para[k];
regvars_refs[k+1]:=regvars_refs[k];
end;
{ calc the new refs
pvarsym(p)^.refs:=j; }
regvars[i]:=pvarsym(p);
regvars_para[i]:=parasym;
regvars_refs[i]:=j;
break;
end;
end;
end;
end;
procedure searchfpuregvars(p : pnamedindexobject);
var
i,j,k : longint;
begin
if (psym(p)^.typ=varsym) and (vo_fpuregable in pvarsym(p)^.varoptions) then
begin
j:=pvarsym(p)^.refs;
{ parameter get a less value }
if parasym then
begin
if cs_littlesize in aktglobalswitches then
dec(j,1)
else
dec(j,100);
end;
{ walk through all momentary register variables }
for i:=1 to maxfpuvarregs do
begin
if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
begin
for k:=maxfpuvarregs-1 downto i do
begin
regvars[k+1]:=regvars[k];
regvars_para[k+1]:=regvars_para[k];
regvars_refs[k+1]:=regvars_refs[k];
end;
{ calc the new refs
pvarsym(p)^.refs:=j; }
regvars[i]:=pvarsym(p);
regvars_para[i]:=parasym;
regvars_refs[i]:=j;
break;
end;
end;
end;
end;
procedure clearrefs(p : pnamedindexobject);
begin
@ -553,12 +469,6 @@ implementation
end;
procedure generatecode(var p : ptree);
var
i : longint;
regsize : topsize;
hr : preference;
label
nextreg;
begin
cleartempgen;
flowcontrol:=[];
@ -576,260 +486,53 @@ implementation
symtablestack^.next^.foreach(@clearrefs);
if not(do_firstpass(p)) then
begin
{ max. optimizations }
{ only if no asm is used }
{ and no try statement }
if (cs_regalloc in aktglobalswitches) and
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) and
not(pocall_inline in aktprocsym^.definition^.proccalloptions) then
begin
{ can we omit the stack frame ? }
{ conditions:
1. procedure (not main block)
2. no constructor or destructor
3. no call to other procedures
4. no interrupt handler
}
{!!!!!! this doesn work yet, because of problems with
with linux and windows
}
(*
if (cs_regalloc in aktglobalswitches) and
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
begin
{ can we omit the stack frame ? }
{ conditions:
1. procedure (not main block)
2. no constructor or destructor
3. no call to other procedures
4. no interrupt handler
}
{!!!!!! this doesn work yet, because of problems with
with linux and windows
}
(*
if assigned(aktprocsym) then
begin
if not(assigned(procinfo^._class)) and
not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
not(po_interrupt in aktprocsym^.definition^.procoptions) and
((procinfo^.flags and pi_do_call)=0) and
(lexlevel>=normal_function_level) then
begin
{ use ESP as frame pointer }
procinfo^.framepointer:=stack_pointer;
use_esp_stackframe:=true;
if assigned(aktprocsym) then
begin
if not(assigned(procinfo^._class)) and
not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
not(po_interrupt in aktprocsym^.definition^.procoptions) and
((procinfo^.flags and pi_do_call)=0) and
(lexlevel>=normal_function_level) then
begin
{ use ESP as frame pointer }
procinfo^.framepointer:=stack_pointer;
use_esp_stackframe:=true;
{ calc parameter distance new }
dec(procinfo^.framepointer_offset,4);
dec(procinfo^.selfpointer_offset,4);
{ calc parameter distance new }
dec(procinfo^.framepointer_offset,4);
dec(procinfo^.selfpointer_offset,4);
{ is this correct ???}
{ retoffset can be negativ for results in eax !! }
{ the value should be decreased only if positive }
if procinfo^.retoffset>=0 then
dec(procinfo^.retoffset,4);
{ is this correct ???}
{ retoffset can be negativ for results in eax !! }
{ the value should be decreased only if positive }
if procinfo^.retoffset>=0 then
dec(procinfo^.retoffset,4);
dec(procinfo^.para_offset,4);
aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset;
end;
end;
*)
if (p^.registers32<4) then
begin
for i:=1 to maxvarregs do
regvars[i]:=nil;
parasym:=false;
symtablestack^.foreach({$ifndef TP}@{$endif}searchregvars);
{ copy parameter into a register ? }
parasym:=true;
symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
{ hold needed registers free }
for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
regvars[i]:=nil;
{ now assign register }
for i:=1 to maxvarregs-p^.registers32 do
begin
if assigned(regvars[i]) then
begin
{ it is nonsens, to copy the variable to }
{ a register because we need then much }
{ too pushes ? }
if reg_pushes[varregs[i]]>=regvars[i]^.refs then
begin
regvars[i]:=nil;
goto nextreg;
end;
{ register is no longer available for }
{ expressions }
{ search the register which is the most }
{ unused }
usableregs:=usableregs-[varregs[i]];
{$ifdef i386}
procinfo^.aktentrycode^.concat(new(pairegalloc,alloc(varregs[i])));
{$endif i386}
is_reg_var[varregs[i]]:=true;
dec(c_usableregs);
{ possibly no 32 bit register are needed }
{ call by reference/const ? }
if (regvars[i]^.varspez=vs_var) or
((regvars[i]^.varspez=vs_const) and
push_addr_param(regvars[i]^.vartype.def)) then
begin
regvars[i]^.reg:=varregs[i];
regsize:=S_L;
end
else
if (regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
(porddef(regvars[i]^.vartype.def)^.size=1) then
begin
{$ifdef i386}
regvars[i]^.reg:=reg32toreg8(varregs[i]);
{$endif}
regsize:=S_B;
end
else
if (regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
(porddef(regvars[i]^.vartype.def)^.size=2) then
begin
{$ifdef i386}
regvars[i]^.reg:=reg32toreg16(varregs[i]);
{$endif}
regsize:=S_W;
end
else
begin
regvars[i]^.reg:=varregs[i];
regsize:=S_L;
end;
{ parameter must be load }
if 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(regvars[i])^.address+procinfo^.para_offset;
hr^.base:=procinfo^.framepointer;
{$ifdef i386}
procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
hr,regvars[i]^.reg)));
{$endif i386}
{$ifdef m68k}
procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
hr,regvars[i]^.reg)));
{$endif m68k}
unused:=unused - [regvars[i]^.reg];
end;
{ procedure uses this register }
{$ifdef i386}
usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
{$endif i386}
{$ifdef m68k}
usedinproc:=usedinproc or ($800 shr word(varregs[i]));
{$endif m68k}
end;
nextreg:
{ dummy }
regsize:=S_W;
end;
for i:=1 to maxvarregs do
begin
if assigned(regvars[i]) then
begin
if cs_asm_source in aktglobalswitches then
procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
reg2str(regvars[i]^.reg)))));
if (status.verbosity and v_debug)=v_debug then
Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
tostr(regvars[i]^.refs),regvars[i]^.name);
end;
end;
end;
if ((p^.registersfpu+1)<maxfpuvarregs) then
begin
for i:=1 to maxfpuvarregs do
regvars[i]:=nil;
parasym:=false;
symtablestack^.foreach({$ifndef TP}@{$endif}searchfpuregvars);
{$ifdef dummy}
{ copy parameter into a register ? }
parasym:=true;
symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
{$endif dummy}
{ hold needed registers free }
{ in non leaf procedures we must be very careful }
{ with assigning registers }
if aktmaxfpuregisters=-1 then
begin
if (procinfo^.flags and pi_do_call)<>0 then
begin
for i:=maxfpuvarregs downto 2 do
regvars[i]:=nil;
end
else
begin
for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu do
regvars[i]:=nil;
end;
end
else
begin
for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
regvars[i]:=nil;
end;
{ now assign register }
for i:=1 to maxfpuvarregs do
begin
if assigned(regvars[i]) then
begin
{$ifdef i386}
{ reserve place on the FPU stack }
regvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
procinfo^.aktentrycode^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
{ ... and clean it up }
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
{$endif i386}
{$ifdef m68k}
regvars[i]^.reg:=fpuvarregs[i];
{$endif m68k}
{$ifdef dummy}
{ parameter must be load }
if 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(regvars[i])^.address+procinfo^.para_offset;
hr^.base:=procinfo^.framepointer;
{$ifdef i386}
procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
hr,regvars[i]^.reg)));
{$endif i386}
{$ifdef m68k}
procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
hr,regvars[i]^.reg)));
{$endif m68k}
end;
{$endif dummy}
end;
end;
if cs_asm_source in aktglobalswitches then
procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
' registers on FPU stack used by temp. expressions'))));
for i:=1 to maxfpuvarregs do
begin
if assigned(regvars[i]) then
begin
if cs_asm_source in aktglobalswitches then
procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
reg2str(regvars[i]^.reg)))));
if (status.verbosity and v_debug)=v_debug then
Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
tostr(regvars[i]^.refs),regvars[i]^.name);
end;
end;
if cs_asm_source in aktglobalswitches then
procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
end;
end;
dec(procinfo^.para_offset,4);
aktprocsym^.definition^.parast^.address_fixup:=procinfo^.para_offset;
end;
end;
*)
end;
{ process register variable stuff (JM) }
assign_regvars(p);
load_regvars(procinfo^.aktentrycode,p);
cleanup_regvars(procinfo^.aktexitcode);
if assigned(aktprocsym) and
(pocall_inline in aktprocsym^.definition^.proccalloptions) then
make_const_global:=true;
@ -846,7 +549,17 @@ implementation
end.
{
$Log$
Revision 1.4 2000-08-03 11:15:42 jonas
Revision 1.5 2000-08-03 13:17:25 jonas
+ allow regvars to be used inside inlined procs, which required the
following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386)
* moved all regvar related code to new regvars unit
+ added pregvarinfo type to hcodegen
+ added regvarinfo field to tprocinfo (symdef/symdefh)
* deallocate the regvars of the caller in secondprocinline before
inlining the called procedure and reallocate them afterwards
Revision 1.4 2000/08/03 11:15:42 jonas
- disable regvars for inlined procedures (merged from fixes branch)
Revision 1.3 2000/07/21 15:14:02 jonas

423
compiler/regvars.pas Normal file
View File

@ -0,0 +1,423 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl and Jonas Maebe
This unit handles register variable allocation
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
{$ifdef TP}
{$E+,F+,N+}
{$endif}
unit regvars;
interface
uses aasm, tree;
procedure assign_regvars(var p: ptree);
procedure load_regvars(asml: paasmoutput; p: ptree);
procedure cleanup_regvars(asml: paasmoutput);
implementation
uses
globtype,systems,comphook,
cobjects,verbose,globals,
symconst,symtable,types,
hcodegen,temp_gen,cpubase,cpuasm
{$ifndef newcg}
,tcflw
{$endif newcg}
{$ifdef GDB}
,gdb
{$endif}
{$ifdef i386}
,tgeni386,cgai386
{$endif}
{$ifdef m68k}
,tgen68k,cga68k
{$endif}
;
type
pregvarinfo = ^tregvarinfo;
tregvarinfo = record
regvars : array[1..maxvarregs] of pvarsym;
regvars_para : array[1..maxvarregs] of boolean;
regvars_refs : array[1..maxvarregs] of longint;
fpuregvars : array[1..maxfpuvarregs] of pvarsym;
fpuregvars_para : array[1..maxfpuvarregs] of boolean;
fpuregvars_refs : array[1..maxfpuvarregs] of longint;
end;
var
parasym : boolean;
procedure searchregvars(p : pnamedindexobject);
var
i,j,k : longint;
begin
if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
begin
j:=pvarsym(p)^.refs;
{ parameter get a less value }
if parasym then
begin
if cs_littlesize in aktglobalswitches then
dec(j,1)
else
dec(j,100);
end;
{ walk through all momentary register variables }
for i:=1 to maxvarregs do
begin
with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
begin
for k:=maxvarregs-1 downto i do
begin
regvars[k+1]:=regvars[k];
regvars_para[k+1]:=regvars_para[k];
regvars_refs[k+1]:=regvars_refs[k];
end;
{ calc the new refs
pvarsym(p)^.refs:=j; }
regvars[i]:=pvarsym(p);
regvars_para[i]:=parasym;
regvars_refs[i]:=j;
break;
end;
end;
end;
end;
procedure searchfpuregvars(p : pnamedindexobject);
var
i,j,k : longint;
begin
if (psym(p)^.typ=varsym) and (vo_fpuregable in pvarsym(p)^.varoptions) then
begin
j:=pvarsym(p)^.refs;
{ parameter get a less value }
if parasym then
begin
if cs_littlesize in aktglobalswitches then
dec(j,1)
else
dec(j,100);
end;
{ walk through all momentary register variables }
for i:=1 to maxfpuvarregs do
begin
with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
if ((fpuregvars[i]=nil) or (j>fpuregvars_refs[i])) and (j>0) then
begin
for k:=maxfpuvarregs-1 downto i do
begin
fpuregvars[k+1]:=fpuregvars[k];
fpuregvars_para[k+1]:=fpuregvars_para[k];
fpuregvars_refs[k+1]:=fpuregvars_refs[k];
end;
{ calc the new refs
pvarsym(p)^.refs:=j; }
fpuregvars[i]:=pvarsym(p);
fpuregvars_para[i]:=parasym;
fpuregvars_refs[i]:=j;
break;
end;
end;
end;
end;
procedure assign_regvars(var p: ptree);
{ register variables }
var
regvarinfo: pregvarinfo;
i: longint;
begin
{ max. optimizations }
{ only if no asm is used }
{ and no try statement }
if (cs_regalloc in aktglobalswitches) and
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
begin
new(regvarinfo);
fillchar(regvarinfo^,sizeof(regvarinfo^),0);
aktprocsym^.definition^.regvarinfo := regvarinfo;
if (p^.registers32<4) then
begin
parasym:=false;
symtablestack^.foreach({$ifndef TP}@{$endif}searchregvars);
{ copy parameter into a register ? }
parasym:=true;
symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
{ hold needed registers free }
for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
begin
regvarinfo^.regvars[i]:=nil;
regvarinfo^.regvars_para[i] := false;
end;
{ now assign register }
for i:=1 to maxvarregs-p^.registers32 do
begin
if assigned(regvarinfo^.regvars[i]) and
(reg_pushes[varregs[i]] < regvarinfo^.regvars[i]^.refs) then
begin
{ register is no longer available for }
{ expressions }
{ search the register which is the most }
{ unused }
usableregs:=usableregs-[varregs[i]];
is_reg_var[varregs[i]]:=true;
dec(c_usableregs);
{ possibly no 32 bit register are needed }
{ call by reference/const ? }
if (regvarinfo^.regvars[i]^.varspez=vs_var) or
((regvarinfo^.regvars[i]^.varspez=vs_const) and
push_addr_param(regvarinfo^.regvars[i]^.vartype.def)) then
begin
regvarinfo^.regvars[i]^.reg:=varregs[i];
end
else
if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
(porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=1) then
begin
{$ifdef i386}
regvarinfo^.regvars[i]^.reg:=reg32toreg8(varregs[i]);
{$endif}
end
else
if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
(porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=2) then
begin
{$ifdef i386}
regvarinfo^.regvars[i]^.reg:=reg32toreg16(varregs[i]);
{$endif}
end
else
begin
regvarinfo^.regvars[i]^.reg:=varregs[i];
end;
if regvarinfo^.regvars_para[i] then
unused:=unused - [regvarinfo^.regvars[i]^.reg];
{ procedure uses this register }
{$ifdef i386}
usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
{$endif i386}
{$ifdef m68k}
usedinproc:=usedinproc or ($800 shr word(varregs[i]));
{$endif m68k}
end
else
begin
regvarinfo^.regvars[i] := nil;
regvarinfo^.regvars_para[i] := false;
end;
end;
end;
if ((p^.registersfpu+1)<maxfpuvarregs) then
begin
parasym:=false;
symtablestack^.foreach({$ifndef TP}@{$endif}searchfpuregvars);
{$ifdef dummy}
{ copy parameter into a register ? }
parasym:=true;
symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
{$endif dummy}
{ hold needed registers free }
{ in non leaf procedures we must be very careful }
{ with assigning registers }
if aktmaxfpuregisters=-1 then
begin
if (procinfo^.flags and pi_do_call)<>0 then
begin
for i:=maxfpuvarregs downto 2 do
regvarinfo^.fpuregvars[i]:=nil;
end
else
begin
for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu do
regvarinfo^.fpuregvars[i]:=nil;
end;
end
else
begin
for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
regvarinfo^.fpuregvars[i]:=nil;
end;
{ now assign register }
for i:=1 to maxfpuvarregs do
begin
if assigned(regvarinfo^.fpuregvars[i]) then
begin
{$ifdef i386}
{ reserve place on the FPU stack }
regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
{$endif i386}
{$ifdef m68k}
regvarinfo^.fpuregvars[i]^.reg:=fpuvarregs[i];
{$endif m68k}
end;
end;
end;
end;
end;
procedure load_regvars(asml: paasmoutput; p: ptree);
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);
for i:=1 to maxvarregs do
begin
{ parameter must be load }
if regvarinfo^.regvars_para[i] then
begin
{$ifdef i386}
asml^.concat(new(pairegalloc,alloc(varregs[i])));
{$endif i386}
{ 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;
{$ifdef i386}
asml^.concat(new(paicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
hr,regvarinfo^.regvars[i]^.reg)));
{$endif i386}
{$ifdef m68k}
asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
hr,regvarinfo^.regvars[i]^.reg)));
{$endif m68k}
end;
end;
for i:=1 to maxvarregs do
begin
if assigned(regvarinfo^.regvars[i]) then
begin
if cs_asm_source in aktglobalswitches then
asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.regvars[i]^.name+
' with weight '+tostr(regvarinfo^.regvars[i]^.refs)+' assigned to register '+
reg2str(regvarinfo^.regvars[i]^.reg)))));
if (status.verbosity and v_debug)=v_debug then
Message3(cg_d_register_weight,reg2str(regvarinfo^.regvars[i]^.reg),
tostr(regvarinfo^.regvars[i]^.refs),regvarinfo^.regvars[i]^.name);
end;
end;
for i:=1 to maxfpuvarregs do
begin
if assigned(regvarinfo^.fpuregvars[i]) then
begin
{$ifdef i386}
{ reserve place on the FPU stack }
regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
asml^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
{$endif i386}
{$ifdef dummy}
{ parameter must be load }
if regvarinfo^.fpuregvars_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;
{$ifdef i386}
asml^.concat(new(paicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
hr,regvarinfo^.regvars[i]^.reg)));
{$endif i386}
{$ifdef m68k}
asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
hr,regvarinfo^.regvars[i]^.reg)));
{$endif m68k}
end;
{$endif dummy}
end;
end;
if assigned(p) then
if cs_asm_source in aktglobalswitches then
asml^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
' registers on FPU stack used by temp. expressions'))));
for i:=1 to maxfpuvarregs do
begin
if assigned(regvarinfo^.fpuregvars[i]) then
begin
if cs_asm_source in aktglobalswitches then
asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.fpuregvars[i]^.name+
' with weight '+tostr(regvarinfo^.fpuregvars[i]^.refs)+' assigned to register '+
reg2str(regvarinfo^.fpuregvars[i]^.reg)))));
if (status.verbosity and v_debug)=v_debug then
Message3(cg_d_register_weight,reg2str(regvarinfo^.fpuregvars[i]^.reg),
tostr(regvarinfo^.fpuregvars[i]^.refs),regvarinfo^.fpuregvars[i]^.name);
end;
end;
if cs_asm_source in aktglobalswitches then
asml^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
end;
end;
procedure cleanup_regvars(asml: paasmoutput);
var
i: longint;
begin
{$ifdef i386}
if (cs_regalloc in aktglobalswitches) and
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
for i:=1 to maxfpuvarregs do
if assigned(fpuregvars[i]) then
{ ... and clean it up }
asml^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
{$endif i386}
end;
end.
{
$Log$
Revision 1.1 2000-08-03 13:17:25 jonas
+ allow regvars to be used inside inlined procs, which required the
following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386)
* moved all regvar related code to new regvars unit
+ added pregvarinfo type to hcodegen
+ added regvarinfo field to tprocinfo (symdef/symdefh)
* deallocate the regvars of the caller in secondprocinline before
inlining the called procedure and reallocate them afterwards
}

17
compiler/symdef.inc
View File

@ -2631,6 +2631,7 @@
interfacedef:=false;
_class := nil;
code:=nil;
regvarinfo := nil;
count:=false;
is_used:=false;
end;
@ -2670,6 +2671,8 @@
localst:=nil;
forwarddef:=false;
interfacedef:=false;
code := nil;
regvarinfo := nil;
lastref:=nil;
lastwritten:=nil;
defref:=nil;
@ -2849,6 +2852,8 @@ Const local_symtable_index : longint = $8001;
dispose(localst,done);
if (pocall_inline in proccalloptions) and assigned(code) then
disposetree(ptree(code));
if assigned(regvarinfo) then
dispose(pregvarinfo(regvarinfo));
if (po_msgstr in procoptions) then
strdispose(messageinf.str);
if
@ -4188,7 +4193,17 @@ Const local_symtable_index : longint = $8001;
{
$Log$
Revision 1.4 2000-08-02 19:49:59 peter
Revision 1.5 2000-08-03 13:17:26 jonas
+ allow regvars to be used inside inlined procs, which required the
following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386)
* moved all regvar related code to new regvars unit
+ added pregvarinfo type to hcodegen
+ added regvarinfo field to tprocinfo (symdef/symdefh)
* deallocate the regvars of the caller in secondprocinline before
inlining the called procedure and reallocate them afterwards
Revision 1.4 2000/08/02 19:49:59 peter
* first things for default parameters
Revision 1.3 2000/07/13 12:08:27 michael

14
compiler/symdefh.inc
View File

@ -415,6 +415,8 @@
{ it's a tree, but this not easy to handle }
{ used for inlined procs }
code : pointer;
{ info about register variables (JM) }
regvarinfo: pointer;
{ true, if the procedure is only declared }
{ (forward procedure) }
forwarddef,
@ -535,7 +537,17 @@
{
$Log$
Revision 1.4 2000-08-02 19:49:59 peter
Revision 1.5 2000-08-03 13:17:26 jonas
+ allow regvars to be used inside inlined procs, which required the
following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386)
* moved all regvar related code to new regvars unit
+ added pregvarinfo type to hcodegen
+ added regvarinfo field to tprocinfo (symdef/symdefh)
* deallocate the regvars of the caller in secondprocinline before
inlining the called procedure and reallocate them afterwards
Revision 1.4 2000/08/02 19:49:59 peter
* first things for default parameters
Revision 1.3 2000/07/13 12:08:27 michael