paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 21:09:44 +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

16
compiler/compiler.pas
View File

@ -49,6 +49,15 @@ unit compiler;
{$endif}
{$endif}
{$ifdef vis}
{$ifndef CPUOK}
{$DEFINE CPUOK}
{$else}
{$fatal cannot define two CPU switches}
{$endif}
{$endif}
{$ifdef powerpc}
{$ifndef CPUOK}
{$DEFINE CPUOK}
@ -377,7 +386,12 @@ end;
end.
{
$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
* display heapsize also for extdebug

17
compiler/i386/cpubase.pas
View File

@ -519,6 +519,12 @@ uses
mmregs = [R_MM0..R_MM7];
usableregsmm = [R_MM0..R_MM7];
c_countusableregsmm = 8;
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_EAX;
lastsaveintreg = R_EBX;
@ -599,11 +605,11 @@ uses
{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
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
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) }
accumulatorhigh = R_EDX;
{ WARNING: don't change to R_ST0!! See comments above implementation of }
@ -714,7 +720,12 @@ implementation
end.
{
$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
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_save_all_registers(list : taasmoutput);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
function fixref(list: taasmoutput; var ref: treference): boolean;
private
@ -167,6 +172,59 @@ Implementation
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 }
{****************************************************************************}
@ -242,7 +300,7 @@ Implementation
begin
if (rg.isaddressregister(register)) then
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
else
if a = 0 then
@ -250,9 +308,9 @@ Implementation
else
begin
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
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;
@ -318,6 +376,7 @@ Implementation
{ extended is not supported, since it is not available on Coldfire }
if opsize = S_FX then
internalerror(20020729);
href := ref;
fixref(list,href);
{ in emulation mode, only 32-bit single is supported }
if cs_fp_emulation in aktmoduleswitches then
@ -683,8 +742,12 @@ Implementation
OP_NEG,
OP_NOT :
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
internalerror(200112291);
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,reg1,reg2);
if (rg.isaddressregister(reg2)) then
begin
@ -1124,14 +1187,10 @@ Implementation
{ zero extend }
OS_8:
begin
if (rg.isaddressregister(reg)) then
internalerror(20020729);
list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
end;
OS_16:
begin
if (rg.isaddressregister(reg)) then
internalerror(20020729);
list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
end;
end; { otherwise the size is already correct }
@ -1276,7 +1335,12 @@ end.
{
$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
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,
{ misc. }
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 }
tregisterset = set of Toldregister;
@ -128,7 +129,22 @@ uses
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 }
firstreg = low(Toldregister);
{# Last register in the tregister enumeration }
@ -442,8 +458,8 @@ uses
{# Registers which are defined as scratch integer and no need to save across
routine calls or in assembler blocks.
}
max_scratch_regs = 2;
scratch_regs: Array[1..max_scratch_regs] of Toldregister = (R_D0,R_D1);
max_scratch_regs = 4;
scratch_regs: Array[1..max_scratch_regs] of Toldregister = (R_D0,R_D1,R_A0,R_A1);
{*****************************************************************************
Default generic sizes
@ -600,14 +616,39 @@ implementation
procedure convert_register_to_enum(var r:Tregister);
begin
{$warning Convert_register_to_enum implementation is missing!}
internalerror(200301082);
if r.enum = R_INTREGISTER then
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.
{
$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
Revision 1.15 2003/01/08 18:43:57 daniel

14
compiler/m68k/cpunode.pas
View File

@ -30,12 +30,12 @@ unit cpunode;
uses
{ 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,
the processor specific nodes must be included
after the generic one (FK)
}
// nm68kadd,
ncpuadd,
// nppccal,
// nppccon,
// nppcflw,
@ -46,13 +46,19 @@ unit cpunode;
{ this not really a node }
// nppcobj,
// nppcmat,
,n68kcnv
n68kmat,
n68kcnv
;
end.
{
$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)
* fix some range-check errors with loadconst
+ add ncgadd unit to m68k

49
compiler/m68k/cpupara.pas
View File

@ -47,19 +47,51 @@ unit cpupara;
implementation
uses
verbose;
verbose,
globals,
globtype,
systems,
cpuinfo,cginfo,cgbase,
defutil;
function tm68kparamanager.getintparaloc(nr : longint) : tparalocation;
begin
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;
procedure tm68kparamanager.create_param_loc_info(p : tabstractprocdef);
var
param_offset : integer;
hp : tparaitem;
begin
{ set default para_alignment to target_info.stackalignment }
{ if para_alignment=0 then
para_alignment:=aktalignment.paraalign;
}
{ frame pointer for nested procedures? }
{ inc(nextintreg); }
{ 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;
function tm68kparamanager.getselflocation(p : tabstractprocdef) : tparalocation;
@ -75,7 +107,12 @@ end.
{
$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
Revision 1.2 2002/12/14 15:02:03 carl

9
compiler/m68k/cputarg.pas
View File

@ -37,7 +37,7 @@ implementation
**************************************}
{$ifndef NOTARGETLINUX}
,t_linux
,t_linux,t_amiga
{$endif}
{**************************************
@ -50,7 +50,12 @@ implementation
end.
{
$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
+ m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline

137
compiler/m68k/n68kmat.pas
View File

@ -27,7 +27,7 @@ unit n68kmat;
interface
uses
node,nmat;
node,nmat,ncgmat,cpubase,cginfo;
type
@ -36,16 +36,22 @@ interface
procedure pass_2;override;
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
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
cginfo,cgbase,pass_1,pass_2,
symconst,symdef,aasmbase,aasmtai,aasmcpu,
cgbase,pass_1,pass_2,
ncon,
cpubase,cpuinfo,paramgr,
cpuinfo,paramgr,defutil,
tgobj,ncgutil,cgobj,rgobj,rgcpu,cgcpu,cg64f32;
@ -114,21 +120,134 @@ implementation
end
else
begin
secondpass(left);
location_copy(location,left.location);
location_force_reg(exprasmlist,location,opsize,false);
cg.a_op_reg_reg(exprasmlist,OP_NOT,opsize,location.register,location.register);
secondpass(left);
location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),false);
location_copy(location,left.location);
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;
{*****************************************************************************
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
cnotnode:=tm68knotnode;
cmoddivnode:=tm68kmoddivnode;
end.
{
$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
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;
countunusedregsaddr,
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 getaddressregister(list: taasmoutput): tregister; override;
procedure ungetaddressregister(list: taasmoutput; r: tregister); override;
@ -46,6 +50,7 @@ unit rgcpu;
const saved : tpushedsaved);override;
procedure saveusedregisters(list: taasmoutput;
var saved : tpushedsaved; const s: tregisterset);override;
procedure cleartempgen;override;
end;
@ -107,8 +112,8 @@ unit rgcpu;
may not be real (JM) }
else
begin
dec(countunusedregsint);
exclude(unusedregsint,r.enum);
dec(countunusedregsaddr);
exclude(unusedregsaddr,r.enum);
end;
tg.ungettemp(list,hr);
end;
@ -138,21 +143,69 @@ unit rgcpu;
saved[r.enum].ofs:=hr.offset;
cg.a_load_reg_ref(list,OS_ADDR,r,hr);
cg.a_reg_dealloc(list,r);
include(unusedregsint,r.enum);
inc(countunusedregsint);
include(unusedregsaddr,r.enum);
inc(countunusedregsaddr);
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
rg := trgcpu.create;
end.
{
$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
Revision 1.4 2002/09/07 15:25:14 peter

304
compiler/ncgadd.pas
View File

@ -33,7 +33,7 @@ interface
tcgaddnode = class(taddnode)
{ function pass_1: tnode; override;}
procedure pass_2;override;
private
protected
procedure pass_left_and_right;
{ load left and right nodes into registers }
procedure load_left_right(cmpop, load_constants: boolean);
@ -51,12 +51,10 @@ interface
procedure second_add64bit;virtual;
procedure second_addordinal;virtual;
{ procedure second_cmpfloat;virtual;}
procedure second_cmpboolean;virtual;
procedure second_cmpsmallset;virtual;
procedure second_cmp64bit;virtual;
procedure second_cmpordinal;virtual;
procedure second_cmpboolean;virtual;abstract;
procedure second_cmpsmallset;virtual;abstract;
procedure second_cmp64bit;virtual;abstract;
procedure second_cmpordinal;virtual;abstract;
end;
implementation
@ -75,50 +73,6 @@ interface
{*****************************************************************************
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;
var
@ -249,58 +203,6 @@ interface
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;
@ -425,6 +327,8 @@ interface
{ calculate the operator which is more difficult }
firstcomplex(self);
cmpop := nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
if cmpop then
second_cmpboolean
else
@ -433,21 +337,15 @@ interface
end;
procedure tcgaddnode.second_cmpboolean;
begin
end;
procedure tcgaddnode.second_addboolean;
var
cgop : TOpCg;
cgsize : TCgSize;
cmpop,
isjump : boolean;
otl,ofl : tasmlabel;
pushedregs : tmaybesave;
begin
cmpop:=false;
if (torddef(left.resulttype.def).typ=bool8bit) or
(torddef(right.resulttype.def).typ=bool8bit) then
cgsize:=OS_8
@ -457,7 +355,7 @@ interface
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
@ -500,60 +398,37 @@ interface
falselabel:=ofl;
end;
cmpop := nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
{ set result location }
if not cmpop then
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def))
else
location_reset(location,LOC_FLAGS,OS_NO);
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
load_left_right(cmpop,false);
load_left_right(false,false);
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
{ compare the }
case nodetype of
ltn,lten,gtn,gten,
equaln,unequaln :
begin
if (right.location.loc <> LOC_CONSTANT) then
exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,
left.location.register,right.location.register))
else
exprasmlist.concat(taicpu.op_reg_const(A_CMPLWI,
left.location.register,longint(right.location.value)));
location.resflags := getresflags;
end;
xorn :
cgop:=OP_XOR;
orn :
cgop:=OP_OR;
andn :
cgop:=OP_AND;
else
begin
case nodetype of
xorn :
cgop:=OP_XOR;
orn :
cgop:=OP_OR;
andn :
cgop:=OP_AND;
else
internalerror(200203247);
end;
internalerror(200203247);
end;
if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT,
left.location.register,right.location.register,
location.register)
else
cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT,
aword(right.location.value),left.location.register,
location.register);
end;
end;
if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT,
left.location.register,right.location.register,
location.register)
else
cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT,
aword(right.location.value),left.location.register,
location.register);
end
else
begin
// just to make sure we free the right registers
cmpop := true;
case nodetype of
andn,
orn :
@ -585,9 +460,9 @@ interface
maketojumpbool(exprasmlist,right,lr_load_regvars);
end;
end;
end;*)
end;
{ free used register (except the result register) }
clear_left_right(cmpop);
clear_left_right(true);
end;
@ -616,104 +491,6 @@ interface
clear_left_right(cmpop);
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;
@ -841,22 +618,6 @@ interface
{*****************************************************************************
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;
var
@ -1049,10 +810,17 @@ interface
clear_left_right(cmpop);
end;
begin
caddnode:=tcgaddnode;
end.
{
$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
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
}
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
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)
}
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;
{
@ -400,7 +405,12 @@ end.
{
$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
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];
c_countusableregsmm = 31-14+1;
{ no distinction on this platform }
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_13;
lastsaveintreg = R_27;
firstsavefpureg = R_F14;
@ -821,7 +828,12 @@ implementation
end.
{
$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
+ implemented register convertion proc

14
compiler/pp.pas
View File

@ -31,6 +31,7 @@ program pp;
M68K generate a compiler for the M68000
SPARC generate a compiler for SPARC
POWERPC generate a compiler for the PowerPC
VIS generate a compile for the VIS
USEOVERLAY compiles a TP version which uses overlays
DEBUG version with debug code is generated
EXTDEBUG some extra debug code is executed
@ -77,6 +78,12 @@ program pp;
{$endif CPUDEFINED}
{$define CPUDEFINED}
{$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 CPUDEFINED}
{$fatal ONLY one of the switches for the CPU type must be defined}
@ -179,7 +186,12 @@ begin
end.
{
$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
- -V option for generating bug report tracing
- more tracing for option parsing

93
compiler/rgobj.pas
View File

@ -43,6 +43,8 @@ unit rgobj;
;
type
regvar_longintarray = array[firstreg..lastreg] of longint;
regvar_booleanarray = array[firstreg..lastreg] of boolean;
regvar_ptreearray = array[firstreg..lastreg] of tnode;
@ -55,6 +57,48 @@ unit rgobj;
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
It is used by the code generator to allocate and free
@ -213,11 +257,11 @@ unit rgobj;
procedure makeregvar(reg: tregister);
procedure saveStateForInline(var state: pointer);
procedure restoreStateAfterInline(var state: pointer);
procedure saveStateForInline(var state: pointer);virtual;
procedure restoreStateAfterInline(var state: pointer);virtual;
procedure saveUnusedState(var state: pointer);
procedure restoreUnusedState(var state: pointer);
procedure saveUnusedState(var state: pointer);virtual;
procedure restoreUnusedState(var state: pointer);virtual;
protected
{ the following two contain the common (generic) code for all }
{ get- and ungetregisterxxx functions/procedures }
@ -275,40 +319,8 @@ unit rgobj;
globals,verbose,
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;
@ -532,6 +544,8 @@ unit rgobj;
ungetregisterfpu(list,r)
else if r.enum in mmregs then
ungetregistermm(list,r)
else if r.enum in addrregs then
ungetaddressregister(list,r)
else internalerror(2002070602);
end;
@ -1016,7 +1030,12 @@ end.
{
$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
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_PMASK = LongInt($FF000000); { the mask for processor types }
IF_PFMASK = LongInt($F001FF00); { the mask for disassembly "prefer" }
IF_V7 = $00000000; { SPARC V7 instruction only (not supported)}
IF_V8 = $01000000; { SPARC V8 instruction (the default)}
IF_V9 = $02000000; { SPARC V9 instruction (not yet supported)}
IF_V7 = $00000000; { SPARC V7 instruction only (not supported)}
IF_V8 = $01000000; { SPARC V8 instruction (the default)}
IF_V9 = $02000000; { SPARC V9 instruction (not yet supported)}
{ added flags }
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
{$WARNING CPU32 opcodes do not fully include the Ultra SPRAC instruction set.}
{ don't change the order of these opcodes! }
@ -378,6 +378,12 @@ const
mmregs=[];
usableregsmm=[];
c_countusableregsmm=0;
{ no distinction on this platform }
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_O0;
lastsaveintreg = R_I7;
@ -400,15 +406,15 @@ const
Taken from rs6000.h (DBX_REGISTER_NUMBER) from GCC 3.x source code.}
stab_regindex:ARRAY[firstreg..lastreg]OF ShortInt=({$INCLUDE stabregi.inc});
{*************************** generic register names **************************}
stack_pointer_reg = R_O6;
frame_pointer_reg = R_I6;
stack_pointer_reg = R_O6;
frame_pointer_reg = R_I6;
{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
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
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;
{There is no accumulator in the SPARC architecture. There are just families
of registers. All registers belonging to the same family are identical except
@ -493,6 +499,8 @@ const
max_operands = 3;
maxintregs = maxvarregs;
maxfpuregs = maxfpuvarregs;
FUNCTION is_calljmp(o:tasmop):boolean;
FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond;
@ -603,7 +611,12 @@ END.
{
$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
Revision 1.20 2003/01/09 20:41:00 daniel

10
compiler/symdef.pas
View File

@ -715,6 +715,9 @@ interface
{$ifdef SPARC}
pbestrealtype : ^ttype = @s64floattype;
{$endif SPARC}
{$ifdef vis}
pbestrealtype : ^ttype = @s64floattype;
{$endif vis}
function mangledname_prefix(typeprefix:string;st:tsymtable):string;
@ -5648,7 +5651,12 @@ implementation
end.
{
$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
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
system_m68k_amiga_info : tsysteminfo =
(
system : target_m68k_Amiga;
system : system_m68k_Amiga;
name : 'Commodore Amiga';
shortname : 'amiga';
flags : [];
cpu : cpu_m68k;
short_name : 'AMIGA';
unit_env : '';
extradefines : '';
sharedlibext : '.library';
staticlibext : '.a';
sourceext : '.pp';
pasext : '.pas';
exeext : '';
defext : '';
scriptext : '';
defext : '.def';
scriptext : '.sh';
smartext : '.sl';
unitext : '.ppa';
unitext : '.ppu';
unitlibext : '.ppl';
asmext : '.asm';
objext : '.o';
resext : '.res';
resobjext : '.or';
staticlibprefix : '';
sharedlibext : '.library';
staticlibext : '.a';
staticlibprefix : 'lib';
sharedlibprefix : '';
Cprefix : '_';
sharedClibext : '.library';
staticClibext : '.a';
staticClibprefix : 'lib';
sharedClibprefix : '';
Cprefix : '';
newline : #10;
dirsep : '/';
files_case_relevent : true;
@ -62,16 +65,31 @@ unit i_amiga;
assemextern : as_gas;
link : nil;
linkextern : nil;
ar : ar_m68k_ar;
ar : ar_gnu_ar;
res : res_none;
script : script_amiga;
endian : endian_big;
stackalignment : 2;
maxCrecordalignment : 4;
heapsize : 128*1024;
stacksize : 8192;
alignment :
(
procalign : 4;
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;
use_function_relative_addresses : false
use_function_relative_addresses : true
);
implementation
@ -79,13 +97,18 @@ unit i_amiga;
initialization
{$ifdef cpu68}
{$ifdef AMIGA}
set_source_info(system_m68k_Amiga);
set_source_info(system_m68k_Amiga_info);
{$endif amiga}
{$endif cpu68}
end.
{
$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
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
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_R8,R_R9,R_R10,R_R11,
R_CCR,R_SP,R_FP,R_PC,
R_FP0,R_FP1,R_FP2,R_FP3,
R_FP4,R_FP5,R_FP6,R_FP7,
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 }
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. }
tregister64 = packed record
@ -88,19 +94,31 @@ uses
treg64 = tregister64;
{# Type definition for the array of string of register nnames }
treg2strtable = array[tregister] of string[5];
treg2strtable = array[toldregister] of string[5];
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 }
firstreg = low(tregister);
firstreg = low(toldregister);
{# Last register in the tregister enumeration }
lastreg = high(tregister);
lastreg = high(toldregister);
std_reg2str : treg2strtable = ('',
'r0','r1','r2','r3','r4','r5','r6','r7','r8','r9','r10','r11','ccr',
'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
*****************************************************************************}
{ 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
@ -350,6 +378,12 @@ uses
mmregs = [];
usableregsmm = [];
c_countusableregsmm = 0;
{ no distinction on this platform }
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_R2;
lastsaveintreg = R_R11;
@ -359,11 +393,11 @@ uses
lastsavemmreg = R_NO;
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);
maxfpuvarregs = 15;
fpuvarregs : Array [1..maxfpuvarregs] of Tregister =
fpuvarregs : Array [1..maxfpuvarregs] of toldregister =
(R_FP1,R_FP2,R_FP3,
R_FP4,R_FP5,R_FP6,
R_FP7,R_FP8,R_FP9,
@ -381,7 +415,7 @@ uses
routine calls or in assembler blocks.
}
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
@ -406,7 +440,7 @@ uses
Currently unsupported by abstract machine
}
stab_regindex : array[tregister] of shortint =
stab_regindex : array[toldregister] of shortint =
(-1,
{ r0..r11 }
-1,-1,-1,-1,-1,-1,
@ -416,7 +450,9 @@ uses
{ FP0..FP7 }
-1,-1,-1,-1,-1,-1,-1,-1,
{ 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
value when that is a scalar value otherwise a pointer to the address of the
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
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) }
accumulatorhigh = R_R1;
fpu_result_reg = R_FP0;
@ -480,6 +516,7 @@ uses
procedure inverse_flags(var r : TResFlags);
function flags_to_cond(const f: TResFlags) : TAsmCond;
procedure convert_register_to_enum(var r:Tregister);
implementation
@ -531,10 +568,40 @@ implementation
flags_to_cond := flags2cond[f];
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.
{
$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
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];
usableregsmm = [R_XMM0..R_XMM15];
c_countusableregsmm = 8;
{ no distinction on this platform }
maxaddrregs = 0;
addrregs = [];
usableregsaddr = [];
c_countusableregsaddr = 0;
firstsaveintreg = R_EAX;
lastsaveintreg = R_R15;
@ -417,11 +424,11 @@ const
{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
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
function othewise it contains a pointer to the returned result}
function_result_reg = accumulator;
function_result_reg = accumulator;
accumulatorhigh = R_RDX;
{ the register where the vmt offset is passed to the destructor }
{ helper routine }
@ -500,7 +507,12 @@ implementation
end.
{
$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
+ very basic support for float128 type (x86-64 only)