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

* Several bugfixes for m68k target (register alloc., opcode emission)

Browse Source 
+ VIS target
  + Generic add more complete (still not verified)
This commit is contained in:
carl 2003-02-02 19:25:54 +00:00
parent 4841a83d44
commit 59d3edeec7
22 changed files with 1478 additions and 401 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/compiler.pas
View File

@ -49,6 +49,15 @@ unit compiler;
{$endif} {$endif}
{$endif} {$endif}
{$ifdef vis}
{$ifndef CPUOK}
{$DEFINE CPUOK}
{$else}
{$fatal cannot define two CPU switches}
{$endif}
{$endif}
{$ifdef powerpc} {$ifdef powerpc}
{$ifndef CPUOK} {$ifndef CPUOK}
{$DEFINE CPUOK} {$DEFINE CPUOK}
@ -377,7 +386,12 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.35 2002-09-05 19:28:31 peter Revision 1.36 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.35 2002/09/05 19:28:31 peter
* removed repetitive pass counting * removed repetitive pass counting
* display heapsize also for extdebug * display heapsize also for extdebug

17
compiler/i386/cpubase.pas
View File

@ -519,6 +519,12 @@ uses
mmregs = [R_MM0..R_MM7]; mmregs = [R_MM0..R_MM7];
usableregsmm = [R_MM0..R_MM7]; usableregsmm = [R_MM0..R_MM7];
c_countusableregsmm = 8; c_countusableregsmm = 8;
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_EAX; firstsaveintreg = R_EAX;
lastsaveintreg = R_EBX; lastsaveintreg = R_EBX;
@ -599,11 +605,11 @@ uses
{the return_result_reg, is used inside the called function to store its return {the return_result_reg, is used inside the called function to store its return
value when that is a scalar value otherwise a pointer to the address of the value when that is a scalar value otherwise a pointer to the address of the
result is placed inside it} result is placed inside it}
return_result_reg = accumulator; return_result_reg = accumulator;
{the function_result_reg contains the function result after a call to a scalar {the function_result_reg contains the function result after a call to a scalar
function othewise it contains a pointer to the returned result} function othewise it contains a pointer to the returned result}
function_result_reg = accumulator; function_result_reg = accumulator;
{# Hi-Results are returned in this register (64-bit value high register) } {# Hi-Results are returned in this register (64-bit value high register) }
accumulatorhigh = R_EDX; accumulatorhigh = R_EDX;
{ WARNING: don't change to R_ST0!! See comments above implementation of } { WARNING: don't change to R_ST0!! See comments above implementation of }
@ -714,7 +720,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.40 2003-01-13 18:37:44 daniel Revision 1.41 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.40 2003/01/13 18:37:44 daniel
* Work on register conversion * Work on register conversion
Revision 1.39 2003/01/09 20:41:00 daniel Revision 1.39 2003/01/09 20:41:00 daniel

82
compiler/m68k/cgcpu.pas
View File

@ -69,6 +69,11 @@ unit cgcpu;
procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);override; procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
procedure g_save_all_registers(list : taasmoutput);override; procedure g_save_all_registers(list : taasmoutput);override;
procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override; procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
{ for address register allocation }
function get_scratch_reg_address(list : taasmoutput) : tregister;override;
function get_scratch_reg_int(list : taasmoutput) : tregister; override;
protected protected
function fixref(list: taasmoutput; var ref: treference): boolean; function fixref(list: taasmoutput; var ref: treference): boolean;
private private
@ -167,6 +172,59 @@ Implementation
end; end;
end; end;
function tcg68k.get_scratch_reg_int(list : taasmoutput) : tregister;
var
r : tregister;
i : longint;
begin
if unusedscratchregisters=[] then
internalerror(68996);
if R_D0 in unusedscratchregisters then
begin
r.enum := R_D0;
end
else if R_D1 in unusedscratchregisters then
begin
r.enum := R_D1;
end
else
internalerror(10);
exclude(unusedscratchregisters,r.enum);
a_reg_alloc(list,r);
get_scratch_reg_int:=r;
end;
function tcg68k.get_scratch_reg_address(list : taasmoutput) : tregister;
var
r : tregister;
i : longint;
begin
if unusedscratchregisters=[] then
internalerror(68996);
if R_A0 in unusedscratchregisters then
begin
r.enum := R_A0;
end
else if R_A1 in unusedscratchregisters then
begin
r.enum := R_A1;
end
else
internalerror(10);
exclude(unusedscratchregisters,r.enum);
a_reg_alloc(list,r);
get_scratch_reg_address:=r;
end;
{****************************************************************************} {****************************************************************************}
{ TCG68K } { TCG68K }
{****************************************************************************} {****************************************************************************}
@ -242,7 +300,7 @@ Implementation
begin begin
if (rg.isaddressregister(register)) then if (rg.isaddressregister(register)) then
begin begin
list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register)) list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
end end
else else
if a = 0 then if a = 0 then
@ -250,9 +308,9 @@ Implementation
else else
begin begin
if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,a,register)) list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
else else
list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register)) list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
end; end;
end; end;
@ -318,6 +376,7 @@ Implementation
{ extended is not supported, since it is not available on Coldfire } { extended is not supported, since it is not available on Coldfire }
if opsize = S_FX then if opsize = S_FX then
internalerror(20020729); internalerror(20020729);
href := ref;
fixref(list,href); fixref(list,href);
{ in emulation mode, only 32-bit single is supported } { in emulation mode, only 32-bit single is supported }
if cs_fp_emulation in aktmoduleswitches then if cs_fp_emulation in aktmoduleswitches then
@ -683,8 +742,12 @@ Implementation
OP_NEG, OP_NEG,
OP_NOT : OP_NOT :
Begin Begin
{ if there are two operands, move the register,
since the operation will only be done on the result
register.
}
if reg1.enum <> R_NO then if reg1.enum <> R_NO then
internalerror(200112291); cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,reg1,reg2);
if (rg.isaddressregister(reg2)) then if (rg.isaddressregister(reg2)) then
begin begin
@ -1124,14 +1187,10 @@ Implementation
{ zero extend } { zero extend }
OS_8: OS_8:
begin begin
if (rg.isaddressregister(reg)) then
internalerror(20020729);
list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg)); list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
end; end;
OS_16: OS_16:
begin begin
if (rg.isaddressregister(reg)) then
internalerror(20020729);
list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg)); list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
end; end;
end; { otherwise the size is already correct } end; { otherwise the size is already correct }
@ -1276,7 +1335,12 @@ end.
{ {
$Log$ $Log$
Revision 1.15 2003-01-08 18:43:57 daniel Revision 1.16 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.15 2003/01/08 18:43:57 daniel
* Tregister changed into a record * Tregister changed into a record
Revision 1.14 2003/01/05 13:36:53 florian Revision 1.14 2003/01/05 13:36:53 florian

55
compiler/m68k/cpubase.pas
View File

@ -109,7 +109,8 @@ uses
R_SPPUSH,R_SPPULL, R_SPPUSH,R_SPPULL,
{ misc. } { misc. }
R_CCR,R_FP0,R_FP1,R_FP2,R_FP3,R_FP4,R_FP5,R_FP6, R_CCR,R_FP0,R_FP1,R_FP2,R_FP3,R_FP4,R_FP5,R_FP6,
R_FP7,R_FPCR,R_SR,R_SSP,R_DFC,R_SFC,R_VBR,R_FPSR); R_FP7,R_FPCR,R_SR,R_SSP,R_DFC,R_SFC,R_VBR,R_FPSR,
R_INTREGISTER,R_FLOATREGISTER);
{# Set type definition for registers } {# Set type definition for registers }
tregisterset = set of Toldregister; tregisterset = set of Toldregister;
@ -128,7 +129,22 @@ uses
treg64 = tregister64; treg64 = tregister64;
Const {New register coding:}
{Special registers:}
const
NR_NO = $0000; {Invalid register}
{Normal registers:}
{General purpose registers:}
NR_D0 = $0100; NR_D1 = $0200; NR_D2 = $0300;
NR_D3 = $0400; NR_D4 = $0500; NR_D5 = $0600;
NR_D6 = $0700; NR_D7 = $0800; NR_A0 = $0900;
NR_A1 = $0A00; NR_A2 = $0B00; NR_A3 = $0C00;
NR_A4 = $0D00; NR_A5 = $0E00; NR_A6 = $0F00;
NR_A7 = $1000;
{# First register in the tregister enumeration } {# First register in the tregister enumeration }
firstreg = low(Toldregister); firstreg = low(Toldregister);
{# Last register in the tregister enumeration } {# Last register in the tregister enumeration }
@ -442,8 +458,8 @@ uses
{# Registers which are defined as scratch integer and no need to save across {# Registers which are defined as scratch integer and no need to save across
routine calls or in assembler blocks. routine calls or in assembler blocks.
} }
max_scratch_regs = 2; max_scratch_regs = 4;
scratch_regs: Array[1..max_scratch_regs] of Toldregister = (R_D0,R_D1); scratch_regs: Array[1..max_scratch_regs] of Toldregister = (R_D0,R_D1,R_A0,R_A1);
{***************************************************************************** {*****************************************************************************
Default generic sizes Default generic sizes
@ -600,14 +616,39 @@ implementation
procedure convert_register_to_enum(var r:Tregister); procedure convert_register_to_enum(var r:Tregister);
begin begin
{$warning Convert_register_to_enum implementation is missing!} if r.enum = R_INTREGISTER then
internalerror(200301082); case r.number of
NR_NO: r.enum:= R_NO;
NR_D0: r.enum:= R_D0;
NR_D1: r.enum:= R_D1;
NR_D2: r.enum:= R_D2;
NR_D3: r.enum:= R_D3;
NR_D4: r.enum:= R_D4;
NR_D5: r.enum:= R_D5;
NR_D6: r.enum:= R_D6;
NR_D7: r.enum:= R_D7;
NR_A0: r.enum:= R_A0;
NR_A1: r.enum:= R_A1;
NR_A2: r.enum:= R_A2;
NR_A3: r.enum:= R_A3;
NR_A4: r.enum:= R_A4;
NR_A5: r.enum:= R_A5;
NR_A6: r.enum:= R_A6;
NR_A7: r.enum:= R_SP;
else
internalerror(200301082);
end;
end; end;
end. end.
{ {
$Log$ $Log$
Revision 1.16 2003-01-09 15:49:56 daniel Revision 1.17 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.16 2003/01/09 15:49:56 daniel
* Added register conversion * Added register conversion
Revision 1.15 2003/01/08 18:43:57 daniel Revision 1.15 2003/01/08 18:43:57 daniel

14
compiler/m68k/cpunode.pas
View File

@ -30,12 +30,12 @@ unit cpunode;
uses uses
{ generic nodes } { generic nodes }
ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgmat,ncgadd ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgmat,ncgadd,
{ to be able to only parts of the generic code, { to be able to only parts of the generic code,
the processor specific nodes must be included the processor specific nodes must be included
after the generic one (FK) after the generic one (FK)
} }
// nm68kadd, ncpuadd,
// nppccal, // nppccal,
// nppccon, // nppccon,
// nppcflw, // nppcflw,
@ -46,13 +46,19 @@ unit cpunode;
{ this not really a node } { this not really a node }
// nppcobj, // nppcobj,
// nppcmat, // nppcmat,
,n68kcnv n68kmat,
n68kcnv
; ;
end. end.
{ {
$Log$ $Log$
Revision 1.3 2002-12-14 15:02:03 carl Revision 1.4 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.3 2002/12/14 15:02:03 carl
* maxoperands -> max_operands (for portability in rautils.pas) * maxoperands -> max_operands (for portability in rautils.pas)
* fix some range-check errors with loadconst * fix some range-check errors with loadconst
+ add ncgadd unit to m68k + add ncgadd unit to m68k

49
compiler/m68k/cpupara.pas
View File

@ -47,19 +47,51 @@ unit cpupara;
implementation implementation
uses uses
verbose; verbose,
globals,
globtype,
systems,
cpuinfo,cginfo,cgbase,
defutil;
function tm68kparamanager.getintparaloc(nr : longint) : tparalocation; function tm68kparamanager.getintparaloc(nr : longint) : tparalocation;
begin begin
fillchar(result,sizeof(tparalocation),0); fillchar(result,sizeof(tparalocation),0);
if nr<1 then
internalerror(2002070801)
else
begin
{ warning : THIS ONLY WORKS WITH INTERNAL ROUTINES,
WHICH MUST ALWAYS PASS 4-BYTE PARAMETERS!!
}
result.loc:=LOC_REFERENCE;
result.reference.index.enum:=frame_pointer_reg;
result.reference.offset:=target_info.first_parm_offset
+nr*4;
end;
end; end;
procedure tm68kparamanager.create_param_loc_info(p : tabstractprocdef); procedure tm68kparamanager.create_param_loc_info(p : tabstractprocdef);
var
param_offset : integer;
hp : tparaitem;
begin begin
{ set default para_alignment to target_info.stackalignment } { frame pointer for nested procedures? }
{ if para_alignment=0 then { inc(nextintreg); }
para_alignment:=aktalignment.paraalign; { constructor? }
} { destructor? }
param_offset := target_info.first_parm_offset;
hp:=tparaitem(p.para.last);
while assigned(hp) do
begin
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.sp_fixup:=0;
hp.paraloc.reference.index.enum:=frame_pointer_reg;
hp.paraloc.reference.offset:=param_offset;
inc(param_offset,aktalignment.paraalign);
hp.paraloc.size := def_cgsize(hp.paratype.def);
hp:=tparaitem(hp.previous);
end;
end; end;
function tm68kparamanager.getselflocation(p : tabstractprocdef) : tparalocation; function tm68kparamanager.getselflocation(p : tabstractprocdef) : tparalocation;
@ -75,7 +107,12 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2003-01-08 18:43:57 daniel Revision 1.4 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.3 2003/01/08 18:43:57 daniel
* Tregister changed into a record * Tregister changed into a record
Revision 1.2 2002/12/14 15:02:03 carl Revision 1.2 2002/12/14 15:02:03 carl

9
compiler/m68k/cputarg.pas
View File

@ -37,7 +37,7 @@ implementation
**************************************} **************************************}
{$ifndef NOTARGETLINUX} {$ifndef NOTARGETLINUX}
,t_linux ,t_linux,t_amiga
{$endif} {$endif}
{************************************** {**************************************
@ -50,7 +50,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.1 2002-08-13 18:01:52 carl Revision 1.2 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.1 2002/08/13 18:01:52 carl
* rename swatoperands to swapoperands * rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing): + m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline assembler generator, system information , inline

137
compiler/m68k/n68kmat.pas
View File

@ -27,7 +27,7 @@ unit n68kmat;
interface interface
uses uses
node,nmat; node,nmat,ncgmat,cpubase,cginfo;
type type
@ -36,16 +36,22 @@ interface
procedure pass_2;override; procedure pass_2;override;
end; end;
tm68kmoddivnode = class(tcgmoddivnode)
procedure emit_div_reg_reg(signed: boolean;denum,num : tregister);override;
procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);override;
end;
implementation implementation
uses uses
globtype,systems, globtype,systems,
cutils,verbose,globals, cutils,verbose,globals,
symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase, symconst,symdef,aasmbase,aasmtai,aasmcpu,
cginfo,cgbase,pass_1,pass_2, cgbase,pass_1,pass_2,
ncon, ncon,
cpubase,cpuinfo,paramgr, cpuinfo,paramgr,defutil,
tgobj,ncgutil,cgobj,rgobj,rgcpu,cgcpu,cg64f32; tgobj,ncgutil,cgobj,rgobj,rgcpu,cgcpu,cg64f32;
@ -114,21 +120,134 @@ implementation
end end
else else
begin begin
secondpass(left); secondpass(left);
location_copy(location,left.location); location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),false);
location_force_reg(exprasmlist,location,opsize,false); location_copy(location,left.location);
cg.a_op_reg_reg(exprasmlist,OP_NOT,opsize,location.register,location.register); if location.loc=LOC_CREGISTER then
location.register := rg.getregisterint(exprasmlist);
{ perform the NOT operation }
cg.a_op_reg_reg(exprasmlist,OP_NOT,opsize,location.register,left.location.register);
end; end;
end; end;
{*****************************************************************************
TM68KMODDIVNODE
*****************************************************************************}
procedure tm68kmoddivnode.emit_div_reg_reg(signed: boolean;denum,num : tregister);
var
continuelabel : tasmlabel;
reg_d0,reg_d1 : tregister;
begin
{ no RTL call, so inline a zero denominator verification }
if aktoptprocessor <> MC68000 then
begin
{ verify if denominator is zero }
objectlibrary.getlabel(continuelabel);
{ compare against zero, if not zero continue }
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(1));
cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
cg.a_label(exprasmlist, continuelabel);
if signed then
exprasmlist.concat(taicpu.op_reg_reg(A_DIVS,S_L,denum,num))
else
exprasmlist.concat(taicpu.op_reg_reg(A_DIVU,S_L,denum,num));
{ result should be in denuminator }
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,num,denum);
end
else
begin
{ On MC68000/68010 mw must pass through RTL routines }
reg_d0:=rg.getexplicitregisterint(exprasmlist,R_D0);
reg_d1:=rg.getexplicitregisterint(exprasmlist,R_D1);
{ put numerator in d0 }
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,num,reg_d0);
{ put denum in D1 }
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,denum,reg_d1);
if signed then
cg.a_call_name(exprasmlist,'FPC_DIV_LONGINT')
else
cg.a_call_name(exprasmlist,'FPC_DIV_CARDINAL');
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,reg_d0,denum);
rg.ungetregisterint(exprasmlist,reg_d0);
rg.ungetregisterint(exprasmlist,reg_d1);
end;
end;
procedure tm68kmoddivnode.emit_mod_reg_reg(signed: boolean;denum,num : tregister);
var tmpreg : tregister;
continuelabel : tasmlabel;
signlabel : tasmlabel;
reg_d0,reg_d1 : tregister;
begin
{ no RTL call, so inline a zero denominator verification }
if aktoptprocessor <> MC68000 then
begin
{ verify if denominator is zero }
objectlibrary.getlabel(continuelabel);
{ compare against zero, if not zero continue }
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(1));
cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
cg.a_label(exprasmlist, continuelabel);
tmpreg := cg.get_scratch_reg_int(exprasmlist);
{ we have to prepare the high register with the }
{ correct sign. i.e we clear it, check if the low dword reg }
{ which will participate in the division is signed, if so we}
{ we extend the sign to the high doword register by inverting }
{ all the bits. }
exprasmlist.concat(taicpu.op_reg(A_CLR,S_L,tmpreg));
objectlibrary.getlabel(signlabel);
exprasmlist.concat(taicpu.op_reg(A_TST,S_L,tmpreg));
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_A,0,tmpreg,signlabel);
{ its a negative value, therefore change sign }
cg.a_label(exprasmlist,signlabel);
{ tmpreg:num / denum }
if signed then
exprasmlist.concat(taicpu.op_reg_reg_reg(A_DIVSL,S_L,denum,tmpreg,num))
else
exprasmlist.concat(taicpu.op_reg_reg_reg(A_DIVUL,S_L,denum,tmpreg,num));
{ remainder in tmpreg }
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,tmpreg,denum);
cg.free_scratch_reg(exprasmlist,tmpreg);
end
else
begin
{ On MC68000/68010 mw must pass through RTL routines }
Reg_d0:=rg.getexplicitregisterint(exprasmlist,R_D0);
Reg_d1:=rg.getexplicitregisterint(exprasmlist,R_D1);
{ put numerator in d0 }
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,num,Reg_D0);
{ put denum in D1 }
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,denum,Reg_D1);
if signed then
cg.a_call_name(exprasmlist,'FPC_MOD_LONGINT')
else
cg.a_call_name(exprasmlist,'FPC_MOD_CARDINAL');
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,Reg_D0,denum);
rg.ungetregisterint(exprasmlist,Reg_D0);
rg.ungetregisterint(exprasmlist,Reg_D1);
end;
end;
begin begin
cnotnode:=tm68knotnode; cnotnode:=tm68knotnode;
cmoddivnode:=tm68kmoddivnode;
end. end.
{ {
$Log$ $Log$
Revision 1.4 2002-09-07 15:25:13 peter Revision 1.5 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.4 2002/09/07 15:25:13 peter
* old logs removed and tabs fixed * old logs removed and tabs fixed
Revision 1.3 2002/08/15 15:15:55 carl Revision 1.3 2002/08/15 15:15:55 carl

440
compiler/m68k/ncpuadd.pas Normal file
View File

@ -0,0 +1,440 @@
{
$Id$
Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe
Code generation for add nodes on the Motorola 680x0 family
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.
****************************************************************************
}
unit ncpuadd;
{$i fpcdefs.inc}
interface
uses
node,nadd,ncgadd,cpubase,cginfo;
type
t68kaddnode = class(tcgaddnode)
procedure second_cmpordinal;override;
procedure second_cmpsmallset;override;
procedure second_cmp64bit;override;
procedure second_cmpboolean;override;
private
function getresflags(unsigned: boolean) : tresflags;
end;
implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,paramgr,
aasmbase,aasmtai,aasmcpu,defutil,htypechk,
cgbase,cpuinfo,pass_1,pass_2,regvars,
cpupara,
ncon,nset,
ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
{*****************************************************************************
Helpers
*****************************************************************************}
function t68kaddnode.getresflags(unsigned : boolean) : tresflags;
begin
case nodetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
else
if not(unsigned) then
begin
if nf_swaped in flags then
case nodetype of
ltn : getresflags:=F_G;
lten : getresflags:=F_GE;
gtn : getresflags:=F_L;
gten : getresflags:=F_LE;
end
else
case nodetype of
ltn : getresflags:=F_L;
lten : getresflags:=F_LE;
gtn : getresflags:=F_G;
gten : getresflags:=F_GE;
end;
end
else
begin
if nf_swaped in flags then
case nodetype of
ltn : getresflags:=F_A;
lten : getresflags:=F_AE;
gtn : getresflags:=F_B;
gten : getresflags:=F_BE;
end
else
case nodetype of
ltn : getresflags:=F_B;
lten : getresflags:=F_BE;
gtn : getresflags:=F_A;
gten : getresflags:=F_AE;
end;
end;
end;
end;
{*****************************************************************************
Smallsets
*****************************************************************************}
procedure t68kaddnode.second_cmpsmallset;
var
tmpreg : tregister;
begin
location_reset(location,LOC_FLAGS,OS_NO);
case nodetype of
equaln,
unequaln :
begin
{emit_compare(true);}
end;
lten,gten:
begin
If (not(nf_swaped in flags) and
(nodetype = lten)) or
((nf_swaped in flags) and
(nodetype = gten)) then
swapleftright;
// now we have to check whether left >= right
tmpreg := cg.get_scratch_reg_int(exprasmlist);
if left.location.loc = LOC_CONSTANT then
begin
cg.a_op_const_reg_reg(exprasmlist,OP_AND,OS_INT,
not(left.location.value),right.location.register,tmpreg);
exprasmlist.concat(taicpu.op_reg(A_TST,S_L,tmpreg));
// the two instructions above should be folded together by
// the peepholeoptimizer
end
else
begin
if right.location.loc = LOC_CONSTANT then
begin
cg.a_load_const_reg(exprasmlist,OS_INT,
aword(right.location.value),tmpreg);
exprasmlist.concat(taicpu.op_reg_reg(A_AND,S_L,
tmpreg,left.location.register));
end
else
exprasmlist.concat(taicpu.op_reg_reg(A_AND,S_L,
right.location.register,left.location.register));
end;
cg.free_scratch_reg(exprasmlist,tmpreg);
location.resflags := getresflags(true);
end;
else
internalerror(2002072701);
end;
end;
{*****************************************************************************
Ordinals
*****************************************************************************}
procedure t68kaddnode.second_cmpordinal;
var
unsigned : boolean;
useconst : boolean;
tmpreg : tregister;
op : tasmop;
begin
{ set result location }
location_reset(location,LOC_JUMP,OS_NO);
{ load values into registers (except constants) }
load_left_right(true, false);
{ determine if the comparison will be unsigned }
unsigned:=not(is_signed(left.resulttype.def)) or
not(is_signed(right.resulttype.def));
// get the constant on the right if there is one
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
// can we use an immediate, or do we have to load the
// constant in a register first?
if (right.location.loc = LOC_CONSTANT) then
begin
{$ifdef extdebug}
if (right.location.size in [OS_64,OS_S64]) and (hi(right.location.valueqword)<>0) and ((hi(right.location.valueqword)<>-1) or unsigned) then
internalerror(2002080301);
{$endif extdebug}
if (nodetype in [equaln,unequaln]) then
if (unsigned and
(right.location.value > high(word))) or
(not unsigned and
(longint(right.location.value) < low(smallint)) or
(longint(right.location.value) > high(smallint))) then
{ we can then maybe use a constant in the 'othersigned' case
(the sign doesn't matter for // equal/unequal)}
unsigned := not unsigned;
if (unsigned and
((right.location.value) <= high(word))) or
(not(unsigned) and
(longint(right.location.value) >= low(smallint)) and
(longint(right.location.value) <= high(smallint))) then
useconst := true
else
begin
useconst := false;
tmpreg := cg.get_scratch_reg_int(exprasmlist);
cg.a_load_const_reg(exprasmlist,OS_INT,
aword(right.location.value),tmpreg);
end
end
else
useconst := false;
location.loc := LOC_FLAGS;
location.resflags := getresflags(unsigned);
op := A_CMP;
if (right.location.loc = LOC_CONSTANT) then
if useconst then
exprasmlist.concat(taicpu.op_reg_const(op,S_L,
left.location.register,longint(right.location.value)))
else
begin
exprasmlist.concat(taicpu.op_reg_reg(op,S_L,
left.location.register,tmpreg));
cg.free_scratch_reg(exprasmlist,tmpreg);
end
else
exprasmlist.concat(taicpu.op_reg_reg(op,S_L,
left.location.register,right.location.register));
end;
{*****************************************************************************
Boolean
*****************************************************************************}
procedure t68kaddnode.second_cmpboolean;
var
cgop : TOpCg;
cgsize : TCgSize;
isjump : boolean;
otl,ofl : tasmlabel;
pushedregs : tmaybesave;
begin
if (torddef(left.resulttype.def).typ=bool8bit) or
(torddef(right.resulttype.def).typ=bool8bit) then
cgsize:=OS_8
else
if (torddef(left.resulttype.def).typ=bool16bit) or
(torddef(right.resulttype.def).typ=bool16bit) then
cgsize:=OS_16
else
cgsize:=OS_32;
if (cs_full_boolean_eval in aktlocalswitches) or
(nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then
begin
if left.nodetype in [ordconstn,realconstn] then
swapleftright;
isjump:=(left.location.loc=LOC_JUMP);
if isjump then
begin
otl:=truelabel;
objectlibrary.getlabel(truelabel);
ofl:=falselabel;
objectlibrary.getlabel(falselabel);
end;
secondpass(left);
if left.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(exprasmlist,left.location,cgsize,false);
if isjump then
begin
truelabel:=otl;
falselabel:=ofl;
end;
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
isjump:=(right.location.loc=LOC_JUMP);
if isjump then
begin
otl:=truelabel;
objectlibrary.getlabel(truelabel);
ofl:=falselabel;
objectlibrary.getlabel(falselabel);
end;
secondpass(right);
maybe_restore(exprasmlist,left.location,pushedregs);
if right.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(exprasmlist,right.location,cgsize,false);
if isjump then
begin
truelabel:=otl;
falselabel:=ofl;
end;
location_reset(location,LOC_FLAGS,OS_NO);
load_left_right(true,false);
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc <> LOC_CONSTANT) then
exprasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,
left.location.register,right.location.register))
else
exprasmlist.concat(taicpu.op_const_reg(A_CMP,S_L,
longint(right.location.value),left.location.register));
location.resflags := getresflags(true);
end;
clear_left_right(true);
end;
{*****************************************************************************
64-bit
*****************************************************************************}
procedure t68kaddnode.second_cmp64bit;
begin
(* load_left_right(true,false);
case nodetype of
ltn,lten,
gtn,gten:
begin
emit_cmp64_hi;
firstjmp64bitcmp;
emit_cmp64_lo;
secondjmp64bitcmp;
end;
equaln,unequaln:
begin
// instead of doing a complicated compare, do
// (left.hi xor right.hi) or (left.lo xor right.lo)
// (somewhate optimized so that no superfluous 'mr's are
// generated)
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc = LOC_CONSTANT) then
begin
if left.location.loc = LOC_REGISTER then
begin
tempreg64.reglo := left.location.registerlow;
tempreg64.reghi := left.location.registerhigh;
end
else
begin
if (aword(right.location.valueqword) <> 0) then
tempreg64.reglo := cg.get_scratch_reg_int(exprasmlist)
else
tempreg64.reglo := left.location.registerlow;
if ((right.location.valueqword shr 32) <> 0) then
tempreg64.reghi := cg.get_scratch_reg_int(exprasmlist)
else
tempreg64.reghi := left.location.registerhigh;
end;
if (aword(right.location.valueqword) <> 0) then
{ negative values can be handled using SUB, }
{ positive values < 65535 using XOR. }
if (longint(right.location.valueqword) >= -32767) and
(longint(right.location.valueqword) < 0) then
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
aword(right.location.valueqword),
left.location.registerlow,tempreg64.reglo)
else
cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
aword(right.location.valueqword),
left.location.registerlow,tempreg64.reglo);
if ((right.location.valueqword shr 32) <> 0) then
if (longint(right.location.valueqword shr 32) >= -32767) and
(longint(right.location.valueqword shr 32) < 0) then
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
aword(right.location.valueqword shr 32),
left.location.registerhigh,tempreg64.reghi)
else
cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
aword(right.location.valueqword shr 32),
left.location.registerhigh,tempreg64.reghi);
end
else
begin
tempreg64.reglo := cg.get_scratch_reg_int(exprasmlist);
tempreg64.reghi := cg.get_scratch_reg_int(exprasmlist);
cg64.a_op64_reg_reg_reg(exprasmlist,OP_XOR,
left.location.register64,right.location.register64,
tempreg64);
end;
cg.a_reg_alloc(exprasmlist,R_0);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_OR_,R_0,
tempreg64.reglo,tempreg64.reghi));
cg.a_reg_dealloc(exprasmlist,R_0);
if (tempreg64.reglo <> left.location.registerlow) then
cg.free_scratch_reg(exprasmlist,tempreg64.reglo);
if (tempreg64.reghi <> left.location.registerhigh) then
cg.free_scratch_reg(exprasmlist,tempreg64.reghi);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags := getresflags;
end;
else
internalerror(2002072803);
end;
{ set result location }
{ (emit_compare sets it to LOC_FLAGS for compares, so set the }
{ real location only now) (JM) }
if cmpop and
not(nodetype in [equaln,unequaln]) then
location_reset(location,LOC_JUMP,OS_NO);
*)
location_reset(location,LOC_JUMP,OS_NO);
end;
begin
caddnode:=t68kaddnode;
end.
{
$Log$
Revision 1.1 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
}

