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

* 64k registers supported

Browse Source 
* fixed some memory leaks
This commit is contained in:
peter 2003-10-17 14:38:32 +00:00
parent 68aae0de5e
commit d0de3b3ea8
28 changed files with 1263 additions and 958 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
compiler/aasmtai.pas
View File

@ -197,7 +197,7 @@ interface
{ Buffer type used for alignment }
tfillbuffer = array[0..63] of char;
Tspill_temp_list=array[0..255] of Treference;
Tspill_temp_list=array[tsuperregister] of Treference;
{ abstract assembler item }
tai = class(TLinkedListItem)
@ -466,13 +466,13 @@ interface
function is_nop:boolean;virtual;abstract;
function is_move:boolean;virtual;abstract;
{ register allocator }
function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsuperregisterset):Tai;
procedure forward_allocation(p:Tai;var unusedregsint:Tsuperregisterset);
function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:tsuperregisterset):Tai;
procedure forward_allocation(p:Tai;var unusedregsint:tsuperregisterset);
function spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:tsuperregisterset;
var unusedregsint:Tsuperregisterset;
const r:tsuperregisterset;
var unusedregsint:tsuperregisterset;
const spilltemplist:Tspill_temp_list):boolean;virtual;
function spilling_decode_loadstore(op: tasmop; var counterpart: tasmop; var wasload: boolean): boolean;virtual;abstract;
function spilling_create_loadstore(op: tasmop; r:tregister; const ref:treference): tai;virtual;abstract;
@ -493,14 +493,10 @@ interface
function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
end;
Ttranstable=array[Tsuperregister] of Tsuperregister;
taasmoutput = class(tlinkedlist)
constructor create;
function getlasttaifilepos : pfileposinfo;
// procedure translate_registers(const table:Ttranstable);
procedure InsertAfter(Item,Loc : TLinkedListItem);
procedure translate_registers(regtype:tregistertype;const table:Ttranstable);
end;
@ -1668,9 +1664,9 @@ implementation
Register allocator methods.
---------------------------------------------------------------------}
function taicpu_abstract.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsuperregisterset):Tai;
function taicpu_abstract.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:tsuperregisterset):Tai;
var
back : Tsuperregisterset;
back : tsuperregisterset;
supreg : tsuperregister;
begin
back:=unusedregsint;
@ -1680,10 +1676,10 @@ implementation
supreg:=getsupreg(Tai_regalloc(p).reg);
{Rewind the register allocation.}
if Tai_regalloc(p).allocation then
include(unusedregsint,supreg)
supregset_include(unusedregsint,supreg)
else
begin
exclude(unusedregsint,supreg);
supregset_exclude(unusedregsint,supreg);
if supreg=huntfor1 then
begin
get_insert_pos:=Tai(p.previous);
@ -1714,9 +1710,9 @@ implementation
if p.typ<>ait_regalloc then
internalerror(200305311);
if Tai_regalloc(p).allocation then
exclude(unusedregsint,getsupreg(Tai_regalloc(p).reg))
supregset_exclude(unusedregsint,getsupreg(Tai_regalloc(p).reg))
else
include(unusedregsint,getsupreg(Tai_regalloc(p).reg));
supregset_include(unusedregsint,getsupreg(Tai_regalloc(p).reg));
p:=Tai(p.next);
end;
end;
@ -1725,9 +1721,9 @@ implementation
function taicpu_abstract.spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsuperregisterset;
const r:Tsuperregisterset;
var unusedregsint:Tsuperregisterset;
const spilltemplist:Tspill_temp_list): boolean;
const spilltemplist:Tspill_temp_list): boolean;
var
i:byte;
supreg, reg1, reg2, reg3: Tsuperregister;
@ -1746,7 +1742,7 @@ implementation
begin
{ the register that's being stored/loaded }
supreg:=getsupreg(oper[0].reg);
if supreg in r then
if supregset_in(r,supreg) then
begin
// Example:
// l?? r20d, 8(r1) ; r20d must be spilled into -60(r1)
@ -1795,7 +1791,7 @@ implementation
{ now the registers used in the reference }
{ a) base }
supreg := getsupreg(oper[1].ref^.base);
if supreg in r then
if supregset_in(r,supreg) then
begin
if wasload then
pos:=get_insert_pos(Tai(previous),getsupreg(oper[1].ref^.index),getsupreg(oper[0].reg),0,unusedregsint)
@ -1819,7 +1815,7 @@ implementation
{ b) index }
supreg := getsupreg(oper[1].ref^.index);
if supreg in r then
if supregset_in(r,supreg) then
begin
if wasload then
pos:=get_insert_pos(Tai(previous),getsupreg(oper[1].ref^.base),getsupreg(oper[0].reg),0,unusedregsint)
@ -1862,7 +1858,7 @@ implementation
reg3 := 0;
supreg:=reg1;
if supreg in r then
if supregset_in(r,supreg) then
begin
// Example:
// add r20d, r21d, r22d ; r20d must be spilled into -60(r1)
@ -1896,7 +1892,7 @@ implementation
if (oper[i].typ = top_reg) then
begin
supreg:=getsupreg(oper[i].reg);
if supreg in r then
if supregset_in(r,supreg) then
begin
// Example:
// add r20d, r21d, r22d ; r20d must be spilled into -60(r1)
@ -2095,76 +2091,21 @@ implementation
procedure Taasmoutput.InsertAfter(Item,Loc : TLinkedListItem);
begin
if assigned(Loc) then
tailineinfo(Item).fileinfo:=tailineinfo(Loc).fileinfo;
{ This is not possible because it is not sure that the
tai at Loc has taifileinfo as parent }
{if assigned(Loc) then
tailineinfo(Item).fileinfo:=tailineinfo(Loc).fileinfo;}
inherited InsertAfter(Item,Loc);
end;
procedure Taasmoutput.translate_registers(regtype:tregistertype;const table:Ttranstable);
var p,q:Tai;
i:shortint;
r:Preference;
{$ifdef arm}
so:pshifterop;
{$endif arm}
begin
p:=Tai(first);
while assigned(p) do
begin
case p.typ of
ait_regalloc:
if (getregtype(Tai_regalloc(p).reg)=regtype) then
setsupreg(Tai_regalloc(p).reg,table[getsupreg(Tai_regalloc(p).reg)]);
ait_instruction:
begin
for i:=0 to Taicpu_abstract(p).ops-1 do
case Taicpu_abstract(p).oper[i].typ of
Top_reg:
if (getregtype(Taicpu_abstract(p).oper[i].reg)=regtype) then
setsupreg(Taicpu_abstract(p).oper[i].reg,table[getsupreg(Taicpu_abstract(p).oper[i].reg)]);
Top_ref:
begin
if regtype=R_INTREGISTER then
begin
r:=Taicpu_abstract(p).oper[i].ref;
if r^.base<>NR_NO then
setsupreg(r^.base,table[getsupreg(r^.base)]);
if r^.index<>NR_NO then
setsupreg(r^.index,table[getsupreg(r^.index)]);
end;
end;
{$ifdef arm}
Top_shifterop:
begin
so:=Taicpu_abstract(p).oper[i].shifterop;
if so^.rs<>NR_NO then
setsupreg(so^.rs,table[getsupreg(so^.rs)]);
end;
{$endif arm}
end;
{ Maybe the operation can be removed when
it is a move and both arguments are the same }
if Taicpu_abstract(p).is_nop then
begin
q:=p;
p:=Tai(p.next);
remove(q);
continue;
end;
end;
end;
p:=Tai(p.next);
end;
end;
end.
{
$Log$
Revision 1.43 2003-10-11 16:06:42 florian
Revision 1.44 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.43 2003/10/11 16:06:42 florian
* fixed some MMX<->SSE
* started to fix ppc, needs an overhaul
+ stabs info improve for spilling, not sure if it works correctly/completly

55
compiler/cgbase.pas
View File

@ -128,7 +128,7 @@ interface
R_SUBF64 { = 6; 64 bits float that allocates 2 FPU registers }
);
TSuperRegister = type byte;
TSuperRegister = type word;
{
The new register coding:
@ -143,11 +143,9 @@ interface
{$ifdef FPC_BIG_ENDIAN}
regtype : Tregistertype;
subreg : Tsubregister;
unused : byte;
supreg : Tsuperregister;
{$else FPC_BIG_ENDIAN}
supreg : Tsuperregister;
unused : byte;
subreg : Tsubregister;
regtype : Tregistertype;
{$endif FPC_BIG_ENDIAN}
@ -163,7 +161,8 @@ interface
{$endif cpu64bit}
{ Set type definition for registers }
tsuperregisterset = set of tsuperregister;
tcpuregisterset = set of byte;
tsuperregisterset = array[byte] of set of byte;
{ Temp types }
ttemptype = (tt_none,
@ -192,7 +191,11 @@ interface
R_SSEREGISTER = R_MMREGISTER;
{ Invalid register number }
RS_INVALID = $ff;
RS_INVALID = high(tsuperregister);
{ Maximum number of cpu registers per register type,
this must fit in tcpuregisterset }
maxcpuregister = 31;
tcgsize2size : Array[tcgsize] of integer =
{ integer values }
@ -238,6 +241,11 @@ interface
var
mms_movescalar : pmmshuffle;
procedure supregset_reset(var regs:tsuperregisterset;setall:boolean);
procedure supregset_include(var regs:tsuperregisterset;s:tsuperregister);
procedure supregset_exclude(var regs:tsuperregisterset;s:tsuperregister);
function supregset_in(const regs:tsuperregisterset;s:tsuperregister):boolean;
function newreg(rt:tregistertype;sr:tsuperregister;sb:tsubregister):tregister;{$ifdef USEINLINE}inline;{$endif}
function getsubreg(r:tregister):tsubregister;{$ifdef USEINLINE}inline;{$endif}
function getsupreg(r:tregister):tsuperregister;{$ifdef USEINLINE}inline;{$endif}
@ -269,10 +277,39 @@ implementation
uses
verbose;
procedure supregset_reset(var regs:tsuperregisterset;setall:boolean);
var
b : byte;
begin
if setall then
b:=$ff
else
b:=0;
fillchar(regs,sizeof(regs),b);
end;
procedure supregset_include(var regs:tsuperregisterset;s:tsuperregister);
begin
include(regs[s shr 8],(s and $ff))
end;
procedure supregset_exclude(var regs:tsuperregisterset;s:tsuperregister);
begin
exclude(regs[s shr 8],(s and $ff))
end;
function supregset_in(const regs:tsuperregisterset;s:tsuperregister):boolean;
begin
result:=(s and $ff) in regs[s shr 8];
end;
function newreg(rt:tregistertype;sr:tsuperregister;sb:tsubregister):tregister;{$ifdef USEINLINE}inline;{$endif}
begin
tregisterrec(result).regtype:=rt;
tregisterrec(result).unused:=0;
tregisterrec(result).supreg:=sr;
tregisterrec(result).subreg:=sb;
end;
@ -430,7 +467,11 @@ finalization
end.
{
$Log$
Revision 1.70 2003-10-13 01:10:01 florian
Revision 1.71 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.70 2003/10/13 01:10:01 florian
* some ideas for mm support implemented
Revision 1.69 2003/10/11 16:06:42 florian

18
compiler/cgobj.pas
View File

@ -77,7 +77,6 @@ unit cgobj;
function getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;abstract;
function getmmregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;abstract;
function getflagregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;abstract;
function getabtintregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;abstract;
{Does the generic cg need SIMD registers, like getmmxregister? Or should
the cpu specific child cg object have such a method?}
procedure ungetregister(list:Taasmoutput;r:Tregister);virtual;abstract;
@ -85,12 +84,13 @@ unit cgobj;
procedure add_move_instruction(instr:Taicpu);virtual;abstract;
function uses_registers(rt:Tregistertype):boolean;virtual;abstract;
{# Get a specific register.}
procedure getexplicitregister(list:Taasmoutput;r:Tregister);virtual;abstract;
{# Get multiple registers specified.}
procedure allocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tsuperregisterset);virtual;abstract;
procedure allocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);virtual;abstract;
{# Free multiple registers specified.}
procedure deallocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tsuperregisterset);virtual;abstract;
procedure deallocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);virtual;abstract;
procedure do_register_allocation(list:Taasmoutput;headertai:tai);virtual;abstract;
@ -613,8 +613,8 @@ implementation
begin
hr:=getintregister(list,size);
a_load_const_reg(list,size,a,hr);
a_param_reg(list,size,hr,locpara);
ungetregister(list,hr);
a_param_reg(list,size,hr,locpara);
end;
procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
@ -623,8 +623,8 @@ implementation
begin
hr:=getintregister(list,size);
a_load_ref_reg(list,size,size,r,hr);
a_param_reg(list,size,hr,locpara);
ungetregister(list,hr);
a_param_reg(list,size,hr,locpara);
end;
@ -651,8 +651,8 @@ implementation
begin
hr:=getaddressregister(list);
a_loadaddr_ref_reg(list,r,hr);
a_param_reg(list,OS_ADDR,hr,locpara);
ungetregister(list,hr);
a_param_reg(list,OS_ADDR,hr,locpara);
end;
@ -1774,7 +1774,11 @@ finalization
end.
{
$Log$
Revision 1.130 2003-10-13 01:23:13 florian
Revision 1.131 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.130 2003/10/13 01:23:13 florian
* some ideas for mm support implemented
Revision 1.129 2003/10/11 16:06:42 florian

17
compiler/i386/cpubase.inc
View File

@ -49,7 +49,9 @@
{*****************************************************************************
Constants
*****************************************************************************}
c_countusableregsint = 4;
{
firstsaveintreg = RS_EAX;
lastsaveintreg = RS_EDX;
firstsavefpureg = RS_INVALID;
@ -59,13 +61,6 @@
general_superregisters = [RS_EAX,RS_EBX,RS_ECX,RS_EDX];
usableregsint = [first_int_imreg..last_int_imreg];
c_countusableregsint = 4;
maxaddrregs = 1;
usableregsaddr = [RS_ESI];
c_countusableregsaddr = 1;
maxvarregs = 4;
varregs : array[1..maxvarregs] of tsuperregister =
(RS_EBX,RS_EDX,RS_ECX,RS_EAX);
@ -73,7 +68,7 @@
maxfpuvarregs = 8;
maxmmvarregs = 8;
}
{*****************************************************************************
GDB Information
@ -170,7 +165,11 @@
{
$Log$
Revision 1.9 2003-09-03 15:55:01 peter
Revision 1.10 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.9 2003/09/03 15:55:01 peter
* NEWRA branch merged
Revision 1.8 2003/09/03 11:18:37 florian

22
compiler/i386/cpupara.pas
View File

@ -45,9 +45,9 @@ unit cpupara;
function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function get_para_align(calloption : tproccalloption):byte;override;
function get_volatile_registers_int(calloption : tproccalloption):tsuperregisterset;override;
function get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;override;
function get_volatile_registers_mm(calloption : tproccalloption):tsuperregisterset;override;
function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tlinkedlist):longint;override;
@ -157,7 +157,7 @@ unit cpupara;
end;
function ti386paramanager.get_volatile_registers_int(calloption : tproccalloption):tsuperregisterset;
function ti386paramanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
begin
case calloption of
pocall_internproc :
@ -186,15 +186,15 @@ unit cpupara;
end;
function ti386paramanager.get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;
function ti386paramanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
begin
result:=[first_fpu_supreg..last_fpu_supreg];
result:=[0..first_fpu_imreg-1];
end;
function ti386paramanager.get_volatile_registers_mm(calloption : tproccalloption):tsuperregisterset;
function ti386paramanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
begin
result:=[first_sse_supreg..last_sse_supreg];
result:=[0..first_sse_imreg-1];
end;
@ -446,7 +446,11 @@ begin
end.
{
$Log$
Revision 1.40 2003-10-11 16:06:42 florian
Revision 1.41 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.40 2003/10/11 16:06:42 florian
* fixed some MMX<->SSE
* started to fix ppc, needs an overhaul
+ stabs info improve for spilling, not sure if it works correctly/completly

13
compiler/i386/n386add.pas
View File

@ -344,9 +344,8 @@ interface
case nodetype of
ltn,lten,gtn,gten,equaln,unequaln :
begin
{$warning forced stdcall calling}
paraloc1:=paramanager.getintparaloc(pocall_stdcall,1);
paraloc2:=paramanager.getintparaloc(pocall_stdcall,2);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
{ process parameters }
secondpass(left);
location_release(exprasmlist,left.location);
@ -814,7 +813,9 @@ interface
oldnodetype : tnodetype;
begin
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
{ the jump the sequence is a little bit hairy }
case nodetype of
ltn,gtn:
@ -1494,7 +1495,11 @@ begin
end.
{
$Log$
Revision 1.85 2003-10-13 09:38:22 florian
Revision 1.86 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.85 2003/10/13 09:38:22 florian
* fixed forgotten commit
Revision 1.84 2003/10/13 01:58:03 florian

45
compiler/i386/rgcpu.pas
View File

@ -39,6 +39,13 @@ unit rgcpu;
procedure add_constraints(reg:Tregister);override;
end;
tpushedsavedloc = record
case byte of
0: (pushed: boolean);
1: (ofs: longint);
end;
tpushedsavedfpu = array[tsuperregister] of tpushedsavedloc;
trgx86fpu = class
{ The "usableregsxxx" contain all registers of type "xxx" that }
@ -54,7 +61,7 @@ unit rgcpu;
{ Contains the registers which are really used by the proc itself.
It doesn't take care of registers used by called procedures
}
used_in_proc_other : totherregisterset;
used_in_proc : tcpuregisterset;
{reg_pushes_other : regvarother_longintarray;
is_reg_var_other : regvarother_booleanarray;
@ -71,11 +78,11 @@ unit rgcpu;
procedure ungetregisterfpu(list: taasmoutput; r : tregister);
{ pushes and restores registers }
procedure saveusedotherregisters(list:Taasmoutput;
var saved:Tpushedsavedother;
const s:Totherregisterset);
procedure restoreusedotherregisters(list:Taasmoutput;
const saved:Tpushedsavedother);
procedure saveusedfpuregisters(list:Taasmoutput;
var saved:Tpushedsavedfpu;
const s:Tcpuregisterset);
procedure restoreusedfpuregisters(list:Taasmoutput;
const saved:Tpushedsavedfpu);
{ corrects the fpu stack register by ofs }
function correct_fpuregister(r : tregister;ofs : byte) : tregister;
@ -88,6 +95,11 @@ implementation
systems,
verbose;
const
{ This value is used in tsaved. If the array value is equal
to this, then this means that this register is not used.}
reg_not_saved = $7fffffff;
{************************************************************************
trgcpu
*************************************************************************}
@ -116,7 +128,7 @@ implementation
var i:Tsuperregister;
begin
used_in_proc_other:=[];
used_in_proc:=[];
t_times := 0;
countusableregsfpu:=c_countusableregsfpu;
unusedregsfpu:=usableregsfpu;
@ -150,15 +162,14 @@ implementation
end;
procedure trgx86fpu.saveusedotherregisters(list: taasmoutput;
var saved : tpushedsavedother; const s: totherregisterset);
procedure trgx86fpu.saveusedfpuregisters(list: taasmoutput;
var saved : tpushedsavedfpu;
const s: tcpuregisterset);
var
r : tregister;
hr : treference;
begin
used_in_proc_other:=used_in_proc_other + s;
used_in_proc:=used_in_proc+s;
{$warning TODO firstsavefpureg}
(*
@ -188,8 +199,8 @@ implementation
end;
procedure trgx86fpu.restoreusedotherregisters(list : taasmoutput;
const saved : tpushedsavedother);
procedure trgx86fpu.restoreusedfpuregisters(list : taasmoutput;
const saved : tpushedsavedfpu);
var
r,r2 : tregister;
@ -242,7 +253,11 @@ implementation
end.
{
$Log$
Revision 1.38 2003-10-10 17:48:14 peter
Revision 1.39 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.38 2003/10/10 17:48:14 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

10
compiler/nbas.pas
View File

@ -53,8 +53,8 @@ interface
currenttai : tai;
getposition : boolean;
{ Used registers in assembler block }
used_regs_int : tsuperregisterset;
used_regs_fpu : totherregisterset;
used_regs_int,
used_regs_fpu : tcpuregisterset;
constructor create(p : taasmoutput);virtual;
constructor create_get_position;
destructor destroy;override;
@ -833,7 +833,11 @@ begin
end.
{
$Log$
Revision 1.64 2003-10-10 17:48:13 peter
Revision 1.65 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.64 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

29
compiler/ncgcal.pas
View File

@ -570,8 +570,9 @@ implementation
procedure tcgcallnode.normal_pass_2;
var
regs_to_push_other : totherregisterset;
regs_to_alloc,regs_to_free:Tsuperregisterset;
regs_to_push_fpu,
regs_to_alloc,
regs_to_free : Tcpuregisterset;
oldpushedparasize : longint;
{ adress returned from an I/O-error }
{ help reference pointer }
@ -665,7 +666,7 @@ implementation
end;
regs_to_alloc:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
regs_to_push_other:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
regs_to_push_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
{ Include Function result registers }
if (not is_void(resulttype.def)) then
@ -737,7 +738,7 @@ implementation
{ release self }
cg.ungetregister(exprasmlist,vmtreg);
pvreg:=cg.getabtintregister(exprasmlist,OS_ADDR);
pvreg:=cg.getintregister(exprasmlist,OS_ADDR);
reference_reset_base(href,vmtreg,
tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber));
cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,pvreg);
@ -747,12 +748,12 @@ implementation
if assigned(left) then
pushparas;
{ Release register containing procvar }
cg.ungetregister(exprasmlist,pvreg);
{ free the resources allocated for the parameters }
freeparas;
{ Release register containing procvar }
cg.ungetregister(exprasmlist,pvreg);
cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_alloc);
cg.allocexplicitregisters(exprasmlist,R_SSEREGISTER,paramanager.get_volatile_registers_mm(procdefinition.proccalloption));
@ -785,7 +786,7 @@ implementation
secondpass(right);
location_release(exprasmlist,right.location);
pvreg:=cg.getabtintregister(exprasmlist,OS_ADDR);
pvreg:=cg.getintregister(exprasmlist,OS_ADDR);
{ Only load OS_ADDR from the reference }
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,right.location.reference,pvreg)
@ -798,12 +799,12 @@ implementation
if assigned(left) then
pushparas;
{ Release register containing procvar }
cg.ungetregister(exprasmlist,pvreg);
{ free the resources allocated for the parameters }
freeparas;
{ Release register containing procvar }
cg.ungetregister(exprasmlist,pvreg);
cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_alloc);
cg.allocexplicitregisters(exprasmlist,R_MMREGISTER,paramanager.get_volatile_registers_mm(procdefinition.proccalloption));
@ -1104,7 +1105,11 @@ begin
end.
{
$Log$
Revision 1.131 2003-10-17 01:22:08 florian
Revision 1.132 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.131 2003/10/17 01:22:08 florian
* compilation of the powerpc compiler fixed
Revision 1.130 2003/10/11 16:06:42 florian

24
compiler/ncgflw.pas
View File

@ -121,7 +121,9 @@ implementation
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
{ 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) }
if lnf_testatbegin in loopflags then
@ -138,7 +140,9 @@ implementation
if assigned(right) then
secondpass(right);
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
cg.a_label(exprasmlist,lcont);
otlabel:=truelabel;
@ -413,7 +417,9 @@ implementation
else
hcond:=OC_A;
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
if temptovalue then
begin
@ -463,7 +469,9 @@ implementation
if assigned(t1) then
begin
secondpass(t1);
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
end;
{If the loopvar doesn't mind on exit, we do the loopvar inc/dec
@ -502,7 +510,9 @@ implementation
hcond:=OC_LT
else
hcond:=OC_B;
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
cmp_const:=aword(Tordconstnode(right).value);
if do_loopvar_at_end then
@ -720,7 +730,9 @@ implementation
include(flowcontrol,fc_break);
if aktbreaklabel<>nil then
begin
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
cg.a_jmp_always(exprasmlist,aktbreaklabel)
end
else
@ -739,7 +751,9 @@ implementation
include(flowcontrol,fc_continue);
if aktcontinuelabel<>nil then
begin
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
cg.a_jmp_always(exprasmlist,aktcontinuelabel)
end
else
@ -756,7 +770,9 @@ implementation
begin
location_reset(location,LOC_VOID,OS_NO);
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
cg.a_jmp_always(exprasmlist,labsym.lab)
end;
@ -769,7 +785,9 @@ implementation
begin
location_reset(location,LOC_VOID,OS_NO);
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
cg.a_label(exprasmlist,labelnr);
secondpass(left);
end;
@ -1461,7 +1479,11 @@ begin
end.
{
$Log$
Revision 1.84 2003-10-10 17:48:13 peter
Revision 1.85 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.84 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

15
compiler/ncgld.pas
View File

@ -64,7 +64,7 @@ implementation
procedure tcgloadnode.pass_2;
var
r,hregister : tregister;
hregister : tregister;
supreg:Tsuperregister;
symtabletype : tsymtabletype;
href : treference;
@ -153,16 +153,13 @@ implementation
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_ref(exprasmlist,OS_ADDR,href,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
r:=cg.getabtintregister(exprasmlist,OS_ADDR);
cg.ungetregister(exprasmlist,r);
cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,hregister,r);
cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_reg(exprasmlist,r);
cg.a_call_reg(exprasmlist,hregister);
cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.getexplicitregister(exprasmlist,NR_FUNCTION_RESULT_REG);
cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT_REG);
hregister:=cg.getaddressregister(exprasmlist);
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_ADDR,r,hregister);
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_ADDR,NR_FUNCTION_RESULT_REG,hregister);
cg.a_jmp_always(exprasmlist,endrelocatelab);
cg.a_label(exprasmlist,norelocatelab);
{ no relocation needed, load the address of the variable only, the
@ -891,7 +888,11 @@ begin
end.
{
$Log$
Revision 1.95 2003-10-14 00:30:48 florian
Revision 1.96 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.95 2003/10/14 00:30:48 florian
+ some code for PIC support added
Revision 1.94 2003/10/11 16:06:42 florian

12
compiler/ncgset.pas
View File

@ -868,7 +868,9 @@ implementation
{ cmps and subs/decs }
min_label:=case_get_min(nodes);
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
{ now generate the jumps }
if opsize in [OS_64,OS_S64] then
genlinearcmplist(nodes)
@ -972,7 +974,9 @@ implementation
secondpass(hp.left);
{ don't come back to case line }
aktfilepos:=exprasmList.getlasttaifilepos^;
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
cg.a_jmp_always(exprasmlist,endlabel);
hp:=tstatementnode(hp.right);
end;
@ -981,7 +985,9 @@ implementation
if assigned(elseblock) then
begin
secondpass(elseblock);
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
end;
cg.a_label(exprasmlist,endlabel);
@ -1003,7 +1009,11 @@ begin
end.
{
$Log$
Revision 1.51 2003-10-10 17:48:13 peter
Revision 1.52 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.51 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

18
compiler/ncgutil.pas
View File

@ -192,8 +192,10 @@ implementation
aktfilepos:=p.fileinfo;
if is_boolean(p.resulttype.def) then
begin
{$ifdef OLDREGVARS}
if loadregvars = lr_load_regvars then
load_all_regvars(list);
{$endif OLDREGVARS}
if is_constboolnode(p) then
begin
if tordconstnode(p).value<>0 then
@ -207,8 +209,10 @@ implementation
case p.location.loc of
LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
begin
{$ifdef OLDREGVARS}
if (p.location.loc = LOC_CREGISTER) then
load_regvar_reg(list,p.location.register);
{$endif OLDREGVARS}
cg.a_cmp_const_loc_label(list,opsize,OC_NE,
0,p.location,truelabel);
{ !!! should happen right after cmp (JM) }
@ -290,6 +294,8 @@ implementation
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
{$warning stdcall forced for SETJMP}
paraloc1:=paramanager.getintparaloc(pocall_stdcall,1);
paramanager.allocparaloc(list,paraloc1);
cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
paramanager.freeparaloc(list,paraloc1);
@ -1196,13 +1202,17 @@ implementation
{ initialize ansi/widesstring para's }
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
{$ifdef OLDREGVARS}
load_regvars(list,nil);
{$endif OLDREGVARS}
end;
procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
begin
{$ifdef OLDREGVARS}
cleanup_regvars(list);
{$endif OLDREGVARS}
{ finalize temporary data }
finalizetempvariables(list);
@ -1286,7 +1296,9 @@ implementation
list.concat(Tai_force_line.Create);
{$endif GDB}
{$ifdef OLDREGVARS}
load_regvars(list,nil);
{$endif OLDREGVARS}
end;
@ -1948,7 +1960,11 @@ implementation
end.
{
$Log$
Revision 1.158 2003-10-10 17:48:13 peter
Revision 1.159 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.158 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

12
compiler/nld.pas
View File

@ -718,8 +718,10 @@ implementation
else
begin
{ get the size before the type conversion - check for all nodes }
if assigned(right.resulttype.def) and (right.nodetype in [loadn,vecn,calln]) then
original_size := right.resulttype.def.size;
if assigned(right.resulttype.def) and
(right.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
(right.nodetype in [loadn,vecn,calln]) then
original_size := right.resulttype.def.size;
inserttypeconv(right,left.resulttype);
end;
@ -1245,7 +1247,11 @@ begin
end.
{
$Log$
Revision 1.112 2003-10-10 17:48:13 peter
Revision 1.113 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.112 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

22
compiler/paramgr.pas
View File

@ -71,10 +71,10 @@ unit paramgr;
@param(nr Parameter number of routine, starting from 1)
}
function get_para_align(calloption : tproccalloption):byte;virtual;
function get_volatile_registers_int(calloption : tproccalloption):tsuperregisterset;virtual;
function get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;virtual;
function get_volatile_registers_flags(calloption : tproccalloption):tsuperregisterset;virtual;
function get_volatile_registers_mm(calloption : tproccalloption):tsuperregisterset;virtual;
function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;virtual;
function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;virtual;
function get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset;virtual;
function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;virtual;
function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;virtual;abstract;
{# allocate a parameter location created with create_paraloc_info
@ -262,25 +262,25 @@ implementation
end;
function tparamanager.get_volatile_registers_int(calloption : tproccalloption):tsuperregisterset;
function tparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
begin
result:=[];
end;
function tparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;
function tparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
begin
result:=[];
end;
function tparamanager.get_volatile_registers_flags(calloption : tproccalloption):tsuperregisterset;
function tparamanager.get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset;
begin
result:=[];
end;
function tparamanager.get_volatile_registers_mm(calloption : tproccalloption):tsuperregisterset;
function tparamanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
begin
result:=[];
end;
@ -437,7 +437,11 @@ end.
{
$Log$
Revision 1.63 2003-10-11 16:06:42 florian
Revision 1.64 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.63 2003/10/11 16:06:42 florian
* fixed some MMX<->SSE
* started to fix ppc, needs an overhaul
+ stabs info improve for spilling, not sure if it works correctly/completly

15
compiler/pinline.pas
View File

@ -60,7 +60,7 @@ implementation
scanner,
pbase,pexpr,
{ codegen }
cgbase,procinfo
cgbase
;
@ -144,7 +144,12 @@ implementation
end
else
begin
p2:=cderefnode.create(p.getcopy);
{ For new(var,constructor) we need to take a copy because
p is also used in the assignmentn below }
if is_new then
p2:=cderefnode.create(p.getcopy)
else
p2:=cderefnode.create(p);
do_resulttypepass(p2);
if is_new then
callflag:=nf_new_call
@ -688,7 +693,11 @@ implementation
end.
{
$Log$
Revision 1.21 2003-10-08 19:19:45 peter
Revision 1.22 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.21 2003/10/08 19:19:45 peter
* set_varstate cleanup
Revision 1.20 2003/10/02 21:15:31 peter

18
compiler/procinfo.pas
View File

@ -122,18 +122,6 @@ unit procinfo;
}
{procedure after_pass1;virtual;}
end;
pregvarinfo = ^tregvarinfo;
tregvarinfo = record
regvars : array[1..maxvarregs] of tvarsym;
regvars_para : array[1..maxvarregs] of boolean;
regvars_refs : array[1..maxvarregs] of longint;
fpuregvars : array[1..maxfpuvarregs] of tvarsym;
fpuregvars_para : array[1..maxfpuvarregs] of boolean;
fpuregvars_refs : array[1..maxfpuvarregs] of longint;
end;
tcprocinfo = class of tprocinfo;
var
@ -217,7 +205,11 @@ implementation
end.
{
$Log$
Revision 1.6 2003-10-14 00:30:48 florian
Revision 1.7 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.6 2003/10/14 00:30:48 florian
+ some code for PIC support added
Revision 1.5 2003/10/10 17:48:13 peter

11
compiler/pstatmnt.pas
View File

@ -475,7 +475,7 @@ implementation
symtab:=withsymtable;
while assigned(obj) do
begin
symtab.next:=twithsymtable.create(obj,obj.symtable.symsearch,refp);
symtab.next:=twithsymtable.create(obj,obj.symtable.symsearch,refp.getcopy);
symtab:=symtab.next;
obj:=obj.childof;
inc(levelcount);
@ -519,6 +519,7 @@ implementation
end
else
begin
p.free;
Message(parser_e_false_with_expr);
{ try to recover from error }
if try_to_consume(_COMMA) then
@ -815,7 +816,7 @@ implementation
{ END is read, got a list of changed registers? }
if try_to_consume(_LECKKLAMMER) then
begin
asmstat.used_regs_fpu:=[first_fpu_supreg..last_fpu_supreg];
asmstat.used_regs_fpu:=[0..first_fpu_imreg-1];
if token<>_RECKKLAMMER then
begin
repeat
@ -1129,7 +1130,11 @@ implementation
end.
{
$Log$
Revision 1.115 2003-10-10 17:48:13 peter
Revision 1.116 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.115 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

40
compiler/psub.pas
View File

@ -496,7 +496,7 @@ implementation
if (not is_void(current_procinfo.procdef.rettype.def)) and
(current_procinfo.procdef.rettype.def.needs_inittable) and
(not is_class(current_procinfo.procdef.rettype.def)) then
finalize_data_node(load_result_node);
addstatement(newstatement,finalize_data_node(load_result_node));
end;
end;
@ -523,7 +523,6 @@ implementation
aktfilepos:=exitpos;
exitcode:=generate_exit_block;
finalizecode:=generate_finalize_block;
exceptcode:=generate_except_block;
exitlabelcode:=generate_exitlabel_block;
{ Generate body of the procedure by combining entry+body+exit }
@ -540,6 +539,11 @@ implementation
{ but it's useless in init/final code of units }
not(current_procinfo.procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
begin
{ Generate special exception block only needed when
implicit finaly is used }
aktfilepos:=exitpos;
exceptcode:=generate_except_block;
{ Initialize before try...finally...end frame }
addstatement(newstatement,initializecode);
aktfilepos:=entrypos;
addstatement(newstatement,ctryfinallynode.create_implicit(
@ -575,6 +579,8 @@ implementation
destructor tcgprocinfo.destroy;
begin
nestedprocs.free;
if assigned(code) then
code.free;
inherited destroy;
end;
@ -589,11 +595,6 @@ implementation
usesacc,
usesfpu,
usesacchi : boolean;
{$ifdef ra_debug}
i,
{$endif ra_debug}
spillingcounter : integer;
fastspill:boolean;
begin
{ the initialization procedure can be empty, then we
don't need to generate anything. When it was an empty
@ -643,22 +644,6 @@ implementation
aktfilepos:=entrypos;
gen_load_para_value(aktproccode);
{$warning FIXME!!}
{ FIXME!! If a procedure contains assembler blocks (or is pure assembler), }
{ then rg.used_in_proc_int already contains info because of that. However, }
{ adding that info happened before initialisation of rg.used_in_proc_int, }
{ so this info cannot be valid! Currently only changing this for entire }
{ assembler procedures... For non-i386, the changed registers are even }
{ always all volatile registers (JM) }
{$ifdef i386}
if (po_assembler in current_procinfo.procdef.procoptions) then
begin
{$warning Fixme}
{ Tcgx86(cg).rgint.used_in_proc:=paramanager.get_volatile_registers_int(pocall_oldfpccall);
Tcgx86(cg).rgother.used_in_proc:=paramanager.get_volatile_registers_int(pocall_oldfpccall);}
end;
{$endif i386}
{ generate code for the body }
generatecode(code);
@ -692,6 +677,7 @@ implementation
gen_exit_code(templist);
aktproccode.concatlist(templist);
{$ifdef OLDREGVARS}
{ note: this must be done only after as much code as possible has }
{ been generated. The result is that when you ungetregister() a }
{ regvar, it will actually free the regvar (and alse free the }
@ -702,6 +688,7 @@ implementation
{ gen_entry_code (that one has to be able to allocate the }
{ regvars again) (JM) }
free_regvars(aktproccode);
{$endif OLDREGVARS}
{ add code that will load the return value, this is not done
for assembler routines when they didn't reference the result
@ -873,6 +860,7 @@ implementation
{ the inline procedure has already got a copy of the tree
stored in current_procinfo.procdef.code }
code.free;
code:=nil;
if (procdef.proccalloption<>pocall_inline) then
procdef.code:=nil;
end;
@ -1277,7 +1265,11 @@ begin
end.
{
$Log$
Revision 1.162 2003-10-10 17:48:13 peter
Revision 1.163 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.162 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

12
compiler/regvars.pas
View File

@ -32,6 +32,7 @@ interface
symsym,
cpubase, cgbase, tgobj;
{$ifdef OLDREGVARS}
procedure assign_regvars(p: tnode);
procedure load_regvars(asml: TAAsmoutput; p: tnode);
procedure cleanup_regvars(asml: TAAsmoutput);
@ -41,6 +42,7 @@ interface
procedure load_all_regvars(asml: TAAsmoutput);
procedure free_regvars(list: taasmoutput);
procedure translate_regvars(list: taasmoutput; const table:Ttranstable);
{$endif OLDREGVARS}
{$ifdef i386}
(*
@ -60,7 +62,7 @@ implementation
symconst,symbase,symtype,symdef,paramgr,defutil,
cpuinfo,cgobj,procinfo;
{$ifdef OLDREGVARS}
procedure searchregvars(p : tnamedindexitem;arg:pointer);
var
i,j,k : longint;
@ -631,12 +633,18 @@ implementation
tostr(regvars[i].refs),regvars[i].name);
end;
end;
{$endif OLDREGVARS}
end.
{
$Log$
Revision 1.70 2003-10-10 17:48:14 peter
Revision 1.71 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.70 2003/10/10 17:48:14 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

1495
compiler/rgobj.pas
View File

File diff suppressed because it is too large Load Diff

46
compiler/symdef.pas
View File

@ -517,8 +517,6 @@ interface
{ it's a tree, but this not easy to handle }
{ used for inlined procs }
code : tnode;
{ info about register variables (JM) }
regvarinfo: pointer;
{ name of the result variable to insert in the localsymtable }
resultname : stringid;
{ true, if the procedure is only declared }
@ -530,10 +528,6 @@ interface
hasforward : boolean;
{ check the problems of manglednames }
has_mangledname : boolean;
{ small set which contains the modified registers }
usedintregisters,
usedmmxregisters,
usedfpuregisters : Tsuperregisterset;
constructor create(level:byte);
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
@ -3116,7 +3110,15 @@ implementation
destructor tabstractprocdef.destroy;
begin
if assigned(para) then
para.free;
begin
{$ifdef MEMDEBUG}
memprocpara.start;
{$endif MEMDEBUG}
para.free;
{$ifdef MEMDEBUG}
memprocpara.stop;
end;
{$endif MEMDEBUG}
if assigned(parast) then
begin
{$ifdef MEMDEBUG}
@ -3454,18 +3456,11 @@ implementation
inc(refcount);
end;
lastref:=defref;
{ first, we assume that all registers are used }
usedintregisters:=paramanager.get_volatile_registers_int(pocall_default);
{$ifdef SUPPORT_MMX}
usedmmxregisters:=paramanager.get_volatile_registers_fpu(pocall_default);
{$endif SUPPORT_MMX}
usedfpuregisters:=paramanager.get_volatile_registers_fpu(pocall_default);
forwarddef:=true;
interfacedef:=false;
hasforward:=false;
_class := nil;
code:=nil;
regvarinfo := nil;
overloadnumber:=0;
{$ifdef GDB}
isstabwritten := false;
@ -3478,9 +3473,6 @@ implementation
inherited ppuload(ppufile);
deftype:=procdef;
ppufile.getnormalset(usedintregisters);
ppufile.getnormalset(usedfpuregisters);
{$warning need to add usedmmxregisters}
has_mangledname:=boolean(ppufile.getbyte);
if has_mangledname then
_mangledname:=stringdup(ppufile.getstring)
@ -3527,7 +3519,6 @@ implementation
forwarddef:=false;
interfacedef:=false;
hasforward:=false;
regvarinfo := nil;
lastref:=nil;
lastwritten:=nil;
defref:=nil;
@ -3566,8 +3557,6 @@ implementation
memprocnodetree.start;
{$endif MEMDEBUG}
end;
if assigned(regvarinfo) then
dispose(pregvarinfo(regvarinfo));
if (po_msgstr in procoptions) then
strdispose(messageinf.str);
if assigned(_mangledname) then
@ -3602,17 +3591,6 @@ implementation
inherited ppuwrite(ppufile);
oldintfcrc:=ppufile.do_interface_crc;
ppufile.do_interface_crc:=false;
{ set all registers to used for simplified compilation PM }
if simplify_ppu then
begin
usedintregisters:=paramanager.get_volatile_registers_int(pocall_default);
usedfpuregisters:=paramanager.get_volatile_registers_fpu(pocall_default);
usedmmxregisters:=paramanager.get_volatile_registers_mm(pocall_default);
end;
ppufile.putnormalset(usedintregisters);
ppufile.putnormalset(usedfpuregisters);
{$warning need to add usedmmxregisters}
ppufile.do_interface_crc:=oldintfcrc;
ppufile.putbyte(byte(has_mangledname));
if has_mangledname then
@ -5890,7 +5868,11 @@ implementation
end.
{
$Log$
Revision 1.178 2003-10-13 14:05:12 peter
Revision 1.179 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.178 2003/10/13 14:05:12 peter
* removed is_visible_for_proc
* search also for class overloads when finding interface
implementations

9
compiler/symsym.pas
View File

@ -331,6 +331,7 @@ interface
function get_label:tasmsymbol;
end;
(*
{ register variables }
pregvarinfo = ^tregvarinfo;
tregvarinfo = record
@ -342,7 +343,7 @@ interface
fpuregvars_para : array[1..maxfpuvarregs] of boolean;
fpuregvars_refs : array[1..maxfpuvarregs] of longint;
end;
*)
var
generrorsym : tsym;
@ -2642,7 +2643,11 @@ implementation
end.
{
$Log$
Revision 1.126 2003-10-13 14:05:12 peter
Revision 1.127 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.126 2003/10/13 14:05:12 peter
* removed is_visible_for_proc
* search also for class overloads when finding interface
implementations

7
compiler/symtable.pas
View File

@ -1684,6 +1684,7 @@ implementation
destructor twithsymtable.destroy;
begin
tobject(withrefnode).free;
symsearch:=nil;
inherited destroy;
end;
@ -2292,7 +2293,11 @@ implementation
end.
{
$Log$
Revision 1.115 2003-10-13 14:05:12 peter
Revision 1.116 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.115 2003/10/13 14:05:12 peter
* removed is_visible_for_proc
* search also for class overloads when finding interface
implementations

10
compiler/symtype.pas
View File

@ -164,6 +164,7 @@ interface
membrowser,
memrealnames,
memmanglednames,
memprocpara,
memprocparast,
memproclocalst,
memprocnodetree : tmemdebug;
@ -839,6 +840,8 @@ initialization
memrealnames.stop;
memmanglednames:=TMemDebug.create('Manglednames');
memmanglednames.stop;
memprocpara:=TMemDebug.create('ProcPara');
memprocpara.stop;
memprocparast:=TMemDebug.create('ProcParaSt');
memprocparast.stop;
memproclocalst:=TMemDebug.create('ProcLocalSt');
@ -850,6 +853,7 @@ finalization
membrowser.free;
memrealnames.free;
memmanglednames.free;
memprocpara.free;
memprocparast.free;
memproclocalst.free;
memprocnodetree.free;
@ -858,7 +862,11 @@ finalization
end.
{
$Log$
Revision 1.28 2003-10-07 16:06:30 peter
Revision 1.29 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.28 2003/10/07 16:06:30 peter
* tsymlist.def renamed to tsymlist.procdef
* tsymlist.procdef is now only used to store the procdef

27
compiler/x86/aasmcpu.pas
View File

@ -204,7 +204,7 @@ interface
function spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsuperregisterset;
const r:Tsuperregisterset;
var unusedregsint:Tsuperregisterset;
const spilltemplist:Tspill_temp_list):boolean;override;
protected
@ -358,9 +358,6 @@ implementation
);
{$endif x86_64}
subreg2type:array[tsubregister] of longint = (
OT_NONE,OT_REG8,OT_REG8,OT_REG16,OT_REG32,OT_REG64,OT_NONE
);
{****************************************************************************
TAI_ALIGN
@ -1895,7 +1892,7 @@ implementation
function Taicpu.spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsuperregisterset;
const r:Tsuperregisterset;
var unusedregsint:Tsuperregisterset;
const spilltemplist:Tspill_temp_list):boolean;
@ -1928,7 +1925,7 @@ implementation
(getregtype(oper[0].reg)=R_INTREGISTER) then
begin
supreg:=getsupreg(oper[0].reg);
if supreg in r then
if supregset_in(r,supreg) then
begin
{Situation example:
push r20d ; r20d must be spilled into [ebp-12]
@ -1945,7 +1942,7 @@ implementation
if oper[0].typ=top_ref then
begin
supreg:=getsupreg(oper[0].ref^.base);
if supreg in r then
if supregset_in(r,supreg) then
begin
{Situation example:
push [r21d+4*r22d] ; r21d must be spilled into [ebp-12]
@ -1971,7 +1968,7 @@ implementation
oper[0].ref^.base:=helpreg;
end;
supreg:=getsupreg(oper[0].ref^.index);
if supreg in r then
if supregset_in(r,supreg) then
begin
{Situation example:
push [r21d+4*r22d] ; r22d must be spilled into [ebp-12]
@ -2007,7 +2004,7 @@ implementation
if oper[i].typ=top_ref then
begin
supreg:=getsupreg(oper[i].ref^.base);
if supreg in r then
if supregset_in(r,supreg) then
begin
{Situation example:
add r20d,[r21d+4*r22d] ; r21d must be spilled into [ebp-12]
@ -2034,7 +2031,7 @@ implementation
forward_allocation(Tai(helpins.next),unusedregsint);
end;
supreg:=getsupreg(oper[i].ref^.index);
if supreg in r then
if supregset_in(r,supreg) then
begin
{Situation example:
add r20d,[r21d+4*r22d] ; r22d must be spilled into [ebp-12]
@ -2066,7 +2063,7 @@ implementation
begin
supreg:=getsupreg(oper[0].reg);
subreg:=getsubreg(oper[0].reg);
if supreg in r then
if supregset_in(r,supreg) then
if oper[1].typ=top_ref then
begin
{Situation example:
@ -2108,7 +2105,7 @@ implementation
begin
supreg:=getsupreg(oper[1].reg);
subreg:=getsubreg(oper[1].reg);
if supreg in r then
if supregset_in(r,supreg) then
begin
if oper[0].typ=top_ref then
begin
@ -2318,7 +2315,11 @@ implementation
end.
{
$Log$
Revision 1.31 2003-10-09 21:31:37 daniel
Revision 1.32 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.31 2003/10/09 21:31:37 daniel
* Register allocator splitted, ans abstract now
Revision 1.30 2003/10/01 20:34:50 peter

80
compiler/x86/cgx86.pas
View File

@ -47,11 +47,11 @@ unit cgx86;
function getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;override;
function getmmregister(list:Taasmoutput;size:Tcgsize):Tregister;override;
procedure getexplicitregister(list:Taasmoutput;r:Tregister);override;
function getabtintregister(list:Taasmoutput;size:Tcgsize):Tregister;override;
procedure ungetregister(list:Taasmoutput;r:Tregister);override;
procedure ungetreference(list:Taasmoutput;const r:Treference);override;
procedure allocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tsuperregisterset);override;
procedure deallocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tsuperregisterset);override;
procedure allocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);override;
procedure deallocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);override;
function uses_registers(rt:Tregistertype):boolean;override;
procedure add_move_instruction(instr:Taicpu);override;
procedure dec_fpu_stack;
procedure inc_fpu_stack;
@ -158,6 +158,9 @@ unit cgx86;
implementation
uses
{$ifdef MEMDEBUG}
cclasses,
{$endif MEMDEBUG}
globtype,globals,verbose,systems,cutils,
symdef,paramgr,tgobj,procinfo;
@ -177,19 +180,29 @@ unit cgx86;
procedure Tcgx86.init_register_allocators;
begin
if cs_create_pic in aktmoduleswitches then
rgint:=trgcpu.create(5,R_INTREGISTER,R_SUBWHOLE,#0#1#2#4#5,first_int_imreg,[RS_EBP,RS_EBX])
rgint:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP,RS_EBX])
else
rgint:=trgcpu.create(6,R_INTREGISTER,R_SUBWHOLE,#0#1#2#3#4#5,first_int_imreg,[RS_EBP]);
rgmm:=trgcpu.create(8,R_MMREGISTER,R_SUBNONE,#0#1#2#3#4#5#6#7,first_sse_imreg,[]);
rgint:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]);
rgmm:=trgcpu.create(R_MMREGISTER,R_SUBNONE,[RS_MM0,RS_MM1,RS_MM2,RS_MM3,RS_MM4,RS_MM5,RS_MM6,RS_MM7],first_sse_imreg,[]);
rgfpu:=Trgx86fpu.create;
end;
procedure Tcgx86.done_register_allocators;
{$ifdef MEMDEBUG}
var
d : tmemdebug;
{$endif}
begin
{$ifdef MEMDEBUG}
d:=tmemdebug.create(current_procinfo.procdef.procsym.name+'-rgobj');
{$endif}
rgint.free;
rgmm.free;
rgfpu.free;
{$ifdef MEMDEBUG}
d.free;
{$endif}
end;
@ -230,12 +243,6 @@ unit cgx86;
end;
function tcgx86.getabtintregister(list:Taasmoutput;size:Tcgsize):Tregister;
begin
result:=rgint.getabtregister(list,cgsize2subreg(size));
end;
procedure tcgx86.ungetregister(list:Taasmoutput;r:Tregister);
begin
case getregtype(r) of
@ -260,7 +267,7 @@ unit cgx86;
end;
procedure Tcgx86.allocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tsuperregisterset);
procedure Tcgx86.allocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);
begin
case rt of
R_INTREGISTER :
@ -273,7 +280,7 @@ unit cgx86;
end;
procedure Tcgx86.deallocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tsuperregisterset);
procedure Tcgx86.deallocexplicitregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);
begin
case rt of
R_INTREGISTER :
@ -286,6 +293,19 @@ unit cgx86;
end;
function Tcgx86.uses_registers(rt:Tregistertype):boolean;
begin
case rt of
R_INTREGISTER :
result:=rgint.uses_registers;
R_SSEREGISTER :
result:=rgmm.uses_registers;
else
internalerror(200310094);
end;
end;
procedure Tcgx86.add_move_instruction(instr:Taicpu);
begin
rgint.add_move_instruction(instr);
@ -309,10 +329,10 @@ unit cgx86;
begin
{ Int }
rgint.do_register_allocation(list,headertai);
list.translate_registers(R_INTREGISTER,rgint.colour);
rgint.translate_registers(list);
{ SSE }
rgmm.do_register_allocation(list,headertai);
list.translate_registers(R_MMREGISTER,rgmm.colour);
rgmm.translate_registers(list);
end;
@ -601,8 +621,8 @@ unit cgx86;
begin
tmpreg:=getaddressregister(list);
a_loadaddr_ref_reg(list,r,tmpreg);
list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
ungetregister(list,tmpreg);
list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
end;
end
else
@ -1495,7 +1515,7 @@ unit cgx86;
list.concat(Tai_section.Create(sec_code));
list.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,pl,0,NR_EDX));
a_call_name(list,target_info.Cprefix+'mcount');
include(rgint.used_in_proc,RS_EDX);
supregset_include(rgint.used_in_proc,RS_EDX);
end;
system_i386_go32v2,system_i386_watcom:
@ -1615,28 +1635,28 @@ unit cgx86;
begin
{ Get temp }
size:=0;
if (RS_EBX in rgint.used_in_proc) then
if supregset_in(rgint.used_in_proc,RS_EBX) then
inc(size,POINTER_SIZE);
if (RS_ESI in rgint.used_in_proc) then
if supregset_in(rgint.used_in_proc,RS_ESI) then
inc(size,POINTER_SIZE);
if (RS_EDI in rgint.used_in_proc) then
if supregset_in(rgint.used_in_proc,RS_EDI) then
inc(size,POINTER_SIZE);
if size>0 then
begin
tg.GetTemp(list,size,tt_noreuse,current_procinfo.save_regs_ref);
{ Copy registers to temp }
href:=current_procinfo.save_regs_ref;
if (RS_EBX in rgint.used_in_proc) then
if supregset_in(rgint.used_in_proc,RS_EBX) then
begin
a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_EBX,href);
inc(href.offset,POINTER_SIZE);
end;
if (RS_ESI in rgint.used_in_proc) then
if supregset_in(rgint.used_in_proc,RS_ESI) then
begin
a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_ESI,href);
inc(href.offset,POINTER_SIZE);
end;
if (RS_EDI in rgint.used_in_proc) then
if supregset_in(rgint.used_in_proc,RS_EDI) then
begin
a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_EDI,href);
inc(href.offset,POINTER_SIZE);
@ -1654,17 +1674,17 @@ unit cgx86;
begin
{ Copy registers from temp }
href:=current_procinfo.save_regs_ref;
if (RS_EBX in rgint.used_in_proc) then
if supregset_in(rgint.used_in_proc,RS_EBX) then
begin
a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EBX);
inc(href.offset,POINTER_SIZE);
end;
if (RS_ESI in rgint.used_in_proc) then
if supregset_in(rgint.used_in_proc,RS_ESI) then
begin
a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_ESI);
inc(href.offset,POINTER_SIZE);
end;
if (RS_EDI in rgint.used_in_proc) then
if supregset_in(rgint.used_in_proc,RS_EDI) then
begin
a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EDI);
inc(href.offset,POINTER_SIZE);
@ -1733,7 +1753,11 @@ unit cgx86;
end.
{
$Log$
Revision 1.79 2003-10-14 00:30:48 florian
Revision 1.80 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.79 2003/10/14 00:30:48 florian
+ some code for PIC support added
Revision 1.78 2003/10/13 01:23:13 florian

26
compiler/x86/cpubase.pas
View File

@ -101,15 +101,8 @@ uses
RS_EBP = RS_RBP;
RS_ESP = RS_RSP;
{ Integer Super register first and last }
first_int_supreg = $00;
{$ifdef x86_64}
last_int_supreg = $0f;
{$else}
last_int_supreg = $07;
{$endif}
{ Number of first imaginary register }
first_int_imreg = $10;
last_int_imreg = $fe;
{ Float Super registers }
RS_ST0 = $00;
@ -121,11 +114,8 @@ uses
RS_ST6 = $06;
RS_ST7 = $07;
{ Float Super register first and last }
first_fpu_supreg = $00;
last_fpu_supreg = $07;
{ Number of first imaginary register }
first_fpu_imreg = $08;
last_fpu_imreg = $fe;
{ MM Super registers }
RS_MM0 = $00;
@ -145,16 +135,12 @@ uses
RS_MM14 = $0e;
RS_MM15 = $0f;
{ Float Super register first and last }
first_sse_supreg = $00;
{ Number of first imaginary register }
{$ifdef x86_64}
last_sse_supreg = $0f;
first_sse_imreg = $10;
{$else x86_64}
last_sse_supreg = $07;
first_sse_imreg = $08;
{$endif x86_64}
last_sse_imreg = $fe;
{ The subregister that specifies the entire register }
{$ifdef x86_64}
@ -568,7 +554,11 @@ implementation
end.
{
$Log$
Revision 1.25 2003-10-11 16:06:42 florian
Revision 1.26 2003-10-17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.25 2003/10/11 16:06:42 florian
* fixed some MMX<->SSE
* started to fix ppc, needs an overhaul
+ stabs info improve for spilling, not sure if it works correctly/completly