diff options
Diffstat (limited to 'compiler/arm')
40 files changed, 10383 insertions, 0 deletions
diff --git a/compiler/arm/aasmcpu.pas b/compiler/arm/aasmcpu.pas new file mode 100644 index 0000000000..534ca0099f --- /dev/null +++ b/compiler/arm/aasmcpu.pas @@ -0,0 +1,2399 @@ +{ + Copyright (c) 2003 by Florian Klaempfl + + Contains the assembler object for the ARM + + 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,globtype,globals,verbose, + aasmbase,aasmtai, + symtype, + cpubase,cpuinfo,cgbase,cgutils; + + const + { "mov reg,reg" source operand number } + O_MOV_SOURCE = 1; + { "mov reg,reg" source operand number } + O_MOV_DEST = 0; + + { Operand types } + OT_NONE = $00000000; + + OT_BITS8 = $00000001; { size, and other attributes, of the operand } + OT_BITS16 = $00000002; + OT_BITS32 = $00000004; + OT_BITS64 = $00000008; { FPU only } + OT_BITS80 = $00000010; + OT_FAR = $00000020; { this means 16:16 or 16:32, like in CALL/JMP } + OT_NEAR = $00000040; + OT_SHORT = $00000080; + OT_BITSTINY = $00000100; { fpu constant } + OT_BITSSHIFTER = + $00000200; + + OT_SIZE_MASK = $000003FF; { all the size attributes } + OT_NON_SIZE = longint(not OT_SIZE_MASK); + + OT_SIGNED = $00000100; { the operand need to be signed -128-127 } + + OT_TO = $00000200; { operand is followed by a colon } + { reverse effect in FADD, FSUB &c } + OT_COLON = $00000400; + + OT_SHIFTEROP = $00000800; + OT_REGISTER = $00001000; + OT_IMMEDIATE = $00002000; + OT_REGLIST = $00008000; + OT_IMM8 = $00002001; + OT_IMM24 = $00002002; + OT_IMM32 = $00002004; + OT_IMM64 = $00002008; + OT_IMM80 = $00002010; + OT_IMMTINY = $00002100; + OT_IMMSHIFTER= $00002200; + OT_IMMEDIATE24 = OT_IMM24; + OT_SHIFTIMM = OT_SHIFTEROP or OT_IMMSHIFTER; + OT_SHIFTIMMEDIATE = OT_SHIFTIMM; + OT_IMMEDIATESHIFTER = OT_IMMSHIFTER; + + OT_IMMEDIATEFPU = OT_IMMTINY; + + OT_REGMEM = $00200000; { for r/m, ie EA, operands } + OT_REGNORM = $00201000; { 'normal' reg, qualifies as EA } + OT_REG8 = $00201001; + OT_REG16 = $00201002; + OT_REG32 = $00201004; + OT_REG64 = $00201008; + OT_VREG = $00201010; { vector register } + OT_MEMORY = $00204000; { register number in 'basereg' } + OT_MEM8 = $00204001; + OT_MEM16 = $00204002; + OT_MEM32 = $00204004; + OT_MEM64 = $00204008; + OT_MEM80 = $00204010; + { word/byte load/store } + OT_AM2 = $00010000; + { misc ld/st operations } + OT_AM3 = $00020000; + { multiple ld/st operations } + OT_AM4 = $00040000; + { co proc. ld/st operations } + OT_AM5 = $00080000; + OT_AMMASK = $000f0000; + + OT_MEMORYAM2 = OT_MEMORY or OT_AM2; + OT_MEMORYAM3 = OT_MEMORY or OT_AM3; + OT_MEMORYAM4 = OT_MEMORY or OT_AM4; + OT_MEMORYAM5 = OT_MEMORY or OT_AM5; + + OT_FPUREG = $01000000; { floating point stack registers } + OT_REG_SMASK = $00070000; { special register operands: these may be treated differently } + { a mask for the following } + + OT_MEM_OFFS = $00604000; { special type of EA } + { simple [address] offset } + OT_ONENESS = $00800000; { special type of immediate operand } + { so UNITY == IMMEDIATE | ONENESS } + OT_UNITY = $00802000; { for shift/rotate instructions } + + instabentries = {$i armnop.inc} + + maxinfolen = 5; + + IF_NONE = $00000000; + + IF_ARMMASK = $000F0000; + IF_ARM7 = $00070000; + IF_FPMASK = $00F00000; + IF_FPA = $00100000; + + { if the instruction can change in a second pass } + IF_PASS2 = longint($80000000); + + type + TInsTabCache=array[TasmOp] of longint; + PInsTabCache=^TInsTabCache; + + tinsentry = record + opcode : tasmop; + ops : byte; + optypes : array[0..3] of longint; + code : array[0..maxinfolen] of char; + flags : longint; + end; + + pinsentry=^tinsentry; + + const + InsTab : array[0..instabentries-1] of TInsEntry={$i armtab.inc} + + var + InsTabCache : PInsTabCache; + + type + taicpu = class(tai_cpu_abstract) + oppostfix : TOpPostfix; + roundingmode : troundingmode; + procedure loadshifterop(opidx:longint;const so:tshifterop); + procedure loadregset(opidx:longint;const s:tcpuregisterset); + constructor op_none(op : tasmop); + + constructor op_reg(op : tasmop;_op1 : tregister); + constructor op_const(op : tasmop;_op1 : longint); + + constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister); + constructor op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference); + constructor op_reg_const(op:tasmop; _op1: tregister; _op2: aint); + + constructor op_ref_regset(op:tasmop; _op1: treference; _op2: tcpuregisterset); + + constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister); + constructor op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: aint); + constructor op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint); + constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; const _op3: treference); + constructor op_reg_reg_shifterop(op : tasmop;_op1,_op2 : tregister;_op3 : tshifterop); + { SFM/LFM } + constructor op_reg_const_ref(op : tasmop;_op1 : tregister;_op2 : aint;_op3 : treference); + + { *M*LL } + constructor op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister); + + { this is for Jmp instructions } + constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); + + constructor op_sym(op : tasmop;_op1 : tasmsymbol); + constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint); + constructor op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint); + constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + + function is_same_reg_move(regtype: Tregistertype):boolean; override; + + function spilling_get_operation_type(opnr: longint): topertype;override; + + { assembler } + public + { the next will reset all instructions that can change in pass 2 } + procedure ResetPass1; + procedure ResetPass2; + function CheckIfValid:boolean; + function GetString:string; + function Pass1(offset:longint):longint;override; + procedure Pass2(objdata:TAsmObjectdata);override; + protected + procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);override; + procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);override; + procedure ppubuildderefimploper(var o:toper);override; + procedure ppuderefoper(var o:toper);override; + private + { next fields are filled in pass1, so pass2 is faster } + inssize : shortint; + insoffset : longint; + LastInsOffset : longint; { need to be public to be reset } + insentry : PInsEntry; + function InsEnd:longint; + procedure create_ot; + function Matches(p:PInsEntry):longint; + function calcsize(p:PInsEntry):shortint; + procedure gencode(objdata:TAsmObjectData); + function NeedAddrPrefix(opidx:byte):boolean; + procedure Swapoperands; + function FindInsentry:boolean; + end; + + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + function spilling_create_load(const ref:treference;r:tregister): tai; + function spilling_create_store(r:tregister; const ref:treference): tai; + + function setoppostfix(i : taicpu;pf : toppostfix) : taicpu; + function setroundingmode(i : taicpu;rm : troundingmode) : taicpu; + function setcondition(i : taicpu;c : tasmcond) : taicpu; + + { inserts pc relative symbols at places where they are reachable } + procedure insertpcrelativedata(list,listtoinsert : taasmoutput); + + procedure InitAsm; + procedure DoneAsm; + + +implementation + + uses + cutils,rgobj,itcpugas; + + + procedure taicpu.loadshifterop(opidx:longint;const so:tshifterop); + begin + allocate_oper(opidx+1); + with oper[opidx]^ do + begin + if typ<>top_shifterop then + begin + clearop(opidx); + new(shifterop); + end; + shifterop^:=so; + typ:=top_shifterop; + if assigned(add_reg_instruction_hook) then + add_reg_instruction_hook(self,shifterop^.rs); + end; + end; + + + procedure taicpu.loadregset(opidx:longint;const s:tcpuregisterset); + var + i : byte; + begin + allocate_oper(opidx+1); + with oper[opidx]^ do + begin + if typ<>top_regset then + clearop(opidx); + new(regset); + regset^:=s; + typ:=top_regset; + for i:=RS_R0 to RS_R15 do + begin + if assigned(add_reg_instruction_hook) and (i in regset^) then + add_reg_instruction_hook(self,newreg(R_INTREGISTER,i,R_SUBWHOLE)); + end; + end; + end; + + +{***************************************************************************** + taicpu Constructors +*****************************************************************************} + + constructor taicpu.op_none(op : tasmop); + begin + inherited create(op); + end; + + + constructor taicpu.op_reg(op : tasmop;_op1 : tregister); + begin + inherited create(op); + ops:=1; + loadreg(0,_op1); + end; + + + constructor taicpu.op_const(op : tasmop;_op1 : longint); + begin + inherited create(op); + ops:=1; + loadconst(0,aint(_op1)); + end; + + + constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister); + begin + inherited create(op); + ops:=2; + loadreg(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: aint); + begin + inherited create(op); + ops:=2; + loadreg(0,_op1); + loadconst(1,aint(_op2)); + end; + + + constructor taicpu.op_ref_regset(op:tasmop; _op1: treference; _op2: tcpuregisterset); + begin + inherited create(op); + ops:=2; + loadref(0,_op1); + loadregset(1,_op2); + end; + + + constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference); + begin + inherited create(op); + ops:=2; + loadreg(0,_op1); + loadref(1,_op2); + end; + + + constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister); + begin + inherited create(op); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadreg(2,_op3); + end; + + + constructor taicpu.op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister); + begin + inherited create(op); + ops:=4; + loadreg(0,_op1); + loadreg(1,_op2); + loadreg(2,_op3); + loadreg(3,_op4); + end; + + + constructor taicpu.op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: aint); + begin + inherited create(op); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadconst(2,aint(_op3)); + end; + + + constructor taicpu.op_reg_const_ref(op : tasmop;_op1 : tregister;_op2 : aint;_op3 : treference); + begin + inherited create(op); + ops:=3; + loadreg(0,_op1); + loadconst(1,_op2); + loadref(2,_op3); + end; + + + constructor taicpu.op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint); + begin + inherited create(op); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadsymbol(0,_op3,_op3ofs); + end; + + + constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; const _op3: treference); + begin + inherited create(op); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadref(2,_op3); + end; + + + constructor taicpu.op_reg_reg_shifterop(op : tasmop;_op1,_op2 : tregister;_op3 : tshifterop); + begin + inherited create(op); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadshifterop(2,_op3); + end; + + + constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); + begin + inherited create(op); + condition:=cond; + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol); + begin + inherited create(op); + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint); + begin + inherited create(op); + ops:=1; + loadsymbol(0,_op1,_op1ofs); + end; + + + constructor taicpu.op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint); + begin + inherited create(op); + ops:=2; + loadreg(0,_op1); + loadsymbol(1,_op2,_op2ofs); + end; + + + constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + begin + inherited create(op); + ops:=2; + loadsymbol(0,_op1,_op1ofs); + loadref(1,_op2); + end; + + + function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; + begin + { allow the register allocator to remove unnecessary moves } + result:=(((opcode=A_MOV) and (regtype = R_INTREGISTER)) or + ((opcode=A_MVF) and (regtype = R_FPUREGISTER)) + ) and + (condition=C_None) and + (ops=2) and + (oper[0]^.typ=top_reg) and + (oper[1]^.typ=top_reg) and + (oper[0]^.reg=oper[1]^.reg); + end; + + + function spilling_create_load(const ref:treference;r:tregister): tai; + begin + case getregtype(r) of + R_INTREGISTER : + result:=taicpu.op_reg_ref(A_LDR,r,ref); + R_FPUREGISTER : + { use lfm because we don't know the current internal format + and avoid exceptions + } + result:=taicpu.op_reg_const_ref(A_LFM,r,1,ref); + else + internalerror(200401041); + end; + end; + + + function spilling_create_store(r:tregister; const ref:treference): tai; + begin + case getregtype(r) of + R_INTREGISTER : + result:=taicpu.op_reg_ref(A_STR,r,ref); + R_FPUREGISTER : + { use sfm because we don't know the current internal format + and avoid exceptions + } + result:=taicpu.op_reg_const_ref(A_SFM,r,1,ref); + else + internalerror(200401041); + end; + end; + + + function taicpu.spilling_get_operation_type(opnr: longint): topertype; + begin + case opcode of + A_ADC,A_ADD,A_AND, + A_EOR,A_CLZ, + A_LDR,A_LDRB,A_LDRBT,A_LDRH,A_LDRSB, + A_LDRSH,A_LDRT, + A_MOV,A_MVN,A_MLA,A_MUL, + A_ORR,A_RSB,A_RSC,A_SBC,A_SUB, + A_SWP,A_SWPB, + A_LDF,A_FLT,A_FIX, + A_ADF,A_DVF,A_FDV,A_FML, + A_RFS,A_RFC,A_RDF, + A_RMF,A_RPW,A_RSF,A_SUF,A_ABS,A_ACS,A_ASN,A_ATN,A_COS, + A_EXP,A_LOG,A_LGN,A_MVF,A_MNF,A_FRD,A_MUF,A_POL,A_RND,A_SIN,A_SQT,A_TAN, + A_LFM: + if opnr=0 then + result:=operand_write + else + result:=operand_read; + A_BIC,A_BKPT,A_B,A_BL,A_BLX,A_BX, + A_CMN,A_CMP,A_TEQ,A_TST, + A_CMF,A_CMFE,A_WFS,A_CNF: + result:=operand_read; + A_SMLAL,A_UMLAL: + if opnr in [0,1] then + result:=operand_readwrite + else + result:=operand_read; + A_SMULL,A_UMULL: + if opnr in [0,1] then + result:=operand_write + else + result:=operand_read; + A_STR,A_STRB,A_STRBT, + A_STRH,A_STRT,A_STF,A_SFM: + { important is what happens with the involved registers } + if opnr=0 then + result := operand_read + else + { check for pre/post indexed } + result := operand_read; + else + internalerror(200403151); + end; + end; + + + procedure BuildInsTabCache; + var + i : longint; + begin + new(instabcache); + FillChar(instabcache^,sizeof(tinstabcache),$ff); + i:=0; + while (i<InsTabEntries) do + begin + if InsTabCache^[InsTab[i].Opcode]=-1 then + InsTabCache^[InsTab[i].Opcode]:=i; + inc(i); + end; + end; + + + procedure InitAsm; + begin + if not assigned(instabcache) then + BuildInsTabCache; + end; + + + procedure DoneAsm; + begin + if assigned(instabcache) then + begin + dispose(instabcache); + instabcache:=nil; + end; + end; + + + function setoppostfix(i : taicpu;pf : toppostfix) : taicpu; + begin + i.oppostfix:=pf; + result:=i; + end; + + + function setroundingmode(i : taicpu;rm : troundingmode) : taicpu; + begin + i.roundingmode:=rm; + result:=i; + end; + + + function setcondition(i : taicpu;c : tasmcond) : taicpu; + begin + i.condition:=c; + result:=i; + end; + + + procedure insertpcrelativedata(list,listtoinsert : taasmoutput); + var + curpos : longint; + lastpos : longint; + curop : longint; + curtai : tai; + curdatatai,hp : tai; + curdata : taasmoutput; + l : tasmlabel; + begin + curdata:=taasmoutput.create; + lastpos:=-1; + curpos:=0; + curtai:=tai(list.first); + while assigned(curtai) do + begin + { instruction? } + if curtai.typ=ait_instruction then + begin + { walk through all operand of the instruction } + for curop:=0 to taicpu(curtai).ops-1 do + begin + { reference? } + if (taicpu(curtai).oper[curop]^.typ=top_ref) then + begin + { pc relative symbol? } + curdatatai:=tai(taicpu(curtai).oper[curop]^.ref^.symboldata); + if assigned(curdatatai) then + begin + { if yes, insert till next symbol } + repeat + hp:=tai(curdatatai.next); + listtoinsert.remove(curdatatai); + curdata.concat(curdatatai); + curdatatai:=hp; + until (curdatatai=nil) or (curdatatai.typ=ait_label); + if lastpos=-1 then + lastpos:=curpos; + end; + end; + end; + inc(curpos); + end; + + { split only at real instructions else the test below fails } + if ((curpos-lastpos)>1016) and (curtai.typ=ait_instruction) and + ( + { don't split loads of pc to lr and the following move } + not( + (taicpu(curtai).opcode=A_MOV) and + (taicpu(curtai).oper[0]^.typ=top_reg) and + (taicpu(curtai).oper[0]^.reg=NR_R14) and + (taicpu(curtai).oper[1]^.typ=top_reg) and + (taicpu(curtai).oper[1]^.reg=NR_PC) + ) + ) then + begin + lastpos:=curpos; + hp:=tai(curtai.next); + objectlibrary.getjumplabel(l); + curdata.insert(taicpu.op_sym(A_B,l)); + curdata.concat(tai_label.create(l)); + list.insertlistafter(curtai,curdata); + curtai:=hp; + end + else + curtai:=tai(curtai.next); + end; + list.concatlist(curdata); + curdata.free; + end; + + +(* + Floating point instruction format information, taken from the linux kernel + ARM Floating Point Instruction Classes + | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | + |c o n d|1 1 0 P|U|u|W|L| Rn |v| Fd |0|0|0|1| o f f s e t | CPDT + |c o n d|1 1 0 P|U|w|W|L| Rn |x| Fd |0|0|1|0| o f f s e t | CPDT (copro 2) + | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | + |c o n d|1 1 1 0|a|b|c|d|e| Fn |j| Fd |0|0|0|1|f|g|h|0|i| Fm | CPDO + |c o n d|1 1 1 0|a|b|c|L|e| Fn | Rd |0|0|0|1|f|g|h|1|i| Fm | CPRT + |c o n d|1 1 1 0|a|b|c|1|e| Fn |1|1|1|1|0|0|0|1|f|g|h|1|i| Fm | comparisons + | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | + + CPDT data transfer instructions + LDF, STF, LFM (copro 2), SFM (copro 2) + + CPDO dyadic arithmetic instructions + ADF, MUF, SUF, RSF, DVF, RDF, + POW, RPW, RMF, FML, FDV, FRD, POL + + CPDO monadic arithmetic instructions + MVF, MNF, ABS, RND, SQT, LOG, LGN, EXP, + SIN, COS, TAN, ASN, ACS, ATN, URD, NRM + + CPRT joint arithmetic/data transfer instructions + FIX (arithmetic followed by load/store) + FLT (load/store followed by arithmetic) + CMF, CNF CMFE, CNFE (comparisons) + WFS, RFS (write/read floating point status register) + WFC, RFC (write/read floating point control register) + + cond condition codes + P pre/post index bit: 0 = postindex, 1 = preindex + U up/down bit: 0 = stack grows down, 1 = stack grows up + W write back bit: 1 = update base register (Rn) + L load/store bit: 0 = store, 1 = load + Rn base register + Rd destination/source register + Fd floating point destination register + Fn floating point source register + Fm floating point source register or floating point constant + + uv transfer length (TABLE 1) + wx register count (TABLE 2) + abcd arithmetic opcode (TABLES 3 & 4) + ef destination size (rounding precision) (TABLE 5) + gh rounding mode (TABLE 6) + j dyadic/monadic bit: 0 = dyadic, 1 = monadic + i constant bit: 1 = constant (TABLE 6) + */ + + /* + TABLE 1 + +-------------------------+---+---+---------+---------+ + | Precision | u | v | FPSR.EP | length | + +-------------------------+---+---+---------+---------+ + | Single | 0 | 0 | x | 1 words | + | Double | 1 | 1 | x | 2 words | + | Extended | 1 | 1 | x | 3 words | + | Packed decimal | 1 | 1 | 0 | 3 words | + | Expanded packed decimal | 1 | 1 | 1 | 4 words | + +-------------------------+---+---+---------+---------+ + Note: x = don't care + */ + + /* + TABLE 2 + +---+---+---------------------------------+ + | w | x | Number of registers to transfer | + +---+---+---------------------------------+ + | 0 | 1 | 1 | + | 1 | 0 | 2 | + | 1 | 1 | 3 | + | 0 | 0 | 4 | + +---+---+---------------------------------+ + */ + + /* + TABLE 3: Dyadic Floating Point Opcodes + +---+---+---+---+----------+-----------------------+-----------------------+ + | a | b | c | d | Mnemonic | Description | Operation | + +---+---+---+---+----------+-----------------------+-----------------------+ + | 0 | 0 | 0 | 0 | ADF | Add | Fd := Fn + Fm | + | 0 | 0 | 0 | 1 | MUF | Multiply | Fd := Fn * Fm | + | 0 | 0 | 1 | 0 | SUF | Subtract | Fd := Fn - Fm | + | 0 | 0 | 1 | 1 | RSF | Reverse subtract | Fd := Fm - Fn | + | 0 | 1 | 0 | 0 | DVF | Divide | Fd := Fn / Fm | + | 0 | 1 | 0 | 1 | RDF | Reverse divide | Fd := Fm / Fn | + | 0 | 1 | 1 | 0 | POW | Power | Fd := Fn ^ Fm | + | 0 | 1 | 1 | 1 | RPW | Reverse power | Fd := Fm ^ Fn | + | 1 | 0 | 0 | 0 | RMF | Remainder | Fd := IEEE rem(Fn/Fm) | + | 1 | 0 | 0 | 1 | FML | Fast Multiply | Fd := Fn * Fm | + | 1 | 0 | 1 | 0 | FDV | Fast Divide | Fd := Fn / Fm | + | 1 | 0 | 1 | 1 | FRD | Fast reverse divide | Fd := Fm / Fn | + | 1 | 1 | 0 | 0 | POL | Polar angle (ArcTan2) | Fd := arctan2(Fn,Fm) | + | 1 | 1 | 0 | 1 | | undefined instruction | trap | + | 1 | 1 | 1 | 0 | | undefined instruction | trap | + | 1 | 1 | 1 | 1 | | undefined instruction | trap | + +---+---+---+---+----------+-----------------------+-----------------------+ + Note: POW, RPW, POL are deprecated, and are available for backwards + compatibility only. + */ + + /* + TABLE 4: Monadic Floating Point Opcodes + +---+---+---+---+----------+-----------------------+-----------------------+ + | a | b | c | d | Mnemonic | Description | Operation | + +---+---+---+---+----------+-----------------------+-----------------------+ + | 0 | 0 | 0 | 0 | MVF | Move | Fd := Fm | + | 0 | 0 | 0 | 1 | MNF | Move negated | Fd := - Fm | + | 0 | 0 | 1 | 0 | ABS | Absolute value | Fd := abs(Fm) | + | 0 | 0 | 1 | 1 | RND | Round to integer | Fd := int(Fm) | + | 0 | 1 | 0 | 0 | SQT | Square root | Fd := sqrt(Fm) | + | 0 | 1 | 0 | 1 | LOG | Log base 10 | Fd := log10(Fm) | + | 0 | 1 | 1 | 0 | LGN | Log base e | Fd := ln(Fm) | + | 0 | 1 | 1 | 1 | EXP | Exponent | Fd := e ^ Fm | + | 1 | 0 | 0 | 0 | SIN | Sine | Fd := sin(Fm) | + | 1 | 0 | 0 | 1 | COS | Cosine | Fd := cos(Fm) | + | 1 | 0 | 1 | 0 | TAN | Tangent | Fd := tan(Fm) | + | 1 | 0 | 1 | 1 | ASN | Arc Sine | Fd := arcsin(Fm) | + | 1 | 1 | 0 | 0 | ACS | Arc Cosine | Fd := arccos(Fm) | + | 1 | 1 | 0 | 1 | ATN | Arc Tangent | Fd := arctan(Fm) | + | 1 | 1 | 1 | 0 | URD | Unnormalized round | Fd := int(Fm) | + | 1 | 1 | 1 | 1 | NRM | Normalize | Fd := norm(Fm) | + +---+---+---+---+----------+-----------------------+-----------------------+ + Note: LOG, LGN, EXP, SIN, COS, TAN, ASN, ACS, ATN are deprecated, and are + available for backwards compatibility only. + */ + + /* + TABLE 5 + +-------------------------+---+---+ + | Rounding Precision | e | f | + +-------------------------+---+---+ + | IEEE Single precision | 0 | 0 | + | IEEE Double precision | 0 | 1 | + | IEEE Extended precision | 1 | 0 | + | undefined (trap) | 1 | 1 | + +-------------------------+---+---+ + */ + + /* + TABLE 5 + +---------------------------------+---+---+ + | Rounding Mode | g | h | + +---------------------------------+---+---+ + | Round to nearest (default) | 0 | 0 | + | Round toward plus infinity | 0 | 1 | + | Round toward negative infinity | 1 | 0 | + | Round toward zero | 1 | 1 | + +---------------------------------+---+---+ +*) + function taicpu.GetString:string; + var + i : longint; + s : string; + addsize : boolean; + begin + s:='['+gas_op2str[opcode]; + for i:=0 to ops-1 do + begin + with oper[i]^ do + begin + if i=0 then + s:=s+' ' + else + s:=s+','; + { type } + addsize:=false; + if (ot and OT_VREG)=OT_VREG then + s:=s+'vreg' + else + if (ot and OT_FPUREG)=OT_FPUREG then + s:=s+'fpureg' + else + if (ot and OT_REGISTER)=OT_REGISTER then + begin + s:=s+'reg'; + addsize:=true; + end + else + if (ot and OT_REGLIST)=OT_REGLIST then + begin + s:=s+'reglist'; + addsize:=false; + end + else + if (ot and OT_IMMEDIATE)=OT_IMMEDIATE then + begin + s:=s+'imm'; + addsize:=true; + end + else + if (ot and OT_MEMORY)=OT_MEMORY then + begin + s:=s+'mem'; + addsize:=true; + if (ot and OT_AM2)<>0 then + s:=s+' am2 '; + end + else + s:=s+'???'; + { size } + if addsize then + begin + if (ot and OT_BITS8)<>0 then + s:=s+'8' + else + if (ot and OT_BITS16)<>0 then + s:=s+'24' + else + if (ot and OT_BITS32)<>0 then + s:=s+'32' + else + if (ot and OT_BITSSHIFTER)<>0 then + s:=s+'shifter' + else + s:=s+'??'; + { signed } + if (ot and OT_SIGNED)<>0 then + s:=s+'s'; + end; + end; + end; + GetString:=s+']'; + end; + + + procedure taicpu.ResetPass1; + begin + { we need to reset everything here, because the choosen insentry + can be invalid for a new situation where the previously optimized + insentry is not correct } + InsEntry:=nil; + InsSize:=0; + LastInsOffset:=-1; + end; + + + procedure taicpu.ResetPass2; + begin + { we are here in a second pass, check if the instruction can be optimized } + if assigned(InsEntry) and + ((InsEntry^.flags and IF_PASS2)<>0) then + begin + InsEntry:=nil; + InsSize:=0; + end; + LastInsOffset:=-1; + end; + + + function taicpu.CheckIfValid:boolean; + begin + end; + + + function taicpu.Pass1(offset:longint):longint; + var + ldr2op : array[PF_B..PF_T] of tasmop = ( + A_LDRB,A_LDRSB,A_LDRBT,A_LDRH,A_LDRSH,A_LDRT); + str2op : array[PF_B..PF_T] of tasmop = ( + A_STRB,A_None,A_STRBT,A_STRH,A_None,A_STRT); + begin + Pass1:=0; + { Save the old offset and set the new offset } + InsOffset:=Offset; + { Error? } + if (Insentry=nil) and (InsSize=-1) then + exit; + { set the file postion } + aktfilepos:=fileinfo; + + { tranlate LDR+postfix to complete opcode } + if (opcode=A_LDR) and (oppostfix<>PF_None) then + begin + if (oppostfix in [low(ldr2op)..high(ldr2op)]) then + opcode:=ldr2op[oppostfix] + else + internalerror(2005091001); + if opcode=A_None then + internalerror(2005091004); + { postfix has been added to opcode } + oppostfix:=PF_None; + end + else if (opcode=A_STR) and (oppostfix<>PF_None) then + begin + if (oppostfix in [low(str2op)..high(str2op)]) then + opcode:=str2op[oppostfix] + else + internalerror(2005091002); + if opcode=A_None then + internalerror(2005091003); + { postfix has been added to opcode } + oppostfix:=PF_None; + end; + + { Get InsEntry } + if FindInsEntry then + begin + InsSize:=4; + LastInsOffset:=InsOffset; + Pass1:=InsSize; + exit; + end; + LastInsOffset:=-1; + end; + + + procedure taicpu.Pass2(objdata:TAsmObjectdata); + begin + { error in pass1 ? } + if insentry=nil then + exit; + aktfilepos:=fileinfo; + { Generate the instruction } + GenCode(objdata); + end; + + + procedure taicpu.ppuloadoper(ppufile:tcompilerppufile;var o:toper); + begin + end; + + + procedure taicpu.ppuwriteoper(ppufile:tcompilerppufile;const o:toper); + begin + end; + + + procedure taicpu.ppubuildderefimploper(var o:toper); + begin + end; + + + procedure taicpu.ppuderefoper(var o:toper); + begin + end; + + + function taicpu.InsEnd:longint; + begin + end; + + + procedure taicpu.create_ot; + var + i,l,relsize : longint; + dummy : byte; + begin + if ops=0 then + exit; + { update oper[].ot field } + for i:=0 to ops-1 do + with oper[i]^ do + begin + case typ of + top_regset: + begin + ot:=OT_REGLIST; + end; + top_reg : + begin + case getregtype(reg) of + R_INTREGISTER: + ot:=OT_REG32 or OT_SHIFTEROP; + R_FPUREGISTER: + ot:=OT_FPUREG; + else + internalerror(2005090901); + end; + end; + top_ref : + begin + if ref^.refaddr=addr_no then + begin + { create ot field } + { we should get the size here dependend on the + instruction } + if (ot and OT_SIZE_MASK)=0 then + ot:=OT_MEMORY or OT_BITS32 + else + ot:=OT_MEMORY or (ot and OT_SIZE_MASK); + if (ref^.base=NR_NO) and (ref^.index=NR_NO) then + ot:=ot or OT_MEM_OFFS; + { if we need to fix a reference, we do it here } + + { pc relative addressing } + if (ref^.base=NR_NO) and + (ref^.index=NR_NO) and + (ref^.shiftmode=SM_None) + { at least we should check if the destination symbol + is in a text section } + { and + (ref^.symbol^.owner="text") } then + ref^.base:=NR_PC; + + { determine possible address modes } + if (ref^.base<>NR_NO) and + ( + ( + (ref^.index=NR_NO) and + (ref^.shiftmode=SM_None) and + (ref^.offset>=-4097) and + (ref^.offset<=4097) + ) or + ( + (ref^.shiftmode=SM_None) and + (ref^.offset=0) + ) or + ( + (ref^.index<>NR_NO) and + (ref^.shiftmode<>SM_None) and + (ref^.shiftimm<=31) and + (ref^.offset=0) + ) + ) then + ot:=ot or OT_AM2; + + if (ref^.index<>NR_NO) and + (oppostfix in [PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA]) and + ( + (ref^.base=NR_NO) and + (ref^.shiftmode=SM_None) and + (ref^.offset=0) + ) then + ot:=ot or OT_AM4; + + end + else + begin + l:=ref^.offset; + if assigned(ref^.symbol) then + inc(l,ref^.symbol.address); + relsize:=(InsOffset+2)-l; + if (relsize<-33554428) or (relsize>33554428) then + ot:=OT_IMM32 + else + ot:=OT_IMM24; + end; + end; + top_local : + begin + { we should get the size here dependend on the + instruction } + if (ot and OT_SIZE_MASK)=0 then + ot:=OT_MEMORY or OT_BITS32 + else + ot:=OT_MEMORY or (ot and OT_SIZE_MASK); + end; + top_const : + begin + ot:=OT_IMMEDIATE; + if is_shifter_const(val,dummy) then + ot:=OT_IMMSHIFTER + else + ot:=OT_IMM32 + end; + top_none : + begin + { generated when there was an error in the + assembler reader. It never happends when generating + assembler } + end; + top_shifterop: + begin + ot:=OT_SHIFTEROP; + end; + else + internalerror(200402261); + end; + end; + end; + + + function taicpu.Matches(p:PInsEntry):longint; + { * IF_SM stands for Size Match: any operand whose size is not + * explicitly specified by the template is `really' intended to be + * the same size as the first size-specified operand. + * Non-specification is tolerated in the input instruction, but + * _wrong_ specification is not. + * + * IF_SM2 invokes Size Match on only the first _two_ operands, for + * three-operand instructions such as SHLD: it implies that the + * first two operands must match in size, but that the third is + * required to be _unspecified_. + * + * IF_SB invokes Size Byte: operands with unspecified size in the + * template are really bytes, and so no non-byte specification in + * the input instruction will be tolerated. IF_SW similarly invokes + * Size Word, and IF_SD invokes Size Doubleword. + * + * (The default state if neither IF_SM nor IF_SM2 is specified is + * that any operand with unspecified size in the template is + * required to have unspecified size in the instruction too...) + } + var + i,j,asize,oprs : longint; + siz : array[0..3] of longint; + begin + Matches:=100; + writeln(getstring,'---'); + + { Check the opcode and operands } + if (p^.opcode<>opcode) or (p^.ops<>ops) then + begin + Matches:=0; + exit; + end; + + { Check that no spurious colons or TOs are present } + for i:=0 to p^.ops-1 do + if (oper[i]^.ot and (not p^.optypes[i]) and (OT_COLON or OT_TO))<>0 then + begin + Matches:=0; + exit; + end; + + { Check that the operand flags all match up } + for i:=0 to p^.ops-1 do + begin + if ((p^.optypes[i] and (not oper[i]^.ot)) or + ((p^.optypes[i] and OT_SIZE_MASK) and + ((p^.optypes[i] xor oper[i]^.ot) and OT_SIZE_MASK)))<>0 then + begin + if ((p^.optypes[i] and (not oper[i]^.ot) and OT_NON_SIZE) or + (oper[i]^.ot and OT_SIZE_MASK))<>0 then + begin + Matches:=0; + exit; + end + else + Matches:=1; + end; + end; + + { check postfixes: + the existance of a certain postfix requires a + particular code } + + { update condition flags + or floating point single } + if (oppostfix=PF_S) and + not(p^.code[0] in [#$04]) then + begin + Matches:=0; + exit; + end; + + { floating point size } + if (oppostfix in [PF_D,PF_E,PF_P,PF_EP]) and + not(p^.code[0] in []) then + begin + Matches:=0; + exit; + end; + + { multiple load/store address modes } + if (oppostfix in [PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA]) and + not(p^.code[0] in [ + // ldr,str,ldrb,strb + #$17, + // stm,ldm + #$26 + ]) then + begin + Matches:=0; + exit; + end; + + { we shouldn't see any opsize prefixes here } + if (oppostfix in [PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T]) then + begin + Matches:=0; + exit; + end; + + if (roundingmode<>RM_None) and not(p^.code[0] in []) then + begin + Matches:=0; + exit; + end; + + { Check operand sizes } + { as default an untyped size can get all the sizes, this is different + from nasm, but else we need to do a lot checking which opcodes want + size or not with the automatic size generation } + asize:=longint($ffffffff); + (* + if (p^.flags and IF_SB)<>0 then + asize:=OT_BITS8 + else if (p^.flags and IF_SW)<>0 then + asize:=OT_BITS16 + else if (p^.flags and IF_SD)<>0 then + asize:=OT_BITS32; + if (p^.flags and IF_ARMASK)<>0 then + begin + siz[0]:=0; + siz[1]:=0; + siz[2]:=0; + if (p^.flags and IF_AR0)<>0 then + siz[0]:=asize + else if (p^.flags and IF_AR1)<>0 then + siz[1]:=asize + else if (p^.flags and IF_AR2)<>0 then + siz[2]:=asize; + end + else + begin + { we can leave because the size for all operands is forced to be + the same + but not if IF_SB IF_SW or IF_SD is set PM } + if asize=-1 then + exit; + siz[0]:=asize; + siz[1]:=asize; + siz[2]:=asize; + end; + + if (p^.flags and (IF_SM or IF_SM2))<>0 then + begin + if (p^.flags and IF_SM2)<>0 then + oprs:=2 + else + oprs:=p^.ops; + for i:=0 to oprs-1 do + if ((p^.optypes[i] and OT_SIZE_MASK) <> 0) then + begin + for j:=0 to oprs-1 do + siz[j]:=p^.optypes[i] and OT_SIZE_MASK; + break; + end; + end + else + oprs:=2; + + { Check operand sizes } + for i:=0 to p^.ops-1 do + begin + if ((p^.optypes[i] and OT_SIZE_MASK)=0) and + ((oper[i]^.ot and OT_SIZE_MASK and (not siz[i]))<>0) and + { Immediates can always include smaller size } + ((oper[i]^.ot and OT_IMMEDIATE)=0) and + (((p^.optypes[i] and OT_SIZE_MASK) or siz[i])<(oper[i]^.ot and OT_SIZE_MASK)) then + Matches:=2; + end; + *) + end; + + + function taicpu.calcsize(p:PInsEntry):shortint; + begin + result:=4; + end; + + + function taicpu.NeedAddrPrefix(opidx:byte):boolean; + begin + end; + + + procedure taicpu.Swapoperands; + begin + end; + + + function taicpu.FindInsentry:boolean; + var + i : longint; + begin + result:=false; + { Things which may only be done once, not when a second pass is done to + optimize } + if (Insentry=nil) or ((InsEntry^.flags and IF_PASS2)<>0) then + begin + { create the .ot fields } + create_ot; + { set the file postion } + aktfilepos:=fileinfo; + end + else + begin + { we've already an insentry so it's valid } + result:=true; + exit; + end; + { Lookup opcode in the table } + InsSize:=-1; + i:=instabcache^[opcode]; + if i=-1 then + begin + Message1(asmw_e_opcode_not_in_table,gas_op2str[opcode]); + exit; + end; + insentry:=@instab[i]; + while (insentry^.opcode=opcode) do + begin + if matches(insentry)=100 then + begin + result:=true; + exit; + end; + inc(i); + insentry:=@instab[i]; + end; + Message1(asmw_e_invalid_opcode_and_operands,GetString); + { No instruction found, set insentry to nil and inssize to -1 } + insentry:=nil; + inssize:=-1; + end; + + + procedure taicpu.gencode(objdata:TAsmObjectData); + var + bytes : dword; + i_field : byte; + + procedure setshifterop(op : byte); + begin + case oper[op]^.typ of + top_const: + begin + i_field:=1; + bytes:=bytes or (oper[op]^.val and $fff); + end; + top_reg: + begin + i_field:=0; + bytes:=bytes or (getsupreg(oper[op]^.reg) shl 16); + + { does a real shifter op follow? } + if (op+1<=op) and (oper[op+1]^.typ=top_shifterop) then + begin + end; + end; + else + internalerror(2005091103); + end; + end; + + begin + bytes:=$0; + { evaluate and set condition code } + + { condition code allowed? } + + { setup rest of the instruction } + case insentry^.code[0] of + #$08: + begin + { set instruction code } + bytes:=bytes or (ord(insentry^.code[1]) shl 26); + bytes:=bytes or (ord(insentry^.code[2]) shl 21); + + { set destination } + bytes:=bytes or (getsupreg(oper[0]^.reg) shl 12); + + { create shifter op } + setshifterop(1); + + { set i field } + bytes:=bytes or (i_field shl 25); + + { set s if necessary } + if oppostfix=PF_S then + bytes:=bytes or (1 shl 20); + end; + #$ff: + internalerror(2005091101); + else + internalerror(2005091102); + end; + { we're finished, write code } + objdata.writebytes(bytes,sizeof(bytes)); + end; + + +end. + +{$ifdef dummy} + (* +static void gencode (long segment, long offset, int bits, + insn *ins, char *codes, long insn_end) +{ + int has_S_code; /* S - setflag */ + int has_B_code; /* B - setflag */ + int has_T_code; /* T - setflag */ + int has_W_code; /* ! => W flag */ + int has_F_code; /* ^ => S flag */ + int keep; + unsigned char c; + unsigned char bytes[4]; + long data, size; + static int cc_code[] = /* bit pattern of cc */ + { /* order as enum in */ + 0x0E, 0x03, 0x02, 0x00, /* nasm.h */ + 0x0A, 0x0C, 0x08, 0x0D, + 0x09, 0x0B, 0x04, 0x01, + 0x05, 0x07, 0x06, + }; + +(* +#ifdef DEBUG +static char *CC[] = + { /* condition code names */ + "AL", "CC", "CS", "EQ", + "GE", "GT", "HI", "LE", + "LS", "LT", "MI", "NE", + "PL", "VC", "VS", "", + "S" +}; +*) + + has_S_code = (ins->condition & C_SSETFLAG); + has_B_code = (ins->condition & C_BSETFLAG); + has_T_code = (ins->condition & C_TSETFLAG); + has_W_code = (ins->condition & C_EXSETFLAG); + has_F_code = (ins->condition & C_FSETFLAG); + ins->condition = (ins->condition & 0x0F); + +(* + if (rt_debug) + { + printf ("gencode: instruction: %s%s", insn_names[ins->opcode], + CC[ins->condition & 0x0F]); + if (has_S_code) + printf ("S"); + if (has_B_code) + printf ("B"); + if (has_T_code) + printf ("T"); + if (has_W_code) + printf ("!"); + if (has_F_code) + printf ("^"); + + printf ("\n"); + + c = *codes; + + printf (" (%d) decode - '0x%02X'\n", ins->operands, c); + + + bytes[0] = 0xB; + bytes[1] = 0xE; + bytes[2] = 0xE; + bytes[3] = 0xF; + } +*) + // First condition code in upper nibble + if (ins->condition < C_NONE) + { + c = cc_code[ins->condition] << 4; + } + else + { + c = cc_code[C_AL] << 4; // is often ALWAYS but not always + } + + + switch (keep = *codes) + { + case 1: + // B, BL + ++codes; + c |= *codes++; + bytes[0] = c; + + if (ins->oprs[0].segment != segment) + { + // fais une relocation + c = 1; + data = 0; // Let the linker locate ?? + } + else + { + c = 0; + data = ins->oprs[0].offset - (offset + 8); + + if (data % 4) + { + errfunc (ERR_NONFATAL, "offset not aligned on 4 bytes"); + } + } + + if (data >= 0x1000) + { + errfunc (ERR_NONFATAL, "too long offset"); + } + + data = data >> 2; + bytes[1] = (data >> 16) & 0xFF; + bytes[2] = (data >> 8) & 0xFF; + bytes[3] = (data ) & 0xFF; + + if (c == 1) + { +// out (offset, segment, &bytes[0], OUT_RAWDATA+1, NO_SEG, NO_SEG); + out (offset, segment, &bytes[0], OUT_REL3ADR+4, ins->oprs[0].segment, NO_SEG); + } + else + { + out (offset, segment, &bytes[0], OUT_RAWDATA+4, NO_SEG, NO_SEG); + } + return; + + case 2: + // SWI + ++codes; + c |= *codes++; + bytes[0] = c; + data = ins->oprs[0].offset; + bytes[1] = (data >> 16) & 0xFF; + bytes[2] = (data >> 8) & 0xFF; + bytes[3] = (data) & 0xFF; + out (offset, segment, &bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); + return; + case 3: + // BX + ++codes; + c |= *codes++; + bytes[0] = c; + bytes[1] = *codes++; + bytes[2] = *codes++; + bytes[3] = *codes++; + c = regval (&ins->oprs[0],1); + if (c == 15) // PC + { + errfunc (ERR_WARNING, "'BX' with R15 has undefined behaviour"); + } + else if (c > 15) + { + errfunc (ERR_NONFATAL, "Illegal register specified for 'BX'"); + } + + bytes[3] |= (c & 0x0F); + out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); + return; + + case 4: // AND Rd,Rn,Rm + case 5: // AND Rd,Rn,Rm,<shift>Rs + case 6: // AND Rd,Rn,Rm,<shift>imm + case 7: // AND Rd,Rn,<shift>imm + ++codes; +#ifdef DEBUG + if (rt_debug) + { + printf (" decode - '0x%02X'\n", keep); + printf (" code - '0x%02X'\n", (unsigned char) ( *codes)); + } +#endif + bytes[0] = c | *codes; + ++codes; + + bytes[1] = *codes; + if (has_S_code) + bytes[1] |= 0x10; + c = regval (&ins->oprs[1],1); + // Rn in low nibble + bytes[1] |= c; + + // Rd in high nibble + bytes[2] = regval (&ins->oprs[0],1) << 4; + + if (keep != 7) + { + // Rm in low nibble + bytes[3] = regval (&ins->oprs[2],1); + } + + // Shifts if any + if (keep == 5 || keep == 6) + { + // Shift in bytes 2 and 3 + if (keep == 5) + { + // Rs + c = regval (&ins->oprs[3],1); + bytes[2] |= c; + + c = 0x10; // Set bit 4 in byte[3] + } + if (keep == 6) + { + c = (ins->oprs[3].offset) & 0x1F; + + // #imm + bytes[2] |= c >> 1; + if (c & 0x01) + { + bytes[3] |= 0x80; + } + c = 0; // Clr bit 4 in byte[3] + } + // <shift> + c |= shiftval (&ins->oprs[3]) << 5; + + bytes[3] |= c; + } + + // reg,reg,imm + if (keep == 7) + { + int shimm; + + shimm = imm_shift (ins->oprs[2].offset); + + if (shimm == -1) + { + errfunc (ERR_NONFATAL, "cannot create that constant"); + } + bytes[3] = shimm & 0xFF; + bytes[2] |= (shimm & 0xF00) >> 8; + } + + out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); + return; + + case 8: // MOV Rd,Rm + case 9: // MOV Rd,Rm,<shift>Rs + case 0xA: // MOV Rd,Rm,<shift>imm + case 0xB: // MOV Rd,<shift>imm + ++codes; +#ifdef DEBUG + if (rt_debug) + { + printf (" decode - '0x%02X'\n", keep); + printf (" code - '0x%02X'\n", (unsigned char) ( *codes)); + } +#endif + bytes[0] = c | *codes; + ++codes; + + bytes[1] = *codes; + if (has_S_code) + bytes[1] |= 0x10; + + // Rd in high nibble + bytes[2] = regval (&ins->oprs[0],1) << 4; + + if (keep != 0x0B) + { + // Rm in low nibble + bytes[3] = regval (&ins->oprs[1],1); + } + + // Shifts if any + if (keep == 0x09 || keep == 0x0A) + { + // Shift in bytes 2 and 3 + if (keep == 0x09) + { + // Rs + c = regval (&ins->oprs[2],1); + bytes[2] |= c; + + c = 0x10; // Set bit 4 in byte[3] + } + if (keep == 0x0A) + { + c = (ins->oprs[2].offset) & 0x1F; + + // #imm + bytes[2] |= c >> 1; + if (c & 0x01) + { + bytes[3] |= 0x80; + } + c = 0; // Clr bit 4 in byte[3] + } + // <shift> + c |= shiftval (&ins->oprs[2]) << 5; + + bytes[3] |= c; + } + + // reg,imm + if (keep == 0x0B) + { + int shimm; + + shimm = imm_shift (ins->oprs[1].offset); + + if (shimm == -1) + { + errfunc (ERR_NONFATAL, "cannot create that constant"); + } + bytes[3] = shimm & 0xFF; + bytes[2] |= (shimm & 0xF00) >> 8; + } + + out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); + return; + + + case 0xC: // CMP Rn,Rm + case 0xD: // CMP Rn,Rm,<shift>Rs + case 0xE: // CMP Rn,Rm,<shift>imm + case 0xF: // CMP Rn,<shift>imm + ++codes; + + bytes[0] = c | *codes++; + + bytes[1] = *codes; + + // Implicit S code + bytes[1] |= 0x10; + + c = regval (&ins->oprs[0],1); + // Rn in low nibble + bytes[1] |= c; + + // No destination + bytes[2] = 0; + + if (keep != 0x0B) + { + // Rm in low nibble + bytes[3] = regval (&ins->oprs[1],1); + } + + // Shifts if any + if (keep == 0x0D || keep == 0x0E) + { + // Shift in bytes 2 and 3 + if (keep == 0x0D) + { + // Rs + c = regval (&ins->oprs[2],1); + bytes[2] |= c; + + c = 0x10; // Set bit 4 in byte[3] + } + if (keep == 0x0E) + { + c = (ins->oprs[2].offset) & 0x1F; + + // #imm + bytes[2] |= c >> 1; + if (c & 0x01) + { + bytes[3] |= 0x80; + } + c = 0; // Clr bit 4 in byte[3] + } + // <shift> + c |= shiftval (&ins->oprs[2]) << 5; + + bytes[3] |= c; + } + + // reg,imm + if (keep == 0x0F) + { + int shimm; + + shimm = imm_shift (ins->oprs[1].offset); + + if (shimm == -1) + { + errfunc (ERR_NONFATAL, "cannot create that constant"); + } + bytes[3] = shimm & 0xFF; + bytes[2] |= (shimm & 0xF00) >> 8; + } + + out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); + return; + + case 0x10: // MRS Rd,<psr> + ++codes; + + bytes[0] = c | *codes++; + + bytes[1] = *codes++; + + // Rd + c = regval (&ins->oprs[0],1); + + bytes[2] = c << 4; + + bytes[3] = 0; + + c = ins->oprs[1].basereg; + + if (c == R_CPSR || c == R_SPSR) + { + if (c == R_SPSR) + { + bytes[1] |= 0x40; + } + } + else + { + errfunc (ERR_NONFATAL, "CPSR or SPSR expected"); + } + + out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); + + return; + + case 0x11: // MSR <psr>,Rm + case 0x12: // MSR <psrf>,Rm + case 0x13: // MSR <psrf>,#expression + ++codes; + + bytes[0] = c | *codes++; + + bytes[1] = *codes++; + + bytes[2] = *codes; + + + if (keep == 0x11 || keep == 0x12) + { + // Rm + c = regval (&ins->oprs[1],1); + + bytes[3] = c; + } + else + { + int shimm; + + shimm = imm_shift (ins->oprs[1].offset); + + if (shimm == -1) + { + errfunc (ERR_NONFATAL, "cannot create that constant"); + } + bytes[3] = shimm & 0xFF; + bytes[2] |= (shimm & 0xF00) >> 8; + } + + c = ins->oprs[0].basereg; + + if ( keep == 0x11) + { + if ( c == R_CPSR || c == R_SPSR) + { + if ( c== R_SPSR) + { + bytes[1] |= 0x40; + } + } + else + { + errfunc (ERR_NONFATAL, "CPSR or SPSR expected"); + } + } + else + { + if ( c == R_CPSR_FLG || c == R_SPSR_FLG) + { + if ( c== R_SPSR_FLG) + { + bytes[1] |= 0x40; + } + } + else + { + errfunc (ERR_NONFATAL, "CPSR_flg or SPSR_flg expected"); + } + } + break; + + case 0x14: // MUL Rd,Rm,Rs + case 0x15: // MULA Rd,Rm,Rs,Rn + ++codes; + + bytes[0] = c | *codes++; + + bytes[1] = *codes++; + + bytes[3] = *codes; + + // Rd + bytes[1] |= regval (&ins->oprs[0],1); + if (has_S_code) + bytes[1] |= 0x10; + + // Rm + bytes[3] |= regval (&ins->oprs[1],1); + + // Rs + bytes[2] = regval (&ins->oprs[2],1); + + if (keep == 0x15) + { + bytes[2] |= regval (&ins->oprs[3],1) << 4; + } + break; + + case 0x16: // SMLAL RdHi,RdLo,Rm,Rs + ++codes; + + bytes[0] = c | *codes++; + + bytes[1] = *codes++; + + bytes[3] = *codes; + + // RdHi + bytes[1] |= regval (&ins->oprs[1],1); + if (has_S_code) + bytes[1] |= 0x10; + + // RdLo + bytes[2] = regval (&ins->oprs[0],1) << 4; + // Rm + bytes[3] |= regval (&ins->oprs[2],1); + + // Rs + bytes[2] |= regval (&ins->oprs[3],1); + + break; + + case 0x17: // LDR Rd, expression + ++codes; + + bytes[0] = c | *codes++; + + bytes[1] = *codes++; + + // Rd + bytes[2] = regval (&ins->oprs[0],1) << 4; + if (has_B_code) + bytes[1] |= 0x40; + if (has_T_code) + { + errfunc (ERR_NONFATAL, "'T' not allowed in pre-index mode"); + } + if (has_W_code) + { + errfunc (ERR_NONFATAL, "'!' not allowed"); + } + + // Rn - implicit R15 + bytes[1] |= 0xF; + + if (ins->oprs[1].segment != segment) + { + errfunc (ERR_NONFATAL, "label not in same segment"); + } + + data = ins->oprs[1].offset - (offset + 8); + + if (data < 0) + { + data = -data; + } + else + { + bytes[1] |= 0x80; + } + + if (data >= 0x1000) + { + errfunc (ERR_NONFATAL, "too long offset"); + } + + bytes[2] |= ((data & 0xF00) >> 8); + bytes[3] = data & 0xFF; + break; + + case 0x18: // LDR Rd, [Rn] + ++codes; + + bytes[0] = c | *codes++; + + bytes[1] = *codes++; + + // Rd + bytes[2] = regval (&ins->oprs[0],1) << 4; + if (has_B_code) + bytes[1] |= 0x40; + if (has_T_code) + { + bytes[1] |= 0x20; // write-back + } + else + { + bytes[0] |= 0x01; // implicit pre-index mode + } + + if (has_W_code) + { + bytes[1] |= 0x20; // write-back + } + + // Rn + c = regval (&ins->oprs[1],1); + bytes[1] |= c; + + if (c == 0x15) // R15 + data = -8; + else + data = 0; + + if (data < 0) + { + data = -data; + } + else + { + bytes[1] |= 0x80; + } + + bytes[2] |= ((data & 0xF00) >> 8); + bytes[3] = data & 0xFF; + break; + + case 0x19: // LDR Rd, [Rn,#expression] + case 0x20: // LDR Rd, [Rn,Rm] + case 0x21: // LDR Rd, [Rn,Rm,shift] + ++codes; + + bytes[0] = c | *codes++; + + bytes[1] = *codes++; + + // Rd + bytes[2] = regval (&ins->oprs[0],1) << 4; + if (has_B_code) + bytes[1] |= 0x40; + + // Rn + c = regval (&ins->oprs[1],1); + bytes[1] |= c; + + if (ins->oprs[ins->operands-1].bracket) // FIXME: Bracket on last operand -> pre-index <-- + { + bytes[0] |= 0x01; // pre-index mode + if (has_W_code) + { + bytes[1] |= 0x20; + } + if (has_T_code) + { + errfunc (ERR_NONFATAL, "'T' not allowed in pre-index mode"); + } + } + else + { + if (has_T_code) // Forced write-back in post-index mode + { + bytes[1] |= 0x20; + } + if (has_W_code) + { + errfunc (ERR_NONFATAL, "'!' not allowed in post-index mode"); + } + } + + if (keep == 0x19) + { + data = ins->oprs[2].offset; + + if (data < 0) + { + data = -data; + } + else + { + bytes[1] |= 0x80; + } + + if (data >= 0x1000) + { + errfunc (ERR_NONFATAL, "too long offset"); + } + + bytes[2] |= ((data & 0xF00) >> 8); + bytes[3] = data & 0xFF; + } + else + { + if (ins->oprs[2].minus == 0) + { + bytes[1] |= 0x80; + } + c = regval (&ins->oprs[2],1); + bytes[3] = c; + + if (keep == 0x21) + { + c = ins->oprs[3].offset; + if (c > 0x1F) + { + errfunc (ERR_NONFATAL, "too large shiftvalue"); + c = c & 0x1F; + } + + bytes[2] |= c >> 1; + if (c & 0x01) + { + bytes[3] |= 0x80; + } + bytes[3] |= shiftval (&ins->oprs[3]) << 5; + } + } + + break; + + case 0x22: // LDRH Rd, expression + ++codes; + + bytes[0] = c | 0x01; // Implicit pre-index + + bytes[1] = *codes++; + + // Rd + bytes[2] = regval (&ins->oprs[0],1) << 4; + + // Rn - implicit R15 + bytes[1] |= 0xF; + + if (ins->oprs[1].segment != segment) + { + errfunc (ERR_NONFATAL, "label not in same segment"); + } + + data = ins->oprs[1].offset - (offset + 8); + + if (data < 0) + { + data = -data; + } + else + { + bytes[1] |= 0x80; + } + + if (data >= 0x100) + { + errfunc (ERR_NONFATAL, "too long offset"); + } + bytes[3] = *codes++; + + bytes[2] |= ((data & 0xF0) >> 4); + bytes[3] |= data & 0xF; + break; + + case 0x23: // LDRH Rd, Rn + ++codes; + + bytes[0] = c | 0x01; // Implicit pre-index + + bytes[1] = *codes++; + + // Rd + bytes[2] = regval (&ins->oprs[0],1) << 4; + + // Rn + c = regval (&ins->oprs[1],1); + bytes[1] |= c; + + if (c == 0x15) // R15 + data = -8; + else + data = 0; + + if (data < 0) + { + data = -data; + } + else + { + bytes[1] |= 0x80; + } + + if (data >= 0x100) + { + errfunc (ERR_NONFATAL, "too long offset"); + } + bytes[3] = *codes++; + + bytes[2] |= ((data & 0xF0) >> 4); + bytes[3] |= data & 0xF; + break; + + case 0x24: // LDRH Rd, Rn, expression + case 0x25: // LDRH Rd, Rn, Rm + ++codes; + + bytes[0] = c; + + bytes[1] = *codes++; + + // Rd + bytes[2] = regval (&ins->oprs[0],1) << 4; + + // Rn + c = regval (&ins->oprs[1],1); + bytes[1] |= c; + + if (ins->oprs[ins->operands-1].bracket) // FIXME: Bracket on last operand -> pre-index <-- + { + bytes[0] |= 0x01; // pre-index mode + if (has_W_code) + { + bytes[1] |= 0x20; + } + } + else + { + if (has_W_code) + { + errfunc (ERR_NONFATAL, "'!' not allowed in post-index mode"); + } + } + + bytes[3] = *codes++; + + if (keep == 0x24) + { + data = ins->oprs[2].offset; + + if (data < 0) + { + data = -data; + } + else + { + bytes[1] |= 0x80; + } + + if (data >= 0x100) + { + errfunc (ERR_NONFATAL, "too long offset"); + } + + bytes[2] |= ((data & 0xF0) >> 4); + bytes[3] |= data & 0xF; + } + else + { + if (ins->oprs[2].minus == 0) + { + bytes[1] |= 0x80; + } + c = regval (&ins->oprs[2],1); + bytes[3] |= c; + + } + break; + + case 0x26: // LDM/STM Rn, {reg-list} + ++codes; + + bytes[0] = c; + + bytes[0] |= ( *codes >> 4) & 0xF; + bytes[1] = ( *codes << 4) & 0xF0; + ++codes; + + if (has_W_code) + { + bytes[1] |= 0x20; + } + if (has_F_code) + { + bytes[1] |= 0x40; + } + + // Rn + bytes[1] |= regval (&ins->oprs[0],1); + + data = ins->oprs[1].basereg; + + bytes[2] = ((data >> 8) & 0xFF); + bytes[3] = (data & 0xFF); + + break; + + case 0x27: // SWP Rd, Rm, [Rn] + ++codes; + + bytes[0] = c; + + bytes[0] |= *codes++; + + bytes[1] = regval (&ins->oprs[2],1); + if (has_B_code) + { + bytes[1] |= 0x40; + } + bytes[2] = regval (&ins->oprs[0],1) << 4; + bytes[3] = *codes++; + bytes[3] |= regval (&ins->oprs[1],1); + break; + + default: + errfunc (ERR_FATAL, "unknown decoding of instruction"); + + bytes[0] = c; + // And a fix nibble + ++codes; + bytes[0] |= *codes++; + + if ( *codes == 0x01) // An I bit + { + + } + if ( *codes == 0x02) // An I bit + { + + } + ++codes; + } + out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); +} + + +*) +{$endif dummy +} diff --git a/compiler/arm/agarmgas.pas b/compiler/arm/agarmgas.pas new file mode 100644 index 0000000000..7622ceaa85 --- /dev/null +++ b/compiler/arm/agarmgas.pas @@ -0,0 +1,237 @@ +{ + Copyright (c) 2003 by Florian Klaempfl + + This unit implements an asm for the ARM + + 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. + + **************************************************************************** +} +{ This unit implements the GNU Assembler writer for the ARM +} + +unit agarmgas; + +{$i fpcdefs.inc} + + interface + + uses + aasmtai, + aggas, + cpubase; + + type + PARMGNUAssembler=^TARMGNUAssembler; + TARMGNUAssembler=class(TGNUassembler) + procedure WriteInstruction(hp : tai);override; + end; + + const + gas_shiftmode2str : array[tshiftmode] of string[3] = ( + '','lsl','lsr','asr','ror','rrx'); + + implementation + + uses + cutils,globals,verbose, + systems, + assemble, + aasmcpu, + itcpugas, + cgbase,cgutils; + + const + as_arm_gas_info : tasminfo = + ( + id : as_gas; + + idtxt : 'AS'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM'; + supported_target : system_any; + flags : [af_allowdirect,af_needar,af_smartlink_sections]; + labelprefix : '.L'; + comment : '# '; + ); + + function getreferencestring(var ref : treference) : string; + var + s : string; + begin + with ref do + begin +{$ifdef extdebug} + // if base=NR_NO then + // internalerror(200308292); + + // if ((index<>NR_NO) or (shiftmode<>SM_None)) and ((offset<>0) or (symbol<>nil)) then + // internalerror(200308293); +{$endif extdebug} + + if assigned(symbol) then + begin + if (base<>NR_NO) and not(is_pc(base)) then + internalerror(200309011); + s:=symbol.name; + if offset<0 then + s:=s+tostr(offset) + else if offset>0 then + s:=s+'+'+tostr(offset); + end + else + begin + s:='['+gas_regname(base); + if addressmode=AM_POSTINDEXED then + s:=s+']'; + if index<>NR_NO then + begin + if signindex<0 then + s:=s+', -' + else + s:=s+', '; + + s:=s+gas_regname(index); + + if shiftmode<>SM_None then + s:=s+' ,'+gas_shiftmode2str[shiftmode]+' #'+tostr(shiftimm); + end + else if offset<>0 then + s:=s+', #'+tostr(offset); + + case addressmode of + AM_OFFSET: + s:=s+']'; + AM_PREINDEXED: + s:=s+']!'; + end; + end; + + end; + getreferencestring:=s; + end; + + + const + shiftmode2str: array[tshiftmode] of string[3] = ('','lsl','lsr','asr','ror','rrx'); + + function getopstr(const o:toper) : string; + var + hs : string; + first : boolean; + r : tsuperregister; + begin + case o.typ of + top_reg: + getopstr:=gas_regname(o.reg); + top_shifterop: + begin + if (o.shifterop^.rs<>NR_NO) and (o.shifterop^.shiftimm=0) then + getopstr:=shiftmode2str[o.shifterop^.shiftmode]+' '+gas_regname(o.shifterop^.rs) + else if (o.shifterop^.rs=NR_NO) then + getopstr:=shiftmode2str[o.shifterop^.shiftmode]+' #'+tostr(o.shifterop^.shiftimm) + else internalerror(200308282); + end; + top_const: + getopstr:='#'+tostr(longint(o.val)); + top_regset: + begin + getopstr:='{'; + first:=true; + for r:=RS_R0 to RS_R15 do + if r in o.regset^ then + begin + if not(first) then + getopstr:=getopstr+','; + getopstr:=getopstr+gas_regname(newreg(R_INTREGISTER,r,R_SUBWHOLE)); + first:=false; + end; + getopstr:=getopstr+'}'; + end; + top_ref: + if o.ref^.refaddr=addr_full then + begin + hs:=o.ref^.symbol.name; + if o.ref^.offset>0 then + hs:=hs+'+'+tostr(o.ref^.offset) + else + if o.ref^.offset<0 then + hs:=hs+tostr(o.ref^.offset); + getopstr:=hs; + end + else + getopstr:=getreferencestring(o.ref^); + else + internalerror(2002070604); + end; + end; + + + Procedure TARMGNUAssembler.WriteInstruction(hp : tai); + var op: TAsmOp; + s: string; + i: byte; + sep: string[3]; + begin + op:=taicpu(hp).opcode; + s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix]; + if taicpu(hp).ops<>0 then + begin + sep:=#9; + for i:=0 to taicpu(hp).ops-1 do + begin + // debug code + // writeln(s); + // writeln(taicpu(hp).fileinfo.line); + + { LDM and STM use references as first operand but they are written like a register } + if (i=0) and (op in [A_LDM,A_STM]) then + begin + case taicpu(hp).oper[0]^.typ of + top_ref: + begin + s:=s+sep+gas_regname(taicpu(hp).oper[0]^.ref^.index); + if taicpu(hp).oper[0]^.ref^.addressmode=AM_PREINDEXED then + s:=s+'!'; + end; + top_reg: + s:=s+sep+gas_regname(taicpu(hp).oper[0]^.reg); + else + internalerror(200311292); + end; + end + { register count of SFM and LFM is written without # } + else if (i=1) and (op in [A_SFM,A_LFM]) then + begin + case taicpu(hp).oper[1]^.typ of + top_const: + s:=s+sep+tostr(taicpu(hp).oper[1]^.val); + else + internalerror(200311292); + end; + end + else + s:=s+sep+getopstr(taicpu(hp).oper[i]^); + + sep:=','; + end; + end; + AsmWriteLn(s); + end; + + +begin + RegisterAssembler(as_arm_gas_info,TARMGNUAssembler); +end. diff --git a/compiler/arm/aoptcpu.pas b/compiler/arm/aoptcpu.pas new file mode 100644 index 0000000000..e15acceb04 --- /dev/null +++ b/compiler/arm/aoptcpu.pas @@ -0,0 +1,42 @@ +{ + Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal + Development Team + + This unit implements the ARM optimizer object + + 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 aoptcpu; + +{$i fpcdefs.inc} + +Interface + +uses cpubase, aopt, aoptcpub; + +Type + TCpuAsmOptimizer = class(TAsmOptimizer) + { uses the same constructor as TAopObj } + End; + +Implementation + +begin + casmoptimizer:=TCpuAsmOptimizer; +End. diff --git a/compiler/arm/aoptcpub.pas b/compiler/arm/aoptcpub.pas new file mode 100644 index 0000000000..d9bc456bf0 --- /dev/null +++ b/compiler/arm/aoptcpub.pas @@ -0,0 +1,120 @@ + { + Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal + Development Team + + This unit contains several types and constants necessary for the + optimizer to work on the ARM architecture + + 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 aoptcpub; { Assembler OPTimizer CPU specific Base } + +{$i fpcdefs.inc} + +{ enable the following define if memory references can have both a base and } +{ index register in 1 operand } + +{$define RefsHaveIndexReg} + +{ enable the following define if memory references can have a scaled index } + +{ define RefsHaveScale} + +{ enable the following define if memory references can have a segment } +{ override } + +{ define RefsHaveSegment} + +Interface + +Uses + cpubase,aasmcpu,AOptBase; + +Type + +{ type of a normal instruction } + TInstr = Taicpu; + PInstr = ^TInstr; + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +{ Info about the conditional registers } + TCondRegs = Object + Constructor Init; + Destructor Done; + End; + +{ ************************************************************************* } +{ **************************** TAoptBaseCpu ******************************* } +{ ************************************************************************* } + + TAoptBaseCpu = class(TAoptBase) + End; + + +{ ************************************************************************* } +{ ******************************* Constants ******************************* } +{ ************************************************************************* } +Const + +{ the maximum number of things (registers, memory, ...) a single instruction } +{ changes } + + MaxCh = 3; + +{ the maximum number of operands an instruction has } + + MaxOps = 3; + +{Oper index of operand that contains the source (reference) with a load } +{instruction } + + LoadSrc = 0; + +{Oper index of operand that contains the destination (register) with a load } +{instruction } + + LoadDst = 1; + +{Oper index of operand that contains the source (register) with a store } +{instruction } + + StoreSrc = 0; + +{Oper index of operand that contains the destination (reference) with a load } +{instruction } + + StoreDst = 1; + + aopt_uncondjmp = A_B; + aopt_condjmp = A_B; + +Implementation + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +Constructor TCondRegs.init; +Begin +End; + +Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl} +Begin +End; + +End. diff --git a/compiler/arm/aoptcpuc.pas b/compiler/arm/aoptcpuc.pas new file mode 100644 index 0000000000..7532a77fa3 --- /dev/null +++ b/compiler/arm/aoptcpuc.pas @@ -0,0 +1,38 @@ + { + Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal + Development Team + + This unit contains the processor specific implementation of the + assembler optimizer common subexpression elimination object. + + 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 aoptcpuc; + +Interface + +Uses + AOptCs; + +Type + TRegInfoCpu = Object(TRegInfo) + End; + + +Implementation + +End. diff --git a/compiler/arm/aoptcpud.pas b/compiler/arm/aoptcpud.pas new file mode 100644 index 0000000000..2df7e2e49e --- /dev/null +++ b/compiler/arm/aoptcpud.pas @@ -0,0 +1,40 @@ +{ + Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal + Development Team + + This unit contains the processor specific implementation of the + assembler optimizer data flow analyzer. + + 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 aoptcpud; + +{$i fpcdefs.inc} + +Interface + +uses + AOptDA; + +Type + TAOptDFACpu = class(TAOptDFA) + End; + +Implementation + + +End. diff --git a/compiler/arm/armatt.inc b/compiler/arm/armatt.inc new file mode 100644 index 0000000000..e29160bef4 --- /dev/null +++ b/compiler/arm/armatt.inc @@ -0,0 +1,90 @@ +{ don't edit, this file is generated from armins.dat } +( +'none', +'abs', +'acs', +'asn', +'atn', +'adc', +'add', +'adf', +'and', +'b', +'bic', +'bl', +'blx', +'bkpt', +'bx', +'cdp', +'cmf', +'cmfe', +'cmn', +'cmp', +'clz', +'cnf', +'cos', +'dvf', +'eor', +'exp', +'fdv', +'flt', +'fix', +'fml', +'frd', +'ldc', +'ldm', +'ldrbt', +'ldrb', +'ldr', +'ldrh', +'ldrsb', +'ldrsh', +'ldrt', +'ldf', +'lfm', +'lgn', +'log', +'mcr', +'mla', +'mov', +'mnf', +'muf', +'mul', +'mvf', +'mvn', +'orr', +'rdf', +'rfs', +'rfc', +'rmf', +'rpw', +'rsb', +'rsc', +'rsf', +'rnd', +'pol', +'sbc', +'sfm', +'sin', +'smlal', +'smull', +'sqt', +'suf', +'stf', +'stm', +'str', +'strb', +'strbt', +'strh', +'strt', +'sub', +'swi', +'swp', +'swpb', +'tan', +'teq', +'tst', +'umlal', +'umull', +'wfs' +); diff --git a/compiler/arm/armatts.inc b/compiler/arm/armatts.inc new file mode 100644 index 0000000000..eb08065e2f --- /dev/null +++ b/compiler/arm/armatts.inc @@ -0,0 +1,90 @@ +{ don't edit, this file is generated from armins.dat } +( +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE +); diff --git a/compiler/arm/armins.dat b/compiler/arm/armins.dat new file mode 100644 index 0000000000..1f4958b86d --- /dev/null +++ b/compiler/arm/armins.dat @@ -0,0 +1,394 @@ +;
+; Table of assembler instructions for Free Pascal
+; adapted from Netwide Assembler by Florian Klaempfl
+;
+;
+; The Netwide Assembler is copyright (C) 1996 Simon Tatham and
+; Julian Hall. All rights reserved. The software is
+; redistributable under the licence given in the file "Licence"
+; distributed in the NASM archive.
+;
+; Format of file: all four fields must be present on every functional
+; line. Hence `void' for no-operand instructions, and `\0' for such
+; as EQU. If the last three fields are all `ignore', no action is
+; taken except to register the opcode as being present.
+;
+;
+; 'ignore' means no instruc
+; 'void' means instruc with zero operands
+;
+; Third field has a first byte indicating how to
+; put together the bits, and then some codes
+; that may be used at will (see assemble.c)
+;
+; \1 - 24 bit pc-rel offset [B, BL]
+; \2 - 24 bit imm value [SWI]
+; \3 - 3 byte code [BX]
+;
+; \4 - reg,reg,reg [AND,EOR,SUB,RSB,ADD,ADC,SBC,RSC,ORR,BIC]
+; \5 - reg,reg,reg,<shift>reg [-"-]
+; \6 - reg,reg,reg,<shift>#imm [-"-]
+; \7 - reg,reg,#imm [-"-]
+;
+; \x8 - reg,reg [MOV,MVN]
+; \x9 - reg,reg,<shift>reg [-"-]
+; \xA - reg,reg,<shift>#imm [-"-]
+; \xB - reg,#imm [-"-]
+;
+; \xC - reg,reg [CMP,CMN,TEQ,TST]
+; \xD - reg,reg,<shift>reg [-"-]
+; \xE - reg,reg,<shift>#imm [-"-]
+; \xF - reg,#imm [-"-]
+;
+; \xFx - floating point instructions
+; Floating point instruction format information, taken from the linux kernel,
+; for detailed tables, see aasmcpu.pas
+;
+; ARM Floating Point Instruction Classes
+; | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
+; |c o n d|1 1 0 P|U|u|W|L| Rn |v| Fd |0|0|0|1| o f f s e t | CPDT
+; |c o n d|1 1 0 P|U|w|W|L| Rn |x| Fd |0|0|1|0| o f f s e t | CPDT (copro 2)
+; | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
+; |c o n d|1 1 1 0|a|b|c|d|e| Fn |j| Fd |0|0|0|1|f|g|h|0|i| Fm | CPDO
+; |c o n d|1 1 1 0|a|b|c|L|e| Fn | Rd |0|0|0|1|f|g|h|1|i| Fm | CPRT
+; |c o n d|1 1 1 0|a|b|c|1|e| Fn |1|1|1|1|0|0|0|1|f|g|h|1|i| Fm | comparisons
+; | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
+;
+; CPDT data transfer instructions
+; LDF, STF, LFM (copro 2), SFM (copro 2)
+;
+; CPDO dyadic arithmetic instructions
+; ADF, MUF, SUF, RSF, DVF, RDF,
+; POW, RPW, RMF, FML, FDV, FRD, POL
+;
+; CPDO monadic arithmetic instructions
+; MVF, MNF, ABS, RND, SQT, LOG, LGN, EXP,
+; SIN, COS, TAN, ASN, ACS, ATN, URD, NRM
+;
+; CPRT joint arithmetic/data transfer instructions
+; FIX (arithmetic followed by load/store)
+; FLT (load/store followed by arithmetic)
+; CMF, CNF CMFE, CNFE (comparisons)
+; WFS, RFS (write/read floating point status register)
+; WFC, RFC (write/read floating point control register)
+; \xF0 - CPDT
+; code 1: copro (1/2)
+; code 2: load/store bit
+; \xF1 - CPDO
+; \xF2 - CPDO monadic
+; \xF3 - CPRT
+; \xF4 - CPRT comparison
+;
+; \xFF - fix me
+;
+
+[NONE]
+void void none
+
+[ABScc]
+
+[ACScc]
+
+[ASNcc]
+
+[ATNcc]
+
+[ADCcc]
+reg32,reg32,reg32 \4\x0\xA0 ARM7
+reg32,reg32,reg32,reg32 \5\x0\xA0 ARM7
+reg32,reg32,reg32,imm \6\x0\xA0 ARM7
+reg32,reg32,imm \7\x2\xA0 ARM7
+
+[ADDcc]
+reg32,reg32,reg32 \4\x0\x80 ARM7
+reg32,reg32,reg32,reg32 \5\x0\x80 ARM7
+reg32,reg32,reg32,imm \6\x0\x80 ARM7
+reg32,reg32,imm \7\x2\x80 ARM7
+
+[ADFcc]
+
+[ANDcc]
+reg32,reg32,reg32 \4\x0\x00 ARM7
+reg32,reg32,reg32,reg32 \5\x0\x00 ARM7
+reg32,reg32,reg32,imm \6\x0\x00 ARM7
+reg32,reg32,imm \7\x2\x00 ARM7
+
+[Bcc]
+mem32 \1\x0A ARM7
+imm24 \1\x0A ARM7
+
+[BICcc]
+reg32,reg32,reg32 \4\x1\xC0 ARM7
+reg32,reg32,reg32,reg32 \5\x1\xC0 ARM7
+reg32,reg32,reg32,imm \6\x1\xC0 ARM7
+reg32,reg32,imm \7\x3\xC0 ARM7
+
+[BLcc]
+mem32 \1\x0B ARM7
+imm24 \1\x0B ARM7
+
+[BLX]
+mem32 \xff ARM7
+imm24 \xff ARM7
+
+[BKPTcc]
+
+[BXcc]
+reg32 \3\x01\x2F\xFF\x10 ARM7
+
+[CDP]
+reg8,reg8 \300\1\x10\101 ARM7
+
+[CMFcc]
+
+[CMFEcc]
+
+[CMNcc]
+reg32,reg32 \xC\x1\x60 ARM7
+reg32,reg32,reg32 \xD\x1\x60 ARM7
+reg32,reg32,imm \xE\x1\x60 ARM7
+reg32,imm \xF\x3\x60 ARM7
+
+[CMPcc]
+reg32,reg32 \xC\x1\x40 ARM7
+reg32,reg32,reg32 \xD\x1\x40 ARM7
+reg32,reg32,imm \xE\x1\x40 ARM7
+reg32,imm \xF\x3\x40 ARM7
+
+[CLZcc]
+reg32,reg32 \x27\x01\x01 ARM7
+
+[CNFcc]
+
+[COScc]
+
+[DVFcc]
+
+[EORcc]
+reg32,reg32,reg32 \4\x0\x20 ARM7
+reg32,reg32,reg32,reg32 \5\x0\x20 ARM7
+reg32,reg32,reg32,imm \6\x0\x20 ARM7
+reg32,reg32,imm \7\x2\x20 ARM7
+
+[EXPcc]
+
+[FDVcc]
+
+[FLTcc]
+
+[FIXcc]
+
+[FMLcc]
+
+[FRDcc]
+
+[LDC]
+reg32,reg32 \321\300\1\x11\101 ARM7
+
+[LDMcc]
+memam4,reglist \x26\x81 ARM7
+
+[LDRBTcc]
+
+[LDRBcc]
+reg32,memam2 \x17\x07\x10 ARM7
+
+[LDRcc]
+reg32,memam2 \x17\x05\x10 ARM7
+; reg32,imm32 \x17\x05\x10 ARM7
+; reg32,reg32 \x18\x04\x10 ARM7
+; reg32,reg32,imm32 \x19\x04\x10 ARM7
+; reg32,reg32,reg32 \x20\x06\x10 ARM7
+; reg32,reg32,reg32,imm32 \x21\x06\x10 ARM7
+
+[LDRHcc]
+reg32,imm32 \x22\x50\xB0 ARM7
+reg32,reg32 \x23\x50\xB0 ARM7
+reg32,reg32,imm32 \x24\x50\xB0 ARM7
+reg32,reg32,reg32 \x25\x10\xB0 ARM7
+
+[LDRSBcc]
+reg32,imm32 \x22\x50\xD0 ARM7
+reg32,reg32 \x23\x50\xD0 ARM7
+reg32,reg32,imm32 \x24\x50\xD0 ARM7
+reg32,reg32,reg32 \x25\x10\xD0 ARM7
+
+[LDRSHcc]
+reg32,imm32 \x22\x50\xF0 ARM7
+reg32,reg32 \x23\x50\xF0 ARM7
+reg32,reg32,imm32 \x24\x50\xF0 ARM7
+reg32,reg32,reg32 \x25\x10\xF0 ARM7
+
+[LDRTcc]
+
+[LDFcc]
+
+[LFMcc]
+reg32,imm8,fpureg \xF0\x02\x01 FPA
+
+[LGNcc]
+
+[LOGcc]
+
+[MCR]
+reg32,mem32 \320\301\1\x13\110 ARM7
+
+[MLAcc]
+reg32,reg32,reg32,reg32 \x15\x00\x20\x90 ARM7
+
+[MOVcc]
+reg32,shifterop \x8\x0\0xd ARM7
+reg32,immshifter \x8\x0\0xd ARM7
+; reg32,reg32,reg32 \x9\x1\xA0 ARM7
+; reg32,reg32,imm \xA\x1\xA0 ARM7
+; reg32,imm \xB\x3\xA0 ARM7
+
+; [MRC]
+; reg32,reg32 \321\301\1\x13\110 ARM7
+
+; [MRScc]
+; reg32,reg32 \x10\x01\x0F ARM7
+
+; [MSRcc]
+; reg32,reg32 \x11\x01\x29\xF0 ARM7
+; regf,reg32 \x12\x01\x28\xF0 ARM7
+; regf,imm \x13\x03\x28\xF0 ARM7
+
+[MNFcc]
+
+[MUFcc]
+
+[MULcc]
+reg32,reg32,reg32 \x14\x00\x00\x90 ARM7
+
+[MVFcc]
+fpureg,fpureg \xF2 FPA
+fpureg,immfpu \xF2 FPA
+
+[MVNcc]
+reg32,reg32 \x8\x0\0xf ARM7
+reg32,reg32,reg32 \x9\x1\xE0 ARM7
+reg32,reg32,imm \xA\x1\xE0 ARM7
+reg32,imm \xB\x3\xE0 ARM7
+
+[ORRcc]
+reg32,reg32,reg32 \4\x1\x80 ARM7
+reg32,reg32,reg32,reg32 \5\x1\x80 ARM7
+reg32,reg32,reg32,imm \6\x1\x80 ARM7
+reg32,reg32,imm \7\x3\x80 ARM7
+
+[RDFcc]
+
+[RFScc]
+
+[RFCcc]
+
+[RMFcc]
+
+[RPWcc]
+
+[RSBcc]
+reg32,reg32,reg32 \4\x0\x60 ARM7
+reg32,reg32,reg32,reg32 \5\x0\x60 ARM7
+reg32,reg32,reg32,imm \6\x0\x60 ARM7
+reg32,reg32,imm \7\x2\x60 ARM7
+
+[RSCcc]
+reg32,reg32,reg32 \4\x0\xE0 ARM7
+reg32,reg32,reg32,reg32 \5\x0\xE0 ARM7
+reg32,reg32,reg32,imm \6\x0\xE0 ARM7
+reg32,reg32,imm \7\x2\xE0 ARM7
+
+[RSFcc]
+
+[RNDcc]
+
+[POLcc]
+
+[SBCcc]
+reg32,reg32,reg32 \4\x0\xC0 ARM7
+reg32,reg32,reg32,reg32 \5\x0\xC0 ARM7
+reg32,reg32,reg32,imm \6\x0\xC0 ARM7
+reg32,reg32,imm \7\x2\xC0 ARM7
+
+[SFMcc]
+reg32,imm8,fpureg \xF0\x02\x00 FPA
+
+[SINcc]
+
+[SMLALcc]
+reg32,reg32,reg32,reg32 \x16\x00\xE0\x90 ARM7
+
+[SMULLcc]
+reg32,reg32,reg32,reg32 \x16\x00\xC0\x90 ARM7
+
+[SQTcc]
+
+[SUFcc]
+
+[STFcc]
+
+[STMcc]
+memam4,reglist \x26\x80 ARM7
+
+[STRcc]
+reg32,memam2 \x17\x04\x00 ARM7
+; reg32,imm32 \x17\x05\x00 ARM7
+; reg32,reg32 \x18\x04\x00 ARM7
+; reg32,reg32,imm32 \x19\x04\x00 ARM7
+; reg32,reg32,reg32 \x20\x06\x00 ARM7
+; reg32,reg32,reg32,imm32 \x21\x06\x00 ARM7
+
+[STRBcc]
+reg32,memam2 \x17\x06\x00 ARM7
+
+[STRBTcc]
+
+; A dummy since it is parsed as STR{cond}H
+[STRHcc]
+reg32,imm32 \x22\x40\xB0 ARM7
+reg32,reg32 \x23\x40\xB0 ARM7
+reg32,reg32,imm32 \x24\x40\xB0 ARM7
+reg32,reg32,reg32 \x25\x00\xB0 ARM7
+
+[STRTcc]
+
+[SUBcc]
+reg32,reg32,shifterop \4\x0\x40 ARM7
+reg32,reg32,immshifter \4\x0\x40 ARM7
+reg32,reg32,reg32 \4\x0\x40 ARM7
+; reg32,reg32,reg32,reg32 \5\x0\x40 ARM7
+; reg32,reg32,reg32,imm \6\x0\x40 ARM7
+; reg32,reg32,imm \7\x2\x40 ARM7
+
+[SWIcc]
+imm \2\x0F ARM7
+
+[SWPcc]
+reg32,reg32,reg32 \x27\x01\x90 ARM7
+
+[SWPBcc]
+reg32,reg32,reg32 \x27\x01\x90 ARM7
+
+[TANcc]
+
+[TEQcc]
+reg32,reg32 \xC\x1\x20 ARM7
+reg32,reg32,reg32 \xD\x1\x20 ARM7
+reg32,reg32,imm \xE\x1\x20 ARM7
+reg32,imm \xF\x3\x20 ARM7
+
+[TSTcc]
+reg32,reg32 \xC\x1\x00 ARM7
+reg32,reg32,reg32 \xD\x1\x00 ARM7
+reg32,reg32,imm \xE\x1\x00 ARM7
+reg32,imm \xF\x3\x00 ARM7
+
+[UMLALcc]
+reg32,reg32,reg32,reg32 \x16\x00\xA0\x90 ARM7
+
+[UMULLcc]
+reg32,reg32,reg32,reg32 \x16\x00\x80\x90 ARM7
+
+[WFScc]
+
diff --git a/compiler/arm/armnop.inc b/compiler/arm/armnop.inc new file mode 100644 index 0000000000..5566510957 --- /dev/null +++ b/compiler/arm/armnop.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from armins.dat } +108; diff --git a/compiler/arm/armop.inc b/compiler/arm/armop.inc new file mode 100644 index 0000000000..134a8c8069 --- /dev/null +++ b/compiler/arm/armop.inc @@ -0,0 +1,90 @@ +{ don't edit, this file is generated from armins.dat } +( +A_NONE, +A_ABS, +A_ACS, +A_ASN, +A_ATN, +A_ADC, +A_ADD, +A_ADF, +A_AND, +A_B, +A_BIC, +A_BL, +A_BLX, +A_BKPT, +A_BX, +A_CDP, +A_CMF, +A_CMFE, +A_CMN, +A_CMP, +A_CLZ, +A_CNF, +A_COS, +A_DVF, +A_EOR, +A_EXP, +A_FDV, +A_FLT, +A_FIX, +A_FML, +A_FRD, +A_LDC, +A_LDM, +A_LDRBT, +A_LDRB, +A_LDR, +A_LDRH, +A_LDRSB, +A_LDRSH, +A_LDRT, +A_LDF, +A_LFM, +A_LGN, +A_LOG, +A_MCR, +A_MLA, +A_MOV, +A_MNF, +A_MUF, +A_MUL, +A_MVF, +A_MVN, +A_ORR, +A_RDF, +A_RFS, +A_RFC, +A_RMF, +A_RPW, +A_RSB, +A_RSC, +A_RSF, +A_RND, +A_POL, +A_SBC, +A_SFM, +A_SIN, +A_SMLAL, +A_SMULL, +A_SQT, +A_SUF, +A_STF, +A_STM, +A_STR, +A_STRB, +A_STRBT, +A_STRH, +A_STRT, +A_SUB, +A_SWI, +A_SWP, +A_SWPB, +A_TAN, +A_TEQ, +A_TST, +A_UMLAL, +A_UMULL, +A_WFS +); diff --git a/compiler/arm/armreg.dat b/compiler/arm/armreg.dat new file mode 100644 index 0000000000..80b7fa00ab --- /dev/null +++ b/compiler/arm/armreg.dat @@ -0,0 +1,84 @@ +; +; ARM registers +; +; layout +; <name>,<type>,<value>,<stdname>,<stab idx>,<dwarf idx> +; +NO,$00,$00,INVALID,-1,-1 +; Integer registers +R0,$01,$00,r0,0,0 +R1,$01,$01,r1,1,1 +R2,$01,$02,r2,2,2 +R3,$01,$03,r3,3,3 +R4,$01,$04,r4,4,4 +R5,$01,$05,r5,5,5 +R6,$01,$06,r6,6,6 +R7,$01,$07,r7,7,7 +R8,$01,$08,r8,8,8 +R9,$01,$09,r9,9,9 +R10,$01,$0a,r10,10,10 +R11,$01,$0b,r11,11,11 +R12,$01,$0c,r12,12,12 +R13,$01,$0d,r13,13,13 +R14,$01,$0e,r14,14,14 +R15,$01,$0f,r15,15,15 + +; Float registers +F0,$02,$00,f0,32,16 +F1,$02,$01,f1,32,17 +F2,$02,$02,f2,32,18 +F3,$02,$03,f3,32,19 +F4,$02,$04,f4,32,20 +F5,$02,$05,f5,32,21 +F6,$02,$06,f6,32,22 +F7,$02,$07,f7,32,23 + +; MM registers +S0,$03,$00,s0,0,0 +S1,$03,$00,s1,0,0 +D0,$03,$00,d0,0,0 +S2,$03,$00,s2,0,0 +S3,$03,$00,s3,0,0 +D1,$03,$00,d1,0,0 +S4,$03,$00,s4,0,0 +S5,$03,$00,s5,0,0 +D2,$03,$00,d2,0,0 +S6,$03,$00,s6,0,0 +S7,$03,$00,s7,0,0 +D3,$03,$00,d3,0,0 +S8,$03,$00,s8,0,0 +S9,$03,$00,s9,0,0 +D4,$03,$00,d4,0,0 +S10,$03,$00,s10,0,0 +S11,$03,$00,s11,0,0 +D5,$03,$00,d5,0,0 +S12,$03,$00,s12,0,0 +S13,$03,$00,s13,0,0 +D6,$03,$00,d6,0,0 +S14,$03,$00,s14,0,0 +S15,$03,$00,s15,0,0 +D7,$03,$00,d7,0,0 +S16,$03,$00,s16,0,0 +S17,$03,$00,s17,0,0 +D8,$03,$00,d8,0,0 +S18,$03,$00,s18,0,0 +S19,$03,$00,s19,0,0 +D9,$03,$00,d9,0,0 +S20,$03,$00,s20,0,0 +S21,$03,$00,s21,0,0 +D10,$03,$00,d10,0,0 +S22,$03,$00,s22,0,0 +S23,$03,$00,s23,0,0 +D11,$03,$00,d11,0,0 +S24,$03,$00,s24,0,0 +S25,$03,$00,s25,0,0 +D12,$03,$00,d12,0,0 +S26,$03,$00,s26,0,0 +S27,$03,$00,s27,0,0 +D13,$03,$00,d13,0,0 +S28,$03,$00,s28,0,0 +S29,$03,$00,s29,0,0 +D14,$03,$00,d14,0,0 +S30,$03,$00,s20,0,0 +S31,$03,$00,s21,0,0 +D15,$03,$00,d15,0,0 diff --git a/compiler/arm/armtab.inc b/compiler/arm/armtab.inc new file mode 100644 index 0000000000..1a81a1eed2 --- /dev/null +++ b/compiler/arm/armtab.inc @@ -0,0 +1,759 @@ +{ don't edit, this file is generated from armins.dat } +( + ( + opcode : A_NONE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #0; + flags : if_none + ), + ( + opcode : A_ADC; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#0#160; + flags : if_arm7 + ), + ( + opcode : A_ADC; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #5#0#160; + flags : if_arm7 + ), + ( + opcode : A_ADC; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); + code : #6#0#160; + flags : if_arm7 + ), + ( + opcode : A_ADC; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #7#2#160; + flags : if_arm7 + ), + ( + opcode : A_ADD; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#0#128; + flags : if_arm7 + ), + ( + opcode : A_ADD; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #5#0#128; + flags : if_arm7 + ), + ( + opcode : A_ADD; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); + code : #6#0#128; + flags : if_arm7 + ), + ( + opcode : A_ADD; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #7#2#128; + flags : if_arm7 + ), + ( + opcode : A_AND; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#0#0; + flags : if_arm7 + ), + ( + opcode : A_AND; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #5#0#0; + flags : if_arm7 + ), + ( + opcode : A_AND; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); + code : #6#0#0; + flags : if_arm7 + ), + ( + opcode : A_AND; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #7#2#0; + flags : if_arm7 + ), + ( + opcode : A_B; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#10; + flags : if_arm7 + ), + ( + opcode : A_B; + ops : 1; + optypes : (ot_immediate24,ot_none,ot_none,ot_none); + code : #1#10; + flags : if_arm7 + ), + ( + opcode : A_BIC; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#1#192; + flags : if_arm7 + ), + ( + opcode : A_BIC; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #5#1#192; + flags : if_arm7 + ), + ( + opcode : A_BIC; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); + code : #6#1#192; + flags : if_arm7 + ), + ( + opcode : A_BIC; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #7#3#192; + flags : if_arm7 + ), + ( + opcode : A_BL; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#11; + flags : if_arm7 + ), + ( + opcode : A_BL; + ops : 1; + optypes : (ot_immediate24,ot_none,ot_none,ot_none); + code : #1#11; + flags : if_arm7 + ), + ( + opcode : A_BLX; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #15#15; + flags : if_arm7 + ), + ( + opcode : A_BLX; + ops : 1; + optypes : (ot_immediate24,ot_none,ot_none,ot_none); + code : #15#15; + flags : if_arm7 + ), + ( + opcode : A_BX; + ops : 1; + optypes : (ot_reg32,ot_none,ot_none,ot_none); + code : #3#1#47#255#16; + flags : if_arm7 + ), + ( + opcode : A_CDP; + ops : 2; + optypes : (ot_reg8,ot_reg8,ot_none,ot_none); + code : #192#1#16#65; + flags : if_arm7 + ), + ( + opcode : A_CMN; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #12#1#96; + flags : if_arm7 + ), + ( + opcode : A_CMN; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #13#1#96; + flags : if_arm7 + ), + ( + opcode : A_CMN; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #14#1#96; + flags : if_arm7 + ), + ( + opcode : A_CMN; + ops : 2; + optypes : (ot_reg32,ot_immediate,ot_none,ot_none); + code : #15#3#96; + flags : if_arm7 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #12#1#64; + flags : if_arm7 + ), + ( + opcode : A_CMP; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #13#1#64; + flags : if_arm7 + ), + ( + opcode : A_CMP; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #14#1#64; + flags : if_arm7 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg32,ot_immediate,ot_none,ot_none); + code : #15#3#64; + flags : if_arm7 + ), + ( + opcode : A_CLZ; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #39#1#1; + flags : if_arm7 + ), + ( + opcode : A_EOR; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#0#32; + flags : if_arm7 + ), + ( + opcode : A_EOR; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #5#0#32; + flags : if_arm7 + ), + ( + opcode : A_EOR; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); + code : #6#0#32; + flags : if_arm7 + ), + ( + opcode : A_EOR; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #7#2#32; + flags : if_arm7 + ), + ( + opcode : A_LDC; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #209#192#1#17#65; + flags : if_arm7 + ), + ( + opcode : A_LDM; + ops : 2; + optypes : (ot_memoryam4,ot_reglist,ot_none,ot_none); + code : #38#129; + flags : if_arm7 + ), + ( + opcode : A_LDRB; + ops : 2; + optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none); + code : #23#7#16; + flags : if_arm7 + ), + ( + opcode : A_LDR; + ops : 2; + optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none); + code : #23#5#16; + flags : if_arm7 + ), + ( + opcode : A_LDRH; + ops : 2; + optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none); + code : #34#80#176; + flags : if_arm7 + ), + ( + opcode : A_LDRH; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #35#80#176; + flags : if_arm7 + ), + ( + opcode : A_LDRH; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none); + code : #36#80#176; + flags : if_arm7 + ), + ( + opcode : A_LDRH; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #37#16#176; + flags : if_arm7 + ), + ( + opcode : A_LDRSB; + ops : 2; + optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none); + code : #34#80#208; + flags : if_arm7 + ), + ( + opcode : A_LDRSB; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #35#80#208; + flags : if_arm7 + ), + ( + opcode : A_LDRSB; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none); + code : #36#80#208; + flags : if_arm7 + ), + ( + opcode : A_LDRSB; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #37#16#208; + flags : if_arm7 + ), + ( + opcode : A_LDRSH; + ops : 2; + optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none); + code : #34#80#240; + flags : if_arm7 + ), + ( + opcode : A_LDRSH; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #35#80#240; + flags : if_arm7 + ), + ( + opcode : A_LDRSH; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none); + code : #36#80#240; + flags : if_arm7 + ), + ( + opcode : A_LDRSH; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #37#16#240; + flags : if_arm7 + ), + ( + opcode : A_LFM; + ops : 3; + optypes : (ot_reg32,ot_immediate or ot_bits8,ot_fpureg,ot_none); + code : #240#2#1; + flags : if_fpa + ), + ( + opcode : A_MCR; + ops : 2; + optypes : (ot_reg32,ot_memory or ot_bits32,ot_none,ot_none); + code : #208#193#1#19#72; + flags : if_arm7 + ), + ( + opcode : A_MLA; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #21#0#32#144; + flags : if_arm7 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg32,ot_shifterop,ot_none,ot_none); + code : #8#1#160; + flags : if_arm7 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg32,ot_immediateshifter,ot_none,ot_none); + code : #8#1#160; + flags : if_arm7 + ), + ( + opcode : A_MUL; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #20#0#0#144; + flags : if_arm7 + ), + ( + opcode : A_MVF; + ops : 2; + optypes : (ot_fpureg,ot_fpureg,ot_none,ot_none); + code : #242; + flags : if_fpa + ), + ( + opcode : A_MVF; + ops : 2; + optypes : (ot_fpureg,ot_immediatefpu,ot_none,ot_none); + code : #242; + flags : if_fpa + ), + ( + opcode : A_MVN; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #8#1#224; + flags : if_arm7 + ), + ( + opcode : A_MVN; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #9#1#224; + flags : if_arm7 + ), + ( + opcode : A_MVN; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #10#1#224; + flags : if_arm7 + ), + ( + opcode : A_MVN; + ops : 2; + optypes : (ot_reg32,ot_immediate,ot_none,ot_none); + code : #11#3#224; + flags : if_arm7 + ), + ( + opcode : A_ORR; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#1#128; + flags : if_arm7 + ), + ( + opcode : A_ORR; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #5#1#128; + flags : if_arm7 + ), + ( + opcode : A_ORR; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); + code : #6#1#128; + flags : if_arm7 + ), + ( + opcode : A_ORR; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #7#3#128; + flags : if_arm7 + ), + ( + opcode : A_RSB; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#0#96; + flags : if_arm7 + ), + ( + opcode : A_RSB; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #5#0#96; + flags : if_arm7 + ), + ( + opcode : A_RSB; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); + code : #6#0#96; + flags : if_arm7 + ), + ( + opcode : A_RSB; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #7#2#96; + flags : if_arm7 + ), + ( + opcode : A_RSC; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#0#224; + flags : if_arm7 + ), + ( + opcode : A_RSC; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #5#0#224; + flags : if_arm7 + ), + ( + opcode : A_RSC; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); + code : #6#0#224; + flags : if_arm7 + ), + ( + opcode : A_RSC; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #7#2#224; + flags : if_arm7 + ), + ( + opcode : A_SBC; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#0#192; + flags : if_arm7 + ), + ( + opcode : A_SBC; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #5#0#192; + flags : if_arm7 + ), + ( + opcode : A_SBC; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); + code : #6#0#192; + flags : if_arm7 + ), + ( + opcode : A_SBC; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #7#2#192; + flags : if_arm7 + ), + ( + opcode : A_SFM; + ops : 3; + optypes : (ot_reg32,ot_immediate or ot_bits8,ot_fpureg,ot_none); + code : #240#2#0; + flags : if_fpa + ), + ( + opcode : A_SMLAL; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #22#0#224#144; + flags : if_arm7 + ), + ( + opcode : A_SMULL; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #22#0#192#144; + flags : if_arm7 + ), + ( + opcode : A_STM; + ops : 2; + optypes : (ot_memoryam4,ot_reglist,ot_none,ot_none); + code : #38#128; + flags : if_arm7 + ), + ( + opcode : A_STR; + ops : 2; + optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none); + code : #23#4#0; + flags : if_arm7 + ), + ( + opcode : A_STRB; + ops : 2; + optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none); + code : #23#6#0; + flags : if_arm7 + ), + ( + opcode : A_STRH; + ops : 2; + optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none); + code : #34#64#176; + flags : if_arm7 + ), + ( + opcode : A_STRH; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #35#64#176; + flags : if_arm7 + ), + ( + opcode : A_STRH; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none); + code : #36#64#176; + flags : if_arm7 + ), + ( + opcode : A_STRH; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #37#0#176; + flags : if_arm7 + ), + ( + opcode : A_SUB; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_shifterop,ot_none); + code : #4#0#64; + flags : if_arm7 + ), + ( + opcode : A_SUB; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediateshifter,ot_none); + code : #4#0#64; + flags : if_arm7 + ), + ( + opcode : A_SUB; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #4#0#64; + flags : if_arm7 + ), + ( + opcode : A_SWI; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #2#15; + flags : if_arm7 + ), + ( + opcode : A_SWP; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #39#1#144; + flags : if_arm7 + ), + ( + opcode : A_SWPB; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #39#1#144; + flags : if_arm7 + ), + ( + opcode : A_TEQ; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #12#1#32; + flags : if_arm7 + ), + ( + opcode : A_TEQ; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #13#1#32; + flags : if_arm7 + ), + ( + opcode : A_TEQ; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #14#1#32; + flags : if_arm7 + ), + ( + opcode : A_TEQ; + ops : 2; + optypes : (ot_reg32,ot_immediate,ot_none,ot_none); + code : #15#3#32; + flags : if_arm7 + ), + ( + opcode : A_TST; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #12#1#0; + flags : if_arm7 + ), + ( + opcode : A_TST; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); + code : #13#1#0; + flags : if_arm7 + ), + ( + opcode : A_TST; + ops : 3; + optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); + code : #14#1#0; + flags : if_arm7 + ), + ( + opcode : A_TST; + ops : 2; + optypes : (ot_reg32,ot_immediate,ot_none,ot_none); + code : #15#3#0; + flags : if_arm7 + ), + ( + opcode : A_UMLAL; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #22#0#160#144; + flags : if_arm7 + ), + ( + opcode : A_UMULL; + ops : 4; + optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); + code : #22#0#128#144; + flags : if_arm7 + ) +); diff --git a/compiler/arm/cgcpu.pas b/compiler/arm/cgcpu.pas new file mode 100644 index 0000000000..d168b47bb8 --- /dev/null +++ b/compiler/arm/cgcpu.pas @@ -0,0 +1,1712 @@ +{ + + Copyright (c) 2003 by Florian Klaempfl + Member of the Free Pascal development team + + This unit implements the code generator for the ARM + + 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 cgcpu; + +{$i fpcdefs.inc} + + interface + + uses + globtype,symtype,symdef, + cgbase,cgutils,cgobj, + aasmbase,aasmcpu,aasmtai, + parabase, + cpubase,cpuinfo,node,cg64f32,rgcpu; + + + type + tcgarm = class(tcg) + { true, if the next arithmetic operation should modify the flags } + cgsetflags : boolean; + procedure init_register_allocators;override; + procedure done_register_allocators;override; + + procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : TCGPara);override; + procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : TCGPara);override; + procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara);override; + + procedure a_call_name(list : taasmoutput;const s : string);override; + procedure a_call_reg(list : taasmoutput;reg: tregister); override; + + procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override; + procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; + + procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg; + size: tcgsize; a: aint; src, dst: tregister); override; + procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; + size: tcgsize; src1, src2, dst: tregister); override; + procedure a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override; + procedure a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override; + + { move instructions } + procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aint;reg : tregister);override; + procedure a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override; + procedure a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override; + procedure a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override; + + { fpu move instructions } + procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override; + procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override; + procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override; + + procedure a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const paraloc : TCGPara);override; + { comparison operations } + procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister; + l : tasmlabel);override; + procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; + + procedure a_jmp_name(list : taasmoutput;const s : string); override; + procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override; + procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override; + + procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override; + + procedure g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);override; + procedure g_proc_exit(list : taasmoutput;parasize : longint;nostackframe:boolean); override; + + procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override; + + procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint);override; + procedure g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint);override; + procedure g_concatcopy_move(list : taasmoutput;const source,dest : treference;len : aint); + procedure g_concatcopy_internal(list : taasmoutput;const source,dest : treference;len : aint;aligned : boolean); + + procedure g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef); override; + procedure g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);override; + + procedure g_save_standard_registers(list : taasmoutput);override; + procedure g_restore_standard_registers(list : taasmoutput);override; + + procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); + procedure fixref(list : taasmoutput;var ref : treference); + procedure handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference); + + procedure g_intf_wrapper(list: taasmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);override; + end; + + tcg64farm = class(tcg64f32) + procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override; + procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override; + procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override; + procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override; + procedure a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override; + procedure a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override; + end; + + const + OpCmp2AsmCond : Array[topcmp] of TAsmCond = (C_NONE,C_EQ,C_GT, + C_LT,C_GE,C_LE,C_NE,C_LS,C_CC,C_CS,C_HI); + + function get_fpu_postfix(def : tdef) : toppostfix; + + implementation + + + uses + globals,verbose,systems,cutils, + fmodule, + symconst,symsym, + tgobj, + procinfo,cpupi, + paramgr; + + + function get_fpu_postfix(def : tdef) : toppostfix; + begin + if def.deftype=floatdef then + begin + case tfloatdef(def).typ of + s32real: + result:=PF_S; + s64real: + result:=PF_D; + s80real: + result:=PF_E; + else + internalerror(200401272); + end; + end + else + internalerror(200401271); + end; + + + procedure tcgarm.init_register_allocators; + begin + inherited init_register_allocators; + { currently, we save R14 always, so we can use it } + rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE, + [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8, + RS_R9,RS_R10,RS_R12,RS_R14],first_int_imreg,[]); + rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE, + [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]); + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE, + [RS_S0,RS_S1,RS_R2,RS_R3,RS_R4,RS_S31],first_mm_imreg,[]); + end; + + + procedure tcgarm.done_register_allocators; + begin + rg[R_INTREGISTER].free; + rg[R_FPUREGISTER].free; + rg[R_MMREGISTER].free; + inherited done_register_allocators; + end; + + + procedure tcgarm.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : TCGPara); + var + ref: treference; + begin + paraloc.check_simple_location; + case paraloc.location^.loc of + LOC_REGISTER,LOC_CREGISTER: + a_load_const_reg(list,size,a,paraloc.location^.register); + LOC_REFERENCE: + begin + reference_reset(ref); + ref.base:=paraloc.location^.reference.index; + ref.offset:=paraloc.location^.reference.offset; + a_load_const_ref(list,size,a,ref); + end; + else + internalerror(2002081101); + end; + end; + + + procedure tcgarm.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : TCGPara); + var + tmpref, ref: treference; + location: pcgparalocation; + sizeleft: aint; + begin + location := paraloc.location; + tmpref := r; + sizeleft := paraloc.intsize; + while assigned(location) do + begin + case location^.loc of + LOC_REGISTER,LOC_CREGISTER: + a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register); + LOC_REFERENCE: + begin + reference_reset_base(ref,location^.reference.index,location^.reference.offset); + g_concatcopy(list,tmpref,ref,sizeleft); + if assigned(location^.next) then + internalerror(2005010710); + end; + LOC_FPUREGISTER,LOC_CFPUREGISTER: + case location^.size of + OS_F32, OS_F64: + a_loadfpu_ref_reg(list,location^.size,tmpref,location^.register); + else + internalerror(2002072801); + end; + LOC_VOID: + begin + // nothing to do + end; + else + internalerror(2002081103); + end; + inc(tmpref.offset,tcgsize2size[location^.size]); + dec(sizeleft,tcgsize2size[location^.size]); + location := location^.next; + end; + end; + + + procedure tcgarm.a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara); + var + ref: treference; + tmpreg: tregister; + begin + paraloc.check_simple_location; + case paraloc.location^.loc of + LOC_REGISTER,LOC_CREGISTER: + a_loadaddr_ref_reg(list,r,paraloc.location^.register); + LOC_REFERENCE: + begin + reference_reset(ref); + ref.base := paraloc.location^.reference.index; + ref.offset := paraloc.location^.reference.offset; + tmpreg := getintregister(list,OS_ADDR); + a_loadaddr_ref_reg(list,r,tmpreg); + a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref); + end; + else + internalerror(2002080701); + end; + end; + + + procedure tcgarm.a_call_name(list : taasmoutput;const s : string); + begin + list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION))); +{ + the compiler does not properly set this flag anymore in pass 1, and + for now we only need it after pass 2 (I hope) (JM) + if not(pi_do_call in current_procinfo.flags) then + internalerror(2003060703); +} + include(current_procinfo.flags,pi_do_call); + end; + + + procedure tcgarm.a_call_reg(list : taasmoutput;reg: tregister); + var + r : tregister; + begin + list.concat(taicpu.op_reg_reg(A_MOV,NR_R14,NR_PC)); + list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,reg)); +{ + the compiler does not properly set this flag anymore in pass 1, and + for now we only need it after pass 2 (I hope) (JM) + if not(pi_do_call in current_procinfo.flags) then + internalerror(2003060703); +} + include(current_procinfo.flags,pi_do_call); + end; + + + procedure tcgarm.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); + begin + a_op_const_reg_reg(list,op,size,a,reg,reg); + end; + + + procedure tcgarm.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); + begin + case op of + OP_NEG: + list.concat(taicpu.op_reg_reg_const(A_RSB,dst,src,0)); + OP_NOT: + begin + list.concat(taicpu.op_reg_reg(A_MVN,dst,src)); + case size of + OS_8 : + a_op_const_reg_reg(list,OP_AND,OS_INT,$ff,dst,dst); + OS_16 : + a_op_const_reg_reg(list,OP_AND,OS_INT,$ffff,dst,dst); + end; + end + else + a_op_reg_reg_reg(list,op,OS_32,src,dst,dst); + end; + end; + + + const + op_reg_reg_opcg2asmop: array[TOpCG] of tasmop = + (A_NONE,A_ADD,A_AND,A_NONE,A_NONE,A_MUL,A_MUL,A_NONE,A_NONE,A_ORR, + A_NONE,A_NONE,A_NONE,A_SUB,A_EOR); + + + procedure tcgarm.a_op_const_reg_reg(list: taasmoutput; op: TOpCg; + size: tcgsize; a: aint; src, dst: tregister); + var + ovloc : tlocation; + begin + a_op_const_reg_reg_checkoverflow(list,op,size,a,src,dst,false,ovloc); + end; + + + procedure tcgarm.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; + size: tcgsize; src1, src2, dst: tregister); + var + ovloc : tlocation; + begin + a_op_reg_reg_reg_checkoverflow(list,op,size,src1,src2,dst,false,ovloc); + end; + + + procedure tcgarm.a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); + var + shift : byte; + tmpreg : tregister; + so : tshifterop; + l1 : longint; + begin + ovloc.loc:=LOC_VOID; + if is_shifter_const(-a,shift) then + case op of + OP_ADD: + begin + op:=OP_SUB; + a:=dword(-a); + end; + OP_SUB: + begin + op:=OP_ADD; + a:=dword(-a); + end + end; + + if is_shifter_const(a,shift) and not(op in [OP_IMUL,OP_MUL]) then + case op of + OP_NEG,OP_NOT, + OP_DIV,OP_IDIV: + internalerror(200308281); + OP_SHL: + begin + if a>32 then + internalerror(200308291); + if a<>0 then + begin + shifterop_reset(so); + so.shiftmode:=SM_LSL; + so.shiftimm:=a; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so)); + end + else + list.concat(taicpu.op_reg_reg(A_MOV,dst,src)); + end; + OP_SHR: + begin + if a>32 then + internalerror(200308292); + shifterop_reset(so); + if a<>0 then + begin + so.shiftmode:=SM_LSR; + so.shiftimm:=a; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so)); + end + else + list.concat(taicpu.op_reg_reg(A_MOV,dst,src)); + end; + OP_SAR: + begin + if a>32 then + internalerror(200308291); + if a<>0 then + begin + shifterop_reset(so); + so.shiftmode:=SM_ASR; + so.shiftimm:=a; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so)); + end + else + list.concat(taicpu.op_reg_reg(A_MOV,dst,src)); + end; + else + list.concat(setoppostfix( + taicpu.op_reg_reg_const(op_reg_reg_opcg2asmop[op],dst,src,a),toppostfix(ord(cgsetflags or setflags)*ord(PF_S)) + )); + if (cgsetflags or setflags) and (size in [OS_8,OS_16,OS_32]) then + begin + ovloc.loc:=LOC_FLAGS; + case op of + OP_ADD: + ovloc.resflags:=F_CS; + OP_SUB: + ovloc.resflags:=F_CC; + end; + end; + end + else + begin + { there could be added some more sophisticated optimizations } + if (op in [OP_MUL,OP_IMUL]) and (a=1) then + a_load_reg_reg(list,size,size,src,dst) + else if (op in [OP_MUL,OP_IMUL]) and (a=0) then + a_load_const_reg(list,size,0,dst) + else if (op in [OP_IMUL]) and (a=-1) then + a_op_reg_reg(list,OP_NEG,size,src,dst) + { we do this here instead in the peephole optimizer because + it saves us a register } + else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a,l1) and not(cgsetflags or setflags) then + a_op_const_reg_reg(list,OP_SHL,size,l1,src,dst) + else + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,setflags,ovloc); + end; + end; + end; + + + procedure tcgarm.a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); + var + so : tshifterop; + tmpreg,overflowreg : tregister; + asmop : tasmop; + begin + ovloc.loc:=LOC_VOID; + case op of + OP_NEG,OP_NOT, + OP_DIV,OP_IDIV: + internalerror(200308281); + OP_SHL: + begin + shifterop_reset(so); + so.rs:=src1; + so.shiftmode:=SM_LSL; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so)); + end; + OP_SHR: + begin + shifterop_reset(so); + so.rs:=src1; + so.shiftmode:=SM_LSR; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so)); + end; + OP_SAR: + begin + shifterop_reset(so); + so.rs:=src1; + so.shiftmode:=SM_ASR; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so)); + end; + OP_IMUL, + OP_MUL: + begin + if cgsetflags or setflags then + begin + overflowreg:=getintregister(list,size); + if op=OP_IMUL then + asmop:=A_SMULL + else + asmop:=A_UMULL; + { the arm doesn't allow that rd and rm are the same } + if dst=src2 then + begin + if dst<>src1 then + list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src1,src2)) + else + begin + tmpreg:=getintregister(list,size); + a_load_reg_reg(list,size,size,src2,dst); + list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,tmpreg,src1)); + end; + end + else + list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src2,src1)); + if op=OP_IMUL then + begin + shifterop_reset(so); + so.shiftmode:=SM_ASR; + so.shiftimm:=31; + list.concat(taicpu.op_reg_reg_shifterop(A_CMP,overflowreg,dst,so)); + end + else + list.concat(taicpu.op_reg_const(A_CMP,overflowreg,0)); + + ovloc.loc:=LOC_FLAGS; + ovloc.resflags:=F_NE; + end + else + begin + { the arm doesn't allow that rd and rm are the same } + if dst=src2 then + begin + if dst<>src1 then + list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src1,src2)) + else + begin + tmpreg:=getintregister(list,size); + a_load_reg_reg(list,size,size,src2,dst); + list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,tmpreg,src1)); + end; + end + else + list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1)); + end; + end; + else + list.concat(setoppostfix( + taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1),toppostfix(ord(cgsetflags or setflags)*ord(PF_S)) + )); + end; + end; + + + procedure tcgarm.a_load_const_reg(list : taasmoutput; size: tcgsize; a : aint;reg : tregister); + var + imm_shift : byte; + l : tasmlabel; + hr : treference; + begin + if not(size in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then + internalerror(2002090902); + if is_shifter_const(a,imm_shift) then + list.concat(taicpu.op_reg_const(A_MOV,reg,a)) + else if is_shifter_const(not(a),imm_shift) then + list.concat(taicpu.op_reg_const(A_MVN,reg,not(a))) + else + begin + reference_reset(hr); + + objectlibrary.getjumplabel(l); + cg.a_label(current_procinfo.aktlocaldata,l); + hr.symboldata:=current_procinfo.aktlocaldata.last; + current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(longint(a))); + + hr.symbol:=l; + list.concat(taicpu.op_reg_ref(A_LDR,reg,hr)); + end; + end; + + + procedure tcgarm.handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference); + var + tmpreg : tregister; + tmpref : treference; + l : tasmlabel; + begin + tmpreg:=NR_NO; + + { Be sure to have a base register } + if (ref.base=NR_NO) then + begin + if ref.shiftmode<>SM_None then + internalerror(200308294); + ref.base:=ref.index; + ref.index:=NR_NO; + end; + + { absolute symbols can't be handled directly, we've to store the symbol reference + in the text segment and access it pc relative + + For now, we assume that references where base or index equals to PC are already + relative, all other references are assumed to be absolute and thus they need + to be handled extra. + + A proper solution would be to change refoptions to a set and store the information + if the symbol is absolute or relative there. + } + + if (assigned(ref.symbol) and + not(is_pc(ref.base)) and + not(is_pc(ref.index)) + ) or + { [#xxx] isn't a valid address operand } + ((ref.base=NR_NO) and (ref.index=NR_NO)) or + (ref.offset<-4095) or + (ref.offset>4095) or + ((oppostfix in [PF_SB,PF_H,PF_SH]) and + ((ref.offset<-255) or + (ref.offset>255) + ) + ) or + ((op in [A_LDF,A_STF]) and + ((ref.offset<-1020) or + (ref.offset>1020) + ) + ) then + begin + reference_reset(tmpref); + + { load symbol } + tmpreg:=getintregister(list,OS_INT); + if assigned(ref.symbol) then + begin + objectlibrary.getjumplabel(l); + cg.a_label(current_procinfo.aktlocaldata,l); + tmpref.symboldata:=current_procinfo.aktlocaldata.last; + + current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset)); + + { load consts entry } + tmpref.symbol:=l; + tmpref.base:=NR_R15; + list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref)); + end + else + a_load_const_reg(list,OS_ADDR,ref.offset,tmpreg); + + if (ref.base<>NR_NO) then + begin + if ref.index<>NR_NO then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg)); + ref.base:=tmpreg; + end + else + begin + ref.index:=tmpreg; + ref.shiftimm:=0; + ref.signindex:=1; + ref.shiftmode:=SM_None; + end; + end + else + ref.base:=tmpreg; + ref.offset:=0; + ref.symbol:=nil; + end; + + if (ref.base<>NR_NO) and (ref.index<>NR_NO) and (ref.offset<>0) then + begin + if tmpreg<>NR_NO then + a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,tmpreg,tmpreg) + else + begin + tmpreg:=getintregister(list,OS_ADDR); + a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,ref.base,tmpreg); + ref.base:=tmpreg; + end; + ref.offset:=0; + end; + + { floating point operations have only limited references + we expect here, that a base is already set } + if (op in [A_LDF,A_STF]) and (ref.index<>NR_NO) then + begin + if ref.shiftmode<>SM_none then + internalerror(200309121); + if tmpreg<>NR_NO then + begin + if ref.base=tmpreg then + begin + if ref.signindex<0 then + list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,tmpreg,ref.index)) + else + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,tmpreg,ref.index)); + ref.index:=NR_NO; + end + else + begin + if ref.index<>tmpreg then + internalerror(200403161); + if ref.signindex<0 then + list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,ref.base,tmpreg)) + else + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg)); + ref.base:=tmpreg; + ref.index:=NR_NO; + end; + end + else + begin + tmpreg:=getintregister(list,OS_ADDR); + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,ref.index)); + ref.base:=tmpreg; + ref.index:=NR_NO; + end; + end; + list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix)); + end; + + + procedure tcgarm.a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference); + var + oppostfix:toppostfix; + begin + case ToSize of + { signed integer registers } + OS_8, + OS_S8: + oppostfix:=PF_B; + OS_16, + OS_S16: + oppostfix:=PF_H; + OS_32, + OS_S32: + oppostfix:=PF_None; + else + InternalError(200308295); + end; + handle_load_store(list,A_STR,oppostfix,reg,ref); + end; + + + procedure tcgarm.a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister); + var + oppostfix:toppostfix; + begin + case FromSize of + { signed integer registers } + OS_8: + oppostfix:=PF_B; + OS_S8: + oppostfix:=PF_SB; + OS_16: + oppostfix:=PF_H; + OS_S16: + oppostfix:=PF_SH; + OS_32, + OS_S32: + oppostfix:=PF_None; + else + InternalError(200308291); + end; + handle_load_store(list,A_LDR,oppostfix,reg,ref); + end; + + + procedure tcgarm.a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister); + var + instr: taicpu; + so : tshifterop; + begin + shifterop_reset(so); + if (tcgsize2size[tosize] < tcgsize2size[fromsize]) or + ( + (tcgsize2size[tosize] = tcgsize2size[fromsize]) and + (tosize <> fromsize) and + not(fromsize in [OS_32,OS_S32]) + ) then + begin + case tosize of + OS_8: + list.concat(taicpu.op_reg_reg_const(A_AND, + reg2,reg1,$ff)); + OS_S8: + begin + so.shiftmode:=SM_LSL; + so.shiftimm:=24; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so)); + so.shiftmode:=SM_ASR; + so.shiftimm:=24; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so)); + end; + OS_16: + begin + so.shiftmode:=SM_LSL; + so.shiftimm:=16; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so)); + so.shiftmode:=SM_LSR; + so.shiftimm:=16; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so)); + end; + OS_S16: + begin + so.shiftmode:=SM_LSL; + so.shiftimm:=16; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so)); + so.shiftmode:=SM_ASR; + so.shiftimm:=16; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so)); + end; + OS_32,OS_S32: + begin + instr:=taicpu.op_reg_reg(A_MOV,reg2,reg1); + list.concat(instr); + add_move_instruction(instr); + end; + else internalerror(2002090901); + end; + end + else + begin + if reg1<>reg2 then + begin + { same size, only a register mov required } + instr:=taicpu.op_reg_reg(A_MOV,reg2,reg1); + list.Concat(instr); + { Notify the register allocator that we have written a move instruction so + it can try to eliminate it. } + add_move_instruction(instr); + end; + end; + end; + + + procedure tcgarm.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const paraloc : TCGPara); + var + href,href2 : treference; + hloc : pcgparalocation; + begin + href:=ref; + hloc:=paraloc.location; + while assigned(hloc) do + begin + case hloc^.loc of + LOC_FPUREGISTER,LOC_CFPUREGISTER: + a_loadfpu_ref_reg(list,size,ref,hloc^.register); + LOC_REGISTER : + a_load_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register); + LOC_REFERENCE : + begin + reference_reset_base(href2,hloc^.reference.index,hloc^.reference.offset); + a_load_ref_ref(list,hloc^.size,hloc^.size,href,href2); + end; + else + internalerror(200408241); + end; + inc(href.offset,tcgsize2size[hloc^.size]); + hloc:=hloc^.next; + end; + end; + + + procedure tcgarm.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); + begin + list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[size])); + end; + + + procedure tcgarm.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); + var + oppostfix:toppostfix; + begin + case size of + OS_F32: + oppostfix:=PF_S; + OS_F64: + oppostfix:=PF_D; + OS_F80: + oppostfix:=PF_E; + else + InternalError(200309021); + end; + handle_load_store(list,A_LDF,oppostfix,reg,ref); + end; + + + procedure tcgarm.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); + var + oppostfix:toppostfix; + begin + case size of + OS_F32: + oppostfix:=PF_S; + OS_F64: + oppostfix:=PF_D; + OS_F80: + oppostfix:=PF_E; + else + InternalError(200309022); + end; + handle_load_store(list,A_STF,oppostfix,reg,ref); + end; + + + { comparison operations } + procedure tcgarm.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister; + l : tasmlabel); + var + tmpreg : tregister; + b : byte; + begin + if is_shifter_const(a,b) then + list.concat(taicpu.op_reg_const(A_CMP,reg,a)) + { CMN reg,0 and CMN reg,$80000000 are different from CMP reg,$ffffffff + and CMP reg,$7fffffff regarding the flags according to the ARM manual } + else if (a<>$7fffffff) and (a<>-1) and is_shifter_const(-a,b) then + list.concat(taicpu.op_reg_const(A_CMN,reg,-a)) + else + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list,size,a,tmpreg); + list.concat(taicpu.op_reg_reg(A_CMP,reg,tmpreg)); + end; + a_jmp_cond(list,cmp_op,l); + end; + + + procedure tcgarm.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); + begin + list.concat(taicpu.op_reg_reg(A_CMP,reg2,reg1)); + a_jmp_cond(list,cmp_op,l); + end; + + + procedure tcgarm.a_jmp_name(list : taasmoutput;const s : string); + begin + list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION))); + end; + + + procedure tcgarm.a_jmp_always(list : taasmoutput;l: tasmlabel); + begin + list.concat(taicpu.op_sym(A_B,l)); + end; + + + procedure tcgarm.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); + var + ai : taicpu; + begin + ai:=setcondition(taicpu.op_sym(A_B,l),flags_to_cond(f)); + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcgarm.g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); + var + ai : taicpu; + begin + list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,1),flags_to_cond(f))); + list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,0),inverse_cond(flags_to_cond(f)))); + end; + + + procedure tcgarm.g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean); + var + ref : treference; + shift : byte; + firstfloatreg,lastfloatreg, + r : byte; + begin + LocalSize:=align(LocalSize,4); + if not(nostackframe) then + begin + firstfloatreg:=RS_NO; + { save floating point registers? } + for r:=RS_F0 to RS_F7 do + if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then + begin + if firstfloatreg=RS_NO then + firstfloatreg:=r; + lastfloatreg:=r; + end; + a_reg_alloc(list,NR_STACK_POINTER_REG); + a_reg_alloc(list,NR_FRAME_POINTER_REG); + a_reg_alloc(list,NR_R12); + + list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_STACK_POINTER_REG)); + { save int registers } + reference_reset(ref); + ref.index:=NR_STACK_POINTER_REG; + ref.addressmode:=AM_PREINDEXED; + list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref, + rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R12,RS_R14,RS_R15]), + PF_FD)); + + list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4)); + + { allocate necessary stack size } + { don't use a_op_const_reg_reg here because we don't allow register allocations + in the entry/exit code } + if not(is_shifter_const(localsize,shift)) then + begin + a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12); + list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12)); + a_reg_dealloc(list,NR_R12); + end + else + begin + a_reg_dealloc(list,NR_R12); + list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize)); + end; + if firstfloatreg<>RS_NO then + begin + reference_reset(ref); + if not(is_shifter_const(-tarmprocinfo(current_procinfo).floatregstart,shift)) then + begin + a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12); + list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,NR_FRAME_POINTER_REG,NR_R12)); + ref.base:=NR_R12; + end + else + begin + ref.base:=NR_FRAME_POINTER_REG; + ref.offset:=tarmprocinfo(current_procinfo).floatregstart; + end; + list.concat(taicpu.op_reg_const_ref(A_SFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE), + lastfloatreg-firstfloatreg+1,ref)); + end; + end; + end; + + + procedure tcgarm.g_proc_exit(list : taasmoutput;parasize : longint;nostackframe:boolean); + var + ref : treference; + firstfloatreg,lastfloatreg, + r : byte; + shift : byte; + begin + if not(nostackframe) then + begin + { restore floating point register } + firstfloatreg:=RS_NO; + { save floating point registers? } + for r:=RS_F0 to RS_F7 do + if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then + begin + if firstfloatreg=RS_NO then + firstfloatreg:=r; + lastfloatreg:=r; + end; + + if firstfloatreg<>RS_NO then + begin + reference_reset(ref); + if not(is_shifter_const(-tarmprocinfo(current_procinfo).floatregstart,shift)) then + begin + a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12); + list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,NR_FRAME_POINTER_REG,NR_R12)); + ref.base:=NR_R12; + end + else + begin + ref.base:=NR_FRAME_POINTER_REG; + ref.offset:=tarmprocinfo(current_procinfo).floatregstart; + end; + list.concat(taicpu.op_reg_const_ref(A_LFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE), + lastfloatreg-firstfloatreg+1,ref)); + end; + + if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then + list.concat(taicpu.op_reg_reg(A_MOV,NR_R15,NR_R14)) + else + begin + { restore int registers and return } + reference_reset(ref); + ref.index:=NR_FRAME_POINTER_REG; + list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R13,RS_R15]),PF_EA)); + end; + end + else + list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R14)); + end; + + + procedure tcgarm.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister); + var + b : byte; + tmpref : treference; + instr : taicpu; + begin + if ref.addressmode<>AM_OFFSET then + internalerror(200309071); + tmpref:=ref; + { Be sure to have a base register } + if (tmpref.base=NR_NO) then + begin + if tmpref.shiftmode<>SM_None then + internalerror(200308294); + if tmpref.signindex<0 then + internalerror(200312023); + tmpref.base:=tmpref.index; + tmpref.index:=NR_NO; + end; + + if assigned(tmpref.symbol) or + not((is_shifter_const(tmpref.offset,b)) or + (is_shifter_const(-tmpref.offset,b)) + ) then + fixref(list,tmpref); + + { expect a base here if there is an index } + if (tmpref.base=NR_NO) and (tmpref.index<>NR_NO) then + internalerror(200312022); + + if tmpref.index<>NR_NO then + begin + if tmpref.shiftmode<>SM_None then + internalerror(200312021); + if tmpref.signindex<0 then + a_op_reg_reg_reg(list,OP_SUB,OS_ADDR,tmpref.base,tmpref.index,r) + else + a_op_reg_reg_reg(list,OP_ADD,OS_ADDR,tmpref.base,tmpref.index,r); + if tmpref.offset<>0 then + a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,r,r); + end + else + begin + if tmpref.offset<>0 then + begin + if tmpref.base<>NR_NO then + a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,tmpref.base,r) + else + a_load_const_reg(list,OS_ADDR,tmpref.offset,r); + end + else + begin + instr:=taicpu.op_reg_reg(A_MOV,r,tmpref.base); + list.concat(instr); + add_move_instruction(instr); + end; + end; + end; + + + procedure tcgarm.fixref(list : taasmoutput;var ref : treference); + var + tmpreg : tregister; + tmpref : treference; + l : tasmlabel; + begin + { absolute symbols can't be handled directly, we've to store the symbol reference + in the text segment and access it pc relative + + For now, we assume that references where base or index equals to PC are already + relative, all other references are assumed to be absolute and thus they need + to be handled extra. + + A proper solution would be to change refoptions to a set and store the information + if the symbol is absolute or relative there. + } + { create consts entry } + reference_reset(tmpref); + objectlibrary.getjumplabel(l); + cg.a_label(current_procinfo.aktlocaldata,l); + tmpref.symboldata:=current_procinfo.aktlocaldata.last; + + if assigned(ref.symbol) then + current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset)) + else + current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset)); + + { load consts entry } + tmpreg:=getintregister(list,OS_INT); + tmpref.symbol:=l; + tmpref.base:=NR_PC; + list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref)); + + if (ref.base<>NR_NO) then + begin + if ref.index<>NR_NO then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg)); + ref.base:=tmpreg; + end + else + begin + ref.index:=tmpreg; + ref.shiftimm:=0; + ref.signindex:=1; + ref.shiftmode:=SM_None; + end; + end + else + ref.base:=tmpreg; + + ref.offset:=0; + ref.symbol:=nil; + end; + + + procedure tcgarm.g_concatcopy_move(list : taasmoutput;const source,dest : treference;len : aint); + var + paraloc1,paraloc2,paraloc3 : TCGPara; + begin + paraloc1.init; + paraloc2.init; + paraloc3.init; + paramanager.getintparaloc(pocall_default,1,paraloc1); + paramanager.getintparaloc(pocall_default,2,paraloc2); + paramanager.getintparaloc(pocall_default,3,paraloc3); + paramanager.allocparaloc(list,paraloc3); + a_param_const(list,OS_INT,len,paraloc3); + paramanager.allocparaloc(list,paraloc2); + a_paramaddr_ref(list,dest,paraloc2); + paramanager.allocparaloc(list,paraloc2); + a_paramaddr_ref(list,source,paraloc1); + paramanager.freeparaloc(list,paraloc3); + paramanager.freeparaloc(list,paraloc2); + paramanager.freeparaloc(list,paraloc1); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + a_call_name(list,'FPC_MOVE'); + dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + paraloc3.done; + paraloc2.done; + paraloc1.done; + end; + + + procedure tcgarm.g_concatcopy_internal(list : taasmoutput;const source,dest : treference;len : aint;aligned : boolean); + var + srcref,dstref:treference; + srcreg,destreg,countreg,r:tregister; + helpsize:aword; + copysize:byte; + cgsize:Tcgsize; + + procedure genloop(count : aword;size : byte); + const + size2opsize : array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32); + var + l : tasmlabel; + begin + objectlibrary.getjumplabel(l); + a_load_const_reg(list,OS_INT,count,countreg); + cg.a_label(list,l); + srcref.addressmode:=AM_POSTINDEXED; + dstref.addressmode:=AM_POSTINDEXED; + srcref.offset:=size; + dstref.offset:=size; + r:=getintregister(list,size2opsize[size]); + a_load_ref_reg(list,size2opsize[size],size2opsize[size],srcref,r); + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,countreg,countreg,1),PF_S)); + a_load_reg_ref(list,size2opsize[size],size2opsize[size],r,dstref); + list.concat(setcondition(taicpu.op_sym(A_B,l),C_NE)); + { keep the registers alive } + list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg)); + list.concat(taicpu.op_reg_reg(A_MOV,srcreg,srcreg)); + list.concat(taicpu.op_reg_reg(A_MOV,destreg,destreg)); + end; + + begin + if len=0 then + exit; + helpsize:=12; + dstref:=dest; + srcref:=source; + if cs_littlesize in aktglobalswitches then + helpsize:=8; + if (len<=helpsize) and aligned then + begin + copysize:=4; + cgsize:=OS_32; + while len<>0 do + begin + if len<2 then + begin + copysize:=1; + cgsize:=OS_8; + end + else if len<4 then + begin + copysize:=2; + cgsize:=OS_16; + end; + dec(len,copysize); + r:=getintregister(list,cgsize); + a_load_ref_reg(list,cgsize,cgsize,srcref,r); + a_load_reg_ref(list,cgsize,cgsize,r,dstref); + inc(srcref.offset,copysize); + inc(dstref.offset,copysize); + end; + end + else + begin + destreg:=getintregister(list,OS_ADDR); + a_loadaddr_ref_reg(list,dest,destreg); + reference_reset_base(dstref,destreg,0); + + srcreg:=getintregister(list,OS_ADDR); + a_loadaddr_ref_reg(list,source,srcreg); + reference_reset_base(srcref,srcreg,0); + + countreg:=getintregister(list,OS_32); + +// if cs_littlesize in aktglobalswitches then + genloop(len,1); +{ + else + begin + helpsize:=len shr 2; + len:=len and 3; + if helpsize>1 then + begin + a_load_const_reg(list,OS_INT,helpsize,countreg); + list.concat(Taicpu.op_none(A_REP,S_NO)); + end; + if helpsize>0 then + list.concat(Taicpu.op_none(A_MOVSD,S_NO)); + if len>1 then + begin + dec(len,2); + list.concat(Taicpu.op_none(A_MOVSW,S_NO)); + end; + if len=1 then + list.concat(Taicpu.op_none(A_MOVSB,S_NO)); + end; +} + end; + end; + + + procedure tcgarm.g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint); + begin + g_concatcopy_internal(list,source,dest,len,false); + end; + + + procedure tcgarm.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint); + begin + g_concatcopy_internal(list,source,dest,len,true); + end; + + + procedure tcgarm.g_overflowCheck(list : taasmoutput;const l : tlocation;def : tdef); + var + ovloc : tlocation; + begin + ovloc.loc:=LOC_VOID; + g_overflowCheck_loc(list,l,def,ovloc); + end; + + + procedure tcgarm.g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation); + var + hl : tasmlabel; + ai:TAiCpu; + hflags : tresflags; + begin + if not(cs_check_overflow in aktlocalswitches) then + exit; + objectlibrary.getjumplabel(hl); + case ovloc.loc of + LOC_VOID: + begin + ai:=taicpu.op_sym(A_B,hl); + ai.is_jmp:=true; + + if not((def.deftype=pointerdef) or + ((def.deftype=orddef) and + (torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then + ai.SetCondition(C_VC) + else + ai.SetCondition(C_CC); + + list.concat(ai); + end; + LOC_FLAGS: + begin + hflags:=ovloc.resflags; + inverse_flags(hflags); + cg.a_jmp_flags(list,hflags,hl); + end; + else + internalerror(200409281); + end; + + a_call_name(list,'FPC_OVERFLOW'); + a_label(list,hl); + end; + + + procedure tcgarm.g_save_standard_registers(list : taasmoutput); + begin + { this work is done in g_proc_entry } + end; + + + procedure tcgarm.g_restore_standard_registers(list : taasmoutput); + begin + { this work is done in g_proc_exit } + end; + + + procedure tcgarm.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); + var + ai : taicpu; + begin + ai:=Taicpu.Op_sym(A_B,l); + ai.SetCondition(OpCmp2AsmCond[cond]); + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcgarm.g_intf_wrapper(list: taasmoutput; procdef: tprocdef; const labelname: string; ioffset: longint); + + procedure loadvmttor12; + var + href : treference; + begin + reference_reset_base(href,NR_R0,0); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12); + end; + + + procedure op_onr12methodaddr; + var + href : treference; + begin + if (procdef.extnumber=$ffff) then + Internalerror(200006139); + { call/jmp vmtoffs(%eax) ; method offs } + reference_reset_base(href,NR_R12,procdef._class.vmtmethodoffset(procdef.extnumber)); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12); + list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12)); + end; + + var + lab : tasmsymbol; + make_global : boolean; + href : treference; + begin + if not(procdef.proctypeoption in [potype_function,potype_procedure]) then + Internalerror(200006137); + if not assigned(procdef._class) or + (procdef.procoptions*[po_classmethod, po_staticmethod, + po_methodpointer, po_interrupt, po_iocheck]<>[]) then + Internalerror(200006138); + if procdef.owner.symtabletype<>objectsymtable then + Internalerror(200109191); + + make_global:=false; + if (not current_module.is_unit) or + (cs_create_smart in aktmoduleswitches) or + (procdef.owner.defowner.owner.symtabletype=globalsymtable) then + make_global:=true; + + if make_global then + list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0)) + else + list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0)); + + { set param1 interface to self } + g_adjust_self_value(list,procdef,ioffset); + + { case 4 } + if po_virtualmethod in procdef.procoptions then + begin + loadvmttor12; + op_onr12methodaddr; + end + { case 0 } + else + list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + + list.concat(Tai_symbol_end.Createname(labelname)); + end; + + + procedure tcg64farm.a_op64_reg_reg(list : taasmoutput;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64); + var + tmpreg : tregister; + begin + case op of + OP_NEG: + begin + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0),PF_S)); + list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0)); + end; + OP_NOT: + begin + cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reglo,regdst.reglo); + cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reghi,regdst.reghi); + end; + else + a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst); + end; + end; + + + procedure tcg64farm.a_op64_const_reg(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;reg : tregister64); + begin + a_op64_const_reg_reg(list,op,size,value,reg,reg); + end; + + + procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64); + var + ovloc : tlocation; + begin + a_op64_const_reg_reg_checkoverflow(list,op,size,value,regsrc,regdst,false,ovloc); + end; + + + procedure tcg64farm.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64); + var + ovloc : tlocation; + begin + a_op64_reg_reg_reg_checkoverflow(list,op,size,regsrc1,regsrc2,regdst,false,ovloc); + end; + + + procedure tcg64farm.a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation); + var + tmpreg : tregister; + b : byte; + begin + ovloc.loc:=LOC_VOID; + case op of + OP_NEG, + OP_NOT : + internalerror(200306017); + end; + if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then + begin + case op of + OP_ADD: + begin + if is_shifter_const(lo(value),b) then + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S)) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,lo(value),tmpreg); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S)); + end; + + if is_shifter_const(hi(value),b) then + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)),PF_S)) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,hi(value),tmpreg); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg),PF_S)); + end; + end; + OP_SUB: + begin + if is_shifter_const(lo(value),b) then + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S)) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,lo(value),tmpreg); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S)); + end; + + if is_shifter_const(hi(value),b) then + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)),PF_S)) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,hi(value),tmpreg); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg),PF_S)); + end; + end; + else + internalerror(200502131); + end; + if size=OS_64 then + begin + { the arm has an weired opinion how flags for SUB/ADD are handled } + ovloc.loc:=LOC_FLAGS; + case op of + OP_ADD: + ovloc.resflags:=F_CS; + OP_SUB: + ovloc.resflags:=F_CC; + end; + end; + end + else + begin + case op of + OP_AND,OP_OR,OP_XOR: + begin + cg.a_op_const_reg_reg(list,op,OS_32,lo(value),regsrc.reglo,regdst.reglo); + cg.a_op_const_reg_reg(list,op,OS_32,hi(value),regsrc.reghi,regdst.reghi); + end; + OP_ADD: + begin + if is_shifter_const(lo(value),b) then + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S)) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,lo(value),tmpreg); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S)); + end; + + if is_shifter_const(hi(value),b) then + list.concat(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value))) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,hi(value),tmpreg); + list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg)); + end; + end; + OP_SUB: + begin + if is_shifter_const(lo(value),b) then + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S)) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,lo(value),tmpreg); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S)); + end; + + if is_shifter_const(hi(value),b) then + list.concat(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value))) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,hi(value),tmpreg); + list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg)); + end; + end; + else + internalerror(2003083101); + end; + end; + end; + + + procedure tcg64farm.a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation); + var + op1,op2:TAsmOp; + begin + ovloc.loc:=LOC_VOID; + case op of + OP_NEG, + OP_NOT : + internalerror(200306017); + end; + if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then + begin + case op of + OP_ADD: + begin + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S)); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi),PF_S)); + end; + OP_SUB: + begin + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S)); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi),PF_S)); + end; + else + internalerror(2003083101); + end; + if size=OS_64 then + begin + { the arm has an weired opinion how flags for SUB/ADD are handled } + ovloc.loc:=LOC_FLAGS; + case op of + OP_ADD: + ovloc.resflags:=F_CC; + OP_SUB: + ovloc.resflags:=F_CS; + end; + end; + end + else + begin + case op of + OP_AND,OP_OR,OP_XOR: + begin + cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reglo,regsrc2.reglo,regdst.reglo); + cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reghi,regsrc2.reghi,regdst.reghi); + end; + OP_ADD: + begin + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S)); + list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi)); + end; + OP_SUB: + begin + list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S)); + list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi)); + end; + else + internalerror(2003083101); + end; + end; + end; + + +begin + cg:=tcgarm.create; + cg64:=tcg64farm.create; +end. diff --git a/compiler/arm/cpubase.pas b/compiler/arm/cpubase.pas new file mode 100644 index 0000000000..097854076b --- /dev/null +++ b/compiler/arm/cpubase.pas @@ -0,0 +1,520 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman + + Contains the base types for the ARM + + 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. + + **************************************************************************** +} +{# Base unit for processor information. This unit contains + enumerations of registers, opcodes, sizes, and other + such things which are processor specific. +} +unit cpubase; + +{$i fpcdefs.inc} + + interface + + uses + cutils,cclasses, + globtype,globals, + cpuinfo, + aasmbase, + cgbase + ; + + +{***************************************************************************** + Assembler Opcodes +*****************************************************************************} + + type + TAsmOp= {$i armop.inc} + + { This should define the array of instructions as string } + op2strtable=array[tasmop] of string[11]; + + const + { First value of opcode enumeration } + firstop = low(tasmop); + { Last value of opcode enumeration } + lastop = high(tasmop); + +{***************************************************************************** + Registers +*****************************************************************************} + + type + { Number of registers used for indexing in tables } + tregisterindex=0..{$i rarmnor.inc}-1; + + const + { Available Superregisters } + {$i rarmsup.inc} + + RS_PC = RS_R15; + + { No Subregisters } + R_SUBWHOLE = R_SUBNONE; + + { Available Registers } + {$i rarmcon.inc} + + { aliases } + NR_PC = NR_R15; + + { Integer Super registers first and last } + first_int_supreg = RS_R0; + first_int_imreg = $10; + + { Float Super register first and last } + first_fpu_supreg = RS_F0; + first_fpu_imreg = $08; + + { MM Super register first and last } + first_mm_supreg = RS_S0; + first_mm_imreg = $20; + +{$warning TODO Calculate bsstart} + regnumber_count_bsstart = 64; + + regnumber_table : array[tregisterindex] of tregister = ( + {$i rarmnum.inc} + ); + + regstabs_table : array[tregisterindex] of shortint = ( + {$i rarmsta.inc} + ); + + regdwarf_table : array[tregisterindex] of shortint = ( + {$i rarmdwa.inc} + ); + { registers which may be destroyed by calls } + VOLATILE_INTREGISTERS = [RS_R0..RS_R3,RS_R12..RS_R15]; + VOLATILE_FPUREGISTERS = [RS_F0..RS_F3]; + + type + totherregisterset = set of tregisterindex; + +{***************************************************************************** + Instruction post fixes +*****************************************************************************} + type + { ARM instructions load/store and arithmetic instructions + can have several instruction post fixes which are collected + in this enumeration + } + TOpPostfix = (PF_None, + { update condition flags + or floating point single } + PF_S, + { floating point size } + PF_D,PF_E,PF_P,PF_EP, + { load/store } + PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T, + { multiple load/store address modes } + PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA + ); + + TRoundingMode = (RM_None,RM_P,RM_M,RM_Z); + + const + cgsize2fpuoppostfix : array[OS_NO..OS_F128] of toppostfix = ( + PF_E, + PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None, + PF_S,PF_D,PF_E,PF_None,PF_None); + + oppostfix2str : array[TOpPostfix] of string[2] = ('', + 's', + 'd','e','p','ep', + 'b','sb','bt','h','sh','t', + 'ia','ib','da','db','fd','fa','ed','ea'); + + roundingmode2str : array[TRoundingMode] of string[1] = ('', + 'p','m','z'); + +{***************************************************************************** + Conditions +*****************************************************************************} + + type + TAsmCond=(C_None, + C_EQ,C_NE,C_CS,C_CC,C_MI,C_PL,C_VS,C_VC,C_HI,C_LS, + C_GE,C_LT,C_GT,C_LE,C_AL,C_NV + ); + + const + cond2str : array[TAsmCond] of string[2]=('', + 'eq','ne','cs','cc','mi','pl','vs','vc','hi','ls', + 'ge','lt','gt','le','al','nv' + ); + + uppercond2str : array[TAsmCond] of string[2]=('', + 'EQ','NE','CS','CC','MI','PL','VS','VC','HI','LS', + 'GE','LT','GT','LE','AL','NV' + ); + +{***************************************************************************** + Flags +*****************************************************************************} + + type + TResFlags = (F_EQ,F_NE,F_CS,F_CC,F_MI,F_PL,F_VS,F_VC,F_HI,F_LS, + F_GE,F_LT,F_GT,F_LE); + +{***************************************************************************** + Operands +*****************************************************************************} + + taddressmode = (AM_OFFSET,AM_PREINDEXED,AM_POSTINDEXED); + tshiftmode = (SM_None,SM_LSL,SM_LSR,SM_ASR,SM_ROR,SM_RRX); + + tupdatereg = (UR_None,UR_Update); + + pshifterop = ^tshifterop; + + tshifterop = record + shiftmode : tshiftmode; + rs : tregister; + shiftimm : byte; + end; + +{***************************************************************************** + Constants +*****************************************************************************} + + const + max_operands = 4; + + {# Constant defining possibly all registers which might require saving } + ALL_OTHERREGISTERS = []; + + general_superregisters = [RS_R0..RS_PC]; + + {# Table of registers which can be allocated by the code generator + internally, when generating the code. + } + { legend: } + { xxxregs = set of all possibly used registers of that type in the code } + { generator } + { usableregsxxx = set of all 32bit components of registers that can be } + { possible allocated to a regvar or using getregisterxxx (this } + { excludes registers which can be only used for parameter } + { passing on ABI's that define this) } + { c_countusableregsxxx = amount of registers in the usableregsxxx set } + + maxintregs = 15; + { to determine how many registers to use for regvars } + maxintscratchregs = 3; + usableregsint = [RS_R4..RS_R10]; + c_countusableregsint = 7; + + maxfpuregs = 8; + fpuregs = [RS_F0..RS_F7]; + usableregsfpu = [RS_F4..RS_F7]; + c_countusableregsfpu = 4; + + mmregs = [RS_D0..RS_D15]; + usableregsmm = [RS_D8..RS_D15]; + c_countusableregsmm = 8; + + maxaddrregs = 0; + addrregs = []; + usableregsaddr = []; + c_countusableregsaddr = 0; + +{***************************************************************************** + Operand Sizes +*****************************************************************************} + + type + topsize = (S_NO, + S_B,S_W,S_L,S_BW,S_BL,S_WL, + S_IS,S_IL,S_IQ, + S_FS,S_FL,S_FX,S_D,S_Q,S_FV,S_FXX + ); + +{***************************************************************************** + Constants +*****************************************************************************} + + const + firstsaveintreg = RS_R4; + lastsaveintreg = RS_R10; + firstsavefpureg = RS_F4; + lastsavefpureg = RS_F7; + firstsavemmreg = RS_D8; + lastsavemmreg = RS_D15; + + maxvarregs = 7; + varregs : Array [1..maxvarregs] of tsuperregister = + (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10); + + maxfpuvarregs = 4; + fpuvarregs : Array [1..maxfpuvarregs] of tsuperregister = + (RS_F4,RS_F5,RS_F6,RS_F7); + +{***************************************************************************** + Default generic sizes +*****************************************************************************} + + { Defines the default address size for a processor, } + OS_ADDR = OS_32; + { the natural int size for a processor, } + OS_INT = OS_32; + OS_SINT = OS_S32; + { the maximum float size for a processor, } + OS_FLOAT = OS_F64; + { the size of a vector register for a processor } + OS_VECTOR = OS_M32; + +{***************************************************************************** + Generic Register names +*****************************************************************************} + + { Stack pointer register } + NR_STACK_POINTER_REG = NR_R13; + RS_STACK_POINTER_REG = RS_R13; + { Frame pointer register } + RS_FRAME_POINTER_REG = RS_R11; + NR_FRAME_POINTER_REG = NR_R11; + { Register for addressing absolute data in a position independant way, + such as in PIC code. The exact meaning is ABI specific. For + further information look at GCC source : PIC_OFFSET_TABLE_REGNUM + } + NR_PIC_OFFSET_REG = NR_R9; + { Results are returned in this register (32-bit values) } + NR_FUNCTION_RETURN_REG = NR_R0; + RS_FUNCTION_RETURN_REG = RS_R0; + { Low part of 64bit return value } + NR_FUNCTION_RETURN64_LOW_REG = NR_R0; + RS_FUNCTION_RETURN64_LOW_REG = RS_R0; + { High part of 64bit return value } + NR_FUNCTION_RETURN64_HIGH_REG = NR_R1; + RS_FUNCTION_RETURN64_HIGH_REG = RS_R1; + { The value returned from a function is available in this register } + NR_FUNCTION_RESULT_REG = NR_FUNCTION_RETURN_REG; + RS_FUNCTION_RESULT_REG = RS_FUNCTION_RETURN_REG; + { The lowh part of 64bit value returned from a function } + NR_FUNCTION_RESULT64_LOW_REG = NR_FUNCTION_RETURN64_LOW_REG; + RS_FUNCTION_RESULT64_LOW_REG = RS_FUNCTION_RETURN64_LOW_REG; + { The high part of 64bit value returned from a function } + NR_FUNCTION_RESULT64_HIGH_REG = NR_FUNCTION_RETURN64_HIGH_REG; + RS_FUNCTION_RESULT64_HIGH_REG = RS_FUNCTION_RETURN64_HIGH_REG; + + NR_FPU_RESULT_REG = NR_F0; + + NR_MM_RESULT_REG = NR_NO; + + NR_RETURN_ADDRESS_REG = NR_FUNCTION_RETURN_REG; + + { Offset where the parent framepointer is pushed } + PARENT_FRAMEPOINTER_OFFSET = 0; + +{***************************************************************************** + GCC /ABI linking information +*****************************************************************************} + + const + { Registers which must be saved when calling a routine declared as + cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers + saved should be the ones as defined in the target ABI and / or GCC. + + This value can be deduced from the CALLED_USED_REGISTERS array in the + GCC source. + } + saved_standard_registers : array[0..6] of tsuperregister = + (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10); + { Required parameter alignment when calling a routine declared as + stdcall and cdecl. The alignment value should be the one defined + by GCC or the target ABI. + + The value of this constant is equal to the constant + PARM_BOUNDARY / BITS_PER_UNIT in the GCC source. + } + std_param_align = 4; + + +{***************************************************************************** + Helpers +*****************************************************************************} + + { Returns the tcgsize corresponding with the size of reg.} + function reg_cgsize(const reg: tregister) : tcgsize; + function cgsize2subreg(s:Tcgsize):Tsubregister; + function is_calljmp(o:tasmop):boolean; + procedure inverse_flags(var f: TResFlags); + function flags_to_cond(const f: TResFlags) : TAsmCond; + function findreg_by_number(r:Tregister):tregisterindex; + function std_regnum_search(const s:string):Tregister; + function std_regname(r:Tregister):string; + + function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE} + + procedure shifterop_reset(var so : tshifterop); + function is_pc(const r : tregister) : boolean; + + function is_shifter_const(d : aint;var imm_shift : byte) : boolean; + + implementation + + uses + rgBase,verbose; + + + const + std_regname_table : array[tregisterindex] of string[7] = ( + {$i rarmstd.inc} + ); + + regnumber_index : array[tregisterindex] of tregisterindex = ( + {$i rarmrni.inc} + ); + + std_regname_index : array[tregisterindex] of tregisterindex = ( + {$i rarmsri.inc} + ); + + + function cgsize2subreg(s:Tcgsize):Tsubregister; + begin + cgsize2subreg:=R_SUBWHOLE; + end; + + + function reg_cgsize(const reg: tregister): tcgsize; + const subreg2cgsize:array[Tsubregister] of Tcgsize = + (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO); + begin + case getregtype(reg) of + R_INTREGISTER : + reg_cgsize:=OS_32; + R_FPUREGISTER : + reg_cgsize:=OS_F80; + else + internalerror(200303181); + end; + end; + + + function is_calljmp(o:tasmop):boolean; + begin + { This isn't 100% perfect because the arm allows jumps also by writing to PC=R15. + To overcome this problem we simply forbid that FPC generates jumps by loading R15 } + is_calljmp:= o in [A_B,A_BL,A_BX,A_BLX]; + end; + + + procedure inverse_flags(var f: TResFlags); + const + inv_flags: array[TResFlags] of TResFlags = + (F_NE,F_EQ,F_CC,F_CS,F_PL,F_MI,F_VC,F_VS,F_LS,F_HI, + F_LT,F_GE,F_LE,F_GT); + begin + f:=inv_flags[f]; + end; + + + function flags_to_cond(const f: TResFlags) : TAsmCond; + const + flag_2_cond: array[F_EQ..F_LE] of TAsmCond = + (C_EQ,C_NE,C_CS,C_CC,C_MI,C_PL,C_VS,C_VC,C_HI,C_LS, + C_GE,C_LT,C_GT,C_LE); + begin + if f>high(flag_2_cond) then + internalerror(200112301); + result:=flag_2_cond[f]; + end; + + + function findreg_by_number(r:Tregister):tregisterindex; + begin + result:=rgBase.findreg_by_number_table(r,regnumber_index); + end; + + + function std_regnum_search(const s:string):Tregister; + begin + result:=regnumber_table[findreg_by_name_table(s,std_regname_table,std_regname_index)]; + end; + + + function std_regname(r:Tregister):string; + var + p : tregisterindex; + begin + p:=findreg_by_number_table(r,regnumber_index); + if p<>0 then + result:=std_regname_table[p] + else + result:=generic_regname(r); + end; + + + procedure shifterop_reset(var so : tshifterop); + begin + FillChar(so,sizeof(so),0); + end; + + + function is_pc(const r : tregister) : boolean; + begin + is_pc:=(r=NR_R15); + end; + + + function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + const + inverse: array[TAsmCond] of TAsmCond=(C_None, + C_NE,C_EQ,C_CC,C_CS,C_PL,C_MI,C_VC,C_VS,C_LS,C_HI, + C_LT,C_GE,C_LE,C_GT,C_None,C_None + ); + begin + result := inverse[c]; + end; + + + function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE} + begin + result := c1 = c2; + end; + + + function rotl(d : dword;b : byte) : dword; + begin + result:=(d shr (32-b)) or (d shl b); + end; + + + function is_shifter_const(d : aint;var imm_shift : byte) : boolean; + var + i : longint; + begin + for i:=0 to 15 do + begin + if (dword(d) and not(rotl($ff,i*2)))=0 then + begin + imm_shift:=i*2; + result:=true; + exit; + end; + end; + result:=false; + end; + +end. diff --git a/compiler/arm/cpuinfo.pas b/compiler/arm/cpuinfo.pas new file mode 100644 index 0000000000..c9aba464a9 --- /dev/null +++ b/compiler/arm/cpuinfo.pas @@ -0,0 +1,88 @@ +{ + Copyright (c) 1998-2002 by the Free Pascal development team + + Basic Processor information for the ARM + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + 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. + + **********************************************************************} + +Unit CPUInfo; + +Interface + + uses + globtype; + +Type + bestreal = double; + ts32real = single; + ts64real = double; + ts80real = type extended; + ts128real = type extended; + ts64comp = comp; + + pbestreal=^bestreal; + + { possible supported processors for this target } + tprocessors = + (no_processor, + armv3, + armv4, + armv5 + ); + + tfputype = + (no_fpuprocessor, + fpu_soft, + fpu_libgcc, + fpu_fpa, + fpu_fpa10, + fpu_fpa11, + fpu_vfp + ); + +Const + {# Size of native extended floating point type } + extended_size = 12; + {# Size of a multimedia register } + mmreg_size = 16; + { target cpu string (used by compiler options) } + target_cpu_string = 'arm'; + + { calling conventions supported by the code generator } + supported_calling_conventions : tproccalloptions = [ + pocall_internproc, + pocall_stdcall, + { same as stdcall only different name mangling } + pocall_cdecl, + { same as stdcall only different name mangling } + pocall_cppdecl, + { same as stdcall but floating point numbers are handled like equal sized integers } + pocall_softfloat + ]; + + processorsstr : array[tprocessors] of string[5] = ('', + 'ARMV3', + 'ARMV4', + 'ARMV5' + ); + + fputypestr : array[tfputype] of string[6] = ('', + 'SOFT', + 'LIBGCC', + 'FPA', + 'FPA10', + 'FPA11', + 'VFP' + ); + + +Implementation + +end. diff --git a/compiler/arm/cpunode.pas b/compiler/arm/cpunode.pas new file mode 100644 index 0000000000..89993d5d1f --- /dev/null +++ b/compiler/arm/cpunode.pas @@ -0,0 +1,46 @@ +{ + Copyright (c) 2000-2003 by Florian Klaempfl + + This unit includes the ARM code generator into the compiler + + 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 cpunode; + +{$i fpcdefs.inc} + + interface + + implementation + + uses + { generic nodes } + ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt,ncgmat, + { to be able to only parts of the generic code, + the processor specific nodes must be included + after the generic one (FK) + } + narmadd, + narmcal, + narmmat, + narminl, + narmcnv, + narmcon + ; + + +end. diff --git a/compiler/arm/cpupara.pas b/compiler/arm/cpupara.pas new file mode 100644 index 0000000000..f22ba181bd --- /dev/null +++ b/compiler/arm/cpupara.pas @@ -0,0 +1,496 @@ +{ + Copyright (c) 2003 by Florian Klaempfl + + ARM specific calling conventions + + 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. + **************************************************************************** +} +{ ARM specific calling conventions are handled by this unit +} +unit cpupara; + +{$i fpcdefs.inc} + + interface + + uses + globtype,globals, + aasmtai, + cpuinfo,cpubase,cgbase, + symconst,symbase,symtype,symdef,parabase,paramgr; + + type + tarmparamanager = class(tparamanager) + function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override; + function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override; + function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override; + procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override; + function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override; + function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override; + private + procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword); + function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; + var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint; + end; + + implementation + + uses + verbose,systems, + rgobj, + defutil,symsym, + cgutils; + + + function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset; + begin + result:=VOLATILE_INTREGISTERS; + end; + + + function tarmparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset; + begin + result:=VOLATILE_FPUREGISTERS; + end; + + + procedure tarmparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara); + var + paraloc : pcgparalocation; + begin + if nr<1 then + internalerror(2002070801); + cgpara.reset; + cgpara.size:=OS_INT; + cgpara.intsize:=tcgsize2size[OS_INT]; + cgpara.alignment:=std_param_align; + paraloc:=cgpara.add_location; + with paraloc^ do + begin + size:=OS_INT; + { the four first parameters are passed into registers } + if nr<=4 then + begin + loc:=LOC_REGISTER; + register:=newreg(R_INTREGISTER,RS_R0+nr-1,R_SUBWHOLE); + end + else + begin + { the other parameters are passed on the stack } + loc:=LOC_REFERENCE; + reference.index:=NR_STACK_POINTER_REG; + reference.offset:=(nr-5)*4; + end; + end; + end; + + + function getparaloc(calloption : tproccalloption; p : tdef) : tcgloc; + begin + { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER + if push_addr_param for the def is true + } + case p.deftype of + orddef: + getparaloc:=LOC_REGISTER; + floatdef: + if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or (cs_fp_emulation in aktmoduleswitches) then + getparaloc:=LOC_REGISTER + else + getparaloc:=LOC_FPUREGISTER; + enumdef: + getparaloc:=LOC_REGISTER; + pointerdef: + getparaloc:=LOC_REGISTER; + formaldef: + getparaloc:=LOC_REGISTER; + classrefdef: + getparaloc:=LOC_REGISTER; + recorddef: + getparaloc:=LOC_REFERENCE; + objectdef: + if is_object(p) then + getparaloc:=LOC_REFERENCE + else + getparaloc:=LOC_REGISTER; + stringdef: + if is_shortstring(p) or is_longstring(p) then + getparaloc:=LOC_REFERENCE + else + getparaloc:=LOC_REGISTER; + procvardef: + if (po_methodpointer in tprocvardef(p).procoptions) then + getparaloc:=LOC_REFERENCE + else + getparaloc:=LOC_REGISTER; + filedef: + getparaloc:=LOC_REGISTER; + arraydef: + getparaloc:=LOC_REFERENCE; + setdef: + if is_smallset(p) then + getparaloc:=LOC_REGISTER + else + getparaloc:=LOC_REFERENCE; + variantdef: + getparaloc:=LOC_REFERENCE; + { avoid problems with errornous definitions } + errordef: + getparaloc:=LOC_REGISTER; + else + internalerror(2002071001); + end; + end; + + + function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; + begin + result:=false; + if varspez in [vs_var,vs_out] then + begin + result:=true; + exit; + end; + case def.deftype of + variantdef, + formaldef, + recorddef: + result:=true; + arraydef: + result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or + is_open_array(def) or + is_array_of_const(def) or + is_array_constructor(def); + objectdef : + result:=is_object(def); + setdef : + result:=(tsetdef(def).settype<>smallset); + stringdef : + result:=tstringdef(def).string_typ in [st_shortstring,st_longstring]; + procvardef : + result:=po_methodpointer in tprocvardef(def).procoptions; + end; + end; + + + procedure tarmparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword); + begin + curintreg:=RS_R0; + curfloatreg:=RS_F0; + curmmreg:=RS_D0; + cur_stack_offset:=0; + end; + + + function tarmparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; + var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint; + + var + nextintreg,nextfloatreg,nextmmreg : tsuperregister; + paradef : tdef; + paraloc : pcgparalocation; + stack_offset : aword; + hp : tparavarsym; + loc : tcgloc; + paracgsize : tcgsize; + paralen : longint; + i : integer; + + procedure assignintreg; + begin + if nextintreg<=RS_R3 then + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE); + inc(nextintreg); + end + else + begin + paraloc^.loc:=LOC_REFERENCE; + paraloc^.reference.index:=NR_STACK_POINTER_REG; + paraloc^.reference.offset:=stack_offset; + inc(stack_offset,4); + end; + end; + + + begin + result:=0; + nextintreg:=curintreg; + nextfloatreg:=curfloatreg; + nextmmreg:=curmmreg; + stack_offset:=cur_stack_offset; + + for i:=0 to paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + { currently only support C-style array of const, + there should be no location assigned to the vararg array itself } + if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and + is_array_of_const(hp.vartype.def) then + begin + paraloc:=hp.paraloc[side].add_location; + { hack: the paraloc must be valid, but is not actually used } + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_R0; + paraloc^.size:=OS_ADDR; + break; + end; + + if push_addr_param(hp.varspez,hp.vartype.def,p.proccalloption) then + paracgsize:=OS_ADDR + else + begin + paracgsize:=def_cgSize(hp.vartype.def); + if paracgsize=OS_NO then + paracgsize:=OS_ADDR; + end; + + hp.paraloc[side].reset; + hp.paraloc[side].size:=paracgsize; + hp.paraloc[side].Alignment:=std_param_align; + + if (hp.varspez in [vs_var,vs_out]) then + begin + paradef:=voidpointertype.def; + loc:=LOC_REGISTER; + end + else + begin + paradef:=hp.vartype.def; + loc:=getparaloc(p.proccalloption,paradef); + end; + + paralen:=tcgsize2size[paracgsize]; + hp.paraloc[side].intsize:=paralen; +{$ifdef EXTDEBUG} + if paralen=0 then + internalerror(200410311); +{$endif EXTDEBUG} + while paralen>0 do + begin + paraloc:=hp.paraloc[side].add_location; + { for things like formaldef } + if paracgsize=OS_NO then + paraloc^.size:=OS_ADDR + else if paracgsize in [OS_64,OS_S64] then + paraloc^.size:=OS_32 + else if (loc=LOC_REGISTER) and (paracgsize in [OS_F32,OS_F64,OS_F80]) then + case paracgsize of + OS_F32: + paraloc^.size:=OS_32; + OS_F64: + paraloc^.size:=OS_64; + else + internalerror(2005082901); + end + else + paraloc^.size:=paracgsize; + case loc of + LOC_REGISTER: + begin + { this is not abi compliant } + if nextintreg<=RS_R3 then + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE); + inc(nextintreg); + end + else + begin + { LOC_REFERENCE covers always the overleft } + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=int_cgsize(paralen); + if (side=callerside) then + paraloc^.reference.index:=NR_STACK_POINTER_REG; + paraloc^.reference.offset:=stack_offset; + inc(stack_offset,align(paralen,4)); + paralen:=0; + end; + end; + LOC_FPUREGISTER: + begin + if nextfloatreg<=RS_F3 then + begin + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE); + inc(nextfloatreg); + end + else + begin + paraloc^.loc:=LOC_REFERENCE; + paraloc^.reference.index:=NR_STACK_POINTER_REG; + paraloc^.reference.offset:=stack_offset; + case paraloc^.size of + OS_F32: + inc(stack_offset,4); + OS_F64: + inc(stack_offset,8); + OS_F80: + inc(stack_offset,10); + OS_F128: + inc(stack_offset,16); + else + internalerror(200403201); + end; + end; + end; + LOC_REFERENCE: + begin + paraloc^.size:=OS_ADDR; + if push_addr_param(hp.varspez,paradef,p.proccalloption) or + is_open_array(paradef) or + is_array_of_const(paradef) then + assignintreg + else + begin + paraloc^.loc:=LOC_REFERENCE; + paraloc^.reference.index:=NR_STACK_POINTER_REG; + paraloc^.reference.offset:=stack_offset; + inc(stack_offset,hp.vartype.def.size); + end; + end; + else + internalerror(2002071002); + end; + if side=calleeside then + begin + if paraloc^.loc=LOC_REFERENCE then + begin + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + inc(paraloc^.reference.offset,4); + end; + end; + dec(paralen,tcgsize2size[paraloc^.size]); + end; + { hack to swap doubles in int registers } + if is_double(hp.vartype.def) and (paracgsize=OS_64) and + (hp.paraloc[side].location^.loc=LOC_REGISTER) then + begin + paraloc:=hp.paraloc[side].location; + hp.paraloc[side].location:=hp.paraloc[side].location^.next; + hp.paraloc[side].location^.next:=paraloc; + paraloc^.next:=nil; + end; + end; + curintreg:=nextintreg; + curfloatreg:=nextfloatreg; + curmmreg:=nextmmreg; + cur_stack_offset:=stack_offset; + result:=cur_stack_offset; + end; + + + function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; + var + cur_stack_offset: aword; + curintreg, curfloatreg, curmmreg: tsuperregister; + retcgsize : tcgsize; + begin + init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset); + + result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset); + + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + retcgsize:=OS_ADDR + else + retcgsize:=def_cgsize(p.rettype.def); + + location_reset(p.funcretloc[side],LOC_INVALID,OS_NO); + p.funcretloc[side].size:=retcgsize; + + { void has no location } + if is_void(p.rettype.def) then + begin + location_reset(p.funcretloc[side],LOC_VOID,OS_NO); + exit; + end; + + { Return in FPU register? } + if p.rettype.def.deftype=floatdef then + begin + if (p.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or (cs_fp_emulation in aktmoduleswitches) then + begin + case retcgsize of + OS_64, + OS_F64: + begin + { low } + p.funcretloc[side].loc:=LOC_REGISTER; + p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_HIGH_REG; + p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_LOW_REG; + p.funcretloc[side].size:=OS_64; + end; + OS_32, + OS_F32: + begin + p.funcretloc[side].loc:=LOC_REGISTER; + p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG; + p.funcretloc[side].size:=OS_32; + end; + else + internalerror(2005082603); + end; + end + else + begin + p.funcretloc[side].loc:=LOC_FPUREGISTER; + p.funcretloc[side].register:=NR_FPU_RESULT_REG; + end; + end + { Return in register? } + else if not ret_in_param(p.rettype.def,p.proccalloption) then + begin + if retcgsize in [OS_64,OS_S64] then + begin + { low } + p.funcretloc[side].loc:=LOC_REGISTER; + p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG; + p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG; + end + else + begin + p.funcretloc[side].loc:=LOC_REGISTER; + p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG; + end; + end + else + begin + p.funcretloc[side].loc:=LOC_REFERENCE; + p.funcretloc[side].size:=retcgsize; + end; + end; + + + function tarmparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint; + var + cur_stack_offset: aword; + curintreg, curfloatreg, curmmreg: tsuperregister; + begin + init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset); + + result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset); + if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then + { just continue loading the parameters in the registers } + result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset) + else + internalerror(200410231); + end; + +begin + paramanager:=tarmparamanager.create; +end. diff --git a/compiler/arm/cpupi.pas b/compiler/arm/cpupi.pas new file mode 100644 index 0000000000..cfe10e315b --- /dev/null +++ b/compiler/arm/cpupi.pas @@ -0,0 +1,105 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + This unit contains the CPU specific part of tprocinfo + + 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. + + **************************************************************************** +} + +{ This unit contains the CPU specific part of tprocinfo. } +unit cpupi; + +{$i fpcdefs.inc} + + interface + + uses + globtype,cutils, + procinfo,cpuinfo,psub; + + type + tarmprocinfo = class(tcgprocinfo) + floatregstart : aint; + // procedure handle_body_start;override; + // procedure after_pass1;override; + procedure set_first_temp_offset;override; + procedure allocate_push_parasize(size: longint);override; + function calc_stackframe_size:longint;override; + end; + + + implementation + + uses + globals,systems, + cpubase, + aasmtai, + tgobj, + symconst,symsym,paramgr, + cgbase, + cgobj; + + procedure tarmprocinfo.set_first_temp_offset; + begin + { We allocate enough space to save all registers because we can't determine + the necessary space because the used registers aren't known before + secondpass is run. Even worse, patching + the local offsets after generating the code could cause trouble because + "shifter" constants could change to non-"shifter" constants. This + is especially a problem when taking the address of a local. For now, + this extra memory should hurt less than generating all local contants with offsets + >256 as non shifter constants } + tg.setfirsttemp(-12-28); + end; + + + procedure tarmprocinfo.allocate_push_parasize(size:longint); + begin + if size>maxpushedparasize then + maxpushedparasize:=size; + end; + + + function tarmprocinfo.calc_stackframe_size:longint; + var + firstfloatreg,lastfloatreg, + r : byte; + floatsavesize : aword; + begin + maxpushedparasize:=align(maxpushedparasize,max(aktalignment.localalignmin,4)); + firstfloatreg:=RS_NO; + { save floating point registers? } + for r:=RS_F0 to RS_F7 do + if r in cg.rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then + begin + if firstfloatreg=RS_NO then + firstfloatreg:=r; + lastfloatreg:=r; + end; + if firstfloatreg<>RS_NO then + floatsavesize:=(lastfloatreg-firstfloatreg+1)*12 + else + floatsavesize:=0; + floatsavesize:=align(floatsavesize,max(aktalignment.localalignmin,4)); + result:=Align(tg.direction*tg.lasttemp,max(aktalignment.localalignmin,4))+maxpushedparasize+floatsavesize; + floatregstart:=-result+maxpushedparasize; + end; + + +begin + cprocinfo:=tarmprocinfo; +end. diff --git a/compiler/arm/cpuswtch.pas b/compiler/arm/cpuswtch.pas new file mode 100644 index 0000000000..49ff032287 --- /dev/null +++ b/compiler/arm/cpuswtch.pas @@ -0,0 +1,118 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller + + interprets the commandline options which are arm specific + + 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 cpuswtch; + +{$i fpcdefs.inc} + +interface + +uses + options; + +type + toptionarm=class(toption) + procedure interpret_proc_specific_options(const opt:string);override; + end; + +implementation + +uses + cutils,globtype,systems,globals; + +procedure toptionarm.interpret_proc_specific_options(const opt:string); +var + more: string; + j: longint; +begin + More:=Upper(copy(opt,3,length(opt)-2)); + case opt[2] of + 'O' : Begin + j := 3; + While (j <= Length(Opt)) Do + Begin + case opt[j] of + '-' : + begin + initglobalswitches:=initglobalswitches-[cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_littlesize, + cs_regvars,cs_uncertainopts]; + FillChar(ParaAlignment,sizeof(ParaAlignment),0); + end; + 'a' : + begin + UpdateAlignmentStr(Copy(Opt,j+1,255),ParaAlignment); + j:=length(Opt); + end; + 'g' : initglobalswitches:=initglobalswitches+[cs_littlesize]; + 'G' : initglobalswitches:=initglobalswitches-[cs_littlesize]; + 'r' : + begin + initglobalswitches:=initglobalswitches+[cs_regvars]; + Simplify_ppu:=false; + end; + 'u' : initglobalswitches:=initglobalswitches+[cs_uncertainopts]; + '1' : initglobalswitches:=initglobalswitches-[cs_fastoptimize,cs_slowoptimize]+[cs_optimize]; + '2' : initglobalswitches:=initglobalswitches-[cs_slowoptimize]+[cs_optimize,cs_fastoptimize]; + '3' : initglobalswitches:=initglobalswitches+[cs_optimize,cs_fastoptimize,cs_slowoptimize]; +{$ifdef dummy} + 'p' : + Begin + If j < Length(Opt) Then + Begin + Case opt[j+1] Of + '1': initoptprocessor := Class386; + '2': initoptprocessor := ClassP5; + '3': initoptprocessor := ClassP6 + Else IllegalPara(Opt) + End; + Inc(j); + End + Else IllegalPara(opt) + End; +{$endif dummy} + else IllegalPara(opt); + End; + Inc(j) + end; + end; +{$ifdef dummy} + 'R' : begin + if More='GAS' then + initasmmode:=asmmode_ppc_gas + else + if More='MOTOROLA' then + initasmmode:=asmmode_ppc_motorola + else + if More='DIRECT' then + initasmmode:=asmmode_direct + else + IllegalPara(opt); + end; +{$endif dummy} + else + IllegalPara(opt); + end; +end; + + +initialization + coption:=toptionarm; +end. diff --git a/compiler/arm/cputarg.pas b/compiler/arm/cputarg.pas new file mode 100644 index 0000000000..61429d9de6 --- /dev/null +++ b/compiler/arm/cputarg.pas @@ -0,0 +1,78 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + Includes the arm dependent target units + + 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 cputarg; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + systems { prevent a syntax error when nothing is included } + +{************************************** + Targets +**************************************} + + {$ifndef NOTARGETLINUX} + ,t_linux + {$endif} + {$ifndef NOTARGETWINCE} + ,t_win + {$endif} + {$ifndef NOTARGETGBA} + ,t_gba + {$endif} + +{************************************** + Assemblers +**************************************} + + {$ifndef NOAGARMGAS} + ,agarmgas + {$endif} + + ,ogcoff + +{************************************** + Assembler Readers +**************************************} + + {$ifndef NoRaarmgas} + ,raarmgas + {$endif NoRaarmgas} + +{************************************** + Debuginfo +**************************************} + + {$ifndef NoDbgStabs} + ,dbgstabs + {$endif NoDbgStabs} + {$ifndef NoDbgDwarf} + ,dbgdwarf + {$endif NoDbgDwarf} + ; + +end. diff --git a/compiler/arm/itcpugas.pas b/compiler/arm/itcpugas.pas new file mode 100644 index 0000000000..74a186a20e --- /dev/null +++ b/compiler/arm/itcpugas.pas @@ -0,0 +1,93 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit contains the ARM GAS instruction tables + + 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 itcpugas; + +{$i fpcdefs.inc} + +interface + + uses + cpubase,cgbase; + + + const + { Standard opcode string table (for each tasmop enumeration). The + opcode strings should conform to the names as defined by the + processor manufacturer. + } + gas_op2str : op2strtable = {$i armatt.inc} + + function gas_regnum_search(const s:string):Tregister; + function gas_regname(r:Tregister):string; + + +implementation + + uses + cutils,verbose; + + const + gas_regname_table : array[tregisterindex] of string[7] = ( + {$i rarmstd.inc} + ); + + gas_regname_index : array[tregisterindex] of tregisterindex = ( + {$i rarmsri.inc} + ); + + function findreg_by_gasname(const s:string):tregisterindex; + var + i,p : tregisterindex; + begin + {Binary search.} + p:=0; + i:=regnumber_count_bsstart; + repeat + if (p+i<=high(tregisterindex)) and (gas_regname_table[gas_regname_index[p+i]]<=s) then + p:=p+i; + i:=i shr 1; + until i=0; + if gas_regname_table[gas_regname_index[p]]=s then + findreg_by_gasname:=gas_regname_index[p] + else + findreg_by_gasname:=0; + end; + + + function gas_regnum_search(const s:string):Tregister; + begin + result:=regnumber_table[findreg_by_gasname(s)]; + end; + + + function gas_regname(r:Tregister):string; + var + p : tregisterindex; + begin + p:=findreg_by_number(r); + if p<>0 then + result:=gas_regname_table[p] + else + result:=generic_regname(r); + end; + +end. diff --git a/compiler/arm/narmadd.pas b/compiler/arm/narmadd.pas new file mode 100644 index 0000000000..5b53c9fd29 --- /dev/null +++ b/compiler/arm/narmadd.pas @@ -0,0 +1,336 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Code generation for add nodes on the ARM + + 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 narmadd; + +{$i fpcdefs.inc} + +interface + + uses + node,ncgadd,cpubase; + + type + tarmaddnode = class(tcgaddnode) + private + function GetResFlags(unsigned:Boolean):TResFlags; + protected + procedure second_addfloat;override; + procedure second_cmpfloat;override; + procedure second_cmpordinal;override; + procedure second_cmpsmallset;override; + procedure second_cmp64bit;override; + end; + + implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef,paramgr, + aasmbase,aasmtai,aasmcpu,defutil,htypechk, + cgbase,cgutils,cgcpu, + cpuinfo,pass_1,pass_2,regvars, + cpupara, + ncon,nset,nadd, + ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32; + +{***************************************************************************** + TSparcAddNode +*****************************************************************************} + + function tarmaddnode.GetResFlags(unsigned:Boolean):TResFlags; + begin + case NodeType of + equaln: + GetResFlags:=F_EQ; + unequaln: + GetResFlags:=F_NE; + else + if not(unsigned) then + begin + if nf_swaped in flags then + case NodeType of + ltn: + GetResFlags:=F_GT; + lten: + GetResFlags:=F_GE; + gtn: + GetResFlags:=F_LT; + gten: + GetResFlags:=F_LE; + end + else + case NodeType of + ltn: + GetResFlags:=F_LT; + lten: + GetResFlags:=F_LE; + gtn: + GetResFlags:=F_GT; + gten: + GetResFlags:=F_GE; + end; + end + else + begin + if nf_swaped in Flags then + case NodeType of + ltn: + GetResFlags:=F_HI; + lten: + GetResFlags:=F_CS; + gtn: + GetResFlags:=F_CC; + gten: + GetResFlags:=F_LS; + end + else + case NodeType of + ltn: + GetResFlags:=F_CC; + lten: + GetResFlags:=F_LS; + gtn: + GetResFlags:=F_HI; + gten: + GetResFlags:=F_CS; + end; + end; + end; + end; + + + procedure tarmaddnode.second_addfloat; + var + op : TAsmOp; + begin + case aktfputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + pass_left_right; + if (nf_swaped in flags) then + swapleftright; + + case nodetype of + addn : + op:=A_ADF; + muln : + op:=A_MUF; + subn : + op:=A_SUF; + slashn : + op:=A_DVF; + else + internalerror(200308313); + end; + + { force fpureg as location, left right doesn't matter + as both will be in a fpureg } + location_force_fpureg(exprasmlist,left.location,true); + location_force_fpureg(exprasmlist,right.location,(left.location.loc<>LOC_CFPUREGISTER)); + + location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); + if left.location.loc<>LOC_CFPUREGISTER then + location.register:=left.location.register + else + location.register:=right.location.register; + + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg_reg(op, + location.register,left.location.register,right.location.register), + cgsize2fpuoppostfix[def_cgsize(resulttype.def)])); + + location.loc:=LOC_FPUREGISTER; + end; + fpu_soft: + { this case should be handled already by pass1 } + internalerror(200308252); + else + internalerror(200308251); + end; + end; + + + procedure tarmaddnode.second_cmpfloat; + begin + pass_left_right; + if (nf_swaped in flags) then + swapleftright; + + { force fpureg as location, left right doesn't matter + as both will be in a fpureg } + location_force_fpureg(exprasmlist,left.location,true); + location_force_fpureg(exprasmlist,right.location,true); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(true); + + if nodetype in [equaln,unequaln] then + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_CMF, + left.location.register,right.location.register), + cgsize2fpuoppostfix[def_cgsize(resulttype.def)])) + else + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE, + left.location.register,right.location.register), + cgsize2fpuoppostfix[def_cgsize(resulttype.def)])); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(false); + end; + + + procedure tarmaddnode.second_cmpsmallset; + var + tmpreg : tregister; + begin + pass_left_right; + + location_reset(location,LOC_FLAGS,OS_NO); + + force_reg_left_right(false,false); + + case nodetype of + equaln: + begin + exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register)); + location.resflags:=F_EQ; + end; + unequaln: + begin + exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register)); + location.resflags:=F_NE; + end; + lten, + gten: + begin + if (not(nf_swaped in flags) and + (nodetype = lten)) or + ((nf_swaped in flags) and + (nodetype = gten)) then + swapleftright; + tmpreg:=cg.getintregister(exprasmlist,location.size); + exprasmlist.concat(taicpu.op_reg_reg_reg(A_AND,tmpreg,left.location.register,right.location.register)); + exprasmlist.concat(taicpu.op_reg_reg(A_CMP,tmpreg,right.location.register)); + location.resflags:=F_EQ; + end; + else + internalerror(2004012401); + end; + end; + + + procedure tarmaddnode.second_cmp64bit; + var + unsigned : boolean; + tmpreg : tregister; + oldnodetype : tnodetype; + begin + pass_left_right; + force_reg_left_right(false,false); + + unsigned:=not(is_signed(left.resulttype.def)) or + not(is_signed(right.resulttype.def)); + + { operation requiring proper N, Z and C flags ? } + if unsigned or (nodetype in [equaln,unequaln]) then + begin + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(unsigned); + exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi)); + exprasmlist.concat(setcondition(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo),C_EQ)); + end + else + { operation requiring proper N, Z and V flags ? } + begin + location_reset(location,LOC_JUMP,OS_NO); + exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi)); + { the jump the sequence is a little bit hairy } + case nodetype of + ltn,gtn: + begin + cg.a_jmp_flags(exprasmlist,getresflags(false),truelabel); + { cheat a little bit for the negative test } + toggleflag(nf_swaped); + cg.a_jmp_flags(exprasmlist,getresflags(false),falselabel); + toggleflag(nf_swaped); + end; + lten,gten: + begin + oldnodetype:=nodetype; + if nodetype=lten then + nodetype:=ltn + else + nodetype:=gtn; + cg.a_jmp_flags(exprasmlist,getresflags(unsigned),truelabel); + { cheat for the negative test } + if nodetype=ltn then + nodetype:=gtn + else + nodetype:=ltn; + cg.a_jmp_flags(exprasmlist,getresflags(unsigned),falselabel); + nodetype:=oldnodetype; + end; + end; + exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo)); + { the comparisaion of the low dword have to be + always unsigned! } + cg.a_jmp_flags(exprasmlist,getresflags(true),truelabel); + cg.a_jmp_always(exprasmlist,falselabel); + end; + end; + + + procedure tarmaddnode.second_cmpordinal; + var + unsigned : boolean; + tmpreg : tregister; + b : byte; + begin + pass_left_right; + force_reg_left_right(true,true); + + unsigned:=not(is_signed(left.resulttype.def)) or + not(is_signed(right.resulttype.def)); + + if right.location.loc = LOC_CONSTANT then + begin + if is_shifter_const(right.location.value,b) then + exprasmlist.concat(taicpu.op_reg_const(A_CMP,left.location.register,right.location.value)) + else + begin + tmpreg:=cg.getintregister(exprasmlist,location.size); + cg.a_load_const_reg(exprasmlist,OS_INT, + right.location.value,tmpreg); + exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,tmpreg)); + end; + end + else + exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register)); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(unsigned); + end; + +begin + caddnode:=tarmaddnode; +end. diff --git a/compiler/arm/narmcal.pas b/compiler/arm/narmcal.pas new file mode 100644 index 0000000000..432403f8a1 --- /dev/null +++ b/compiler/arm/narmcal.pas @@ -0,0 +1,50 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Implements the ARM specific part of call nodes + + 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. + + **************************************************************************** +} +unit narmcal; + +{$i fpcdefs.inc} + +interface + + uses + symdef,node,ncal,ncgcal; + + type + tarmcallnode = class(tcgcallnode) + // procedure push_framepointer;override; + end; + +implementation + + uses + paramgr; + +(* + procedure tarmcallnode.push_framepointer; + begin + framepointer_paraloc:=paramanager.getintparaloc(procdefinition.proccalloption,1); + end; +*) + +begin + ccallnode:=tarmcallnode; +end. diff --git a/compiler/arm/narmcnv.pas b/compiler/arm/narmcnv.pas new file mode 100644 index 0000000000..6fb0fdc62e --- /dev/null +++ b/compiler/arm/narmcnv.pas @@ -0,0 +1,265 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate ARM assembler for type converting nodes + + 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 narmcnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncnv,ncgcnv,defcmp; + + type + tarmtypeconvnode = class(tcgtypeconvnode) + protected + function first_int_to_real: tnode;override; + { procedure second_int_to_int;override; } + { procedure second_string_to_string;override; } + { procedure second_cstring_to_pchar;override; } + { procedure second_string_to_chararray;override; } + { procedure second_array_to_pointer;override; } + // function first_int_to_real: tnode; override; + { procedure second_pointer_to_array;override; } + { procedure second_chararray_to_string;override; } + { procedure second_char_to_string;override; } + procedure second_int_to_real;override; + // procedure second_real_to_real;override; + { procedure second_cord_to_pointer;override; } + { procedure second_proc_to_procvar;override; } + { procedure second_bool_to_int;override; } + procedure second_int_to_bool;override; + { procedure second_load_smallset;override; } + { procedure second_ansistring_to_pchar;override; } + { procedure second_pchar_to_string;override; } + { procedure second_class_to_intf;override; } + { procedure second_char_to_char;override; } + end; + +implementation + + uses + verbose,globtype,globals,systems, + symconst,symdef,aasmbase,aasmtai, + defutil, + cgbase,cgutils, + pass_1,pass_2, + ncon,ncal, + ncgutil, + cpubase,aasmcpu, + rgobj,tgobj,cgobj,cgcpu; + + +{***************************************************************************** + FirstTypeConv +*****************************************************************************} + + function tarmtypeconvnode.first_int_to_real: tnode; + var + fname: string[19]; + begin + if cs_fp_emulation in aktmoduleswitches then + begin + if target_info.system in system_wince then + begin + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resulttype.def) or + is_currency(left.resulttype.def) then + begin + { hack to avoid double division by 10000, as it's + already done by resulttypepass.resulttype_int_to_real } + if is_currency(left.resulttype.def) then + left.resulttype := s64inttype; + if is_signed(left.resulttype.def) then + fname:='I64TOD' + else + fname:='UI64TOD'; + end + else + { other integers are supposed to be 32 bit } + begin + if is_signed(left.resulttype.def) then + fname:='ITOD' + else + fname:='UTOD'; + firstpass(left); + end; + result:=ccallnode.createintern(fname,ccallparanode.create( + left,nil)); + left:=nil; + firstpass(result); + exit; + end + else + begin + internalerror(2005082803); + end; + end + else + begin + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resulttype.def) or + is_currency(left.resulttype.def) then + begin + { hack to avoid double division by 10000, as it's + already done by resulttypepass.resulttype_int_to_real } + if is_currency(left.resulttype.def) then + left.resulttype := s64inttype; + if is_signed(left.resulttype.def) then + fname := 'fpc_int64_to_double' + else + fname := 'fpc_qword_to_double'; + result := ccallnode.createintern(fname,ccallparanode.create( + left,nil)); + left:=nil; + firstpass(result); + exit; + end + else + { other integers are supposed to be 32 bit } + begin + if is_signed(left.resulttype.def) then + inserttypeconv(left,s32inttype) + else + inserttypeconv(left,u32inttype); + firstpass(left); + end; + result := nil; + if registersfpu<1 then + registersfpu:=1; + expectloc:=LOC_FPUREGISTER; + end; + end; + + + procedure tarmtypeconvnode.second_int_to_real; + var + instr : taicpu; + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); + location_force_reg(exprasmlist,left.location,OS_32,true); + location.register:=cg.getfpuregister(exprasmlist,location.size); + instr:=taicpu.op_reg_reg(A_FLT,location.register,left.location.register); + instr.oppostfix:=cgsize2fpuoppostfix[def_cgsize(resulttype.def)]; + exprasmlist.concat(instr); + end; + + + procedure tarmtypeconvnode.second_int_to_bool; + var + hregister : tregister; + href : treference; + resflags : tresflags; + hlabel,oldtruelabel,oldfalselabel : tasmlabel; + begin + oldtruelabel:=truelabel; + oldfalselabel:=falselabel; + objectlibrary.getjumplabel(truelabel); + objectlibrary.getjumplabel(falselabel); + secondpass(left); + if codegenerror then + exit; + { byte(boolean) or word(wordbool) or longint(longbool) must + be accepted for var parameters } + if (nf_explicit in flags) and + (left.resulttype.def.size=resulttype.def.size) and + (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then + begin + location_copy(location,left.location); + truelabel:=oldtruelabel; + falselabel:=oldfalselabel; + exit; + end; + + { Load left node into flag F_NE/F_E } + resflags:=F_NE; + case left.location.loc of + LOC_CREFERENCE, + LOC_REFERENCE : + begin + if left.location.size in [OS_64,OS_S64] then + begin + hregister:=cg.getintregister(exprasmlist,OS_INT); + cg.a_load_ref_reg(exprasmlist,OS_32,OS_32,left.location.reference,hregister); + href:=left.location.reference; + inc(href.offset,4); + tcgarm(cg).cgsetflags:=true; + cg.a_op_ref_reg(exprasmlist,OP_OR,OS_32,href,hregister); + tcgarm(cg).cgsetflags:=false; + end + else + begin + location_force_reg(exprasmlist,left.location,left.location.size,true); + tcgarm(cg).cgsetflags:=true; + cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register); + tcgarm(cg).cgsetflags:=false; + end; + end; + LOC_FLAGS : + begin + resflags:=left.location.resflags; + end; + LOC_REGISTER,LOC_CREGISTER : + begin + if left.location.size in [OS_64,OS_S64] then + begin + hregister:=cg.getintregister(exprasmlist,OS_32); + cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,left.location.register64.reglo,hregister); + tcgarm(cg).cgsetflags:=true; + cg.a_op_reg_reg(exprasmlist,OP_OR,OS_32,left.location.register64.reghi,hregister); + tcgarm(cg).cgsetflags:=false; + end + else + begin + tcgarm(cg).cgsetflags:=true; + cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register); + tcgarm(cg).cgsetflags:=false; + end; + end; + LOC_JUMP : + begin + hregister:=cg.getintregister(exprasmlist,OS_INT); + objectlibrary.getjumplabel(hlabel); + cg.a_label(exprasmlist,truelabel); + cg.a_load_const_reg(exprasmlist,OS_INT,1,hregister); + cg.a_jmp_always(exprasmlist,hlabel); + cg.a_label(exprasmlist,falselabel); + cg.a_load_const_reg(exprasmlist,OS_INT,0,hregister); + cg.a_label(exprasmlist,hlabel); + tcgarm(cg).cgsetflags:=true; + cg.a_op_reg_reg(exprasmlist,OP_OR,OS_INT,hregister,hregister); + tcgarm(cg).cgsetflags:=false; + end; + else + internalerror(200311301); + end; + { load flags to register } + location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def)); + location.register:=cg.getintregister(exprasmlist,location.size); + cg.g_flags2reg(exprasmlist,location.size,resflags,location.register); + truelabel:=oldtruelabel; + falselabel:=oldfalselabel; + end; + + +begin + ctypeconvnode:=tarmtypeconvnode; +end. diff --git a/compiler/arm/narmcon.pas b/compiler/arm/narmcon.pas new file mode 100644 index 0000000000..b37b240b4b --- /dev/null +++ b/compiler/arm/narmcon.pas @@ -0,0 +1,141 @@ +{ + Copyright (c) 2005 by Florian Klaempfl + + Code generation for const nodes on the ARM + + 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 narmcon; + +{$i fpcdefs.inc} + +interface + + uses + node,ncgcon,cpubase; + + type + tarmrealconstnode = class(tcgrealconstnode) + procedure pass_2;override; + end; + + implementation + + uses + verbose, + globtype,globals, + cpuinfo, + aasmbase,aasmtai, + symconst,symdef, + defutil, + cgbase,cgutils, + procinfo, + ncon; + +{***************************************************************************** + TARMREALCONSTNODE +*****************************************************************************} + + procedure tarmrealconstnode.pass_2; + { I suppose the parser/pass_1 must make sure the generated real } + { constants are actually supported by the target processor? (JM) } + const + floattype2ait:array[tfloattype] of taitype= + (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit); + var + hp1 : tai; + lastlabel : tasmlabel; + realait : taitype; + hiloswapped : boolean; + + begin + location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def)); + lastlabel:=nil; + realait:=floattype2ait[tfloatdef(resulttype.def).typ]; + hiloswapped:=aktfputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]; + { const already used ? } + if not assigned(lab_real) then + begin + objectlibrary.getjumplabel(lastlabel); + lab_real:=lastlabel; + current_procinfo.aktlocaldata.concat(Tai_label.Create(lastlabel)); + location.reference.symboldata:=current_procinfo.aktlocaldata.last; + case realait of + ait_real_32bit : + begin + current_procinfo.aktlocaldata.concat(Tai_real_32bit.Create(ts32real(value_real))); + { range checking? } + if ((cs_check_range in aktlocalswitches) or + (cs_check_overflow in aktlocalswitches)) and + (tai_real_32bit(asmlist[al_typedconsts].last).value=double(MathInf)) then + Message(parser_e_range_check_error); + end; + + ait_real_64bit : + begin + if hiloswapped then + current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real))) + else + current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create(ts64real(value_real))); + + { range checking? } + if ((cs_check_range in aktlocalswitches) or + (cs_check_overflow in aktlocalswitches)) and + (tai_real_64bit(asmlist[al_typedconsts].last).value=double(MathInf)) then + Message(parser_e_range_check_error); + end; + + ait_real_80bit : + begin + current_procinfo.aktlocaldata.concat(Tai_real_80bit.Create(value_real)); + + { range checking? } + if ((cs_check_range in aktlocalswitches) or + (cs_check_overflow in aktlocalswitches)) and + (tai_real_80bit(asmlist[al_typedconsts].last).value=double(MathInf)) then + Message(parser_e_range_check_error); + end; +{$ifdef cpufloat128} + ait_real_128bit : + begin + current_procinfo.aktlocaldata.concat(Tai_real_128bit.Create(value_real)); + + { range checking? } + if ((cs_check_range in aktlocalswitches) or + (cs_check_overflow in aktlocalswitches)) and + (tai_real_128bit(asmlist[al_typedconsts].last).value=double(MathInf)) then + Message(parser_e_range_check_error); + end; +{$endif cpufloat128} + + { the round is necessary for native compilers where comp isn't a float } + ait_comp_64bit : + if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then + message(parser_e_range_check_error) + else + current_procinfo.aktlocaldata.concat(Tai_comp_64bit.Create(round(value_real))); + else + internalerror(2005092401); + end; + end; + location.reference.symbol:=lab_real; + location.reference.base:=NR_R15; + end; + +begin + crealconstnode:=tarmrealconstnode; +end. diff --git a/compiler/arm/narminl.pas b/compiler/arm/narminl.pas new file mode 100644 index 0000000000..ab9453c24c --- /dev/null +++ b/compiler/arm/narminl.pas @@ -0,0 +1,216 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generates ARM inline nodes + + 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 narminl; + +{$i fpcdefs.inc} + +interface + + uses + node,ninl,ncginl; + + type + tarminlinenode = class(tcgInlineNode) + function first_abs_real: tnode; override; + function first_sqr_real: tnode; override; + function first_sqrt_real: tnode; override; + { atn,sin,cos,lgn isn't supported by the linux fpe + function first_arctan_real: tnode; override; + function first_ln_real: tnode; override; + function first_cos_real: tnode; override; + function first_sin_real: tnode; override; + } + procedure second_abs_real; override; + procedure second_sqr_real; override; + procedure second_sqrt_real; override; + { atn,sin,cos,lgn isn't supported by the linux fpe + procedure second_arctan_real; override; + procedure second_ln_real; override; + procedure second_cos_real; override; + procedure second_sin_real; override; + } + private + procedure load_fpu_location; + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals,fmodule, + symconst,symdef, + aasmbase,aasmtai,aasmcpu, + cgbase,cgutils, + pass_1,pass_2, + cpubase,paramgr, + nbas,ncon,ncal,ncnv,nld, + tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu,cgcpu; + +{***************************************************************************** + tarminlinenode +*****************************************************************************} + + procedure tarminlinenode.load_fpu_location; + begin + secondpass(left); + location_force_fpureg(exprasmlist,left.location,true); + location_copy(location,left.location); + if left.location.loc=LOC_CFPUREGISTER then + begin + location.register:=cg.getfpuregister(exprasmlist,location.size); + location.loc := LOC_FPUREGISTER; + end; + end; + + + function tarminlinenode.first_abs_real : tnode; + begin + if cs_fp_emulation in aktmoduleswitches then + result:=inherited first_abs_real + else + begin + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + first_abs_real:=nil; + end; + end; + + + function tarminlinenode.first_sqr_real : tnode; + begin + if cs_fp_emulation in aktmoduleswitches then + result:=inherited first_sqr_real + else + begin + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + first_sqr_real:=nil; + end; + end; + + + function tarminlinenode.first_sqrt_real : tnode; + begin + if cs_fp_emulation in aktmoduleswitches then + result:=inherited first_sqrt_real + else + begin + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + first_sqrt_real := nil; + end; + end; + + + { atn,sin,cos,lgn isn't supported by the linux fpe + function tarminlinenode.first_arctan_real: tnode; + begin + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + result:=nil; + end; + + + function tarminlinenode.first_ln_real: tnode; + begin + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + result:=nil; + end; + + function tarminlinenode.first_cos_real: tnode; + begin + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + result:=nil; + end; + + + function tarminlinenode.first_sin_real: tnode; + begin + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + result:=nil; + end; + } + + + procedure tarminlinenode.second_abs_real; + begin + load_fpu_location; + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_ABS,location.register,location.register),get_fpu_postfix(resulttype.def))); + end; + + + procedure tarminlinenode.second_sqr_real; + begin + load_fpu_location; + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg_reg(A_MUF,location.register,left.location.register,left.location.register),get_fpu_postfix(resulttype.def))); + end; + + + procedure tarminlinenode.second_sqrt_real; + begin + load_fpu_location; + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_SQT,location.register,location.register),get_fpu_postfix(resulttype.def))); + end; + + + { atn, sin, cos, lgn isn't supported by the linux fpe + procedure tarminlinenode.second_arctan_real; + begin + load_fpu_location; + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_ATN,location.register,location.register),get_fpu_postfix(resulttype.def))); + end; + + + procedure tarminlinenode.second_ln_real; + begin + load_fpu_location; + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_LGN,location.register,location.register),get_fpu_postfix(resulttype.def))); + end; + + procedure tarminlinenode.second_cos_real; + begin + load_fpu_location; + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_COS,location.register,location.register),get_fpu_postfix(resulttype.def))); + end; + + + procedure tarminlinenode.second_sin_real; + begin + load_fpu_location; + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_SIN,location.register,location.register),get_fpu_postfix(resulttype.def))); + end; + } + +begin + cinlinenode:=tarminlinenode; +end. diff --git a/compiler/arm/narmmat.pas b/compiler/arm/narmmat.pas new file mode 100644 index 0000000000..884ff77a28 --- /dev/null +++ b/compiler/arm/narmmat.pas @@ -0,0 +1,121 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate ARM assembler for math nodes + + 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 narmmat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat,ncgmat; + + type + tarmnotnode = class(tcgnotnode) + procedure second_boolean;override; + end; + + + tarmunaryminusnode = class(tcgunaryminusnode) + procedure second_float;override; + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef, + aasmbase,aasmcpu,aasmtai, + defutil, + cgbase,cgobj,cgutils, + pass_1,pass_2, + ncon, + cpubase,cpuinfo, + ncgutil,cgcpu,cg64f32,rgobj; + +{***************************************************************************** + TARMNOTNODE +*****************************************************************************} + + procedure tarmnotnode.second_boolean; + var + hl : tasmlabel; + ins : taicpu; + begin + { if the location is LOC_JUMP, we do the secondpass after the + labels are allocated + } + if left.expectloc=LOC_JUMP then + begin + hl:=truelabel; + truelabel:=falselabel; + falselabel:=hl; + secondpass(left); + maketojumpbool(exprasmlist,left,lr_load_regvars); + hl:=truelabel; + truelabel:=falselabel; + falselabel:=hl; + location.loc:=LOC_JUMP; + end + else + begin + secondpass(left); + case left.location.loc of + LOC_FLAGS : + begin + location_copy(location,left.location); + inverse_flags(location.resflags); + end; + LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE : + begin + location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),true); + exprasmlist.concat(taicpu.op_reg_const(A_CMP,left.location.register,0)); + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=F_EQ; + end; + else + internalerror(2003042401); + end; + end; + end; + +{***************************************************************************** + TARMUNARYMINUSNODE +*****************************************************************************} + + procedure tarmunaryminusnode.second_float; + begin + secondpass(left); + location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); + location_force_fpureg(exprasmlist,left.location,false); + location:=left.location; + exprasmlist.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSF, + location.register,left.location.register,0), + cgsize2fpuoppostfix[def_cgsize(resulttype.def)])); + end; + + +begin + cnotnode:=tarmnotnode; + cunaryminusnode:=tarmunaryminusnode; +end. diff --git a/compiler/arm/raarm.pas b/compiler/arm/raarm.pas new file mode 100644 index 0000000000..0b22d8a41e --- /dev/null +++ b/compiler/arm/raarm.pas @@ -0,0 +1,54 @@ +{ + Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman + + Handles the common arm assembler reader routines + + 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 raarm; + +{$i fpcdefs.inc} + + interface + + uses + cpubase, + aasmtai, + rautils; + + type + TARMOperand=class(TOperand) + end; + + TARMInstruction=class(TInstruction) + oppostfix : toppostfix; + function ConcatInstruction(p:TAAsmoutput) : tai;override; + end; + + implementation + + uses + aasmcpu; + + function TARMInstruction.ConcatInstruction(p:TAAsmoutput) : tai; + begin + result:=inherited ConcatInstruction(p); + (result as taicpu).oppostfix:=oppostfix; + end; + + +end. diff --git a/compiler/arm/raarmgas.pas b/compiler/arm/raarmgas.pas new file mode 100644 index 0000000000..f1ceb6d00c --- /dev/null +++ b/compiler/arm/raarmgas.pas @@ -0,0 +1,797 @@ +{ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing for the ARM GNU AS styled inline assembler. + + 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 raarmgas; + +{$i fpcdefs.inc} + + Interface + + uses + raatt,raarm, + cpubase; + + type + tarmattreader = class(tattreader) + actoppostfix : TOpPostfix; + function is_asmopcode(const s: string):boolean;override; + function is_register(const s:string):boolean;override; + procedure handleopcode;override; + procedure BuildReference(oper : tarmoperand); + procedure BuildOperand(oper : tarmoperand); + function TryBuildShifterOp(oper : tarmoperand) : boolean; + procedure BuildOpCode(instr : tarminstruction); + procedure ReadSym(oper : tarmoperand); + procedure ConvertCalljmp(instr : tarminstruction); + end; + + + Implementation + + uses + { helpers } + cutils, + { global } + globtype,globals,verbose, + systems, + { aasm } + cpuinfo,aasmbase,aasmtai,aasmcpu, + { symtable } + symconst,symbase,symtype,symsym,symtable, + { parser } + scanner, + procinfo, + itcpugas, + rabase,rautils, + cgbase,cgobj + ; + + + function tarmattreader.is_register(const s:string):boolean; + type + treg2str = record + name : string[2]; + reg : tregister; + end; + + const + extraregs : array[0..19] of treg2str = ( + (name: 'A1'; reg : NR_R0), + (name: 'A2'; reg : NR_R1), + (name: 'A3'; reg : NR_R2), + (name: 'A4'; reg : NR_R3), + (name: 'V1'; reg : NR_R4), + (name: 'V2'; reg : NR_R5), + (name: 'V3'; reg : NR_R6), + (name: 'V4'; reg : NR_R7), + (name: 'V5'; reg : NR_R8), + (name: 'V6'; reg : NR_R9), + (name: 'V7'; reg : NR_R10), + (name: 'V8'; reg : NR_R11), + (name: 'WR'; reg : NR_R7), + (name: 'SB'; reg : NR_R9), + (name: 'SL'; reg : NR_R10), + (name: 'FP'; reg : NR_R11), + (name: 'IP'; reg : NR_R12), + (name: 'SP'; reg : NR_R13), + (name: 'LR'; reg : NR_R14), + (name: 'PC'; reg : NR_R15)); + + var + i : longint; + + begin + result:=inherited is_register(s); + { reg found? + possible aliases are always 2 char + } + if result or (length(s)<>2) then + exit; + for i:=low(extraregs) to high(extraregs) do + begin + if s=extraregs[i].name then + begin + actasmregister:=extraregs[i].reg; + result:=true; + actasmtoken:=AS_REGISTER; + exit; + end; + end; + end; + + + procedure tarmattreader.ReadSym(oper : tarmoperand); + var + tempstr : string; + typesize,l,k : longint; + begin + tempstr:=actasmpattern; + Consume(AS_ID); + { typecasting? } + if (actasmtoken=AS_LPAREN) and + SearchType(tempstr,typesize) then + begin + oper.hastype:=true; + Consume(AS_LPAREN); + BuildOperand(oper); + Consume(AS_RPAREN); + if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then + oper.SetSize(typesize,true); + end + else + if not oper.SetupVar(tempstr,false) then + Message1(sym_e_unknown_id,tempstr); + { record.field ? } + if actasmtoken=AS_DOT then + begin + BuildRecordOffsetSize(tempstr,l,k); + inc(oper.opr.ref.offset,l); + end; + end; + + + Procedure tarmattreader.BuildReference(oper : tarmoperand); + + procedure Consume_RBracket; + begin + if actasmtoken<>AS_RBRACKET then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end + else + begin + Consume(AS_RBRACKET); + if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end; + end; + end; + + + procedure read_index; + begin + Consume(AS_COMMA); + if actasmtoken=AS_REGISTER then + Begin + oper.opr.ref.index:=actasmregister; + Consume(AS_REGISTER); + end + else if actasmtoken=AS_HASH then + begin + Consume(AS_HASH); + inc(oper.opr.ref.offset,BuildConstExpression(false,true)); + end; + end; + + + begin + Consume(AS_LBRACKET); + if actasmtoken=AS_REGISTER then + begin + oper.opr.ref.base:=actasmregister; + Consume(AS_REGISTER); + { can either be a register or a right parenthesis } + { (reg) } + if actasmtoken=AS_RBRACKET then + Begin + Consume_RBracket; + oper.opr.ref.addressmode:=AM_POSTINDEXED; + if actasmtoken=AS_COMMA then + read_index; + exit; + end; + if actasmtoken=AS_COMMA then + begin + read_index; + Consume_RBracket; + end; + if actasmtoken=AS_NOT then + begin + consume(AS_NOT); + oper.opr.ref.addressmode:=AM_PREINDEXED; + end; + end {end case } + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; + + + function tarmattreader.TryBuildShifterOp(oper : tarmoperand) : boolean; + + procedure handlepara(sm : tshiftmode); + begin + consume(AS_ID); + fillchar(oper.opr,sizeof(oper.opr),0); + oper.opr.typ:=OPR_SHIFTEROP; + oper.opr.shifterop.shiftmode:=sm; + if sm<>SM_RRX then + begin + case actasmtoken of + AS_REGISTER: + begin + oper.opr.shifterop.rs:=actasmregister; + consume(AS_REGISTER); + end; + AS_HASH: + begin + consume(AS_HASH); + oper.opr.shifterop.shiftimm:=BuildConstExpression(false,false); + end; + else + Message(asmr_e_illegal_shifterop_syntax); + end; + end; + end; + + begin + result:=true; + if (actasmtoken=AS_ID) then + begin + if (actasmpattern='LSL') then + handlepara(SM_LSL) + else if (actasmpattern='LSR') then + handlepara(SM_LSR) + else if (actasmpattern='ASR') then + handlepara(SM_ASR) + else if (actasmpattern='ROR') then + handlepara(SM_ROR) + else if (actasmpattern='RRX') then + handlepara(SM_ROR) + else + result:=false; + end + else + result:=false; + end; + + + Procedure tarmattreader.BuildOperand(oper : tarmoperand); + var + expr : string; + typesize,l : longint; + + + procedure AddLabelOperand(hl:tasmlabel); + begin + if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and + is_calljmp(actopcode) then + begin + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symbol:=hl; + end + else + begin + oper.InitRef; + oper.opr.ref.symbol:=hl; + end; + end; + + + procedure MaybeRecordOffset; + var + hasdot : boolean; + l, + toffset, + tsize : longint; + begin + if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then + exit; + l:=0; + hasdot:=(actasmtoken=AS_DOT); + if hasdot then + begin + if expr<>'' then + begin + BuildRecordOffsetSize(expr,toffset,tsize); + inc(l,toffset); + oper.SetSize(tsize,true); + end; + end; + if actasmtoken in [AS_PLUS,AS_MINUS] then + inc(l,BuildConstExpression(true,false)); + case oper.opr.typ of + OPR_LOCAL : + begin + { don't allow direct access to fields of parameters, because that + will generate buggy code. Allow it only for explicit typecasting } + if hasdot and + (not oper.hastype) and + (tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and + (current_procinfo.procdef.proccalloption<>pocall_register) then + Message(asmr_e_cannot_access_field_directly_for_parameters); + inc(oper.opr.localsymofs,l) + end; + OPR_CONSTANT : + inc(oper.opr.val,l); + OPR_REFERENCE : + inc(oper.opr.ref.offset,l); + else + internalerror(200309221); + end; + end; + + + function MaybeBuildReference:boolean; + { Try to create a reference, if not a reference is found then false + is returned } + begin + MaybeBuildReference:=true; + case actasmtoken of + AS_INTNUM, + AS_MINUS, + AS_PLUS: + Begin + oper.opr.ref.offset:=BuildConstExpression(True,False); + if actasmtoken<>AS_LPAREN then + Message(asmr_e_invalid_reference_syntax) + else + BuildReference(oper); + end; + AS_LPAREN: + BuildReference(oper); + AS_ID: { only a variable is allowed ... } + Begin + ReadSym(oper); + case actasmtoken of + AS_END, + AS_SEPARATOR, + AS_COMMA: ; + AS_LPAREN: + BuildReference(oper); + else + Begin + Message(asmr_e_invalid_reference_syntax); + Consume(actasmtoken); + end; + end; {end case } + end; + else + MaybeBuildReference:=false; + end; { end case } + end; + + + var + tempreg : tregister; + ireg : tsuperregister; + hl : tasmlabel; + ofs : longint; + registerset : tcpuregisterset; + Begin + expr:=''; + case actasmtoken of + AS_LBRACKET: { Memory reference or constant expression } + Begin + oper.InitRef; + BuildReference(oper); + end; + + AS_HASH: { Constant expression } + Begin + Consume(AS_HASH); + BuildConstantOperand(oper); + end; + + (* + AS_INTNUM, + AS_MINUS, + AS_PLUS: + Begin + { Constant memory offset } + { This must absolutely be followed by ( } + oper.InitRef; + oper.opr.ref.offset:=BuildConstExpression(True,False); + if actasmtoken<>AS_LPAREN then + begin + ofs:=oper.opr.ref.offset; + BuildConstantOperand(oper); + inc(oper.opr.val,ofs); + end + else + BuildReference(oper); + end; + *) + AS_ID: { A constant expression, or a Variable ref. } + Begin + { Local Label ? } + if is_locallabel(actasmpattern) then + begin + CreateLocalLabel(actasmpattern,hl,false); + Consume(AS_ID); + AddLabelOperand(hl); + end + else + { Check for label } + if SearchLabel(actasmpattern,hl,false) then + begin + Consume(AS_ID); + AddLabelOperand(hl); + end + else + { probably a variable or normal expression } + { or a procedure (such as in CALL ID) } + Begin + { is it a constant ? } + if SearchIConstant(actasmpattern,l) then + Begin + if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then + Message(asmr_e_invalid_operand_type); + BuildConstantOperand(oper); + end + else + begin + expr:=actasmpattern; + Consume(AS_ID); + { typecasting? } + if (actasmtoken=AS_LPAREN) and + SearchType(expr,typesize) then + begin + oper.hastype:=true; + Consume(AS_LPAREN); + BuildOperand(oper); + Consume(AS_RPAREN); + if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then + oper.SetSize(typesize,true); + end + else + begin + if not(oper.SetupVar(expr,false)) then + Begin + { look for special symbols ... } + if expr= '__HIGH' then + begin + consume(AS_LPAREN); + if not oper.setupvar('high'+actasmpattern,false) then + Message1(sym_e_unknown_id,'high'+actasmpattern); + consume(AS_ID); + consume(AS_RPAREN); + end + else + if expr = '__RESULT' then + oper.SetUpResult + else + if expr = '__SELF' then + oper.SetupSelf + else + if expr = '__OLDEBP' then + oper.SetupOldEBP + else + Message1(sym_e_unknown_id,expr); + end; + end; + end; + if actasmtoken=AS_DOT then + MaybeRecordOffset; + { add a constant expression? } + if (actasmtoken=AS_PLUS) then + begin + l:=BuildConstExpression(true,false); + case oper.opr.typ of + OPR_CONSTANT : + inc(oper.opr.val,l); + OPR_LOCAL : + inc(oper.opr.localsymofs,l); + OPR_REFERENCE : + inc(oper.opr.ref.offset,l); + else + internalerror(200309202); + end; + end + end; + { Do we have a indexing reference, then parse it also } + if actasmtoken=AS_LPAREN then + BuildReference(oper); + end; + + { Register, a variable reference or a constant reference } + AS_REGISTER: + Begin + { save the type of register used. } + tempreg:=actasmregister; + Consume(AS_REGISTER); + if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then + Begin + if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then + Message(asmr_e_invalid_operand_type); + oper.opr.typ:=OPR_REGISTER; + oper.opr.reg:=tempreg; + end + else if (actasmtoken=AS_NOT) and (actopcode in [A_LDM,A_STM]) then + begin + consume(AS_NOT); + oper.opr.typ:=OPR_REFERENCE; + oper.opr.ref.addressmode:=AM_PREINDEXED; + oper.opr.ref.index:=tempreg; + end + else + Message(asmr_e_syn_operand); + end; + + { Registerset } + AS_LSBRACKET: + begin + consume(AS_LSBRACKET); + registerset:=[]; + while true do + begin + if actasmtoken=AS_REGISTER then + begin + include(registerset,getsupreg(actasmregister)); + tempreg:=actasmregister; + consume(AS_REGISTER); + if actasmtoken=AS_MINUS then + begin + consume(AS_MINUS); + for ireg:=getsupreg(tempreg) to getsupreg(actasmregister) do + include(registerset,ireg); + consume(AS_REGISTER); + end; + end + else + consume(AS_REGISTER); + if actasmtoken=AS_COMMA then + consume(AS_COMMA) + else + break; + end; + consume(AS_RSBRACKET); + oper.opr.typ:=OPR_REGSET; + oper.opr.regset:=registerset; + end; + AS_END, + AS_SEPARATOR, + AS_COMMA: ; + else + Begin + Message(asmr_e_syn_operand); + Consume(actasmtoken); + end; + end; { end case } + end; + + +{***************************************************************************** + tarmattreader +*****************************************************************************} + + procedure tarmattreader.BuildOpCode(instr : tarminstruction); + var + operandnum : longint; + Begin + { opcode } + if (actasmtoken<>AS_OPCODE) then + Begin + Message(asmr_e_invalid_or_missing_opcode); + RecoverConsume(true); + exit; + end; + { Fill the instr object with the current state } + with instr do + begin + Opcode:=ActOpcode; + condition:=ActCondition; + oppostfix:=actoppostfix; + end; + + { We are reading operands, so opcode will be an AS_ID } + operandnum:=1; + Consume(AS_OPCODE); + { Zero operand opcode ? } + if actasmtoken in [AS_SEPARATOR,AS_END] then + begin + operandnum:=0; + exit; + end; + { Read the operands } + repeat + case actasmtoken of + AS_COMMA: { Operand delimiter } + Begin + if ((instr.opcode=A_MOV) and (operandnum=2)) or + ((operandnum=3) and not(instr.opcode in [A_UMLAL,A_UMULL,A_SMLAL,A_SMULL])) then + begin + Consume(AS_COMMA); + if not(TryBuildShifterOp(instr.Operands[4] as tarmoperand)) then + Message(asmr_e_illegal_shifterop_syntax); + Inc(operandnum); + end + else + begin + if operandnum>Max_Operands then + Message(asmr_e_too_many_operands) + else + Inc(operandnum); + Consume(AS_COMMA); + end; + end; + AS_SEPARATOR, + AS_END : { End of asm operands for this opcode } + begin + break; + end; + else + BuildOperand(instr.Operands[operandnum] as tarmoperand); + end; { end case } + until false; + instr.Ops:=operandnum; + end; + + + function tarmattreader.is_asmopcode(const s: string):boolean; + + const + { sorted by length so longer postfixes will match first } + postfix2strsorted : array[1..19] of string[2] = ( + 'EP','SB','BT','SH', + 'IA','IB','DA','DB','FD','FA','ED','EA', + 'B','D','E','P','T','H','S'); + + postfixsorted : array[1..19] of TOpPostfix = ( + PF_EP,PF_SB,PF_BT,PF_SH, + PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA, + PF_B,PF_D,PF_E,PF_P,PF_T,PF_H,PF_S); + + var + str2opentry: tstr2opentry; + len, + j, + sufidx : longint; + hs : string; + maxlen : longint; + icond : tasmcond; + Begin + { making s a value parameter would break other assembler readers } + hs:=s; + is_asmopcode:=false; + + { clear op code } + actopcode:=A_None; + + actcondition:=C_None; + + { first, handle B else BLS is read wrong } + if ((hs[1]='B') and (length(hs)=3)) then + begin + for icond:=low(tasmcond) to high(tasmcond) do + begin + if copy(hs,2,3)=uppercond2str[icond] then + begin + actopcode:=A_B; + actasmtoken:=AS_OPCODE; + actcondition:=icond; + is_asmopcode:=true; + exit; + end; + end; + end; + maxlen:=max(length(hs),5); + for j:=maxlen downto 1 do + begin + str2opentry:=tstr2opentry(iasmops.search(copy(hs,1,j))); + if assigned(str2opentry) then + begin + actopcode:=str2opentry.op; + actasmtoken:=AS_OPCODE; + { strip op code } + delete(hs,1,j); + break; + end; + end; + if not(assigned(str2opentry)) then + exit; + { search for condition, conditions are always 2 chars } + if length(hs)>1 then + begin + for icond:=low(tasmcond) to high(tasmcond) do + begin + if copy(hs,1,2)=uppercond2str[icond] then + begin + actcondition:=icond; + { strip condition } + delete(hs,1,2); + break; + end; + end; + end; + { check for postfix } + if length(hs)>0 then + begin + for j:=low(postfixsorted) to high(postfixsorted) do + begin + if copy(hs,1,length(postfix2strsorted[j]))=postfix2strsorted[j] then + begin + actoppostfix:=postfixsorted[j]; + { strip postfix } + delete(hs,1,length(postfix2strsorted[j])); + break; + end; + end; + end; + { if we stripped all postfixes, it's a valid opcode } + is_asmopcode:=length(hs)=0; + end; + + + procedure tarmattreader.ConvertCalljmp(instr : tarminstruction); + var + newopr : toprrec; + begin + if instr.Operands[1].opr.typ=OPR_REFERENCE then + begin + newopr.typ:=OPR_SYMBOL; + newopr.symbol:=instr.Operands[1].opr.ref.symbol; + newopr.symofs:=instr.Operands[1].opr.ref.offset; + if (instr.Operands[1].opr.ref.base<>NR_NO) or + (instr.Operands[1].opr.ref.index<>NR_NO) then + Message(asmr_e_syn_operand); + instr.Operands[1].opr:=newopr; + end; + end; + + + procedure tarmattreader.handleopcode; + var + instr : tarminstruction; + begin + instr:=TarmInstruction.Create(TarmOperand); + BuildOpcode(instr); + if is_calljmp(instr.opcode) then + ConvertCalljmp(instr); + { + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + instr.CheckOperandSizes; + } + instr.ConcatInstruction(curlist); + instr.Free; + actoppostfix:=PF_None; + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +const + asmmode_arm_att_info : tasmmodeinfo = + ( + id : asmmode_arm_gas; + idtxt : 'GAS'; + casmreader : tarmattreader; + ); + + asmmode_arm_standard_info : tasmmodeinfo = + ( + id : asmmode_standard; + idtxt : 'STANDARD'; + casmreader : tarmattreader; + ); + +initialization + RegisterAsmMode(asmmode_arm_att_info); + RegisterAsmMode(asmmode_arm_standard_info); +end. diff --git a/compiler/arm/rarmcon.inc b/compiler/arm/rarmcon.inc new file mode 100644 index 0000000000..910b6297dc --- /dev/null +++ b/compiler/arm/rarmcon.inc @@ -0,0 +1,74 @@ +{ don't edit, this file is generated from armreg.dat } +NR_NO = tregister($00000000); +NR_R0 = tregister($01000000); +NR_R1 = tregister($01000001); +NR_R2 = tregister($01000002); +NR_R3 = tregister($01000003); +NR_R4 = tregister($01000004); +NR_R5 = tregister($01000005); +NR_R6 = tregister($01000006); +NR_R7 = tregister($01000007); +NR_R8 = tregister($01000008); +NR_R9 = tregister($01000009); +NR_R10 = tregister($0100000a); +NR_R11 = tregister($0100000b); +NR_R12 = tregister($0100000c); +NR_R13 = tregister($0100000d); +NR_R14 = tregister($0100000e); +NR_R15 = tregister($0100000f); +NR_F0 = tregister($02000000); +NR_F1 = tregister($02000001); +NR_F2 = tregister($02000002); +NR_F3 = tregister($02000003); +NR_F4 = tregister($02000004); +NR_F5 = tregister($02000005); +NR_F6 = tregister($02000006); +NR_F7 = tregister($02000007); +NR_S0 = tregister($03000000); +NR_S1 = tregister($03000000); +NR_D0 = tregister($03000000); +NR_S2 = tregister($03000000); +NR_S3 = tregister($03000000); +NR_D1 = tregister($03000000); +NR_S4 = tregister($03000000); +NR_S5 = tregister($03000000); +NR_D2 = tregister($03000000); +NR_S6 = tregister($03000000); +NR_S7 = tregister($03000000); +NR_D3 = tregister($03000000); +NR_S8 = tregister($03000000); +NR_S9 = tregister($03000000); +NR_D4 = tregister($03000000); +NR_S10 = tregister($03000000); +NR_S11 = tregister($03000000); +NR_D5 = tregister($03000000); +NR_S12 = tregister($03000000); +NR_S13 = tregister($03000000); +NR_D6 = tregister($03000000); +NR_S14 = tregister($03000000); +NR_S15 = tregister($03000000); +NR_D7 = tregister($03000000); +NR_S16 = tregister($03000000); +NR_S17 = tregister($03000000); +NR_D8 = tregister($03000000); +NR_S18 = tregister($03000000); +NR_S19 = tregister($03000000); +NR_D9 = tregister($03000000); +NR_S20 = tregister($03000000); +NR_S21 = tregister($03000000); +NR_D10 = tregister($03000000); +NR_S22 = tregister($03000000); +NR_S23 = tregister($03000000); +NR_D11 = tregister($03000000); +NR_S24 = tregister($03000000); +NR_S25 = tregister($03000000); +NR_D12 = tregister($03000000); +NR_S26 = tregister($03000000); +NR_S27 = tregister($03000000); +NR_D13 = tregister($03000000); +NR_S28 = tregister($03000000); +NR_S29 = tregister($03000000); +NR_D14 = tregister($03000000); +NR_S30 = tregister($03000000); +NR_S31 = tregister($03000000); +NR_D15 = tregister($03000000); diff --git a/compiler/arm/rarmdwa.inc b/compiler/arm/rarmdwa.inc new file mode 100644 index 0000000000..b963effed4 --- /dev/null +++ b/compiler/arm/rarmdwa.inc @@ -0,0 +1,74 @@ +{ don't edit, this file is generated from armreg.dat } +-1, +0, +1, +2, +3, +4, +5, +6, +7, +8, +9, +10, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +21, +22, +23, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0 diff --git a/compiler/arm/rarmnor.inc b/compiler/arm/rarmnor.inc new file mode 100644 index 0000000000..44c9e774d1 --- /dev/null +++ b/compiler/arm/rarmnor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from armreg.dat } +73 diff --git a/compiler/arm/rarmnum.inc b/compiler/arm/rarmnum.inc new file mode 100644 index 0000000000..78c00db232 --- /dev/null +++ b/compiler/arm/rarmnum.inc @@ -0,0 +1,74 @@ +{ don't edit, this file is generated from armreg.dat } +tregister($00000000), +tregister($01000000), +tregister($01000001), +tregister($01000002), +tregister($01000003), +tregister($01000004), +tregister($01000005), +tregister($01000006), +tregister($01000007), +tregister($01000008), +tregister($01000009), +tregister($0100000a), +tregister($0100000b), +tregister($0100000c), +tregister($0100000d), +tregister($0100000e), +tregister($0100000f), +tregister($02000000), +tregister($02000001), +tregister($02000002), +tregister($02000003), +tregister($02000004), +tregister($02000005), +tregister($02000006), +tregister($02000007), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000), +tregister($03000000) diff --git a/compiler/arm/rarmrni.inc b/compiler/arm/rarmrni.inc new file mode 100644 index 0000000000..f1de634d81 --- /dev/null +++ b/compiler/arm/rarmrni.inc @@ -0,0 +1,74 @@ +{ don't edit, this file is generated from armreg.dat } +0, +1, +2, +3, +4, +5, +6, +7, +8, +9, +10, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +31, +32, +33, +34, +35, +36, +37, +38, +39, +40, +41, +42, +43, +44, +45, +46, +47, +48, +49, +50, +51, +52, +53, +54, +55, +56, +57, +58, +59, +60, +61, +62, +63, +64, +65, +66, +67, +68, +69, +70, +71, +72 diff --git a/compiler/arm/rarmsri.inc b/compiler/arm/rarmsri.inc new file mode 100644 index 0000000000..8cbe04bfc1 --- /dev/null +++ b/compiler/arm/rarmsri.inc @@ -0,0 +1,74 @@ +{ don't edit, this file is generated from armreg.dat } +0, +27, +30, +57, +60, +63, +66, +69, +72, +33, +36, +39, +42, +45, +48, +51, +54, +17, +18, +19, +20, +21, +22, +23, +24, +1, +2, +11, +12, +13, +14, +15, +16, +3, +4, +5, +6, +7, +8, +9, +10, +25, +26, +40, +41, +43, +44, +46, +47, +49, +50, +52, +53, +28, +55, +70, +71, +56, +58, +59, +61, +62, +64, +65, +67, +68, +29, +31, +32, +34, +35, +37, +38 diff --git a/compiler/arm/rarmsta.inc b/compiler/arm/rarmsta.inc new file mode 100644 index 0000000000..f72724eb6a --- /dev/null +++ b/compiler/arm/rarmsta.inc @@ -0,0 +1,74 @@ +{ don't edit, this file is generated from armreg.dat } +-1, +0, +1, +2, +3, +4, +5, +6, +7, +8, +9, +10, +11, +12, +13, +14, +15, +32, +32, +32, +32, +32, +32, +32, +32, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0 diff --git a/compiler/arm/rarmstd.inc b/compiler/arm/rarmstd.inc new file mode 100644 index 0000000000..cf1936e398 --- /dev/null +++ b/compiler/arm/rarmstd.inc @@ -0,0 +1,74 @@ +{ don't edit, this file is generated from armreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'f0', +'f1', +'f2', +'f3', +'f4', +'f5', +'f6', +'f7', +'s0', +'s1', +'d0', +'s2', +'s3', +'d1', +'s4', +'s5', +'d2', +'s6', +'s7', +'d3', +'s8', +'s9', +'d4', +'s10', +'s11', +'d5', +'s12', +'s13', +'d6', +'s14', +'s15', +'d7', +'s16', +'s17', +'d8', +'s18', +'s19', +'d9', +'s20', +'s21', +'d10', +'s22', +'s23', +'d11', +'s24', +'s25', +'d12', +'s26', +'s27', +'d13', +'s28', +'s29', +'d14', +'s20', +'s21', +'d15' diff --git a/compiler/arm/rarmsup.inc b/compiler/arm/rarmsup.inc new file mode 100644 index 0000000000..9a92340b41 --- /dev/null +++ b/compiler/arm/rarmsup.inc @@ -0,0 +1,74 @@ +{ don't edit, this file is generated from armreg.dat } +RS_NO = $00; +RS_R0 = $00; +RS_R1 = $01; +RS_R2 = $02; +RS_R3 = $03; +RS_R4 = $04; +RS_R5 = $05; +RS_R6 = $06; +RS_R7 = $07; +RS_R8 = $08; +RS_R9 = $09; +RS_R10 = $0a; +RS_R11 = $0b; +RS_R12 = $0c; +RS_R13 = $0d; +RS_R14 = $0e; +RS_R15 = $0f; +RS_F0 = $00; +RS_F1 = $01; +RS_F2 = $02; +RS_F3 = $03; +RS_F4 = $04; +RS_F5 = $05; +RS_F6 = $06; +RS_F7 = $07; +RS_S0 = $00; +RS_S1 = $00; +RS_D0 = $00; +RS_S2 = $00; +RS_S3 = $00; +RS_D1 = $00; +RS_S4 = $00; +RS_S5 = $00; +RS_D2 = $00; +RS_S6 = $00; +RS_S7 = $00; +RS_D3 = $00; +RS_S8 = $00; +RS_S9 = $00; +RS_D4 = $00; +RS_S10 = $00; +RS_S11 = $00; +RS_D5 = $00; +RS_S12 = $00; +RS_S13 = $00; +RS_D6 = $00; +RS_S14 = $00; +RS_S15 = $00; +RS_D7 = $00; +RS_S16 = $00; +RS_S17 = $00; +RS_D8 = $00; +RS_S18 = $00; +RS_S19 = $00; +RS_D9 = $00; +RS_S20 = $00; +RS_S21 = $00; +RS_D10 = $00; +RS_S22 = $00; +RS_S23 = $00; +RS_D11 = $00; +RS_S24 = $00; +RS_S25 = $00; +RS_D12 = $00; +RS_S26 = $00; +RS_S27 = $00; +RS_D13 = $00; +RS_S28 = $00; +RS_S29 = $00; +RS_D14 = $00; +RS_S30 = $00; +RS_S31 = $00; +RS_D15 = $00; diff --git a/compiler/arm/rgcpu.pas b/compiler/arm/rgcpu.pas new file mode 100644 index 0000000000..a522a4f38c --- /dev/null +++ b/compiler/arm/rgcpu.pas @@ -0,0 +1,168 @@ +{ + Copyright (c) 1998-2003 by Florian Klaempfl + + This unit implements the arm specific class for the register + allocator + + 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 rgcpu; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,aasmtai,aasmcpu, + cgbase,cgutils, + cpubase, + rgobj; + + type + trgcpu = class(trgobj) + procedure do_spill_read(list:Taasmoutput;pos:tai;const spilltemp:treference;tempreg:tregister);override; + procedure do_spill_written(list:Taasmoutput;pos:tai;const spilltemp:treference;tempreg:tregister);override; + end; + + trgintcpu = class(trgcpu) + procedure add_cpu_interferences(p : tai);override; + end; + + implementation + + uses + verbose, cutils, + cgobj, + procinfo; + + + procedure trgcpu.do_spill_read(list:Taasmoutput;pos:tai;const spilltemp:treference;tempreg:tregister); + var + helpins: tai; + tmpref : treference; + helplist : taasmoutput; + l : tasmlabel; + hreg : tregister; + begin + if abs(spilltemp.offset)>4095 then + begin + helplist:=taasmoutput.create; + reference_reset(tmpref); + { create consts entry } + objectlibrary.getjumplabel(l); + cg.a_label(current_procinfo.aktlocaldata,l); + tmpref.symboldata:=current_procinfo.aktlocaldata.last; + + current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(spilltemp.offset)); + + { load consts entry } + if getregtype(tempreg)=R_INTREGISTER then + hreg:=getregisterinline(helplist,R_SUBWHOLE) + else + hreg:=cg.getintregister(helplist,OS_ADDR); + + tmpref.symbol:=l; + tmpref.base:=NR_R15; + helplist.concat(taicpu.op_reg_ref(A_LDR,hreg,tmpref)); + + reference_reset_base(tmpref,hreg,0); + + if spilltemp.index<>NR_NO then + internalerror(200401263); + + helpins:=spilling_create_load(tmpref,tempreg); + helplist.concat(helpins); + if pos=nil then + list.insertlistafter(list.first,helplist) + else + list.insertlistafter(pos.next,helplist); + + helplist.free; + end + else + inherited do_spill_read(list,pos,spilltemp,tempreg); + end; + + + procedure trgcpu.do_spill_written(list:Taasmoutput;pos:tai;const spilltemp:treference;tempreg:tregister); + var + helpins: tai; + tmpref : treference; + helplist : taasmoutput; + l : tasmlabel; + hreg : tregister; + begin + if abs(spilltemp.offset)>4095 then + begin + helplist:=taasmoutput.create; + reference_reset(tmpref); + { create consts entry } + objectlibrary.getjumplabel(l); + cg.a_label(current_procinfo.aktlocaldata,l); + tmpref.symboldata:=current_procinfo.aktlocaldata.last; + + current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(spilltemp.offset)); + + { load consts entry } + if getregtype(tempreg)=R_INTREGISTER then + hreg:=getregisterinline(helplist,R_SUBWHOLE) + else + hreg:=cg.getintregister(helplist,OS_ADDR); + tmpref.symbol:=l; + tmpref.base:=NR_R15; + helplist.concat(taicpu.op_reg_ref(A_LDR,hreg,tmpref)); + + if spilltemp.index<>NR_NO then + internalerror(200401263); + + reference_reset_base(tmpref,hreg,0); + + helplist.concat(spilling_create_store(tempreg,tmpref)); + + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist) + end + else + inherited do_spill_written(list,pos,spilltemp,tempreg); + end; + + + procedure trgintcpu.add_cpu_interferences(p : tai); + begin + if p.typ=ait_instruction then + begin + case taicpu(p).opcode of + A_MUL: + add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg)); + A_UMULL, + A_UMLAL, + A_SMULL, + A_SMLAL: + begin + add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg)); + add_edge(getsupreg(taicpu(p).oper[1]^.reg),getsupreg(taicpu(p).oper[2]^.reg)); + add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[2]^.reg)); + end; + end; + end; + end; + + +end. |