63
compiler/m68k/rgcpu.pas
View File

@ -38,6 +38,10 @@ unit rgcpu;
unusedregsaddr,usableregsaddr : tregisterset; unusedregsaddr,usableregsaddr : tregisterset;
countunusedregsaddr, countunusedregsaddr,
countusableregsaddr : byte; countusableregsaddr : byte;
procedure saveStateForInline(var state: pointer);override;
procedure restoreStateAfterInline(var state: pointer);override;
procedure saveUnusedState(var state: pointer);override;
procedure restoreUnusedState(var state: pointer);override;
function isaddressregister(reg: tregister): boolean; override; function isaddressregister(reg: tregister): boolean; override;
function getaddressregister(list: taasmoutput): tregister; override; function getaddressregister(list: taasmoutput): tregister; override;
procedure ungetaddressregister(list: taasmoutput; r: tregister); override; procedure ungetaddressregister(list: taasmoutput; r: tregister); override;
@ -46,6 +50,7 @@ unit rgcpu;
const saved : tpushedsaved);override; const saved : tpushedsaved);override;
procedure saveusedregisters(list: taasmoutput; procedure saveusedregisters(list: taasmoutput;
var saved : tpushedsaved; const s: tregisterset);override; var saved : tpushedsaved; const s: tregisterset);override;
procedure cleartempgen;override;
end; end;
@ -107,8 +112,8 @@ unit rgcpu;
may not be real (JM) } may not be real (JM) }
else else
begin begin
dec(countunusedregsint); dec(countunusedregsaddr);
exclude(unusedregsint,r.enum); exclude(unusedregsaddr,r.enum);
end; end;
tg.ungettemp(list,hr); tg.ungettemp(list,hr);
end; end;
@ -138,21 +143,69 @@ unit rgcpu;
saved[r.enum].ofs:=hr.offset; saved[r.enum].ofs:=hr.offset;
cg.a_load_reg_ref(list,OS_ADDR,r,hr); cg.a_load_reg_ref(list,OS_ADDR,r,hr);
cg.a_reg_dealloc(list,r); cg.a_reg_dealloc(list,r);
include(unusedregsint,r.enum); include(unusedregsaddr,r.enum);
inc(countunusedregsint); inc(countunusedregsaddr);
end; end;
end; end;
end; end;
procedure trgcpu.saveStateForInline(var state: pointer);
begin
inherited savestateforinline(state);
psavedstate(state)^.unusedregsaddr := unusedregsaddr;
psavedstate(state)^.usableregsaddr := usableregsaddr;
psavedstate(state)^.countunusedregsaddr := countunusedregsaddr;
end;
procedure trgcpu.restoreStateAfterInline(var state: pointer);
begin
unusedregsaddr := psavedstate(state)^.unusedregsaddr;
usableregsaddr := psavedstate(state)^.usableregsaddr;
countunusedregsaddr := psavedstate(state)^.countunusedregsaddr;
inherited restoreStateAfterInline(state);
end;
procedure trgcpu.saveUnusedState(var state: pointer);
begin
inherited saveUnusedState(state);
punusedstate(state)^.unusedregsaddr := unusedregsaddr;
punusedstate(state)^.countunusedregsaddr := countunusedregsaddr;
end;
procedure trgcpu.restoreUnusedState(var state: pointer);
begin
unusedregsaddr := punusedstate(state)^.unusedregsaddr;
countunusedregsaddr := punusedstate(state)^.countunusedregsaddr;
inherited restoreUnusedState(state);
end;
procedure trgcpu.cleartempgen;
begin
inherited cleartempgen;
countunusedregsaddr:=countusableregsaddr;
unusedregsaddr:=usableregsaddr;
end;
initialization initialization
rg := trgcpu.create; rg := trgcpu.create;
end. end.
{ {
$Log$ $Log$
Revision 1.5 2003-01-08 18:43:57 daniel Revision 1.6 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.5 2003/01/08 18:43:57 daniel
* Tregister changed into a record * Tregister changed into a record
Revision 1.4 2002/09/07 15:25:14 peter Revision 1.4 2002/09/07 15:25:14 peter

304
compiler/ncgadd.pas
View File

@ -33,7 +33,7 @@ interface
tcgaddnode = class(taddnode) tcgaddnode = class(taddnode)
{ function pass_1: tnode; override;} { function pass_1: tnode; override;}
procedure pass_2;override; procedure pass_2;override;
private protected
procedure pass_left_and_right; procedure pass_left_and_right;
{ load left and right nodes into registers } { load left and right nodes into registers }
procedure load_left_right(cmpop, load_constants: boolean); procedure load_left_right(cmpop, load_constants: boolean);
@ -51,12 +51,10 @@ interface
procedure second_add64bit;virtual; procedure second_add64bit;virtual;
procedure second_addordinal;virtual; procedure second_addordinal;virtual;
{ procedure second_cmpfloat;virtual;} { procedure second_cmpfloat;virtual;}
procedure second_cmpboolean;virtual; procedure second_cmpboolean;virtual;abstract;
procedure second_cmpsmallset;virtual; procedure second_cmpsmallset;virtual;abstract;
procedure second_cmp64bit;virtual; procedure second_cmp64bit;virtual;abstract;
procedure second_cmpordinal;virtual; procedure second_cmpordinal;virtual;abstract;
end; end;
implementation implementation
@ -75,50 +73,6 @@ interface
{***************************************************************************** {*****************************************************************************
Helpers Helpers
*****************************************************************************} *****************************************************************************}
(*
function tcgaddnode.getresflags(unsigned : boolean) : tresflags;
begin
case nodetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
else
if not(unsigned) then
begin
if nf_swaped in flags then
case nodetype of
ltn : getresflags:=F_G;
lten : getresflags:=F_GE;
gtn : getresflags:=F_L;
gten : getresflags:=F_LE;
end
else
case nodetype of
ltn : getresflags:=F_L;
lten : getresflags:=F_LE;
gtn : getresflags:=F_G;
gten : getresflags:=F_GE;
end;
end
else
begin
if nf_swaped in flags then
case nodetype of
ltn : getresflags:=F_A;
lten : getresflags:=F_AE;
gtn : getresflags:=F_B;
gten : getresflags:=F_BE;
end
else
case nodetype of
ltn : getresflags:=F_B;
lten : getresflags:=F_BE;
gtn : getresflags:=F_A;
gten : getresflags:=F_AE;
end;
end;
end;
end;
*)
procedure tcgaddnode.pass_left_and_right; procedure tcgaddnode.pass_left_and_right;
var var
@ -249,58 +203,6 @@ interface
end; end;
procedure tcgaddnode.second_cmpsmallset;
begin
location_reset(location,LOC_FLAGS,OS_NO);
case nodetype of
equaln,
unequaln :
begin
{emit_compare(true);}
end;
lten,gten:
begin
(*
If (not(nf_swaped in flags) and
(nodetype = lten)) or
((nf_swaped in flags) and
(nodetype = gten)) then
swapleftright;
// now we have to check whether left >= right
tmpreg := cg.get_scratch_reg_int(exprasmlist);
if left.location.loc = LOC_CONSTANT then
begin
cg.a_op_const_reg_reg(exprasmlist,OP_AND,OS_INT,
not(left.location.value),right.location.register,tmpreg);
exprasmlist.concat(taicpu.op_reg_const(A_CMPWI,tmpreg,0));
// the two instructions above should be folded together by
// the peepholeoptimizer
end
else
begin
if right.location.loc = LOC_CONSTANT then
begin
cg.a_load_const_reg(exprasmlist,OS_INT,
aword(right.location.value),tmpreg);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_,tmpreg,
tmpreg,left.location.register));
end
else
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_,tmpreg,
right.location.register,left.location.register));
end;
cg.free_scratch_reg(exprasmlist,tmpreg);
location.resflags.cr := R_CR0;
location.resflags.flag := F_EQ;
opdone := true;*)
end;
else
internalerror(2002072701);
end;
end;
procedure tcgaddnode.second_addsmallset; procedure tcgaddnode.second_addsmallset;
@ -425,6 +327,8 @@ interface
{ calculate the operator which is more difficult } { calculate the operator which is more difficult }
firstcomplex(self); firstcomplex(self);
cmpop := nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
if cmpop then if cmpop then
second_cmpboolean second_cmpboolean
else else
@ -433,21 +337,15 @@ interface
end; end;
procedure tcgaddnode.second_cmpboolean;
begin
end;
procedure tcgaddnode.second_addboolean; procedure tcgaddnode.second_addboolean;
var var
cgop : TOpCg; cgop : TOpCg;
cgsize : TCgSize; cgsize : TCgSize;
cmpop,
isjump : boolean; isjump : boolean;
otl,ofl : tasmlabel; otl,ofl : tasmlabel;
pushedregs : tmaybesave; pushedregs : tmaybesave;
begin begin
cmpop:=false;
if (torddef(left.resulttype.def).typ=bool8bit) or if (torddef(left.resulttype.def).typ=bool8bit) or
(torddef(right.resulttype.def).typ=bool8bit) then (torddef(right.resulttype.def).typ=bool8bit) then
cgsize:=OS_8 cgsize:=OS_8
@ -457,7 +355,7 @@ interface
cgsize:=OS_16 cgsize:=OS_16
else else
cgsize:=OS_32; cgsize:=OS_32;
(*
if (cs_full_boolean_eval in aktlocalswitches) or if (cs_full_boolean_eval in aktlocalswitches) or
(nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then (nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then
begin begin
@ -500,60 +398,37 @@ interface
falselabel:=ofl; falselabel:=ofl;
end; end;
cmpop := nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
{ set result location } { set result location }
if not cmpop then location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def))
else
location_reset(location,LOC_FLAGS,OS_NO);
load_left_right(cmpop,false); load_left_right(false,false);
if (left.location.loc = LOC_CONSTANT) then if (left.location.loc = LOC_CONSTANT) then
swapleftright; swapleftright;
{ compare the }
case nodetype of case nodetype of
ltn,lten,gtn,gten, xorn :
equaln,unequaln : cgop:=OP_XOR;
begin orn :
if (right.location.loc <> LOC_CONSTANT) then cgop:=OP_OR;
exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW, andn :
left.location.register,right.location.register)) cgop:=OP_AND;
else
exprasmlist.concat(taicpu.op_reg_const(A_CMPLWI,
left.location.register,longint(right.location.value)));
location.resflags := getresflags;
end;
else else
begin internalerror(200203247);
case nodetype of end;
xorn :
cgop:=OP_XOR;
orn :
cgop:=OP_OR;
andn :
cgop:=OP_AND;
else
internalerror(200203247);
end;
if right.location.loc <> LOC_CONSTANT then if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT, cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT,
left.location.register,right.location.register, left.location.register,right.location.register,
location.register) location.register)
else else
cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT, cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT,
aword(right.location.value),left.location.register, aword(right.location.value),left.location.register,
location.register); location.register);
end;
end;
end end
else else
begin begin
// just to make sure we free the right registers
cmpop := true;
case nodetype of case nodetype of
andn, andn,
orn : orn :
@ -585,9 +460,9 @@ interface
maketojumpbool(exprasmlist,right,lr_load_regvars); maketojumpbool(exprasmlist,right,lr_load_regvars);
end; end;
end; end;
end;*) end;
{ free used register (except the result register) } { free used register (except the result register) }
clear_left_right(cmpop); clear_left_right(true);
end; end;
@ -616,104 +491,6 @@ interface
clear_left_right(cmpop); clear_left_right(cmpop);
end; end;
procedure tcgaddnode.second_cmp64bit;
begin
(* load_left_right(true,false);
case nodetype of
ltn,lten,
gtn,gten:
begin
emit_cmp64_hi;
firstjmp64bitcmp;
emit_cmp64_lo;
secondjmp64bitcmp;
end;
equaln,unequaln:
begin
// instead of doing a complicated compare, do
// (left.hi xor right.hi) or (left.lo xor right.lo)
// (somewhate optimized so that no superfluous 'mr's are
// generated)
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc = LOC_CONSTANT) then
begin
if left.location.loc = LOC_REGISTER then
begin
tempreg64.reglo := left.location.registerlow;
tempreg64.reghi := left.location.registerhigh;
end
else
begin
if (aword(right.location.valueqword) <> 0) then
tempreg64.reglo := cg.get_scratch_reg_int(exprasmlist)
else
tempreg64.reglo := left.location.registerlow;
if ((right.location.valueqword shr 32) <> 0) then
tempreg64.reghi := cg.get_scratch_reg_int(exprasmlist)
else
tempreg64.reghi := left.location.registerhigh;
end;
if (aword(right.location.valueqword) <> 0) then
{ negative values can be handled using SUB, }
{ positive values < 65535 using XOR. }
if (longint(right.location.valueqword) >= -32767) and
(longint(right.location.valueqword) < 0) then
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
aword(right.location.valueqword),
left.location.registerlow,tempreg64.reglo)
else
cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
aword(right.location.valueqword),
left.location.registerlow,tempreg64.reglo);
if ((right.location.valueqword shr 32) <> 0) then
if (longint(right.location.valueqword shr 32) >= -32767) and
(longint(right.location.valueqword shr 32) < 0) then
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
aword(right.location.valueqword shr 32),
left.location.registerhigh,tempreg64.reghi)
else
cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
aword(right.location.valueqword shr 32),
left.location.registerhigh,tempreg64.reghi);
end
else
begin
tempreg64.reglo := cg.get_scratch_reg_int(exprasmlist);
tempreg64.reghi := cg.get_scratch_reg_int(exprasmlist);
cg64.a_op64_reg_reg_reg(exprasmlist,OP_XOR,
left.location.register64,right.location.register64,
tempreg64);
end;
cg.a_reg_alloc(exprasmlist,R_0);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_OR_,R_0,
tempreg64.reglo,tempreg64.reghi));
cg.a_reg_dealloc(exprasmlist,R_0);
if (tempreg64.reglo <> left.location.registerlow) then
cg.free_scratch_reg(exprasmlist,tempreg64.reglo);
if (tempreg64.reghi <> left.location.registerhigh) then
cg.free_scratch_reg(exprasmlist,tempreg64.reghi);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags := getresflags;
end;
else
internalerror(2002072803);
end;
{ set result location }
{ (emit_compare sets it to LOC_FLAGS for compares, so set the }
{ real location only now) (JM) }
if cmpop and
not(nodetype in [equaln,unequaln]) then
location_reset(location,LOC_JUMP,OS_NO);
*)
end;
procedure tcgaddnode.second_add64bit; procedure tcgaddnode.second_add64bit;
@ -841,22 +618,6 @@ interface
{***************************************************************************** {*****************************************************************************
Ordinals Ordinals
*****************************************************************************} *****************************************************************************}
procedure tcgaddnode.second_cmpordinal;
var
unsigned : boolean;
begin
{ set result location }
location_reset(location,LOC_FLAGS,OS_NO);
{ load values into registers (except constants) }
load_left_right(true, false);
{ determine if the comparison will be unsigned }
unsigned:=not(is_signed(left.resulttype.def)) or
not(is_signed(right.resulttype.def));
end;
procedure tcgaddnode.second_addordinal; procedure tcgaddnode.second_addordinal;
var var
@ -1049,10 +810,17 @@ interface
clear_left_right(cmpop); clear_left_right(cmpop);
end; end;
begin
caddnode:=tcgaddnode;
end. end.
{ {
$Log$ $Log$
Revision 1.4 2003-01-08 18:43:56 daniel Revision 1.5 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.4 2003/01/08 18:43:56 daniel
* Tregister changed into a record * Tregister changed into a record
Revision 1.3 2002/12/14 15:02:03 carl Revision 1.3 2002/12/14 15:02:03 carl

16
compiler/paramgr.pas
View File

@ -64,13 +64,18 @@ unit paramgr;
is required for cdecl procedures is required for cdecl procedures
} }
function copy_value_on_stack(def : tdef;calloption : tproccalloption) : boolean; function copy_value_on_stack(def : tdef;calloption : tproccalloption) : boolean;
{ Returns a structure giving the information on {# Returns a structure giving the information on
the storage of the parameter (which must be the storage of the parameter (which must be
an integer parameter) an integer parameter). This is only used when calling
internal routines directly, where all parameters must
be 4-byte values.
@param(nr Parameter number of routine, starting from 1) @param(nr Parameter number of routine, starting from 1)
} }
function getintparaloc(nr : longint) : tparalocation;virtual;abstract; function getintparaloc(nr : longint) : tparalocation;virtual;abstract;
{# This is used to populate the location information on all parameters
for the routine. This is used for normal call resolution.
}
procedure create_param_loc_info(p : tabstractprocdef);virtual;abstract; procedure create_param_loc_info(p : tabstractprocdef);virtual;abstract;
{ {
@ -400,7 +405,12 @@ end.
{ {
$Log$ $Log$
Revision 1.30 2003-01-08 18:43:56 daniel Revision 1.31 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.30 2003/01/08 18:43:56 daniel
* Tregister changed into a record * Tregister changed into a record
Revision 1.29 2002/12/23 20:58:03 peter Revision 1.29 2002/12/23 20:58:03 peter

14
compiler/powerpc/cpubase.pas
View File

@ -512,6 +512,13 @@ uses
usableregsmm = [R_M14..R_M31]; usableregsmm = [R_M14..R_M31];
c_countusableregsmm = 31-14+1; c_countusableregsmm = 31-14+1;
{ no distinction on this platform }
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_13; firstsaveintreg = R_13;
lastsaveintreg = R_27; lastsaveintreg = R_27;
firstsavefpureg = R_F14; firstsavefpureg = R_F14;
@ -821,7 +828,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.42 2003-01-16 11:31:28 olle Revision 1.43 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.42 2003/01/16 11:31:28 olle
+ added new register constants + added new register constants
+ implemented register convertion proc + implemented register convertion proc

14
compiler/pp.pas
View File

@ -31,6 +31,7 @@ program pp;
M68K generate a compiler for the M68000 M68K generate a compiler for the M68000
SPARC generate a compiler for SPARC SPARC generate a compiler for SPARC
POWERPC generate a compiler for the PowerPC POWERPC generate a compiler for the PowerPC
VIS generate a compile for the VIS
USEOVERLAY compiles a TP version which uses overlays USEOVERLAY compiles a TP version which uses overlays
DEBUG version with debug code is generated DEBUG version with debug code is generated
EXTDEBUG some extra debug code is executed EXTDEBUG some extra debug code is executed
@ -77,6 +78,12 @@ program pp;
{$endif CPUDEFINED} {$endif CPUDEFINED}
{$define CPUDEFINED} {$define CPUDEFINED}
{$endif M68K} {$endif M68K}
{$ifdef vis}
{$ifdef CPUDEFINED}
{$fatal ONLY one of the switches for the CPU type must be defined}
{$endif CPUDEFINED}
{$define CPUDEFINED}
{$endif}
{$ifdef iA64} {$ifdef iA64}
{$ifdef CPUDEFINED} {$ifdef CPUDEFINED}
{$fatal ONLY one of the switches for the CPU type must be defined} {$fatal ONLY one of the switches for the CPU type must be defined}
@ -179,7 +186,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.19 2002-11-15 01:58:53 peter Revision 1.20 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.19 2002/11/15 01:58:53 peter
* merged changes from 1.0.7 up to 04-11 * merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing - -V option for generating bug report tracing
- more tracing for option parsing - more tracing for option parsing

93
compiler/rgobj.pas
View File

@ -43,6 +43,8 @@ unit rgobj;
; ;
type type
regvar_longintarray = array[firstreg..lastreg] of longint; regvar_longintarray = array[firstreg..lastreg] of longint;
regvar_booleanarray = array[firstreg..lastreg] of boolean; regvar_booleanarray = array[firstreg..lastreg] of boolean;
regvar_ptreearray = array[firstreg..lastreg] of tnode; regvar_ptreearray = array[firstreg..lastreg] of tnode;
@ -55,6 +57,48 @@ unit rgobj;
tpushedsaved = array[firstreg..lastreg] of tpushedsavedloc; tpushedsaved = array[firstreg..lastreg] of tpushedsavedloc;
(******************************* private struct **********************)
psavedstate = ^tsavedstate;
tsavedstate = record
unusedregsint,usableregsint : tregisterset;
unusedregsfpu,usableregsfpu : tregisterset;
unusedregsmm,usableregsmm : tregisterset;
unusedregsaddr,usableregsaddr : tregisterset;
countunusedregsaddr,
countunusedregsint,
countunusedregsfpu,
countunusedregsmm : byte;
countusableregsaddr,
countusableregsint,
countusableregsfpu,
countusableregsmm : byte;
{ contains the registers which are really used by the proc itself }
usedbyproc,
usedinproc : tregisterset;
reg_pushes : regvar_longintarray;
is_reg_var : regvar_booleanarray;
regvar_loaded: regvar_booleanarray;
{$ifdef TEMPREGDEBUG}
reg_user : regvar_ptreearray;
reg_releaser : regvar_ptreearray;
{$endif TEMPREGDEBUG}
end;
(******************************* private struct **********************)
punusedstate = ^tunusedstate;
tunusedstate = record
unusedregsint : tregisterset;
unusedregsfpu : tregisterset;
unusedregsmm : tregisterset;
unusedregsaddr : tregisterset;
countunusedregsaddr,
countunusedregsint,
countunusedregsfpu,
countunusedregsmm : byte;
end;
{# {#
This class implements the abstract register allocator This class implements the abstract register allocator
It is used by the code generator to allocate and free It is used by the code generator to allocate and free
@ -213,11 +257,11 @@ unit rgobj;
procedure makeregvar(reg: tregister); procedure makeregvar(reg: tregister);
procedure saveStateForInline(var state: pointer); procedure saveStateForInline(var state: pointer);virtual;
procedure restoreStateAfterInline(var state: pointer); procedure restoreStateAfterInline(var state: pointer);virtual;
procedure saveUnusedState(var state: pointer); procedure saveUnusedState(var state: pointer);virtual;
procedure restoreUnusedState(var state: pointer); procedure restoreUnusedState(var state: pointer);virtual;
protected protected
{ the following two contain the common (generic) code for all } { the following two contain the common (generic) code for all }
{ get- and ungetregisterxxx functions/procedures } { get- and ungetregisterxxx functions/procedures }
@ -275,40 +319,8 @@ unit rgobj;
globals,verbose, globals,verbose,
cgobj,tgobj,regvars; cgobj,tgobj,regvars;
type
psavedstate = ^tsavedstate;
tsavedstate = record
unusedregsint,usableregsint : tregisterset;
unusedregsfpu,usableregsfpu : tregisterset;
unusedregsmm,usableregsmm : tregisterset;
countunusedregsint,
countunusedregsfpu,
countunusedregsmm : byte;
countusableregsint,
countusableregsfpu,
countusableregsmm : byte;
{ contains the registers which are really used by the proc itself }
usedbyproc,
usedinproc : tregisterset;
reg_pushes : regvar_longintarray;
is_reg_var : regvar_booleanarray;
regvar_loaded: regvar_booleanarray;
{$ifdef TEMPREGDEBUG}
reg_user : regvar_ptreearray;
reg_releaser : regvar_ptreearray;
{$endif TEMPREGDEBUG}
end;
punusedstate = ^tunusedstate;
tunusedstate = record
unusedregsint : tregisterset;
unusedregsfpu : tregisterset;
unusedregsmm : tregisterset;
countunusedregsint,
countunusedregsfpu,
countunusedregsmm : byte;
end;
constructor trgobj.create; constructor trgobj.create;
@ -532,6 +544,8 @@ unit rgobj;
ungetregisterfpu(list,r) ungetregisterfpu(list,r)
else if r.enum in mmregs then else if r.enum in mmregs then
ungetregistermm(list,r) ungetregistermm(list,r)
else if r.enum in addrregs then
ungetaddressregister(list,r)
else internalerror(2002070602); else internalerror(2002070602);
end; end;
@ -1016,7 +1030,12 @@ end.
{ {
$Log$ $Log$
Revision 1.21 2003-01-08 18:43:57 daniel Revision 1.22 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.21 2003/01/08 18:43:57 daniel
* Tregister changed into a record * Tregister changed into a record
Revision 1.20 2002/10/05 12:43:28 carl Revision 1.20 2002/10/05 12:43:28 carl

31
compiler/sparc/cpubase.pas
View File

@ -121,12 +121,12 @@ const
IF_SSE = $00010000; { it's a SSE (KNI, MMX2) instruction } IF_SSE = $00010000; { it's a SSE (KNI, MMX2) instruction }
IF_PMASK = LongInt($FF000000); { the mask for processor types } IF_PMASK = LongInt($FF000000); { the mask for processor types }
IF_PFMASK = LongInt($F001FF00); { the mask for disassembly "prefer" } IF_PFMASK = LongInt($F001FF00); { the mask for disassembly "prefer" }
IF_V7 = $00000000; { SPARC V7 instruction only (not supported)} IF_V7 = $00000000; { SPARC V7 instruction only (not supported)}
IF_V8 = $01000000; { SPARC V8 instruction (the default)} IF_V8 = $01000000; { SPARC V8 instruction (the default)}
IF_V9 = $02000000; { SPARC V9 instruction (not yet supported)} IF_V9 = $02000000; { SPARC V9 instruction (not yet supported)}
{ added flags } { added flags }
IF_PRE = $40000000; { it's a prefix instruction } IF_PRE = $40000000; { it's a prefix instruction }
IF_PASS2 = LongInt($80000000);{instruction can change in a second pass?} IF_PASS2 = LongInt($80000000);{instruction can change in a second pass?}
TYPE TYPE
{$WARNING CPU32 opcodes do not fully include the Ultra SPRAC instruction set.} {$WARNING CPU32 opcodes do not fully include the Ultra SPRAC instruction set.}
{ don't change the order of these opcodes! } { don't change the order of these opcodes! }
@ -378,6 +378,12 @@ const
mmregs=[]; mmregs=[];
usableregsmm=[]; usableregsmm=[];
c_countusableregsmm=0; c_countusableregsmm=0;
{ no distinction on this platform }
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_O0; firstsaveintreg = R_O0;
lastsaveintreg = R_I7; lastsaveintreg = R_I7;
@ -400,15 +406,15 @@ const
Taken from rs6000.h (DBX_REGISTER_NUMBER) from GCC 3.x source code.} Taken from rs6000.h (DBX_REGISTER_NUMBER) from GCC 3.x source code.}
stab_regindex:ARRAY[firstreg..lastreg]OF ShortInt=({$INCLUDE stabregi.inc}); stab_regindex:ARRAY[firstreg..lastreg]OF ShortInt=({$INCLUDE stabregi.inc});
{*************************** generic register names **************************} {*************************** generic register names **************************}
stack_pointer_reg = R_O6; stack_pointer_reg = R_O6;
frame_pointer_reg = R_I6; frame_pointer_reg = R_I6;
{the return_result_reg, is used inside the called function to store its return {the return_result_reg, is used inside the called function to store its return
value when that is a scalar value otherwise a pointer to the address of the value when that is a scalar value otherwise a pointer to the address of the
result is placed inside it} result is placed inside it}
return_result_reg = R_I0; return_result_reg = R_I0;
{the function_result_reg contains the function result after a call to a scalar {the function_result_reg contains the function result after a call to a scalar
function othewise it contains a pointer to the returned result} function othewise it contains a pointer to the returned result}
function_result_reg = R_O0; function_result_reg = R_O0;
self_pointer_reg =R_G5; self_pointer_reg =R_G5;
{There is no accumulator in the SPARC architecture. There are just families {There is no accumulator in the SPARC architecture. There are just families
of registers. All registers belonging to the same family are identical except of registers. All registers belonging to the same family are identical except
@ -493,6 +499,8 @@ const
max_operands = 3; max_operands = 3;
maxintregs = maxvarregs; maxintregs = maxvarregs;
maxfpuregs = maxfpuvarregs; maxfpuregs = maxfpuvarregs;
FUNCTION is_calljmp(o:tasmop):boolean; FUNCTION is_calljmp(o:tasmop):boolean;
FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond; FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond;
@ -603,7 +611,12 @@ END.
{ {
$Log$ $Log$
Revision 1.21 2003-01-20 22:21:36 mazen Revision 1.22 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.21 2003/01/20 22:21:36 mazen
* many stuff related to RTL fixed * many stuff related to RTL fixed
Revision 1.20 2003/01/09 20:41:00 daniel Revision 1.20 2003/01/09 20:41:00 daniel

10
compiler/symdef.pas
View File

@ -715,6 +715,9 @@ interface
{$ifdef SPARC} {$ifdef SPARC}
pbestrealtype : ^ttype = @s64floattype; pbestrealtype : ^ttype = @s64floattype;
{$endif SPARC} {$endif SPARC}
{$ifdef vis}
pbestrealtype : ^ttype = @s64floattype;
{$endif vis}
function mangledname_prefix(typeprefix:string;st:tsymtable):string; function mangledname_prefix(typeprefix:string;st:tsymtable):string;
@ -5648,7 +5651,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.127 2003-01-21 14:36:44 pierre Revision 1.128 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.127 2003/01/21 14:36:44 pierre
* set sizes needs to be passes in bits not bytes to stabs info * set sizes needs to be passes in bits not bytes to stabs info
Revision 1.126 2003/01/16 22:11:33 peter Revision 1.126 2003/01/16 22:11:33 peter

57
compiler/systems/i_amiga.pas
View File

@ -30,31 +30,34 @@ unit i_amiga;
const const
system_m68k_amiga_info : tsysteminfo = system_m68k_amiga_info : tsysteminfo =
( (
system : target_m68k_Amiga; system : system_m68k_Amiga;
name : 'Commodore Amiga'; name : 'Commodore Amiga';
shortname : 'amiga'; shortname : 'amiga';
flags : []; flags : [];
cpu : cpu_m68k; cpu : cpu_m68k;
short_name : 'AMIGA';
unit_env : ''; unit_env : '';
extradefines : ''; extradefines : '';
sharedlibext : '.library';
staticlibext : '.a';
sourceext : '.pp'; sourceext : '.pp';
pasext : '.pas'; pasext : '.pas';
exeext : ''; exeext : '';
defext : ''; defext : '.def';
scriptext : ''; scriptext : '.sh';
smartext : '.sl'; smartext : '.sl';
unitext : '.ppa'; unitext : '.ppu';
unitlibext : '.ppl'; unitlibext : '.ppl';
asmext : '.asm'; asmext : '.asm';
objext : '.o'; objext : '.o';
resext : '.res'; resext : '.res';
resobjext : '.or'; resobjext : '.or';
staticlibprefix : ''; sharedlibext : '.library';
staticlibext : '.a';
staticlibprefix : 'lib';
sharedlibprefix : ''; sharedlibprefix : '';
Cprefix : '_'; sharedClibext : '.library';
staticClibext : '.a';
staticClibprefix : 'lib';
sharedClibprefix : '';
Cprefix : '';
newline : #10; newline : #10;
dirsep : '/'; dirsep : '/';
files_case_relevent : true; files_case_relevent : true;
@ -62,16 +65,31 @@ unit i_amiga;
assemextern : as_gas; assemextern : as_gas;
link : nil; link : nil;
linkextern : nil; linkextern : nil;
ar : ar_m68k_ar; ar : ar_gnu_ar;
res : res_none; res : res_none;
script : script_amiga; script : script_amiga;
endian : endian_big; endian : endian_big;
stackalignment : 2; alignment :
maxCrecordalignment : 4; (
heapsize : 128*1024; procalign : 4;
stacksize : 8192; loopalign : 4;
jumpalign : 0;
constalignmin : 0;
constalignmax : 4;
varalignmin : 0;
varalignmax : 4;
localalignmin : 0;
localalignmax : 4;
paraalign : 4;
recordalignmin : 0;
recordalignmax : 2;
maxCrecordalign : 4
);
first_parm_offset : 8;
heapsize : 256*1024;
stacksize : 262144;
DllScanSupported:false; DllScanSupported:false;
use_function_relative_addresses : false use_function_relative_addresses : true
); );
implementation implementation
@ -79,13 +97,18 @@ unit i_amiga;
initialization initialization
{$ifdef cpu68} {$ifdef cpu68}
{$ifdef AMIGA} {$ifdef AMIGA}
set_source_info(system_m68k_Amiga); set_source_info(system_m68k_Amiga_info);
{$endif amiga} {$endif amiga}
{$endif cpu68} {$endif cpu68}
end. end.
{ {
$Log$ $Log$
Revision 1.1 2002-09-06 15:03:51 carl Revision 1.2 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.1 2002/09/06 15:03:51 carl
* moved files to systems directory * moved files to systems directory
Revision 1.3 2002/08/13 18:01:51 carl Revision 1.3 2002/08/13 18:01:51 carl

259
compiler/vis/aasmcpu.pas Normal file
View File

@ -0,0 +1,259 @@
{
$Id$
Copyright (c) 1998-2001 by Florian Klaempfl and Pierre Muller
virtual instruction set family assembler instructions
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.
****************************************************************************
}
unit aasmcpu;
{$i fpcdefs.inc}
interface
uses
cclasses,aasmtai,
aasmbase,globals,verbose,
cpubase,cpuinfo;
type
taicpu = class(taicpu_abstract)
opsize : topsize;
constructor op_none(op : tasmop;_size : topsize);
constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister);
constructor op_const(op : tasmop;_size : topsize;_op1 : longint);
constructor op_ref(op : tasmop;_size : topsize;_op1 : treference);
constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : treference);
constructor op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister);
constructor op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister);
constructor op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference);
{ this is for Jmp instructions }
constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
{ for DBxx opcodes }
constructor op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol);
constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
private
procedure init(_size : topsize); { this need to be called by all constructor }
end;
tai_align = class(tai_align_abstract)
{ nothing to add }
end;
procedure InitAsm;
procedure DoneAsm;
implementation
{*****************************************************************************
Taicpu Constructors
*****************************************************************************}
procedure taicpu.init(_size : topsize);
begin
typ:=ait_instruction;
is_jmp:=false;
opsize:=_size;
ops:=0;
end;
constructor taicpu.op_none(op : tasmop;_size : topsize);
begin
inherited create(op);;
init(_size);
end;
constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister);
begin
inherited create(op);;
init(_size);
ops:=1;
loadreg(0,_op1);
end;
constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : longint);
begin
inherited create(op);;
init(_size);
ops:=1;
loadconst(0,aword(_op1));
end;
constructor taicpu.op_ref(op : tasmop;_size : topsize;_op1 : treference);
begin
inherited create(op);;
init(_size);
ops:=1;
loadref(0,_op1);
end;
constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
begin
inherited create(op);;
init(_size);
ops:=2;
loadreg(0,_op1);
loadreg(1,_op2);
end;
constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : treference);
begin
inherited create(op);;
init(_size);
ops:=2;
loadreg(0,_op1);
loadref(1,_op2);
end;
constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister);
begin
inherited create(op);;
init(_size);
ops:=2;
loadconst(0,aword(_op1));
loadreg(1,_op2);
end;
constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference);
begin
inherited create(op);;
init(_size);
ops:=2;
loadconst(0,aword(_op1));
loadref(1,_op2);
end;
constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister);
begin
inherited create(op);;
init(_size);
ops:=2;
loadref(0,_op1);
loadreg(1,_op2);
end;
constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
begin
inherited create(op);;
init(_size);
ops:=1;
loadsymbol(0,_op1,0);
end;
constructor taicpu.op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol);
begin
inherited create(op);
init(_size);
ops:=2;
loadreg(0,_op1);
loadsymbol(1,_op2,0);
end;
constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
begin
inherited create(op);
init(_size);
ops:=2;
loadsymbol(0,_op1,_op1ofs);
loadref(1,_op2);
end;
constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
begin
inherited create(op);
init(_size);
ops:=1;
loadsymbol(0,_op1,_op1ofs);
end;
constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
begin
inherited create(op);;
init(_size);
ops:=2;
loadreg(0,_op2);
loadsymbol(1,_op1,_op1ofs);
end;
constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
begin
inherited create(op);
init(_size);
condition:=cond;
ops:=1;
loadsymbol(0,_op1,0);
end;
procedure InitAsm;
begin
end;
procedure DoneAsm;
begin
end;
end.
{
$Log$
Revision 1.1 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
}

