From 59d3edeec7a9b21a50e2313900a5049c2d605735 Mon Sep 17 00:00:00 2001 From: carl Date: Sun, 2 Feb 2003 19:25:54 +0000 Subject: [PATCH] * Several bugfixes for m68k target (register alloc., opcode emission) + VIS target + Generic add more complete (still not verified) --- compiler/compiler.pas | 16 +- compiler/i386/cpubase.pas | 17 +- compiler/m68k/cgcpu.pas | 82 ++++++- compiler/m68k/cpubase.pas | 55 ++++- compiler/m68k/cpunode.pas | 14 +- compiler/m68k/cpupara.pas | 49 +++- compiler/m68k/cputarg.pas | 9 +- compiler/m68k/n68kmat.pas | 137 ++++++++++- compiler/m68k/ncpuadd.pas | 440 +++++++++++++++++++++++++++++++++++ compiler/m68k/rgcpu.pas | 63 ++++- compiler/ncgadd.pas | 304 +++--------------------- compiler/paramgr.pas | 16 +- compiler/powerpc/cpubase.pas | 14 +- compiler/pp.pas | 14 +- compiler/rgobj.pas | 93 +++++--- compiler/sparc/cpubase.pas | 31 ++- compiler/symdef.pas | 10 +- compiler/systems/i_amiga.pas | 57 +++-- compiler/vis/aasmcpu.pas | 259 +++++++++++++++++++++ compiler/vis/cpubase.pas | 97 ++++++-- compiler/vis/cpupara.pas | 84 +++++++ compiler/x86_64/cpubase.pas | 18 +- 22 files changed, 1478 insertions(+), 401 deletions(-) create mode 100644 compiler/m68k/ncpuadd.pas create mode 100644 compiler/vis/aasmcpu.pas create mode 100644 compiler/vis/cpupara.pas diff --git a/compiler/compiler.pas b/compiler/compiler.pas index ca3d8697a0..13f438fe1b 100644 --- a/compiler/compiler.pas +++ b/compiler/compiler.pas @@ -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 diff --git a/compiler/i386/cpubase.pas b/compiler/i386/cpubase.pas index 03b1d2a381..c74eee0cd4 100644 --- a/compiler/i386/cpubase.pas +++ b/compiler/i386/cpubase.pas @@ -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 diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas index 5e83580fc3..76b41dab18 100644 --- a/compiler/m68k/cgcpu.pas +++ b/compiler/m68k/cgcpu.pas @@ -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 diff --git a/compiler/m68k/cpubase.pas b/compiler/m68k/cpubase.pas index 56e2feef10..1ce9ca31ec 100644 --- a/compiler/m68k/cpubase.pas +++ b/compiler/m68k/cpubase.pas @@ -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 diff --git a/compiler/m68k/cpunode.pas b/compiler/m68k/cpunode.pas index cab4577808..7e80bac471 100644 --- a/compiler/m68k/cpunode.pas +++ b/compiler/m68k/cpunode.pas @@ -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 diff --git a/compiler/m68k/cpupara.pas b/compiler/m68k/cpupara.pas index fd655563a8..b035d3c203 100644 --- a/compiler/m68k/cpupara.pas +++ b/compiler/m68k/cpupara.pas @@ -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 diff --git a/compiler/m68k/cputarg.pas b/compiler/m68k/cputarg.pas index 65420f3633..00edb5d6e4 100644 --- a/compiler/m68k/cputarg.pas +++ b/compiler/m68k/cputarg.pas @@ -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 diff --git a/compiler/m68k/n68kmat.pas b/compiler/m68k/n68kmat.pas index d8c50415c6..fdb6733e3c 100644 --- a/compiler/m68k/n68kmat.pas +++ b/compiler/m68k/n68kmat.pas @@ -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 diff --git a/compiler/m68k/ncpuadd.pas b/compiler/m68k/ncpuadd.pas new file mode 100644 index 0000000000..c1876006a0 --- /dev/null +++ b/compiler/m68k/ncpuadd.pas @@ -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) + +} diff --git a/compiler/m68k/rgcpu.pas b/compiler/m68k/rgcpu.pas index 1688e643c9..25009b0e8a 100644 --- a/compiler/m68k/rgcpu.pas +++ b/compiler/m68k/rgcpu.pas @@ -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 diff --git a/compiler/ncgadd.pas b/compiler/ncgadd.pas index 46e50b9ee2..c4c1dee6fa 100644 --- a/compiler/ncgadd.pas +++ b/compiler/ncgadd.pas @@ -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 diff --git a/compiler/paramgr.pas b/compiler/paramgr.pas index 3b6da98bcd..48eaaca466 100644 --- a/compiler/paramgr.pas +++ b/compiler/paramgr.pas @@ -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 diff --git a/compiler/powerpc/cpubase.pas b/compiler/powerpc/cpubase.pas index ddd5c8ccb3..ce89da6286 100644 --- a/compiler/powerpc/cpubase.pas +++ b/compiler/powerpc/cpubase.pas @@ -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 diff --git a/compiler/pp.pas b/compiler/pp.pas index 7db03525ec..d63261ae3a 100644 --- a/compiler/pp.pas +++ b/compiler/pp.pas @@ -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 diff --git a/compiler/rgobj.pas b/compiler/rgobj.pas index a93b588a60..39df6c034f 100644 --- a/compiler/rgobj.pas +++ b/compiler/rgobj.pas @@ -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 diff --git a/compiler/sparc/cpubase.pas b/compiler/sparc/cpubase.pas index 53895ec9d8..ec83acb6ea 100644 --- a/compiler/sparc/cpubase.pas +++ b/compiler/sparc/cpubase.pas @@ -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 diff --git a/compiler/symdef.pas b/compiler/symdef.pas index b79272960c..6500fe2175 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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 diff --git a/compiler/systems/i_amiga.pas b/compiler/systems/i_amiga.pas index 54b3eb93b3..2357f5db42 100644 --- a/compiler/systems/i_amiga.pas +++ b/compiler/systems/i_amiga.pas @@ -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 diff --git a/compiler/vis/aasmcpu.pas b/compiler/vis/aasmcpu.pas new file mode 100644 index 0000000000..1ad3783486 --- /dev/null +++ b/compiler/vis/aasmcpu.pas @@ -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) + + + +} diff --git a/compiler/vis/cpubase.pas b/compiler/vis/cpubase.pas index 6fe5fc05e9..b872e75073 100644 --- a/compiler/vis/cpubase.pas +++ b/compiler/vis/cpubase.pas @@ -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 diff --git a/compiler/vis/cpupara.pas b/compiler/vis/cpupara.pas new file mode 100644 index 0000000000..a2313dd948 --- /dev/null +++ b/compiler/vis/cpupara.pas @@ -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) + +} diff --git a/compiler/x86_64/cpubase.pas b/compiler/x86_64/cpubase.pas index 35b1a3b1a7..c5f81eea21 100644 --- a/compiler/x86_64/cpubase.pas +++ b/compiler/x86_64/cpubase.pas @@ -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)