97
compiler/vis/cpubase.pas
View File

@ -66,18 +66,24 @@ uses
*****************************************************************************} *****************************************************************************}
type type
tregister = (R_NO,R_R0,R_R1,R_R2,R_R3, toldregister = (R_NO,R_R0,R_R1,R_R2,R_R3,
R_R4,R_R5,R_R6,R_R7, R_R4,R_R5,R_R6,R_R7,
R_R8,R_R9,R_R10,R_R11, R_R8,R_R9,R_R10,R_R11,
R_CCR,R_SP,R_FP,R_PC, R_CCR,R_SP,R_FP,R_PC,
R_FP0,R_FP1,R_FP2,R_FP3, R_FP0,R_FP1,R_FP2,R_FP3,
R_FP4,R_FP5,R_FP6,R_FP7, R_FP4,R_FP5,R_FP6,R_FP7,
R_FP8,R_FP9,R_FP10,R_FP11, R_FP8,R_FP9,R_FP10,R_FP11,
R_FP12,R_FP13,R_FP14,R_FP15 R_FP12,R_FP13,R_FP14,R_FP15,
R_INTREGISTER,R_FPUREGISTER
); );
{# Set type definition for registers } {# Set type definition for registers }
tregisterset = set of tregister; tregisterset = set of Toldregister;
tregister=record
enum:toldregister;
number:word;
end;
{ A type to store register locations for 64 Bit values. } { A type to store register locations for 64 Bit values. }
tregister64 = packed record tregister64 = packed record
@ -88,19 +94,31 @@ uses
treg64 = tregister64; treg64 = tregister64;
{# Type definition for the array of string of register nnames } {# Type definition for the array of string of register nnames }
treg2strtable = array[tregister] of string[5]; treg2strtable = array[toldregister] of string[5];
Const Const
{Special registers:}
NR_NO = $0000; {Invalid register}
{Normal registers:}
{General purpose registers:}
NR_R0 = $0100; NR_R1 = $0200; NR_R2 = $0300;
NR_R3 = $0400; NR_R4 = $0500; NR_R5 = $0600;
NR_R6 = $0700; NR_R7 = $0800; NR_R8 = $0900;
NR_R9 = $0A00; NR_R10 = $0B00; NR_R11 = $0C00;
{# First register in the tregister enumeration } {# First register in the tregister enumeration }
firstreg = low(tregister); firstreg = low(toldregister);
{# Last register in the tregister enumeration } {# Last register in the tregister enumeration }
lastreg = high(tregister); lastreg = high(toldregister);
std_reg2str : treg2strtable = ('', std_reg2str : treg2strtable = ('',
'r0','r1','r2','r3','r4','r5','r6','r7','r8','r9','r10','r11','ccr', 'r0','r1','r2','r3','r4','r5','r6','r7','r8','r9','r10','r11','ccr',
'sp','fp','pc','fp0','fp1','fp2','fp3','fp4','fp5','fp6','fp7', 'sp','fp','pc','fp0','fp1','fp2','fp3','fp4','fp5','fp6','fp7',
'fp8','fp9','fp10','fp11','fp12','fp13','fp14','fp15' 'fp8','fp9','fp10','fp11','fp12','fp13','fp14','fp15','',''
); );
@ -199,6 +217,16 @@ uses
{***************************************************************************** {*****************************************************************************
Operand Sizes Operand Sizes
*****************************************************************************} *****************************************************************************}
{ S_NO = No Size of operand }
{ S_B = 8-bit size operand }
{ S_W = 16-bit size operand }
{ S_L = 32-bit size operand }
{ Floating point types }
{ S_FS = single type (32 bit) }
{ S_FD = double/64bit integer }
{ S_FX = Extended type }
topsize = (S_NO,S_B,S_W,S_L,S_FS,S_FD,S_FX,S_IQ);
{***************************************************************************** {*****************************************************************************
Generic Location Generic Location
@ -350,6 +378,12 @@ uses
mmregs = []; mmregs = [];
usableregsmm = []; usableregsmm = [];
c_countusableregsmm = 0; c_countusableregsmm = 0;
{ no distinction on this platform }
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_R2; firstsaveintreg = R_R2;
lastsaveintreg = R_R11; lastsaveintreg = R_R11;
@ -359,11 +393,11 @@ uses
lastsavemmreg = R_NO; lastsavemmreg = R_NO;
maxvarregs = 10; maxvarregs = 10;
varregs : Array [1..maxvarregs] of Tregister = varregs : Array [1..maxvarregs] of toldregister =
(R_R2,R_R3,R_R4,R_R5,R_R6,R_R7,R_R8,R_R9,R_R10,R_R11); (R_R2,R_R3,R_R4,R_R5,R_R6,R_R7,R_R8,R_R9,R_R10,R_R11);
maxfpuvarregs = 15; maxfpuvarregs = 15;
fpuvarregs : Array [1..maxfpuvarregs] of Tregister = fpuvarregs : Array [1..maxfpuvarregs] of toldregister =
(R_FP1,R_FP2,R_FP3, (R_FP1,R_FP2,R_FP3,
R_FP4,R_FP5,R_FP6, R_FP4,R_FP5,R_FP6,
R_FP7,R_FP8,R_FP9, R_FP7,R_FP8,R_FP9,
@ -381,7 +415,7 @@ uses
routine calls or in assembler blocks. routine calls or in assembler blocks.
} }
max_scratch_regs = 2; max_scratch_regs = 2;
scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_R0,R_R1); scratch_regs: Array[1..max_scratch_regs] of toldregister = (R_R0,R_R1);
{***************************************************************************** {*****************************************************************************
Default generic sizes Default generic sizes
@ -406,7 +440,7 @@ uses
Currently unsupported by abstract machine Currently unsupported by abstract machine
} }
stab_regindex : array[tregister] of shortint = stab_regindex : array[toldregister] of shortint =
(-1, (-1,
{ r0..r11 } { r0..r11 }
-1,-1,-1,-1,-1,-1, -1,-1,-1,-1,-1,-1,
@ -416,7 +450,9 @@ uses
{ FP0..FP7 } { FP0..FP7 }
-1,-1,-1,-1,-1,-1,-1,-1, -1,-1,-1,-1,-1,-1,-1,-1,
{ FP8..FP15 } { FP8..FP15 }
-1,-1,-1,-1,-1,-1,-1,-1 -1,-1,-1,-1,-1,-1,-1,-1,
{ invalid }
-1,-1
); );
@ -440,11 +476,11 @@ uses
{the return_result_reg, is used inside the called function to store its return {the return_result_reg, is used inside the called function to store its return
value when that is a scalar value otherwise a pointer to the address of the value when that is a scalar value otherwise a pointer to the address of the
result is placed inside it} result is placed inside it}
return_result_reg = accumulator; return_result_reg = accumulator;
{the function_result_reg contains the function result after a call to a scalar {the function_result_reg contains the function result after a call to a scalar
function othewise it contains a pointer to the returned result} function othewise it contains a pointer to the returned result}
function_result_reg = accumulator; function_result_reg = accumulator;
{# Hi-Results are returned in this register (64-bit value high register) } {# Hi-Results are returned in this register (64-bit value high register) }
accumulatorhigh = R_R1; accumulatorhigh = R_R1;
fpu_result_reg = R_FP0; fpu_result_reg = R_FP0;
@ -480,6 +516,7 @@ uses
procedure inverse_flags(var r : TResFlags); procedure inverse_flags(var r : TResFlags);
function flags_to_cond(const f: TResFlags) : TAsmCond; function flags_to_cond(const f: TResFlags) : TAsmCond;
procedure convert_register_to_enum(var r:Tregister);
implementation implementation
@ -531,10 +568,40 @@ implementation
flags_to_cond := flags2cond[f]; flags_to_cond := flags2cond[f];
end; end;
procedure convert_register_to_enum(var r:Tregister);
begin
if r.enum = R_INTREGISTER then
case r.number of
NR_NO: r.enum:= R_NO;
NR_R0: r.enum:= R_R0;
NR_R1: r.enum:= R_R1;
NR_R2: r.enum:= R_R2;
NR_R3: r.enum:= R_R3;
NR_R4: r.enum:= R_R4;
NR_R5: r.enum:= R_R5;
NR_R6: r.enum:= R_R6;
NR_R7: r.enum:= R_R7;
NR_R8: r.enum:= R_R8;
NR_R9: r.enum:= R_R9;
NR_R10: r.enum:= R_R10;
NR_R11: r.enum:= R_R11;
else
internalerror(200301082);
end;
end;
end. end.
{ {
$Log$ $Log$
Revision 1.3 2002-11-17 18:26:16 mazen Revision 1.4 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.3 2002/11/17 18:26:16 mazen
* fixed a compilation bug accmulator-->accumulator, in definition of return_result_reg * fixed a compilation bug accmulator-->accumulator, in definition of return_result_reg
Revision 1.2 2002/11/17 17:49:09 mazen Revision 1.2 2002/11/17 17:49:09 mazen

84
compiler/vis/cpupara.pas Normal file
View File

@ -0,0 +1,84 @@
{
$Id$
Copyright (c) 2002 by Florian Klaempfl
Generates the argument location information for the
virtual instruction set machine
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published bymethodpointer
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.
****************************************************************************
}
{ Generates the argument location information for 680x0.
}
unit cpupara;
{$i fpcdefs.inc}
interface
uses
cpubase,
symdef,paramgr;
type
{ Returns the location for the nr-st 32 Bit int parameter
if every parameter before is an 32 Bit int parameter as well
and if the calling conventions for the helper routines of the
rtl are used.
}
tcpuparamanager = class(tparamanager)
function getintparaloc(nr : longint) : tparalocation;override;
procedure create_param_loc_info(p : tabstractprocdef);override;
function getselflocation(p : tabstractprocdef) : tparalocation;override;
end;
implementation
uses
verbose,
globals,
globtype,
systems,
cpuinfo,cginfo,cgbase,
defutil;
function tcpuparamanager.getintparaloc(nr : longint) : tparalocation;
begin
end;
procedure tcpuparamanager.create_param_loc_info(p : tabstractprocdef);
var
param_offset : integer;
hp : tparaitem;
begin
end;
function tcpuparamanager.getselflocation(p : tabstractprocdef) : tparalocation;
begin
end;
begin
paramanager:=tcpuparamanager.create;
end.
{
$Log$
Revision 1.1 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
}

18
compiler/x86_64/cpubase.pas
View File

@ -371,6 +371,13 @@ const
mmregs = [R_MM0..R_MM7]; mmregs = [R_MM0..R_MM7];
usableregsmm = [R_XMM0..R_XMM15]; usableregsmm = [R_XMM0..R_XMM15];
c_countusableregsmm = 8; c_countusableregsmm = 8;
{ no distinction on this platform }
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_EAX; firstsaveintreg = R_EAX;
lastsaveintreg = R_R15; lastsaveintreg = R_R15;
@ -417,11 +424,11 @@ const
{the return_result_reg, is used inside the called function to store its return {the return_result_reg, is used inside the called function to store its return
value when that is a scalar value otherwise a pointer to the address of the value when that is a scalar value otherwise a pointer to the address of the
result is placed inside it} result is placed inside it}
return_result_reg = accumulator; return_result_reg = accumulator;
{the function_result_reg contains the function result after a call to a scalar {the function_result_reg contains the function result after a call to a scalar
function othewise it contains a pointer to the returned result} function othewise it contains a pointer to the returned result}
function_result_reg = accumulator; function_result_reg = accumulator;
accumulatorhigh = R_RDX; accumulatorhigh = R_RDX;
{ the register where the vmt offset is passed to the destructor } { the register where the vmt offset is passed to the destructor }
{ helper routine } { helper routine }
@ -500,7 +507,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.5 2003-01-05 13:36:54 florian Revision 1.6 2003-02-02 19:25:54 carl
* Several bugfixes for m68k target (register alloc., opcode emission)
+ VIS target
+ Generic add more complete (still not verified)
Revision 1.5 2003/01/05 13:36:54 florian
* x86-64 compiles * x86-64 compiles
+ very basic support for float128 type (x86-64 only) + very basic support for float128 type (x86-64 only)