diff --git a/compiler/sparc/aasmcpu.pas b/compiler/sparc/aasmcpu.pas new file mode 100644 index 0000000000..c6f86852b8 --- /dev/null +++ b/compiler/sparc/aasmcpu.pas @@ -0,0 +1,1195 @@ +{*****************************************************************************} +{ File : aasmcpu.pas } +{ Author : Mazen NEIFER } +{ Project : Free Pascal Compiler (FPC) } +{ Creation date : 2002\05\01 } +{ Last modification date : 2002\08\20 } +{ Licence : GPL } +{ Bug report : mazen.neifer.01@supaero.org } +{*****************************************************************************} +{ + $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl and Peter Vreman + + Contains the assembler object for the i386 + + * This code was inspired by the NASM sources + The Netwide Assembler is copyright (C) 1996 Simon Tatham and + Julian Hall. All rights reserved. + + 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; +{$INCLUDE fpcdefs.inc} +INTERFACE +USES + cclasses,globals,verbose, + cpuinfo,cpubase, + symppu, + aasmbase,aasmtai; +CONST + MaxPrefixes=4; +type + TOperandOrder = (op_intel,op_att); + + { alignment for operator } + tai_align = class(tai_align_abstract) + reg : tregister; + constructor create(b:byte); + constructor create_op(b: byte; _op: byte); + function getfillbuf:pchar;override; + end; + + taicpu = class(taicpu_abstract) + opsize : topsize; + constructor op_none(op : tasmop;_size : topsize); + + constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister); + constructor op_const(op : tasmop;_size : topsize;_op1 : aword); + constructor op_ref(op : tasmop;_size : topsize;const _op1 : treference); + + constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); + constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference); + constructor op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aword); + + constructor op_const_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister); + constructor op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aword); + constructor op_const_ref(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference); + + constructor op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister); + { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) } + constructor op_ref_ref(op : tasmop;_size : topsize;const _op1,_op2 : treference); + + constructor op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister); + constructor op_reg_const_reg(op:tasmop;_size:topsize;_op1:TRegister;_op2:aWord;_op3:tregister); + constructor op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference;_op3 : tregister); + constructor op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister; const _op3 : treference); + constructor op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;const _op3 : treference); + + { this is for Jmp instructions } + constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol); + + constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); + constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + + procedure changeopsize(siz:topsize); + + function GetString:string; + procedure CheckNonCommutativeOpcodes; + private + FOperandOrder : TOperandOrder; + procedure init(_size : topsize); { this need to be called by all constructor } +{$ifndef NOAG386BIN} + public + { the next will reset all instructions that can change in pass 2 } + procedure ResetPass1; + procedure ResetPass2; + function CheckIfValid:boolean; + function Pass1(offset:longint):longint;virtual; + procedure SetOperandOrder(order:TOperandOrder); + private + { next fields are filled in pass1, so pass2 is faster } + insentry : PInsEntry; + insoffset, + inssize : longint; + LastInsOffset : longint; { need to be public to be reset } + function InsEnd:longint; + procedure create_ot; + function Matches(p:PInsEntry):longint; + function calcsize(p:PInsEntry):longint; + function NeedAddrPrefix(opidx:byte):boolean; + procedure Swatoperands; +{$endif NOAG386BIN} + end; +PROCEDURE DoneAsm; +PROCEDURE InitAsm; +implementation + +uses + cutils, + CpuGas; +{**************************************************************************** + TAI_ALIGN + ****************************************************************************} + + constructor tai_align.create(b: byte); + begin + inherited create(b); + reg := R_NO; + end; + + + constructor tai_align.create_op(b: byte; _op: byte); + begin + inherited create_op(b,_op); + reg := R_NO; + end; + + + function tai_align.getfillbuf:pchar; + const + alignarray:array[0..5] of string[8]=( + #$8D#$B4#$26#$00#$00#$00#$00, + #$8D#$B6#$00#$00#$00#$00, + #$8D#$74#$26#$00, + #$8D#$76#$00, + #$89#$F6, + #$90 + ); + var + bufptr : pchar; + j : longint; + begin + if not use_op then + begin + bufptr:=@buf; + while (fillsize>0) do + begin + for j:=0 to 5 do + if (fillsize>=length(alignarray[j])) then + break; + move(alignarray[j][1],bufptr^,length(alignarray[j])); + inc(bufptr,length(alignarray[j])); + dec(fillsize,length(alignarray[j])); + end; + end; + getfillbuf:=pchar(@buf); + end; + + +{***************************************************************************** + Taicpu Constructors +*****************************************************************************} + + procedure taicpu.changeopsize(siz:topsize); + begin + opsize:=siz; + end; + + + procedure taicpu.init(_size : topsize); + begin + { default order is att } + FOperandOrder:=op_att; + {segprefix:=R_NO;}{This may be only for I386 architecture!} + opsize:=_size; +{$ifndef NOAG386BIN} + insentry:=nil; + LastInsOffset:=-1; + InsOffset:=0; + InsSize:=0; +{$endif} + end; + + + constructor taicpu.op_none(op : tasmop;_size : topsize); + begin + inherited create(op); + init(_size); + end; + + + constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister); + begin + inherited create(op); + init(_size); + ops:=1; + loadreg(0,_op1); + end; + + + constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : aword); + begin + inherited create(op); + init(_size); + ops:=1; + loadconst(0,_op1); + end; + + + constructor taicpu.op_ref(op : tasmop;_size : topsize;const _op1 : treference); + begin + inherited create(op); + init(_size); + ops:=1; + loadref(0,_op1); + end; + + + constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aword); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadconst(1,_op2); + end; + + + constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadref(1,_op2); + end; + + + constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadconst(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aword); + begin + inherited create(op); + init(_size); + ops:=2; + loadconst(0,_op1); + loadconst(1,_op2); + end; + + + constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadconst(0,_op1); + loadref(1,_op2); + end; + + + constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadref(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_ref_ref(op : tasmop;_size : topsize;const _op1,_op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadref(0,_op1); + loadref(1,_op2); + end; + + + constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister); + begin + inherited create(op); + init(_size); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadreg(2,_op3); + end; +CONSTRUCTOR taicpu.op_reg_const_reg(op:tasmop;_size:topsize;_op1:TRegister;_op2:aWord;_op3:TRegister); + BEGIN + INHERITED create(op); + init(_size); + ops:=3; + LoadReg(0,_op1); + LoadConst(1,_op2); + LoadReg(2,_op3); + END; + + constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;const _op3 : treference); + begin + inherited create(op); + init(_size); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadref(2,_op3); + end; + + + constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference;_op3 : tregister); + begin + inherited create(op); + init(_size); + ops:=3; + loadconst(0,_op1); + loadref(1,_op2); + loadreg(2,_op3); + end; + + + constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;const _op3 : treference); + begin + inherited create(op); + init(_size); + ops:=3; + loadconst(0,_op1); + loadreg(1,_op2); + loadref(2,_op3); + end; + + + constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol); + begin + inherited create(op); + init(_size); + condition:=cond; + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); + begin + inherited create(op); + init(_size); + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + begin + inherited create(op); + init(_size); + ops:=1; + loadsymbol(0,_op1,_op1ofs); + end; + + + constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadsymbol(0,_op1,_op1ofs); + loadreg(1,_op2); + end; + + + constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadsymbol(0,_op1,_op1ofs); + loadref(1,_op2); + end; + + function taicpu.GetString:string; + var + i : longint; + s : string; + addsize : boolean; + begin + s:='['+std_op2str[opcode]; + for i:=1to ops do + begin + if i=1 then + s:=s+' ' + else + s:=s+','; + { type } + addsize:=false; + if (oper[i-1].ot and OT_XMMREG)=OT_XMMREG then + s:=s+'xmmreg' + else + if (oper[i-1].ot and OT_MMXREG)=OT_MMXREG then + s:=s+'mmxreg' + else + if (oper[i-1].ot and OT_FPUREG)=OT_FPUREG then + s:=s+'fpureg' + else + if (oper[i-1].ot and OT_REGISTER)=OT_REGISTER then + begin + s:=s+'reg'; + addsize:=true; + end + else + if (oper[i-1].ot and OT_IMMEDIATE)=OT_IMMEDIATE then + begin + s:=s+'imm'; + addsize:=true; + end + else + if (oper[i-1].ot and OT_MEMORY)=OT_MEMORY then + begin + s:=s+'mem'; + addsize:=true; + end + else + s:=s+'???'; + { size } + if addsize then + begin + if (oper[i-1].ot and OT_BITS8)<>0 then + s:=s+'8' + else + if (oper[i-1].ot and OT_BITS16)<>0 then + s:=s+'16' + else + if (oper[i-1].ot and OT_BITS32)<>0 then + s:=s+'32' + else + s:=s+'??'; + { signed } + if (oper[i-1].ot and OT_SIGNED)<>0 then + s:=s+'s'; + end; + end; + GetString:=s+']'; + end; + + + procedure taicpu.Swatoperands; + var + p : TOper; + begin + { Fix the operands which are in AT&T style and we need them in Intel style } + case ops of + 2 : begin + { 0,1 -> 1,0 } + p:=oper[0]; + oper[0]:=oper[1]; + oper[1]:=p; + end; + 3 : begin + { 0,1,2 -> 2,1,0 } + p:=oper[0]; + oper[0]:=oper[2]; + oper[2]:=p; + end; + end; + end; + + + procedure taicpu.SetOperandOrder(order:TOperandOrder); + begin + if FOperandOrder<>order then + begin + Swatoperands; + FOperandOrder:=order; + end; + end; + + +{ This check must be done with the operand in ATT order + i.e.after swapping in the intel reader + but before swapping in the NASM and TASM writers PM } +procedure taicpu.CheckNonCommutativeOpcodes; +begin +{ if ((ops=2) and + (oper[0].typ=top_reg) and + (oper[1].typ=top_reg) and + (oper[0].reg IN [R_F0..RF31])) or + (ops=0) then + if opcode=A_FSUBR then + opcode:=A_FSUB + else if opcode=A_FSUB then + opcode:=A_FSUBR + else if opcode=A_FDIVR then + opcode:=A_FDIV + else if opcode=A_FDIV then + opcode:=A_FDIVR + else if opcode=A_FSUBRP then + opcode:=A_FSUBP + else if opcode=A_FSUBP then + opcode:=A_FSUBRP + else if opcode=A_FDIVRP then + opcode:=A_FDIVP + else if opcode=A_FDIVP then + opcode:=A_FDIVRP; + if ((ops=1) and + (oper[0].typ=top_reg) and + (oper[0].reg in [R_ST1..R_ST7])) then + if opcode=A_FSUBRP then + opcode:=A_FSUBP + else if opcode=A_FSUBP then + opcode:=A_FSUBRP + else if opcode=A_FDIVRP then + opcode:=A_FDIVP + else if opcode=A_FDIVP then + opcode:=A_FDIVRP;} +end; + + +{***************************************************************************** + Assembler +*****************************************************************************} + +{$ifndef NOAG386BIN} + +type + ea=packed record + sib_present : boolean; + bytes : byte; + size : byte; + modrm : byte; + sib : byte; + end; + +procedure taicpu.create_ot; +{ + this function will also fix some other fields which only needs to be once +} +var + i,l,relsize : longint; +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_reg : + {ot:=reg2type[reg]}; + top_ref : + begin + { create ot field } + if (ot and OT_SIZE_MASK)=0 then + ot:=OT_MEMORY or opsize_2_type[i,opsize] + else + ot:=OT_MEMORY or (ot and OT_SIZE_MASK); + if (ref^.base=R_NO) and (ref^.index=R_NO) then + ot:=ot or OT_MEM_OFFS; + { fix scalefactor } + if (ref^.index=R_NO) then + ref^.scalefactor:=0 + else + if (ref^.scalefactor=0) then + ref^.scalefactor:=1; + end; + top_const : + begin + if (opsize<>S_W) and (longint(val)>=-128) and (val<=127) then + ot:=OT_IMM8 or OT_SIGNED + else + ot:=OT_IMMEDIATE or opsize_2_type[i,opsize]; + end; + top_symbol : + begin + if LastInsOffset=-1 then + l:=0 + else + l:=InsOffset-LastInsOffset; + inc(l,symofs); + if assigned(sym) then + inc(l,sym.address); + { instruction size will then always become 2 (PFV) } + relsize:=(InsOffset+2)-l; + if (not assigned(sym) or + ((sym.currbind<>AB_EXTERNAL) and (sym.address<>0))) and + (relsize>=-128) and (relsize<=127) then + ot:=OT_IMM32 or OT_SHORT + else + ot:=OT_IMM32 or OT_NEAR; + end; + end; + end; +end; + + +function taicpu.InsEnd:longint; +begin + InsEnd:=InsOffset+InsSize; +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..2] of longint; +begin + Matches:=100; + + { 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 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; + + +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; +var + m,i : longint; +begin + CheckIfValid:=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 + { We need intel style operands } + SetOperandOrder(op_intel); + { create the .ot fields } + create_ot; + { set the file postion } + aktfilepos:=fileinfo; + end + else + begin + { we've already an insentry so it's valid } + CheckIfValid:=true; + exit; + end; +{ Lookup opcode in the table } + InsSize:=-1; + i:=instabcache^[opcode]; + if i=-1 then + begin +{$ifdef TP} + Message1(asmw_e_opcode_not_in_table,''); +{$else} + Message1(asmw_e_opcode_not_in_table,std_op2str[opcode]); +{$endif} + exit; + end; +// insentry:=@instab[i]; + while (insentry^.opcode=opcode) do + begin + m:=matches(insentry); + if m=100 then + begin + InsSize:=calcsize(insentry); + {if (segprefix<>R_NO) then + inc(InsSize);}{No segprefix!} + { For opsize if size if forced } + if (insentry^.flags and (IF_SB or IF_SW or IF_SD))<>0 then + begin + if (insentry^.flags and IF_ARMASK)=0 then + begin + if (insentry^.flags and IF_SB)<>0 then + begin + if opsize=S_NO then + opsize:=S_B; + end + else if (insentry^.flags and IF_SW)<>0 then + begin + if opsize=S_NO then + opsize:=S_W; + end + else if (insentry^.flags and IF_SD)<>0 then + begin + if opsize=S_NO then + opsize:=S_L; + end; + end; + end; + CheckIfValid:=true; + exit; + end; + inc(i); +// insentry:=@instab[i]; + end; + if insentry^.opcode<>opcode then + Message1(asmw_e_invalid_opcode_and_operands,GetString); +{ No instruction found, set insentry to nil and inssize to -1 } + insentry:=nil; + inssize:=-1; +end; + + + +function taicpu.Pass1(offset:longint):longint; +begin + Pass1:=0; +{ Save the old offset and set the new offset } + InsOffset:=Offset; +{ Things which may only be done once, not when a second pass is done to + optimize } + if Insentry=nil then + begin + { Check if error last time then InsSize=-1 } + if InsSize=-1 then + exit; + { set the file postion } + aktfilepos:=fileinfo; + end + else + begin +{$ifdef PASS2FLAG} + { we are here in a second pass, check if the instruction can be optimized } + if (InsEntry^.flags and IF_PASS2)=0 then + begin + Pass1:=InsSize; + exit; + end; + { update the .ot fields, some top_const can be updated } + create_ot; +{$endif} + end; +{ Check if it's a valid instruction } + if CheckIfValid then + begin + LastInsOffset:=InsOffset; + Pass1:=InsSize; + exit; + end; + LastInsOffset:=-1; +end; +function taicpu.NeedAddrPrefix(opidx:byte):boolean; +var + i,b : tregister; +begin +{ if (OT_MEMORY and (not oper[opidx].ot))=0 then + begin + i:=oper[opidx].ref^.index; + b:=oper[opidx].ref^.base; + if not(i in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) or + not(b in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) then + begin + NeedAddrPrefix:=true; + exit; + end; + end;} + NeedAddrPrefix:=false; +end; + + +function regval(r:tregister):byte; +begin + {case r of + R_EAX,R_AX,R_AL,R_ES,R_CR0,R_DR0,R_ST,R_ST0,R_MM0,R_XMM0 : + regval:=0; + R_ECX,R_CX,R_CL,R_CS,R_DR1,R_ST1,R_MM1,R_XMM1 : + regval:=1; + R_EDX,R_DX,R_DL,R_SS,R_CR2,R_DR2,R_ST2,R_MM2,R_XMM2 : + regval:=2; + R_EBX,R_BX,R_BL,R_DS,R_CR3,R_DR3,R_TR3,R_ST3,R_MM3,R_XMM3 : + regval:=3; + R_ESP,R_SP,R_AH,R_FS,R_CR4,R_TR4,R_ST4,R_MM4,R_XMM4 : + regval:=4; + R_EBP,R_BP,R_CH,R_GS,R_TR5,R_ST5,R_MM5,R_XMM5 : + regval:=5; + R_ESI,R_SI,R_DH,R_DR6,R_TR6,R_ST6,R_MM6,R_XMM6 : + regval:=6; + R_EDI,R_DI,R_BH,R_DR7,R_TR7,R_ST7,R_MM7,R_XMM7 : + regval:=7; + else} + begin + internalerror(777001); + regval:=0; + end; +{ end;} +end; + + +function process_ea(const input:toper;var output:ea;rfield:longint):boolean; +{const + regs : array[0..63] of tregister=( + R_MM0, R_EAX, R_AX, R_AL, R_XMM0, R_NO, R_NO, R_NO, + R_MM1, R_ECX, R_CX, R_CL, R_XMM1, R_NO, R_NO, R_NO, + R_MM2, R_EDX, R_DX, R_DL, R_XMM2, R_NO, R_NO, R_NO, + R_MM3, R_EBX, R_BX, R_BL, R_XMM3, R_NO, R_NO, R_NO, + R_MM4, R_ESP, R_SP, R_AH, R_XMM4, R_NO, R_NO, R_NO, + R_MM5, R_EBP, R_BP, R_CH, R_XMM5, R_NO, R_NO, R_NO, + R_MM6, R_ESI, R_SI, R_DH, R_XMM6, R_NO, R_NO, R_NO, + R_MM7, R_EDI, R_DI, R_BH, R_XMM7, R_NO, R_NO, R_NO + );} +var + j : longint; + i,b : tregister; + sym : tasmsymbol; + md,s : byte; + base,index,scalefactor, + o : longint; +begin + process_ea:=false; +{ register ? } +{ if (input.typ=top_reg) then + begin + j:=0; + while (j<=high(regs)) do + begin + if input.reg=regs[j] then + break; + inc(j); + end; + if j<=high(regs) then + begin + output.sib_present:=false; + output.bytes:=0; + output.modrm:=$c0 or (rfield shl 3) or (j shr 3); + output.size:=1; + process_ea:=true; + end; + exit; + end;} +{ memory reference } + i:=input.ref^.index; + b:=input.ref^.base; + s:=input.ref^.scalefactor; + o:=input.ref^.offset+input.ref^.offsetfixup; + sym:=input.ref^.symbol; +{ it's direct address } + if (b=R_NO) and (i=R_NO) then + begin + { it's a pure offset } + output.sib_present:=false; + output.bytes:=4; + output.modrm:=5 or (rfield shl 3); + end + else + { it's an indirection } + begin + { 16 bit address? } +{ if not((i in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) and + (b in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI])) then + Message(asmw_e_16bit_not_supported);} +{$ifdef OPTEA} + { make single reg base } + if (b=R_NO) and (s=1) then + begin + b:=i; + i:=R_NO; + end; + { convert [3,5,9]*EAX to EAX+[2,4,8]*EAX } +{ if (b=R_NO) and + (((s=2) and (i<>R_ESP)) or + (s=3) or (s=5) or (s=9)) then + begin + b:=i; + dec(s); + end;} + { swap ESP into base if scalefactor is 1 } +{ if (s=1) and (i=R_ESP) then + begin + i:=b; + b:=R_ESP; + end;} +{$endif} + { wrong, for various reasons } +{ if (i=R_ESP) or ((s<>1) and (s<>2) and (s<>4) and (s<>8) and (i<>R_NO)) then + exit;} + { base } +{ case b of + R_EAX : base:=0; + R_ECX : base:=1; + R_EDX : base:=2; + R_EBX : base:=3; + R_ESP : base:=4; + R_NO, + R_EBP : base:=5; + R_ESI : base:=6; + R_EDI : base:=7; + else + exit; + end;} + { index } +{ case i of + R_EAX : index:=0; + R_ECX : index:=1; + R_EDX : index:=2; + R_EBX : index:=3; + R_NO : index:=4; + R_EBP : index:=5; + R_ESI : index:=6; + R_EDI : index:=7; + else + exit; + end; + case s of + 0, + 1 : scalefactor:=0; + 2 : scalefactor:=1; + 4 : scalefactor:=2; + 8 : scalefactor:=3; + else + exit; + end; + if (b=R_NO) or + ((b<>R_EBP) and (o=0) and (sym=nil)) then + md:=0 + else + if ((o>=-128) and (o<=127) and (sym=nil)) then + md:=1 + else + md:=2; + if (b=R_NO) or (md=2) then + output.bytes:=4 + else + output.bytes:=md;} + { SIB needed ? } +{ if (i=R_NO) and (b<>R_ESP) then + begin + output.sib_present:=false; + output.modrm:=(md shl 6) or (rfield shl 3) or base; + end + else + begin + output.sib_present:=true; + output.modrm:=(md shl 6) or (rfield shl 3) or 4; + output.sib:=(scalefactor shl 6) or (index shl 3) or base; + end;} + end; + if output.sib_present then + output.size:=2+output.bytes + else + output.size:=1+output.bytes; + process_ea:=true; +end; + + +function taicpu.calcsize(p:PInsEntry):longint; +var + codes : pchar; + c : byte; + len : longint; + ea_data : ea; +begin + len:=0; + codes:=@p^.code; + repeat + c:=ord(codes^); + inc(codes); + case c of + 0 : + break; + 1,2,3 : + begin + inc(codes,c); + inc(len,c); + end; + 8,9,10 : + begin + inc(codes); + inc(len); + end; + 4,5,6,7 : + begin + if opsize=S_W then + inc(len,2) + else + inc(len); + end; + 15, + 12,13,14, + 16,17,18, + 20,21,22, + 40,41,42 : + inc(len); + 24,25,26, + 31, + 48,49,50 : + inc(len,2); + 28,29,30, { we don't have 16 bit immediates code } + 32,33,34, + 52,53,54, + 56,57,58 : + inc(len,4); + 192,193,194 : + if NeedAddrPrefix(c-192) then + inc(len); + 208 : + inc(len); + 200, + 201, + 202, + 209, + 210, + 217,218,219 : ; + 216 : + begin + inc(codes); + inc(len); + end; + 224,225,226 : + begin + InternalError(777002); + end; + else + begin + if (c>=64) and (c<=191) then + begin + if not process_ea(oper[(c shr 3) and 7], ea_data, 0) then + Message(asmw_e_invalid_effective_address) + else + inc(len,ea_data.size); + end + else + InternalError(777003); + end; + end; + until false; + calcsize:=len; +end; + + +{$endif NOAG386BIN} +PROCEDURE DoneAsm; + BEGIN + END; +PROCEDURE InitAsm; + BEGIN + END; +end. diff --git a/compiler/sparc/cgcpu.pas b/compiler/sparc/cgcpu.pas new file mode 100644 index 0000000000..4b523da7f1 --- /dev/null +++ b/compiler/sparc/cgcpu.pas @@ -0,0 +1,1066 @@ +{*****************************************************************************} +{ File : cgcpu.pas } +{ Author : Mazen NEIFER } +{ Project : Free Pascal Compiler (FPC) } +{ Creation date : 2002\04\26 } +{ Last modification date : 2002\08\20 } +{ Licence : GPL } +{ Bug report : mazen.neifer.01@supaero.org } +{*****************************************************************************} +{ Copyright (c) 1998-2000 by Florian Klaempfl + + 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; +{This unit implements the code generator for the SPARC architecture} +{$INCLUDE fpcdefs.inc} +INTERFACE +USES + cginfo,cgbase,cgobj,cg64f32, + aasmbase,aasmtai,aasmcpu, + cpubase,cpuinfo,cpupara, + node,symconst; +TYPE + tcgSPARC=CLASS(tcg) + PROCEDURE a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;CONST LocPara:TParaLocation);OVERRIDE; +{This method is used to pass a parameter, which is located in a register, to a +routine. It should push/send the parameter to the routine, as required by the +specific processor ABI. It is overriden for each CPU target. + Size : is the size of the operand in the register + r : is the register source of the operand + nr : is number of that parameter in the routine parameters list starting + from one from left to right} + PROCEDURE a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);OVERRIDE; + PROCEDURE a_param_ref(list:TAasmOutput;size:tcgsize;CONST r:TReference;CONST LocPara:TParaLocation);OVERRIDE; + PROCEDURE a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);OVERRIDE; + PROCEDURE a_call_name(list:TAasmOutput;CONST s:string);OVERRIDE; + PROCEDURE a_call_ref(list:TAasmOutput;CONST ref:TReference);OVERRIDE; + PROCEDURE a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister);OVERRIDE; + PROCEDURE a_op_const_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;a:AWord;CONST ref:TReference);OVERRIDE; + PROCEDURE a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);OVERRIDE; + PROCEDURE a_op_ref_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;CONST ref:TReference;reg:TRegister);OVERRIDE; + PROCEDURE a_op_reg_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;reg:TRegister;CONST ref:TReference);OVERRIDE; + PROCEDURE a_op_const_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;a:aword;src, dst:tregister);OVERRIDE; + PROCEDURE a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;src1, src2, dst:tregister);OVERRIDE; + { move instructions } + PROCEDURE a_load_const_reg(list:TAasmOutput;size:tcgsize;a:aword;reg:tregister);OVERRIDE; + PROCEDURE a_load_const_ref(list:TAasmOutput;size:tcgsize;a:aword;CONST ref:TReference);OVERRIDE; + PROCEDURE a_load_reg_ref(list:TAasmOutput;size:tcgsize;reg:tregister;CONST ref:TReference);OVERRIDE; + PROCEDURE a_load_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);OVERRIDE; + PROCEDURE a_load_reg_reg(list:TAasmOutput;size:tcgsize;reg1,reg2:tregister);OVERRIDE; + PROCEDURE a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tregister);OVERRIDE; + { fpu move instructions } + PROCEDURE a_loadfpu_reg_reg(list:TAasmOutput;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; + { vector register move instructions } + PROCEDURE a_loadmm_reg_reg(list:TAasmOutput;reg1, reg2:tregister);OVERRIDE; + PROCEDURE a_loadmm_ref_reg(list:TAasmOutput;CONST ref:TReference;reg:tregister);OVERRIDE; + PROCEDURE a_loadmm_reg_ref(list:TAasmOutput;reg:tregister;CONST ref:TReference);OVERRIDE; + PROCEDURE a_parammm_reg(list:TAasmOutput;reg:tregister);OVERRIDE; + { comparison operations } + PROCEDURE a_cmp_const_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;reg:tregister;l:tasmlabel);OVERRIDE; + PROCEDURE a_cmp_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;CONST ref:TReference;l:tasmlabel);OVERRIDE; + PROCEDURE a_cmp_reg_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;reg1,reg2:tregister;l:tasmlabel);OVERRIDE; + PROCEDURE a_cmp_ref_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;CONST ref:TReference;reg:tregister;l:tasmlabel);OVERRIDE; + PROCEDURE a_jmp_cond(list:TAasmOutput;cond:TOpCmp;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_stackframe_entry(list:TAasmOutput;localsize:LongInt);OVERRIDE; + PROCEDURE g_restore_frame_pointer(list:TAasmOutput);OVERRIDE; + PROCEDURE g_return_from_proc(list:TAasmOutput;parasize:aword);OVERRIDE; + PROCEDURE g_concatcopy(list:TAasmOutput;CONST source,dest:TReference;len:aword;delsource,loadref:boolean);OVERRIDE; + class function reg_cgsize(CONST reg:tregister):tcgsize;OVERRIDE; + PRIVATE + PROCEDURE sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize); + PROCEDURE floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference); + PROCEDURE floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference); + PROCEDURE floatloadops(t:tcgsize;var op:tasmop;var s:topsize); + PROCEDURE floatstoreops(t:tcgsize;var op:tasmop;var s:topsize); + END; + TCg64fSPARC=class(tcg64f32) + PROCEDURE a_op64_ref_reg(list:TAasmOutput;op:TOpCG;CONST ref:TReference;reg:TRegister64);OVERRIDE; + PROCEDURE a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64);OVERRIDE; + PROCEDURE a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:qWord;regdst:TRegister64);OVERRIDE; + PROCEDURE a_op64_const_ref(list:TAasmOutput;op:TOpCG;value:qWord;CONST ref:TReference);OVERRIDE; + PROCEDURE get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp); + END; +CONST + TOpCG2AsmOp:ARRAY[topcg]OF TAsmOp=(A_NONE,A_ADD,A_AND,A_UDIV,A_SDIV,A_UMUL, A_SMUL, A_NEG,A_NOT,A_OR,A_not,A_not,A_not,A_SUB,A_XOR); + TOpCmp2AsmCond:ARRAY[topcmp]OF TAsmCond=(C_NONE,C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A); + TCGSize2OpSize:ARRAY[tcgsize]OF TOpSize=(S_NO,S_B,S_W,S_L,S_L,S_B,S_W,S_L,S_L,S_FS,S_FL,S_FX,S_IQ,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO); +IMPLEMENTATION +USES + globtype,globals,verbose,systems,cutils, + symdef,symsym,defbase,paramgr, + rgobj,tgobj,rgcpu; + { we implement the following routines because otherwise we can't } + { instantiate the class since it's abstract } +PROCEDURE tcgSPARC.a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;CONST LocPara:TParaLocation); + BEGIN + IF(Size<>OS_32)AND(Size<>OS_S32) + THEN + InternalError(2002032212); + List.Concat(taicpu.op_reg(A_SAVE,S_L,r)); + END; +PROCEDURE tcgSPARC.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation); + BEGIN + IF(Size<>OS_32)AND(Size<>OS_S32) + THEN + InternalError(2002032213); + List.Concat(taicpu.op_const(A_SAVE,S_L,a)); + END; +PROCEDURE tcgSPARC.a_param_ref(list:TAasmOutput;size:tcgsize;CONST r:TReference;CONST LocPara:TParaLocation); + VAR + tmpreg:TRegister; + BEGIN + IF((Size=OS_32)AND(Size=OS_S32)) + THEN + InternalError(2002032214); + list.concat(taicpu.op_ref(A_SAVE,S_L,r)); + END; +PROCEDURE tcgSPARC.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation); + VAR + tmpreg:TRegister; + BEGIN + IF r.segment<>R_NO + THEN + CGMessage(cg_e_cant_use_far_pointer_there); + IF(r.base=R_NO)AND(r.index=R_NO) + THEN + list.concat(Taicpu.Op_sym_ofs(A_SAVE,S_L,r.symbol,r.offset)) + ELSE IF(r.base=R_NO)AND(r.index<>R_NO)AND + (r.offset=0)AND(r.scalefactor=0)AND(r.symbol=nil) + THEN + list.concat(Taicpu.Op_reg(A_SAVE,S_L,r.index)) + ELSE IF(r.base<>R_NO)AND(r.index=R_NO)AND + (r.offset=0)AND(r.symbol=nil) + THEN + list.concat(Taicpu.Op_reg(A_SAVE,S_L,r.base)) + ELSE + BEGIN + tmpreg:=get_scratch_reg_address(list); + a_loadaddr_ref_reg(list,r,tmpreg); + list.concat(taicpu.op_reg(A_SAVE,S_L,tmpreg)); + free_scratch_reg(list,tmpreg); + END; + END; +PROCEDURE tcgSPARC.a_call_name(list:TAasmOutput;CONST s:string); + BEGIN + WITH List,objectlibrary DO + BEGIN + concat(taicpu.op_sym(A_CALL,S_NO,newasmsymbol(s))); + concat(taicpu.op_none(A_NOP,S_NO)); + END; + END; +PROCEDURE tcgSPARC.a_call_ref(list:TAasmOutput;CONST ref:TReference); + BEGIN + list.concat(taicpu.op_ref(A_CALL,S_NO,ref)); + list.concat(taicpu.op_none(A_NOP,S_NO)); + END; +{********************** load instructions ********************} +PROCEDURE tcgSPARC.a_load_const_reg(list:TAasmOutput;size:TCGSize;a:aword;reg:TRegister); + BEGIN + WITH List DO + IF a<>0 + THEN{R_G0 is usually set to zero, so we use it} + Concat(taicpu.op_reg_const_reg(A_OR,TCGSize2OpSize[size],R_G0,a,reg)) + ELSE{The is no A_MOV in sparc, that's why we use A_OR with help of R_G0} + Concat(taicpu.op_reg_reg_reg(A_OR,TCGSize2OpSize[size],R_G0,R_G0,reg)); + END; +PROCEDURE tcgSPARC.a_load_const_ref(list:TAasmOutput;size:tcgsize;a:aword;CONST ref:TReference); + BEGIN + WITH List DO + IF a=0 + THEN + Concat(taicpu.op_reg_ref(A_ST,TCGSize2OpSize[size],R_G0,ref)) + ELSE + BEGIN + a_load_const_reg(list,size,a,R_G1); + list.concat(taicpu.op_reg_ref(A_ST,TCGSize2OpSize[size],R_G1,ref)); + END; + END; +PROCEDURE tcgSPARC.a_load_reg_ref(list:TAasmOutput;size:TCGSize;reg:tregister;CONST ref:TReference); + BEGIN + list.concat(taicpu.op_reg_ref(A_NONE,TCGSize2OpSize[size],reg,ref)); + END; +PROCEDURE tcgSPARC.a_load_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister); + VAR + op:tasmop; + s:topsize; + begin + sizes2load(size,S_L,op,s); + list.concat(taicpu.op_ref_reg(op,s,ref,reg)); + end; + + + PROCEDURE tcgSPARC.a_load_reg_reg(list:TAasmOutput;size:tcgsize;reg1,reg2:tregister); + + var + op:tasmop; + s:topsize; + + begin + sizes2load(size,S_L,op,s); + if ((reg1) = (reg2)) then + begin + { "mov reg1, reg1" doesn't make sense } + if op = A_NONE then + exit; + { optimize movzx with "and ffff," operation } + //if (op = A_NONEZX) then + begin + case size of + OS_8: + begin + list.concat(taicpu.op_const_reg(A_AND,S_L,255,reg2)); + exit; + end; + OS_16: + begin + list.concat(taicpu.op_const_reg(A_AND,S_L,65535,reg2)); + exit; + end; + end; + end; + end; + list.concat(taicpu.op_reg_reg(op,s,reg1,reg2)); + end; + { all fpu load routines expect that R_ST[0-7] means an fpu regvar and } + { R_ST means "the current value at the top of the fpu stack" (JM) } + PROCEDURE tcgSPARC.a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister); + + begin + if NOT (reg1 IN [R_F0..R_F31]) then + begin + list.concat(taicpu.op_reg(A_NONE,S_NO, + trgcpu(rg).correct_fpuregister(reg1,trgcpu(rg).fpuvaroffset))); + inc(trgcpu(rg).fpuvaroffset); + end; + if NOT (reg2 IN [R_F0..R_F31]) then + begin + list.concat(taicpu.op_reg(A_JMPL,S_NO, + trgcpu(rg).correct_fpuregister(reg2,trgcpu(rg).fpuvaroffset))); + dec(trgcpu(rg).fpuvaroffset); + end; + end; + + + PROCEDURE tcgSPARC.a_loadfpu_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister); + + begin + floatload(list,size,ref); +{ if (reg <> R_ST) then + a_loadfpu_reg_reg(list,R_ST,reg);} + end; + + + PROCEDURE tcgSPARC.a_loadfpu_reg_ref(list:TAasmOutput;size:tcgsize;reg:tregister;CONST ref:TReference); + + begin +{ if reg <> R_ST then + a_loadfpu_reg_reg(list,reg,R_ST);} + floatstore(list,size,ref); + end; + + + PROCEDURE tcgSPARC.a_loadmm_reg_reg(list:TAasmOutput;reg1, reg2:tregister); + + begin +// list.concat(taicpu.op_reg_reg(A_NONEQ,S_NO,reg1,reg2)); + end; + + + PROCEDURE tcgSPARC.a_loadmm_ref_reg(list:TAasmOutput;CONST ref:TReference;reg:tregister); + + begin +// list.concat(taicpu.op_ref_reg(A_NONEQ,S_NO,ref,reg)); + end; + + + PROCEDURE tcgSPARC.a_loadmm_reg_ref(list:TAasmOutput;reg:tregister;CONST ref:TReference); + + begin +// list.concat(taicpu.op_reg_ref(A_NONEQ,S_NO,reg,ref)); + end; +PROCEDURE tcgSPARC.a_parammm_reg(list:TAasmOutput;reg:tregister); + VAR + href:TReference; + BEGIN +// list.concat(taicpu.op_const_reg(A_SUB,S_L,8,R_RSP)); +// reference_reset_base(href,R_ESP,0); +// list.concat(taicpu.op_reg_ref(A_NONEQ,S_NO,reg,href)); + END; +PROCEDURE tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister); + + var + opcode:tasmop; + power:LongInt; + + begin +(* Case Op of + OP_DIV, OP_IDIV: + Begin + if ispowerof2(a,power) then + begin + case op of + OP_DIV: + opcode := A_SHR; + OP_IDIV: + opcode := A_SAR; + end; + list.concat(taicpu.op_const_reg(opcode,S_L,power, + reg)); + exit; + end; + { the rest should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109224); + End; + OP_MUL,OP_IMUL: + begin + if not(cs_check_overflow in aktlocalswitches) and + ispowerof2(a,power) then + begin + list.concat(taicpu.op_const_reg(A_SHL,S_L,power, + reg)); + exit; + end; + if op = OP_IMUL then + list.concat(taicpu.op_const_reg(A_IMUL,S_L, + a,reg)) + else + { OP_MUL should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109225); + end; + OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR: + if not(cs_check_overflow in aktlocalswitches) and + (a = 1) and + (op in [OP_ADD,OP_SUB]) then + if op = OP_ADD then + list.concat(taicpu.op_reg(A_INC,S_L,reg)) + else + list.concat(taicpu.op_reg(A_DEC,S_L,reg)) + else if (a = 0) then + if (op <> OP_AND) then + exit + else + list.concat(taicpu.op_const_reg(A_NONE,S_L,0,reg)) + else if (a = high(aword)) and + (op in [OP_AND,OP_OR,OP_XOR]) then + begin + case op of + OP_AND: + exit; + OP_OR: + list.concat(taicpu.op_const_reg(A_NONE,S_L,high(aword),reg)); + OP_XOR: + list.concat(taicpu.op_reg(A_NOT,S_L,reg)); + end + end + else + list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],S_L, + a,reg)); + OP_SHL,OP_SHR,OP_SAR: + begin + if (a and 31) <> 0 Then + list.concat(taicpu.op_const_reg( + TOpCG2AsmOp[op],S_L,a and 31,reg)); + if (a shr 5) <> 0 Then + internalerror(68991); + end + else internalerror(68992); + end;*) + end; + + + PROCEDURE tcgSPARC.a_op_const_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;a:AWord;CONST ref:TReference); + + var + opcode:tasmop; + power:LongInt; + + begin +(* Case Op of + OP_DIV, OP_IDIV: + Begin + if ispowerof2(a,power) then + begin + case op of + OP_DIV: + opcode := A_SHR; + OP_IDIV: + opcode := A_SAR; + end; + list.concat(taicpu.op_const_ref(opcode, + TCgSize2OpSize[size],power,ref)); + exit; + end; + { the rest should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109231); + End; + OP_MUL,OP_IMUL: + begin + if not(cs_check_overflow in aktlocalswitches) and + ispowerof2(a,power) then + begin + list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size], + power,ref)); + exit; + end; + { can't multiply a memory location directly with a CONSTant } + if op = OP_IMUL then + inherited a_op_const_ref(list,op,size,a,ref) + else + { OP_MUL should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109232); + end; + OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR: + if not(cs_check_overflow in aktlocalswitches) and + (a = 1) and + (op in [OP_ADD,OP_SUB]) then + if op = OP_ADD then + list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],ref)) + else + list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],ref)) + else if (a = 0) then + if (op <> OP_AND) then + exit + else + a_load_const_ref(list,size,0,ref) + else if (a = high(aword)) and + (op in [OP_AND,OP_OR,OP_XOR]) then + begin + case op of + OP_AND: + exit; + OP_OR: + list.concat(taicpu.op_const_ref(A_NONE,TCgSize2OpSize[size],high(aword),ref)); + OP_XOR: + list.concat(taicpu.op_ref(A_NOT,TCgSize2OpSize[size],ref)); + end + end + else + list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op], + TCgSize2OpSize[size],a,ref)); + OP_SHL,OP_SHR,OP_SAR: + begin + if (a and 31) <> 0 Then + list.concat(taicpu.op_const_ref( + TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,ref)); + if (a shr 5) <> 0 Then + internalerror(68991); + end + else internalerror(68992); + end;*) + end; + + + PROCEDURE tcgSPARC.a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister); + + var + regloadsize:tcgsize; + dstsize:topsize; + tmpreg:tregister; + popecx:boolean; + + begin +(* dstsize := S_Q{makeregsize(dst,size)}; + case op of + OP_NEG,OP_NOT: + begin + if src <> R_NO then + internalerror(200112291); + list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst)); + end; + OP_MUL,OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(200109233); + OP_SHR,OP_SHL,OP_SAR: + begin + tmpreg := R_NO; + { we need cl to hold the shift count, so if the destination } + { is ecx, save it to a temp for now } + if dst in [R_ECX,R_CX,R_CL] then + begin + case S_L of + S_B:regloadsize := OS_8; + S_W:regloadsize := OS_16; + else regloadsize := OS_32; + end; + tmpreg := get_scratch_reg(list); + a_load_reg_reg(list,reg.regloadsize,src,tmpreg); + end; + if not(src in [R_ECX,R_CX,R_CL]) then + begin + { is ecx still free (it's also free if it was allocated } + { to dst, since we've moved dst somewhere else already) } + if not((dst = R_ECX) or + ((R_ECX in rg.unusedregsint) and + { this will always be true, it's just here to } + { allocate ecx } + (rg.getexplicitregisterint(list,R_ECX) = R_ECX))) then + begin + list.concat(taicpu.op_reg(A_SAVE,S_L,R_ECX)); + popecx := true; + end; + a_load_reg_reg(list,OS_8,(src),R_CL); + end + else + src := R_CL; + { do the shift } + if tmpreg = R_NO then + list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize, + R_CL,dst)) + else + begin + list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],S_L, + R_CL,tmpreg)); + { move result back to the destination } + a_load_reg_reg(list,OS_32,tmpreg,R_ECX); + free_scratch_reg(list,tmpreg); + end; + if popecx then + list.concat(taicpu.op_reg(A_POP,S_L,R_ECX)) + else if not (dst in [R_ECX,R_CX,R_CL]) then + rg.ungetregisterint(list,R_ECX); + end; + else + begin + if S_L <> dstsize then + internalerror(200109226); + list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize, + src,dst)); + end; + end;*) + end; + + + PROCEDURE tcgSPARC.a_op_ref_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;CONST ref:TReference;reg:TRegister); + + var + opsize:topsize; + + begin +(* case op of + OP_NEG,OP_NOT,OP_IMUL: + begin + inherited a_op_ref_reg(list,op,size,ref,reg); + end; + OP_MUL,OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(200109239); + else + begin + opsize := S_Q{makeregsize(reg,size)}; + list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],opsize,ref,reg)); + end; + end;*) + end; + + + PROCEDURE tcgSPARC.a_op_reg_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;reg:TRegister;CONST ref:TReference); + + var + opsize:topsize; + + begin +(* case op of + OP_NEG,OP_NOT: + begin + if reg <> R_NO then + internalerror(200109237); + list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],ref)); + end; + OP_IMUL: + begin + { this one needs a load/imul/store, which is the default } + inherited a_op_ref_reg(list,op,size,ref,reg); + end; + OP_MUL,OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(200109238); + else + begin + opsize := tcgsize2opsize[size]; + list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],opsize,reg,ref)); + end; + end;*) + end; + + + PROCEDURE tcgSPARC.a_op_const_reg_reg(list:TAasmOutput;op:TOpCg; + size:tcgsize;a:aword;src, dst:tregister); + var + tmpref:TReference; + power:LongInt; + opsize:topsize; + begin + opsize := S_L; + if (opsize <> S_L) or + not (size in [OS_32,OS_S32]) then + begin + inherited a_op_const_reg_reg(list,op,size,a,src,dst); + exit; + end; + { if we get here, we have to do a 32 bit calculation, guaranteed } + Case Op of + OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR, + OP_SAR: + { can't do anything special for these } + inherited a_op_const_reg_reg(list,op,size,a,src,dst); + OP_IMUL: + begin + if not(cs_check_overflow in aktlocalswitches) and + ispowerof2(a,power) then + { can be done with a shift } + inherited a_op_const_reg_reg(list,op,size,a,src,dst); + list.concat(taicpu.op_reg_const_reg(A_SMUL,S_L,src,a,dst)); + end; + OP_ADD, OP_SUB: + if (a = 0) then + a_load_reg_reg(list,size,src,dst) + else + begin + reference_reset(tmpref); + tmpref.base := src; + tmpref.offset := LongInt(a); + if op = OP_SUB then + tmpref.offset := -tmpref.offset; + list.concat(taicpu.op_ref_reg(A_NONE,S_L,tmpref,dst)); + end + else internalerror(200112302); + end; + end; + + PROCEDURE tcgSPARC.a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg; + size:tcgsize;src1, src2, dst:tregister); + var + tmpref:TReference; + opsize:topsize; + begin + opsize := S_L; + if (opsize <> S_L) or + (S_L <> S_L) or + not (size in [OS_32,OS_S32]) then + begin + inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst); + exit; + end; + { if we get here, we have to do a 32 bit calculation, guaranteed } + Case Op of + OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR, + OP_SAR,OP_SUB,OP_NOT,OP_NEG: + { can't do anything special for these } + inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst); + OP_IMUL: + list.concat(taicpu.op_reg_reg_reg(A_SMUL,S_L,src1,src2,dst)); + OP_ADD: + begin + reference_reset(tmpref); + tmpref.base := src1; + tmpref.index := src2; + tmpref.scalefactor := 1; + list.concat(taicpu.op_ref_reg(A_NONE,S_L,tmpref,dst)); + end + else internalerror(200112303); + end; + end; + +{*************** compare instructructions ****************} + + PROCEDURE tcgSPARC.a_cmp_const_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;reg:tregister; + l:tasmlabel); + + begin + if (a = 0) then + list.concat(taicpu.op_reg_reg(A_CMP,S_L,reg,reg)) + else + list.concat(taicpu.op_const_reg(A_CMP,S_L,a,reg)); + a_jmp_cond(list,cmp_op,l); + end; + + PROCEDURE tcgSPARC.a_cmp_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;CONST ref:TReference; + l:tasmlabel); + + begin + list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],a,ref)); + a_jmp_cond(list,cmp_op,l); + end; + + PROCEDURE tcgSPARC.a_cmp_reg_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp; + reg1,reg2:tregister;l:tasmlabel); + + begin + { if regsize(reg1) <> S_L then + internalerror(200109226); + list.concat(taicpu.op_reg_reg(A_CMP,regsize(reg1),reg1,reg2)); + a_jmp_cond(list,cmp_op,l);} + end; + + PROCEDURE tcgSPARC.a_cmp_ref_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;CONST ref:TReference;reg:tregister;l:tasmlabel); + + var + opsize:topsize; + + begin + opsize := S_Q{makeregsize(reg,size)}; + list.concat(taicpu.op_ref_reg(A_CMP,opsize,ref,reg)); + a_jmp_cond(list,cmp_op,l); + end; + + PROCEDURE tcgSPARC.a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:tasmlabel); + + var + ai:taicpu; + + begin + if cond=OC_None then + ai := Taicpu.Op_sym(A_JMPL,S_NO,l) + else + begin + ai:=Taicpu.Op_sym(A_JMPL,S_NO,l); + ai.SetCondition(TOpCmp2AsmCond[cond]); + end; + ai.is_jmp:=true; + list.concat(ai); + end; + + PROCEDURE tcgSPARC.a_jmp_flags(list:TAasmOutput;CONST f:TResFlags;l:tasmlabel); + var + ai:taicpu; + begin + ai := Taicpu.op_sym(A_JMPL,S_NO,l); + ai.SetCondition(flags_to_cond(f)); + ai.is_jmp := true; + list.concat(ai); + end; + +PROCEDURE tcgSPARC.g_flags2reg(list:TAasmOutput;Size:TCgSize;CONST f:tresflags;reg:TRegister); + VAR + ai:taicpu; + hreg:tregister; + BEGIN + hreg := rg.makeregsize(reg,OS_8); +// ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg); + ai.SetCondition(flags_to_cond(f)); + list.concat(ai); + IF hreg<>reg + THEN + a_load_reg_reg(list,OS_8,hreg,reg); + END; + +{ *********** entry/exit code and address loading ************ } + +PROCEDURE tcgSPARC.g_stackframe_entry(list:TAasmOutput;localsize:LongInt); + VAR + href:TReference; + i:integer; + again:tasmlabel; + BEGIN + WITH list DO + BEGIN + concat(Taicpu.Op_reg(A_SAVE,S_L,Frame_Pointer_Reg)); + concat(Taicpu.Op_reg_reg(A_NONE,S_L,Stack_Pointer_Reg,Frame_Pointer_Reg)); + IF localsize>0 + THEN + concat(Taicpu.Op_const_reg(A_SUB,S_L,localsize,Stack_Pointer_Reg)); + END; + END; +PROCEDURE tcgSPARC.g_restore_frame_pointer(list:TAasmOutput); + BEGIN + list.concat(Taicpu.Op_none(A_RESTORE,S_NO)); + END; +PROCEDURE tcgSPARC.g_return_from_proc(list:TAasmOutput;parasize:aword); + BEGIN + { Routines with the poclearstack flag set use only a ret } + { also routines with parasize=0 } + WITH List DO + (*IF(po_clearstack IN aktprocdef.procoptions) + THEN + { complex return values are removed from stack in C code PM } + IF ret_in_param(aktprocdef.rettype.def) + THEN + Concat(Taicpu.Op_const(A_RET,S_NO,4)) + ELSE + Concat(Taicpu.Op_none(A_RET,S_NO)) + ELSE*) + IF(parasize=0) + THEN + Concat(Taicpu.Op_none(A_RET,S_NO)) + ELSE + BEGIN + { parameters are limited to 65535 bytes because } + { ret allows only imm16 } + IF(parasize>65535) + THEN + CGMessage(cg_e_parasize_too_big); + Concat(Taicpu.Op_const(A_RET,S_NO,parasize)); + END; + END; + + PROCEDURE tcgSPARC.a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tregister); + + begin +// list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,r)); + end; +{ ************* 64bit operations ************ } + PROCEDURE TCg64fSPARC.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp); + begin + case op of + OP_ADD : + begin + op1:=A_ADD; + op2:=A_ADD; + end; + OP_SUB : + begin + op1:=A_SUB; + op2:=A_SUB; + end; + OP_XOR : + begin + op1:=A_XOR; + op2:=A_XOR; + end; + OP_OR : + begin + op1:=A_OR; + op2:=A_OR; + end; + OP_AND : + begin + op1:=A_AND; + op2:=A_AND; + end; + else + internalerror(200203241); + end; + end; + + + PROCEDURE TCg64fSPARC.a_op64_ref_reg(list:TAasmOutput;op:TOpCG;CONST ref:TReference;reg:TRegister64); + var + op1,op2:TAsmOp; + tempref:TReference; + begin + get_64bit_ops(op,op1,op2); + list.concat(taicpu.op_ref_reg(op1,S_L,ref,reg.reglo)); + tempref:=ref; + inc(tempref.offset,4); + list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reg.reghi)); + end; + + + PROCEDURE TCg64fSPARC.a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64); + var + op1,op2:TAsmOp; + begin + get_64bit_ops(op,op1,op2); + list.concat(taicpu.op_reg_reg(op1,S_L,regsrc.reglo,regdst.reglo)); + list.concat(taicpu.op_reg_reg(op2,S_L,regsrc.reghi,regdst.reghi)); + end; + + + PROCEDURE TCg64fSPARC.a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:qWord;regdst:TRegister64); + var + op1,op2:TAsmOp; + begin + case op of + OP_AND,OP_OR,OP_XOR: + WITH cg DO + begin + a_op_const_reg(list,op,Lo(Value),regdst.reglo); + a_op_const_reg(list,op,Hi(Value),regdst.reghi); + end; + OP_ADD, OP_SUB: + begin + // can't use a_op_const_ref because this may use dec/inc + get_64bit_ops(op,op1,op2); + list.concat(taicpu.op_const_reg(op1,S_L,Lo(Value),regdst.reglo)); + list.concat(taicpu.op_const_reg(op2,S_L,Hi(Value),regdst.reghi)); + end; + else + internalerror(200204021); + end; + end; + + + PROCEDURE TCg64fSPARC.a_op64_const_ref(list:TAasmOutput;op:TOpCG;value:qWord;CONST ref:TReference); + var + op1,op2:TAsmOp; + tempref:TReference; + begin + case op of + OP_AND,OP_OR,OP_XOR: + WITH cg DO + begin + a_op_const_ref(list,op,OS_32,Lo(Value),ref); + tempref:=ref; + inc(tempref.offset,4); + a_op_const_ref(list,op,OS_32,Hi(Value),tempref); + end; + OP_ADD, OP_SUB: + begin + get_64bit_ops(op,op1,op2); + // can't use a_op_const_ref because this may use dec/inc + list.concat(taicpu.op_const_ref(op1,S_L,Lo(Value),ref)); + tempref:=ref; + inc(tempref.offset,4); + list.concat(taicpu.op_const_ref(op2,S_L,Hi(Value),tempref)); + end; + else + internalerror(200204022); + end; + end; + + +{ ************* concatcopy ************ } + + PROCEDURE tcgSPARC.g_concatcopy(list:TAasmOutput;CONST source,dest:TReference;len:aword;delsource,loadref:boolean); + + { temp implementation, until it's permanenty moved here from cga.pas } + + var + oldlist:TAasmOutput; + + begin + if list <> exprasmlist then + begin + oldlist := exprasmlist; + exprasmlist := list; + end; +// cga.concatcopy(source,dest,len,delsource,loadref); + if list <> exprasmlist then + list := oldlist; + end; + + + function tcgSPARC.reg_cgsize(CONST reg:tregister):tcgsize; +// CONST +// regsize_2_cgsize:array[S_B..S_L] of tcgsize = (OS_8,OS_16,OS_32); + begin + //result := regsize_2_cgsize[S_L]; + end; + + +{***************** This is private property, keep out! :) *****************} +PROCEDURE tcgSPARC.sizes2load(s1:tcgsize;s2:topsize;VAR op:tasmop;VAR s3:topsize); + BEGIN +{ case s2 of + S_B: + if S1 in [OS_8,OS_S8] then + s3 := S_B + else internalerror(200109221); + S_W: + case s1 of + OS_8,OS_S8: + s3 := S_BW; + OS_16,OS_S16: + s3 := S_W; + else internalerror(200109222); + end; + S_L: + case s1 of + OS_8,OS_S8: + s3 := S_BL; + OS_16,OS_S16: + s3 := S_WL; + OS_32,OS_S32: + s3 := S_L; + else internalerror(200109223); + end; + else internalerror(200109227); + end; + if s3 in [S_B,S_W,S_L] then + op := A_NONE + else if s1 in [OS_8,OS_16,OS_32] then + op := A_NONEZX + else + op := A_NONESX;} + END; +PROCEDURE tcgSPARC.floatloadops(t:tcgsize;VAR op:tasmop;VAR s:topsize); + BEGIN +(* case t of + OS_F32:begin + op:=A_FLD; + s:=S_FS; + end; + OS_F64:begin + op:=A_FLD; + { ???? } + s:=S_FL; + end; + OS_F80:begin + op:=A_FLD; + s:=S_FX; + end; + OS_C64:begin + op:=A_FILD; + s:=S_IQ; + end; + else internalerror(17); + end;*) + END; +PROCEDURE tcgSPARC.floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference); + VAR + op:tasmop; + s:topsize; + BEGIN + floatloadops(t,op,s); + list.concat(Taicpu.Op_ref(op,s,ref)); + inc(trgcpu(rg).fpuvaroffset); + END; +PROCEDURE tcgSPARC.floatstoreops(t:tcgsize;var op:tasmop;var s:topsize); + BEGIN +{ case t of + OS_F32:begin + op:=A_FSTP; + s:=S_FS; + end; + OS_F64:begin + op:=A_FSTP; + s:=S_FL; + end; + OS_F80:begin + op:=A_FSTP; + s:=S_FX; + end; + OS_C64:begin + op:=A_FISTP; + s:=S_IQ; + end; + else + internalerror(17); + end;} + end; +PROCEDURE tcgSPARC.floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference); + VAR + op:tasmop; + s:topsize; + BEGIN + floatstoreops(t,op,s); + list.concat(Taicpu.Op_ref(op,s,ref)); + dec(trgcpu(rg).fpuvaroffset); + END; +BEGIN + cg:=tcgSPARC.create; +END. diff --git a/compiler/sparc/cpubase.pas b/compiler/sparc/cpubase.pas new file mode 100644 index 0000000000..25bdb8895c --- /dev/null +++ b/compiler/sparc/cpubase.pas @@ -0,0 +1,598 @@ +{*****************************************************************************} +{ File : cpubase.pas } +{ Author : Mazen NEIFER } +{ Project : Free Pascal Compiler (FPC) } +{ Creation date : 2002\04\26 } +{ Last modification date : 2002\08\20 } +{ Licence : GPL } +{ Bug report : mazen.neifer.01@supaero.org } +{*****************************************************************************} +{ $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl and Peter Vreman + + Contains the base types for the i386 + + * This code was inspired by the NASM sources + The Netwide Assembler is copyright (C) 1996 Simon Tatham and + Julian Hall. All rights reserved. + + 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 cpuBase; +{$INCLUDE fpcdefs.inc} +INTERFACE +USES globals,cutils,cclasses,aasmbase,cpuinfo,cginfo; +CONST +{Size of the instruction table converted by nasmconv.pas} + maxinfolen = 8; +{Defines the default address size for a processor} + OS_ADDR=OS_32;{$WARNING "OS_ADDR" was set to "OS_32" but not verified!} +{the natural int size for a processor} + OS_INT=OS_32;{$WARNING "OS_INT" was set to "OS_32" but not verified!} +{the maximum float size for a processor} + OS_FLOAT=OS_F80;{$WARNING "OS_FLOAT" was set to "OS_F80" but not verified!} +{the size of a vector register for a processor} + OS_VECTOR=OS_M64;{$WARNING "OS_VECTOR" was set to "OS_M64" but not verified!} +{By default we want everything} +{$DEFINE ATTOP} +{$DEFINE ATTREG} +{$DEFINE ATTSUF} +{We Don't need the intel style opcodes as we are coding for SPARC architecture} +{$DEFINE NORA386INT} +{$DEFINE NOAG386NSM} +{$DEFINE NOAG386INT} +CONST +{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_SIZE_MASK = $000000FF; { 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_REGISTER = $00001000; + OT_IMMEDIATE = $00002000; + OT_IMM8 = $00002001; + OT_IMM16 = $00002002; + OT_IMM32 = $00002004; + OT_IMM64 = $00002008; + OT_IMM80 = $00002010; + 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_MMXREG = $00201008; { MMX registers } + OT_XMMREG = $00201010; { Katmai registers } + OT_MEMORY = $00204000; { register number in 'basereg' } + OT_MEM8 = $00204001; + OT_MEM16 = $00204002; + OT_MEM32 = $00204004; + OT_MEM64 = $00204008; + OT_MEM80 = $00204010; + OT_FPUREG = $01000000; { floating point stack registers } + OT_FPU0 = $01000800; { FPU stack register zero } + OT_REG_SMASK = $00070000; { special register operands: these may be treated differently } + { a mask for the following } + OT_REG_ACCUM = $00211000; { accumulator: AL, AX or EAX } + OT_REG_AL = $00211001; { REG_ACCUM | BITSxx } + OT_REG_AX = $00211002; { ditto } + OT_REG_EAX = $00211004; { and again } + OT_REG_COUNT = $00221000; { counter: CL, CX or ECX } + OT_REG_CL = $00221001; { REG_COUNT | BITSxx } + OT_REG_CX = $00221002; { ditto } + OT_REG_ECX = $00221004; { another one } + OT_REG_DX = $00241002; + + OT_REG_SREG = $00081002; { any segment register } + OT_REG_CS = $01081002; { CS } + OT_REG_DESS = $02081002; { DS, ES, SS (non-CS 86 registers) } + OT_REG_FSGS = $04081002; { FS, GS (386 extENDed registers) } + + OT_REG_CDT = $00101004; { CRn, DRn and TRn } + OT_REG_CREG = $08101004; { CRn } + OT_REG_CR4 = $08101404; { CR4 (Pentium only) } + OT_REG_DREG = $10101004; { DRn } + OT_REG_TREG = $20101004; { TRn } + + 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 } + +{Instruction flags } + IF_NONE = $00000000; + IF_SM = $00000001; { size match first two operands } + IF_SM2 = $00000002; + IF_SB = $00000004; { unsized operands can't be non-byte } + IF_SW = $00000008; { unsized operands can't be non-word } + IF_SD = $00000010; { unsized operands can't be nondword } + IF_AR0 = $00000020; { SB, SW, SD applies to argument 0 } + IF_AR1 = $00000040; { SB, SW, SD applies to argument 1 } + IF_AR2 = $00000060; { SB, SW, SD applies to argument 2 } + IF_ARMASK = $00000060; { mask for unsized argument spec } + IF_PRIV = $00000100; { it's a privileged instruction } + IF_SMM = $00000200; { it's only valid in SMM } + IF_PROT = $00000400; { it's protected mode only } + IF_UNDOC = $00001000; { it's an undocumented instruction } + IF_FPU = $00002000; { it's an FPU instruction } + IF_MMX = $00004000; { it's an MMX instruction } + IF_3DNOW = $00008000; { it's a 3DNow! instruction } + IF_SSE = $00010000; { it's a SSE (KNI, MMX2) instruction } + IF_PMASK = + LongInt($FF000000); { the mask for processor types } + IF_PFMASK = + LongInt($F001FF00); { the mask for disassembly "prefer" } + IF_8086 = $00000000; { 8086 instruction } + IF_186 = $01000000; { 186+ instruction } + IF_286 = $02000000; { 286+ instruction } + IF_386 = $03000000; { 386+ instruction } + IF_486 = $04000000; { 486+ instruction } + IF_PENT = $05000000; { Pentium instruction } + IF_P6 = $06000000; { P6 instruction } + IF_KATMAI = $07000000; { Katmai instructions } + IF_CYRIX = $10000000; { Cyrix-specific instruction } + IF_AMD = $20000000; { AMD-specific instruction } + { added flags } + IF_PRE = $40000000; { it's a prefix instruction } + IF_PASS2 =LongInt($80000000);{if the instruction can change in a second pass} +TYPE + TAttSuffix=( + AttSufNONE, {No suffix is needed} + AttSufINT, {Integer operation suffix is needed} + AttSufFPU, {} + AttSufFPUint{} + ); +{$WARNING CPU32 opcodes do not fully include the Ultra SPRAC instruction set.} + TAsmOp=({$INCLUDE opcode.inc}); + op2strtable=ARRAY[TAsmOp]OF STRING[11]; +CONST + FirstOp=Low(TAsmOp); + LastOp=High(TAsmOp); +{$IFDEF ATTSUF} + att_needsuffix:ARRAY[tasmop]OF TAttSuffix=({$INCLUDE sparcatts.inc}); +{$ENDIF ATTSUF} + std_op2str:op2strtable=({$INCLUDE attinstr.inc}); +{***************************************************************************** + Operand Sizes +*****************************************************************************} +TYPE + { S_NO = No Size of operand } + { S_B = Byte size operand } + { S_W = Word size operand } + { S_L = DWord size operand } + { USED FOR conversions in x86} + { S_BW = Byte to word } + { S_BL = Byte to long } + { S_WL = Word to long } + { Floating point types } + { S_FS = single type (32 bit) } + { S_FL = double/64bit integer } + { S_FX = ExtENDed type } + { S_IS = integer on 16 bits } + { S_IL = integer on 32 bits } + { S_IQ = integer on 64 bits } + 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_NEAR, + S_FAR, + S_SHORT); +CONST + { Intel style operands ! } + opsize_2_type:ARRAY[0..2,topsize] of LongInt=( + (OT_NONE, + OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS16,OT_BITS32,OT_BITS32, + OT_BITS16,OT_BITS32,OT_BITS64, + OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64, + OT_NEAR,OT_FAR,OT_SHORT + ), + (OT_NONE, + OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS8,OT_BITS8,OT_BITS16, + OT_BITS16,OT_BITS32,OT_BITS64, + OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64, + OT_NEAR,OT_FAR,OT_SHORT + ), + (OT_NONE, + OT_BITS8,OT_BITS16,OT_BITS32,OT_NONE,OT_NONE,OT_NONE, + OT_BITS16,OT_BITS32,OT_BITS64, + OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64, + OT_NEAR,OT_FAR,OT_SHORT + ) + ); + +{$IFDEF ATTOP} + att_opsize2str : ARRAY[topsize] of string[2] = ('', + 'b','w','l','bw','bl','wl', + 's','l','q', + 's','l','t','d','q','v', + '','','' + ); +{$ENDIF} +{***************************************************************************** + Conditions +*****************************************************************************} +TYPE + TAsmCond=(C_None, + C_A,C_AE,C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_NA,C_NAE, + C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_NO,C_NP, + C_NS,C_NZ,C_O,C_P,C_PE,C_PO,C_S,C_Z + ); +CONST + cond2str:ARRAY[TAsmCond] of string[3]=('', + 'a','ae','b','be','c','e','g','ge','l','le','na','nae', + 'nb','nbe','nc','ne','ng','nge','nl','nle','no','np', + 'ns','nz','o','p','pe','po','s','z' + ); + inverse_cond:ARRAY[TAsmCond] of TAsmCond=(C_None, + C_NA,C_NAE,C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_A,C_AE, + C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_O,C_P, + C_S,C_Z,C_NO,C_NP,C_NP,C_P,C_NS,C_NZ + ); +CONST + CondAsmOps=3; + CondAsmOp:ARRAY[0..CondAsmOps-1] of TAsmOp=(A_FCMPd, A_JMPL, A_FCMPs); + CondAsmOpStr:ARRAY[0..CondAsmOps-1] of string[4]=('FCMPd','JMPL','FCMPs'); +{***************************************************************************** + Registers +*****************************************************************************} +TYPE + { enumeration for registers, don't change the order } + { it's used by the register size conversions } + TRegister=({$INCLUDE registers.inc}); + TRegister64=PACKED RECORD + {A type to store register locations for 64 Bit values.} + RegLo,RegHi:TRegister; + END; + treg64=tregister64;{alias for compact code} + TRegisterSet=SET OF TRegister; + reg2strtable=ARRAY[tregister] OF STRING[6]; +CONST + firstreg = low(tregister); + lastreg = high(tregister); +{$ifdef ATTREG} + std_reg2str:reg2strtable=({$INCLUDE strregs.inc}); +{$ENDif ATTREG} +{***************************************************************************** + Flags +*****************************************************************************} +TYPE + TResFlags=( + F_E, {Equal} + F_NE, {Not Equal} + F_G, {Greater} + F_L, {Less} + F_GE, {Greater or Equal} + F_LE, {Less or Equal} + F_C, {Carry} + F_NC, {Not Carry} + F_A, {Above} + F_AE, {Above or Equal} + F_B, {Below} + F_BE {Below or Equal} + ); +{***************************************************************************** + Reference +*****************************************************************************} +TYPE + trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup); + + { immediate/reference record } + poperreference = ^treference; + treference = packed record + segment, + base, + index : tregister; + scalefactor : byte; + offset : LongInt; + symbol : tasmsymbol; + offsetfixup : LongInt; + options : trefoptions; +{$ifdef newcg} + alignment : byte; +{$ENDif newcg} + END; + { reference record } + PParaReference=^TParaReference; + TParaReference=PACKED RECORD + Index:TRegister; + Offset:longint; + END; +{***************************************************************************** + Operands +*****************************************************************************} + + { Types of operand } + toptype=(top_none,top_reg,top_ref,top_CONST,top_symbol); + + toper=record + ot : LongInt; + case typ : toptype of + top_none : (); + top_reg : (reg:tregister); + top_ref : (ref:poperreference); + top_CONST : (val:aword); + top_symbol : (sym:tasmsymbol;symofs:LongInt); + END; + + + +{***************************************************************************** + Argument Classification +*****************************************************************************} + +TYPE + TArgClass = ( + { the following classes should be defined by all processor implemnations } + AC_NOCLASS, + AC_MEMORY, + AC_INTEGER, + AC_FPU, + { the following argument classes are i386 specific } + AC_FPUUP, + AC_SSE, + AC_SSEUP); + +{***************************************************************************** + Generic Location +*****************************************************************************} +TYPE + TLoc=( {information about the location of an operand} + LOC_INVALID, { added for tracking problems} + LOC_CONSTANT, { CONSTant value } + LOC_JUMP, { boolean results only, jump to false or true label } + LOC_FLAGS, { boolean results only, flags are set } + LOC_CREFERENCE, { in memory CONSTant value } + LOC_REFERENCE, { in memory value } + LOC_REGISTER, { in a processor register } + LOC_CREGISTER, { Constant register which shouldn't be modified } + LOC_FPUREGISTER, { FPU stack } + LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack } + LOC_MMXREGISTER, { MMX register } + LOC_CMMXREGISTER, { MMX register variable } + LOC_MMREGISTER, + LOC_CMMREGISTER + ); +{tparamlocation describes where a parameter for a procedure is stored. +References are given from the caller's point of view. The usual TLocation isn't +used, because contains a lot of unnessary fields.} + TParaLocation=PACKED RECORD + Size:TCGSize; + Loc:TLoc; + sp_fixup:LongInt; + CASE TLoc OF + LOC_REFERENCE:(reference:tparareference); + { segment in reference at the same place as in loc_register } + LOC_REGISTER,LOC_CREGISTER : ( + CASE LongInt OF + 1 : (register,registerhigh : tregister); + { overlay a registerlow } + 2 : (registerlow : tregister); + { overlay a 64 Bit register type } + 3 : (reg64 : tregister64); + 4 : (register64 : tregister64); + ); + { it's only for better handling } + LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister); + END; + TLocation=PACKED RECORD + loc : TLoc; + size : TCGSize; + case TLoc of + LOC_FLAGS : (resflags : tresflags); + LOC_CONSTANT : ( + case longint of + 1 : (value : AWord); + 2 : (valuelow, valuehigh:AWord); + { overlay a complete 64 Bit value } + 3 : (valueqword : qword); + ); + LOC_CREFERENCE, + LOC_REFERENCE : (reference : treference); + { segment in reference at the same place as in loc_register } + LOC_REGISTER,LOC_CREGISTER : ( + case longint of + 1 : (register,registerhigh,segment : tregister); + { overlay a registerlow } + 2 : (registerlow : tregister); + { overlay a 64 Bit register type } + 3 : (reg64 : tregister64); + 4 : (register64 : tregister64); + ); + { it's only for better handling } + LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister); + end; +{***************************************************************************** + Constants +*****************************************************************************} + +CONST + general_registers = [R_G0..R_I7]; + + { 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 } + + intregs = [R_G0..R_I7]; + usableregsint = general_registers; + c_countusableregsint = 4; + + fpuregs = [R_F0..R_F31]; + usableregsfpu = []; + c_countusableregsfpu = 0; + + mmregs = [R_G0..R_G7]; + usableregsmm = [R_G0..R_G7]; + c_countusableregsmm = 8; + + firstsaveintreg = R_G0; + lastsaveintreg = R_I7; + firstsavefpureg = R_F0; + lastsavefpureg = R_F31; + firstsavemmreg = R_G0; + lastsavemmreg = R_I7; + lowsavereg = R_G0; + highsavereg = R_I7; + + ALL_REGISTERS = [lowsavereg..highsavereg]; + + lvaluelocations = [LOC_REFERENCE,LOC_CFPUREGISTER, + LOC_CREGISTER,LOC_MMXREGISTER,LOC_CMMXREGISTER]; +{ + registers_saved_on_cdecl = [R_ESI,R_EDI,R_EBX];} + + { generic register names } + stack_pointer_reg=R_O6; + frame_pointer_reg=R_I6; + self_pointer_reg=R_G5; + accumulator = R_G0; + accumulatorhigh = R_I7; + { WARNING: don't change to R_ST0!! See comments above implementation of } + { a_loadfpu* methods in rgcpu (JM) } + fpu_result_reg=R_F0; + mmresultreg=R_G0; +{*****************************************************************************} +{ GCC /ABI linking information } +{*****************************************************************************} +{# 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.} + std_saved_registers=[R_O6]; +{# 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; +{# Registers which are defined as scratch and no need to save across routine +calls or in assembler blocks.} + ScratchRegsCount=3; + scratch_regs:ARRAY[1..ScratchRegsCount]OF TRegister=(R_O4,R_O5,R_I7); + {$WARNING FIXME : Scratch registers list has to be verified} +{ low and high of the available maximum width integer general purpose } +{ registers } + LoGPReg = R_G0; + HiGPReg = R_I7; + +{ low and high of every possible width general purpose register (same as } +{ above on most architctures apart from the 80x86) } + LoReg = R_G0; + HiReg = R_I7; + + cpuflags = []; + + { sizes } + pointersize = 4; + extENDed_size = 8;{SPARC architecture uses IEEE floating point numbers} + mmreg_size = 8; + sizepostfix_pointer = S_L; + + +{***************************************************************************** + Instruction table +*****************************************************************************} + +{$ifndef NOAG386BIN} +TYPE + tinsentry=packed record + opcode : tasmop; + ops : byte; + optypes : ARRAY[0..2] of LongInt; + code : ARRAY[0..maxinfolen] of char; + flags : LongInt; + END; + pinsentry=^tinsentry; + + TInsTabCache=ARRAY[TasmOp] of LongInt; + PInsTabCache=^TInsTabCache; +VAR + InsTabCache : PInsTabCache; +{$ENDif NOAG386BIN} +{***************************************************************************** + Helpers +*****************************************************************************} + + CONST + maxvarregs=30; + VarRegs:ARRAY[1..maxvarregs]OF TRegister=( + R_G0,R_G1,R_G2,R_G3,R_G4,R_G5,R_G6,R_G7, + R_O0,R_O1,R_O2,R_O3,R_O4,R_O5,{R_R14=R_SP}R_O7, + R_L0,R_L1,R_L2,R_L3,R_L4,R_L5,R_L6,R_L7, + R_I0,R_I1,R_I2,R_I3,R_I4,R_I5,{R_R30=R_FP}R_I7 + ); + maxfpuvarregs = 8; + max_operands = 3; + + maxintregs = maxvarregs; + maxfpuregs = maxfpuvarregs; + +FUNCTION reg2str(r:tregister):string; +FUNCTION is_calljmp(o:tasmop):boolean; +FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond; +IMPLEMENTATION +FUNCTION reg2str(r:tregister):string; + TYPE + TStrReg=ARRAY[TRegister]OF STRING[5]; + CONST + StrReg:TStrReg=({$INCLUDE strregs.inc}); + BEGIN + reg2str:=StrReg[r]; + END; +FUNCTION is_calljmp(o:tasmop):boolean; + BEGIN + CASE o OF + A_CALL,A_JMPL: + is_calljmp:=true; + ELSE + is_calljmp:=false; + END; + END; +FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond; + CONST + flags_2_cond:ARRAY[TResFlags]OF TAsmCond=(C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE); + BEGIN + result:=flags_2_cond[f]; + END; +END. diff --git a/compiler/sparc/cpugas.pas b/compiler/sparc/cpugas.pas new file mode 100644 index 0000000000..05482fd87a --- /dev/null +++ b/compiler/sparc/cpugas.pas @@ -0,0 +1,318 @@ +{*****************************************************************************} +{ File : cpugas.pas } +{ Author : Mazen NEIFER } +{ Project : Free Pascal Compiler (FPC) } +{ Creation date : 2002\05\01 } +{ Last modification date : 2002\08\20 } +{ Licence : GPL } +{ Bug report : mazen.neifer.01@supaero.org } +{*****************************************************************************} +{ $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl + + This unit implements an asmoutput class for SPARC AT&T syntax + + 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 CpuGas; +{$INCLUDE fpcdefs.inc} +INTERFACE +USES + cclasses,cpubase, + globals, + aasmbase,aasmtai,aasmcpu,assemble,aggas; +TYPE + TGasSPARC=class(TGnuAssembler) + PROCEDURE WriteInstruction(hp:Tai);OVERRIDE; + END; +IMPLEMENTATION +USES + strings, + dos, + globtype, + fmodule,finput, + cutils,systems, + verbose; +CONST + line_length = 70; +VAR +{$ifdef GDB} + n_line : byte; { different types of source lines } + linecount, + includecount : longint; + funcname : pchar; + stabslastfileinfo : tfileposinfo; +{$endif} + lastsec : tsection; { last section type written } + lastfileinfo : tfileposinfo; + infile, + lastinfile : tinputfile; + symendcount : longint; + + function fixline(s:string):string; + { + return s with all leading and ending spaces and tabs removed + } + var + i,j,k : longint; + begin + i:=length(s); + while (i>0) and (s[i] in [#9,' ']) do + dec(i); + j:=1; + while (jR_NO then + s:=std_reg2str[segment]+':' + else + s:=''; + if assigned(symbol) then + s:=s+symbol.name; + if offset<0 then + s:=s+tostr(offset) + else + if (offset>0) then + begin + if assigned(symbol) then + s:=s+'+'+tostr(offset) + else + s:=s+tostr(offset); + end + else if (index=R_NO) and (base=R_NO) and not assigned(symbol) then + s:=s+'0'; + if (index<>R_NO) and (base=R_NO) then + begin + s:=s+'(,'+std_reg2str[index]; + if scalefactor<>0 then + s:=s+','+tostr(scalefactor)+')' + else + s:=s+')'; + end + else + if (index=R_NO) and (base<>R_NO) then + s:=s+'('+std_reg2str[base]+')' + else + if (index<>R_NO) and (base<>R_NO) then + begin + s:=s+'('+std_reg2str[base]+','+std_reg2str[index]; + if scalefactor<>0 then + s:=s+','+tostr(scalefactor)+')' + else + s := s+')'; + end; + end; + getreferencestring:=s; + end; + + function getopstr(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg : + getopstr:=std_reg2str[o.reg]; + top_ref : + getopstr:=getreferencestring(o.ref^); + top_const : + getopstr:='$'+tostr(longint(o.val)); + top_symbol : + begin + if assigned(o.sym) then + hs:='$'+o.sym.name + else + hs:='$'; + if o.symofs>0 then + hs:=hs+'+'+tostr(o.symofs) + else + if o.symofs<0 then + hs:=hs+tostr(o.symofs) + else + if not(assigned(o.sym)) then + hs:=hs+'0'; + getopstr:=hs; + end; + else + internalerror(10001); + end; + end; + + function getopstr_jmp(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg : + getopstr_jmp:='*'+std_reg2str[o.reg]; + top_ref : + getopstr_jmp:='*'+getreferencestring(o.ref^); + top_const : + getopstr_jmp:=tostr(longint(o.val)); + top_symbol : + begin + hs:=o.sym.name; + if o.symofs>0 then + hs:=hs+'+'+tostr(o.symofs) + else + if o.symofs<0 then + hs:=hs+tostr(o.symofs); + getopstr_jmp:=hs; + end; + else + internalerror(10001); + end; + end; + + +{**************************************************************************** + TISPARCATTASMOUTPUT + ****************************************************************************} + + const + ait_const2str : array[ait_const_32bit..ait_const_8bit] of string[8]= + (#9'.long'#9,#9'.short'#9,#9'.byte'#9); +PROCEDURE TGasSPARC.WriteInstruction(hp:Tai); + VAR + Op:TAsmOp; + s:STRING; + i:Integer; + sep:STRING[3]; + BEGIN + IF hp.typ<>ait_instruction + THEN + Exit; + taicpu(hp).SetOperandOrder(op_att); + op:=taicpu(hp).opcode; + { call maybe not translated to call } + s:=#9+std_op2str[op]+cond2str[taicpu(hp).condition]; + IF is_CallJmp(op) + THEN + { call and jmp need an extra handling } + { this code is only called if jmp isn't a labeled instruction } + { quick hack to overcome a problem with manglednames=255 chars } + BEGIN +{ IF op<>A_JMPl + THEN + s:=cond2str(op,taicpu(hp).condition)+',' + ELSE} + s:=#9'b'#9; + s:=s+getopstr_jmp(taicpu(hp).oper[0]); + END + ELSE + BEGIN {process operands} + s:=#9+std_op2str[op]; + IF taicpu(hp).ops<>0 + THEN + BEGIN + { + if not is_calljmp(op) then + sep:=',' + else + } + sep:=#9; + FOR i:=0 TO taicpu(hp).ops-1 DO + BEGIN + s:=s+sep+getopstr(taicpu(hp).oper[i]); + sep:=','; + END; + END; + END; + AsmWriteLn(s); + END; +{***************************************************************************** + Initialize +*****************************************************************************} +CONST + as_SPARC_as_info:TAsmInfo=( + id : as_gas; + idtxt : 'AS'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM'; + supported_target : system_any; + outputbinary: false; + allowdirect : true; + needar : true; + labelprefix_only_inside_procedure : false; + labelprefix : '.L'; + comment : '# '; + secnames : ({sec_none}'', {no section} + {sec_code}'.text', {executable code} + {sec_data}'.data', {initialized R/W data} + {sec_bss}'.bss', {uninitialized R/W data} + {sec_idata2}'.comment', {comments} + {sec_idata4}'.debug', {debugging information} + {sec_idata5}'.rodata', {RO data} + {sec_idata6}'.line', {line numbers info for symbolic debug} + {sec_idata7}'.init', {runtime intialization code} + {sec_edata}'.fini', {runtime finalization code} + {sec_stab}'.stab', + {sec_stabstr} '.stabstr', + {sec_common}'.note') {note info} + ); +INITIALIZATION + RegisterAssembler(as_SPARC_as_info,TGasSPARC); +END. diff --git a/compiler/sparc/cpuinfo.pas b/compiler/sparc/cpuinfo.pas new file mode 100644 index 0000000000..bb980a35c1 --- /dev/null +++ b/compiler/sparc/cpuinfo.pas @@ -0,0 +1,68 @@ +{*****************************************************************************} +{ File : cpuinfo.pas } +{ Author : Mazen NEIFER } +{ Project : Free Pascal Compiler (FPC) } +{ Creation date : 2002\26\26 } +{ Last modification date : 2002\08\20 } +{ Licence : GPL } +{ Bug report : mazen.neifer.01@supaero.org } +{*****************************************************************************} +{ + $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl + + Basic Processor information + + 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 cpuinfo; +{$INCLUDE fpcdefs.inc} +INTERFACE +TYPE +{# Natural integer register type and size for the target machine } + AWord=Cardinal; + PAWord=^AWord; +{ the ordinal type used when evaluating constant integer expressions } + TConstExprInt=int64; +{ this must be an ordinal type with the same size as a pointer } +{ Note: must be unsigned!! Otherwise, ugly code like } +{ pointer(-1) will result in a pointer with the value } +{ $fffffffffffffff on a 32bit machine if the compiler uses } +{ int64 constants internally (JM) } + TConstPtrUInt=cardinal; + bestreal = extended; + ts32real = single; + ts64real = double; + ts80real = extended; + ts64comp = extended; + pbestreal=^bestreal; +{ possible supported processors for this target } + tprocessors=(no_processor,SPARC_V8,SPARC_V9); +CONST +{# Size of native extended floating point type } + extended_size = 10; +{# Size of a pointer } + pointer_size = 4; +{# Size of a multimedia register } + mmreg_size = 8; +{ target cpu string (used by compiler options) } + target_cpu_string = 'SPARC'; +{ size of the buffer used for setjump/longjmp + the size of this buffer is deduced from the + jmp_buf structure in setjumph.inc file } + jmp_buf_size = 24; +IMPLEMENTATION +END. diff --git a/compiler/sparc/cpupara.pas b/compiler/sparc/cpupara.pas new file mode 100644 index 0000000000..18c41ed66f --- /dev/null +++ b/compiler/sparc/cpupara.pas @@ -0,0 +1,151 @@ +{*****************************************************************************} +{ File : cpupara.pas } +{ Author : Mazen NEIFER } +{ Project : Free Pascal Compiler (FPC) } +{ Creation date : 2002\07\13 } +{ Last modification date : 2002\08\20 } +{ Licence : GPL } +{ Bug report : mazen.neifer.01@supaero.org } +{*****************************************************************************} +{ + $Id$ + Copyright (c) 2002 by Florian Klaempfl + + PowerPC 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. + ****************************************************************************} +UNIT cpupara; +{SPARC specific calling conventions are handled by this unit} +{$INCLUDE fpcdefs.inc} +INTERFACE +USES + cpubase, + symconst,symbase,symdef,paramgr; +TYPE + TSparcParaManager=CLASS(TParaManager) + FUNCTION getintparaloc(nr:longint):tparalocation;OVERRIDE; + PROCEDURE create_param_loc_info(p:tabstractprocdef);OVERRIDE; + FUNCTION GetSelfLocation(p:tabstractprocdef):tparalocation;OVERRIDE; + end; +IMPLEMENTATION +USES + verbose, + cpuinfo, + symtype; +FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation; + BEGIN + fillchar(result,sizeof(tparalocation),0); + if nr<1 + then + internalerror(2002070801) + else if nr<=8 + then + BEGIN + result.loc:=LOC_REGISTER; + result.register:=tregister(longint(R_O0)+nr); + end + else + BEGIN + result.loc:=LOC_REFERENCE; + result.reference.index:=stack_pointer_reg; + result.reference.offset:=(nr-8)*4; + end; + end; + + FUNCTION getparaloc(p : tdef) : tloc; + + BEGIN + case p.deftype of + orddef: + getparaloc:=LOC_REGISTER; + floatdef: + getparaloc:=LOC_FPUREGISTER; + enumdef: + getparaloc:=LOC_REGISTER; + pointerdef: + getparaloc:=LOC_REGISTER; + else + internalerror(2002071001); + end; + end; + + PROCEDURE TSparcParaManager.create_param_loc_info(p : tabstractprocdef); + + var + nextintreg,nextfloatreg,nextmmreg : tregister; + stack_offset : aword; + hp : tparaitem; + loc : tloc; + + BEGIN + nextintreg:=R_G3; + nextfloatreg:=R_F1; + nextmmreg:=R_L1; + stack_offset:=0; + { pointer for structured results ? } + { !!!nextintreg:=R_4; } + + { frame pointer for nested procedures? } + { inc(nextintreg); } + { constructor? } + { destructor? } + hp:=tparaitem(p.para.last); + while assigned(hp) do + BEGIN + loc:=getparaloc(hp.paratype.def); + case loc of + LOC_REGISTER: + BEGIN + if nextintreg<=R_I7 then + BEGIN + hp.paraloc.loc:=LOC_REGISTER; + hp.paraloc.register:=nextintreg; + inc(nextintreg); + end + else + BEGIN + {!!!!!!!} + internalerror(2002071003); + end; + end; + else + internalerror(2002071002); + end; + hp:=tparaitem(hp.previous); + end; + end; + +FUNCTION TSparcParaManager.GetSelfLocation(p:tabstractprocdef):tparalocation; + BEGIN + getselflocation.loc:=LOC_REFERENCE; + getselflocation.reference.index:=R_G3{R_ESP}; + getselflocation.reference.offset:=4; + END; + +BEGIN + paramanager:=TSparcParaManager.create; +end. +{ + $Log$ + Revision 1.1 2002-08-21 13:30:07 mazen + *** empty log message *** + + Revision 1.2 2002/07/11 14:41:34 florian + * start of the new generic parameter handling + + Revision 1.1 2002/07/07 09:44:32 florian + * powerpc target fixed, very simple units can be compiled +} diff --git a/compiler/sparc/psystem.pas b/compiler/sparc/psystem.pas new file mode 100644 index 0000000000..d1b5c0307a --- /dev/null +++ b/compiler/sparc/psystem.pas @@ -0,0 +1,557 @@ +{ + $Id$ + Copyright (c) 1998-2002 by Florian Klaempfl + + Load the system unit, create required defs for systemunit + + 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 psystem; + +{$i fpcdefs.inc} + +interface + + uses + symbase; + + procedure insertinternsyms(p : tsymtable); + procedure insert_intern_types(p : tsymtable); + + procedure readconstdefs; + procedure createconstdefs; + + procedure registernodes; + procedure registertais; + + +implementation + + uses + globals,globtype, + symconst,symtype,symsym,symdef,symtable, + aasmtai,aasmcpu, +{$ifdef GDB} + gdb, +{$endif GDB} + node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl,nopt; + + + procedure insertinternsyms(p : tsymtable); + { + all intern procedures for the system unit + } + begin + p.insert(tsyssym.create('Concat',in_concat_x)); + p.insert(tsyssym.create('Write',in_write_x)); + p.insert(tsyssym.create('WriteLn',in_writeln_x)); + p.insert(tsyssym.create('Assigned',in_assigned_x)); + p.insert(tsyssym.create('Read',in_read_x)); + p.insert(tsyssym.create('ReadLn',in_readln_x)); + p.insert(tsyssym.create('Ofs',in_ofs_x)); + p.insert(tsyssym.create('SizeOf',in_sizeof_x)); + p.insert(tsyssym.create('TypeOf',in_typeof_x)); + p.insert(tsyssym.create('Low',in_low_x)); + p.insert(tsyssym.create('High',in_high_x)); + p.insert(tsyssym.create('Seg',in_seg_x)); + p.insert(tsyssym.create('Ord',in_ord_x)); + p.insert(tsyssym.create('Pred',in_pred_x)); + p.insert(tsyssym.create('Succ',in_succ_x)); + p.insert(tsyssym.create('Exclude',in_exclude_x_y)); + p.insert(tsyssym.create('Include',in_include_x_y)); + p.insert(tsyssym.create('Break',in_break)); + p.insert(tsyssym.create('Exit',in_exit)); + p.insert(tsyssym.create('Continue',in_continue)); + p.insert(tsyssym.create('Dec',in_dec_x)); + p.insert(tsyssym.create('Inc',in_inc_x)); + p.insert(tsyssym.create('Str',in_str_x_string)); + p.insert(tsyssym.create('Assert',in_assert_x_y)); + p.insert(tsyssym.create('Val',in_val_x)); + p.insert(tsyssym.create('Addr',in_addr_x)); + p.insert(tsyssym.create('TypeInfo',in_typeinfo_x)); + p.insert(tsyssym.create('SetLength',in_setlength_x)); + p.insert(tsyssym.create('Finalize',in_finalize_x)); + p.insert(tsyssym.create('Length',in_length_x)); + p.insert(tsyssym.create('New',in_new_x)); + p.insert(tsyssym.create('Dispose',in_dispose_x)); + end; + + + procedure insert_intern_types(p : tsymtable); + { + all the types inserted into the system unit + } + + function addtype(const s:string;const t:ttype):ttypesym; + begin + result:=ttypesym.create(s,t); + p.insert(result); + { add init/final table if required } + if t.def.needs_inittable then + generate_inittable(result); + end; + + procedure adddef(const s:string;def:tdef); + var + t : ttype; + begin + t.setdef(def); + p.insert(ttypesym.create(s,t)); + end; + + var + { several defs to simulate more or less C++ objects for GDB } + vmttype, + vmtarraytype : ttype; + vmtsymtable : tsymtable; + begin + { Normal types } + if (cs_fp_emulation in aktmoduleswitches) then + begin + addtype('Single',s32floattype); + { extended size is the best real type for the target } + addtype('Real',s32floattype); + pbestrealtype:=@s32floattype; + end + else + begin + addtype('Single',s32floattype); + addtype('Double',s64floattype); + { extended size is the best real type for the target } + addtype('Extended',pbestrealtype^); + addtype('Real',s64floattype); + end; +{$ifdef x86} + adddef('Comp',tfloatdef.create(s64comp)); +{$endif x86} + addtype('Currency',s64currencytype); + addtype('Pointer',voidpointertype); + addtype('FarPointer',voidfarpointertype); + addtype('ShortString',cshortstringtype); + addtype('LongString',clongstringtype); + addtype('AnsiString',cansistringtype); + addtype('WideString',cwidestringtype); + addtype('Boolean',booltype); + addtype('ByteBool',booltype); + adddef('WordBool',torddef.create(bool16bit,0,1)); + adddef('LongBool',torddef.create(bool32bit,0,1)); + addtype('Char',cchartype); + addtype('WideChar',cwidechartype); + adddef('Text',tfiledef.createtext); + addtype('Cardinal',u32bittype); + addtype('QWord',cu64bittype); + addtype('Int64',cs64bittype); + adddef('TypedFile',tfiledef.createtyped(voidtype)); + addtype('Variant',cvarianttype); + { Internal types } + addtype('$formal',cformaltype); + addtype('$void',voidtype); + addtype('$byte',u8bittype); + addtype('$word',u16bittype); + addtype('$ulong',u32bittype); + addtype('$longint',s32bittype); + addtype('$qword',cu64bittype); + addtype('$int64',cs64bittype); + addtype('$char',cchartype); + addtype('$widechar',cwidechartype); + addtype('$shortstring',cshortstringtype); + addtype('$longstring',clongstringtype); + addtype('$ansistring',cansistringtype); + addtype('$widestring',cwidestringtype); + addtype('$openshortstring',openshortstringtype); + addtype('$boolean',booltype); + addtype('$void_pointer',voidpointertype); + addtype('$char_pointer',charpointertype); + addtype('$void_farpointer',voidfarpointertype); + addtype('$openchararray',openchararraytype); + addtype('$file',cfiletype); + addtype('$variant',cvarianttype); + addtype('$s32real',s32floattype); + addtype('$s64real',s64floattype); + addtype('$s80real',s80floattype); + addtype('$s64currency',s64currencytype); + { Add a type for virtual method tables } + vmtsymtable:=trecordsymtable.create; + vmttype.setdef(trecorddef.create(vmtsymtable)); + pvmttype.setdef(tpointerdef.create(vmttype)); + vmtsymtable.insert(tvarsym.create('$parent',pvmttype)); + vmtsymtable.insert(tvarsym.create('$length',s32bittype)); + vmtsymtable.insert(tvarsym.create('$mlength',s32bittype)); + vmtarraytype.setdef(tarraydef.create(0,1,s32bittype)); + tarraydef(vmtarraytype.def).elementtype:=voidpointertype; + vmtsymtable.insert(tvarsym.create('$__pfn',vmtarraytype)); + addtype('$__vtbl_ptr_type',vmttype); + addtype('$pvmt',pvmttype); + vmtarraytype.setdef(tarraydef.create(0,1,s32bittype)); + tarraydef(vmtarraytype.def).elementtype:=pvmttype; + addtype('$vtblarray',vmtarraytype); + { Add functions that require compiler magic } + insertinternsyms(p); + end; + + + procedure readconstdefs; + { + Load all default definitions for consts from the system unit + } + begin + globaldef('byte',u8bittype); + globaldef('word',u16bittype); + globaldef('ulong',u32bittype); + globaldef('longint',s32bittype); + globaldef('qword',cu64bittype); + globaldef('int64',cs64bittype); + globaldef('formal',cformaltype); + globaldef('void',voidtype); + globaldef('char',cchartype); + globaldef('widechar',cwidechartype); + globaldef('shortstring',cshortstringtype); + globaldef('longstring',clongstringtype); + globaldef('ansistring',cansistringtype); + globaldef('widestring',cwidestringtype); + globaldef('openshortstring',openshortstringtype); + globaldef('openchararray',openchararraytype); + globaldef('s32real',s32floattype); + globaldef('s64real',s64floattype); + globaldef('s80real',s80floattype); + globaldef('s64currency',s64currencytype); + globaldef('boolean',booltype); + globaldef('void_pointer',voidpointertype); + globaldef('char_pointer',charpointertype); + globaldef('void_farpointer',voidfarpointertype); + globaldef('file',cfiletype); + globaldef('pvmt',pvmttype); + globaldef('variant',cvarianttype); +{$ifdef i386} + ordpointertype:=u32bittype; +{$endif i386} +{$ifdef x86_64} + ordpointertype:=cu64bittype; +{$endif x86_64} +{$ifdef powerpc} + ordpointertype:=u32bittype; +{$endif powerpc} +{$ifdef sparc} + ordpointertype:=u32bittype; +{$endif sparc} +{$ifdef m68k} + ordpointertype:=u32bittype; +{$endif} + end; + + + procedure createconstdefs; + { + Create all default definitions for consts for the system unit + } + var + oldregisterdef : boolean; + begin + { create definitions for constants } + oldregisterdef:=registerdef; + registerdef:=false; + cformaltype.setdef(tformaldef.create); + voidtype.setdef(torddef.create(uvoid,0,0)); + u8bittype.setdef(torddef.create(u8bit,0,255)); + u16bittype.setdef(torddef.create(u16bit,0,65535)); + u32bittype.setdef(torddef.create(u32bit,0,high(cardinal))); + s32bittype.setdef(torddef.create(s32bit,low(longint),high(longint))); + cu64bittype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword)))); + cs64bittype.setdef(torddef.create(s64bit,low(int64),high(int64))); + booltype.setdef(torddef.create(bool8bit,0,1)); + cchartype.setdef(torddef.create(uchar,0,255)); + cwidechartype.setdef(torddef.create(uwidechar,0,65535)); + cshortstringtype.setdef(tstringdef.createshort(255)); + { should we give a length to the default long and ansi string definition ?? } + clongstringtype.setdef(tstringdef.createlong(-1)); + cansistringtype.setdef(tstringdef.createansi(-1)); + cwidestringtype.setdef(tstringdef.createwide(-1)); + { length=0 for shortstring is open string (needed for readln(string) } + openshortstringtype.setdef(tstringdef.createshort(0)); + openchararraytype.setdef(tarraydef.create(0,-1,s32bittype)); + tarraydef(openchararraytype.def).elementtype:=cchartype; +{$ifdef x86} + {$ifdef i386} + ordpointertype:=u32bittype; + {$endif i386} + {$ifdef x86_64} + ordpointertype:=cu64bittype; + {$endif x86_64} + s32floattype.setdef(tfloatdef.create(s32real)); + s64floattype.setdef(tfloatdef.create(s64real)); + s80floattype.setdef(tfloatdef.create(s80real)); +{$endif x86} +{$ifdef powerpc} + ordpointertype:=u32bittype; + s32floattype.setdef(tfloatdef.create(s32real)); + s64floattype.setdef(tfloatdef.create(s64real)); + s80floattype.setdef(tfloatdef.create(s80real)); +{$endif powerpc} +{$ifdef sparc} + ordpointertype:=u32bittype; + s32floattype.setdef(tfloatdef.create(s32real)); + s64floattype.setdef(tfloatdef.create(s64real)); + s80floattype.setdef(tfloatdef.create(s80real)); +{$endif sparc} +{$ifdef m68k} + ordpointertype:=u32bittype; + s32floattype.setdef(tfloatdef.create(s32real)); + s64floattype.setdef(tfloatdef.create(s64real)); + s80floattype.setdef(tfloatdef.create(s80real)); +{$endif} + s64currencytype.setdef(tfloatdef.create(s64currency)); + { some other definitions } + voidpointertype.setdef(tpointerdef.create(voidtype)); + charpointertype.setdef(tpointerdef.create(cchartype)); + voidfarpointertype.setdef(tpointerdef.createfar(voidtype)); + cfiletype.setdef(tfiledef.createuntyped); + cvarianttype.setdef(tvariantdef.create); + registerdef:=oldregisterdef; + end; + + + procedure registernodes; + { + Register all possible nodes in the nodeclass array that + will be used for loading the nodes from a ppu + } + begin + nodeclass[addn]:=caddnode; + nodeclass[muln]:=caddnode; + nodeclass[subn]:=caddnode; + nodeclass[divn]:=cmoddivnode; + nodeclass[symdifn]:=caddnode; + nodeclass[modn]:=cmoddivnode; + nodeclass[assignn]:=cassignmentnode; + nodeclass[loadn]:=cloadnode; + nodeclass[rangen]:=crangenode; + nodeclass[ltn]:=caddnode; + nodeclass[lten]:=caddnode; + nodeclass[gtn]:=caddnode; + nodeclass[gten]:=caddnode; + nodeclass[equaln]:=caddnode; + nodeclass[unequaln]:=caddnode; + nodeclass[inn]:=cinnode; + nodeclass[orn]:=caddnode; + nodeclass[xorn]:=caddnode; + nodeclass[shrn]:=cshlshrnode; + nodeclass[shln]:=cshlshrnode; + nodeclass[slashn]:=caddnode; + nodeclass[andn]:=caddnode; + nodeclass[subscriptn]:=csubscriptnode; + nodeclass[derefn]:=cderefnode; + nodeclass[addrn]:=caddrnode; + nodeclass[doubleaddrn]:=cdoubleaddrnode; + nodeclass[ordconstn]:=cordconstnode; + nodeclass[typeconvn]:=ctypeconvnode; + nodeclass[calln]:=ccallnode; + nodeclass[callparan]:=ccallparanode; + nodeclass[realconstn]:=crealconstnode; + nodeclass[unaryminusn]:=cunaryminusnode; + nodeclass[asmn]:=casmnode; + nodeclass[vecn]:=cvecnode; + nodeclass[pointerconstn]:=cpointerconstnode; + nodeclass[stringconstn]:=cstringconstnode; + nodeclass[funcretn]:=cfuncretnode; + nodeclass[selfn]:=cselfnode; + nodeclass[notn]:=cnotnode; + nodeclass[inlinen]:=cinlinenode; + nodeclass[niln]:=cnilnode; + nodeclass[errorn]:=cerrornode; + nodeclass[typen]:=ctypenode; + nodeclass[hnewn]:=chnewnode; + nodeclass[hdisposen]:=chdisposenode; + nodeclass[setelementn]:=csetelementnode; + nodeclass[setconstn]:=csetconstnode; + nodeclass[blockn]:=cblocknode; + nodeclass[statementn]:=cstatementnode; + nodeclass[ifn]:=cifnode; + nodeclass[breakn]:=cbreaknode; + nodeclass[continuen]:=ccontinuenode; + nodeclass[whilerepeatn]:=cwhilerepeatnode; + nodeclass[forn]:=cfornode; + nodeclass[exitn]:=cexitnode; + nodeclass[withn]:=cwithnode; + nodeclass[casen]:=ccasenode; + nodeclass[labeln]:=clabelnode; + nodeclass[goton]:=cgotonode; + nodeclass[tryexceptn]:=ctryexceptnode; + nodeclass[raisen]:=craisenode; + nodeclass[tryfinallyn]:=ctryfinallynode; + nodeclass[onn]:=connode; + nodeclass[isn]:=cisnode; + nodeclass[asn]:=casnode; + nodeclass[caretn]:=caddnode; + nodeclass[failn]:=cfailnode; + nodeclass[starstarn]:=caddnode; + nodeclass[procinlinen]:=cprocinlinenode; + nodeclass[arrayconstructorn]:=carrayconstructornode; + nodeclass[arrayconstructorrangen]:=carrayconstructorrangenode; + nodeclass[tempcreaten]:=ctempcreatenode; + nodeclass[temprefn]:=ctemprefnode; + nodeclass[tempdeleten]:=ctempdeletenode; + nodeclass[addoptn]:=caddnode; + nodeclass[nothingn]:=cnothingnode; + nodeclass[loadvmtn]:=cloadvmtnode; + nodeclass[guidconstn]:=cguidconstnode; + nodeclass[rttin]:=crttinode; + end; + + + procedure registertais; + { + Register all possible tais in the taiclass array that + will be used for loading the tais from a ppu + } + begin + aiclass[ait_none]:=nil; + aiclass[ait_align]:=tai_align; + aiclass[ait_section]:=tai_section; + aiclass[ait_comment]:=tai_comment; + aiclass[ait_direct]:=tai_direct; + aiclass[ait_string]:=tai_string; + aiclass[ait_instruction]:=taicpu; + aiclass[ait_datablock]:=tai_datablock; + aiclass[ait_symbol]:=tai_symbol; + aiclass[ait_symbol_end]:=tai_symbol_end; + aiclass[ait_label]:=tai_label; + aiclass[ait_const_32bit]:=tai_const; + aiclass[ait_const_16bit]:=tai_const; + aiclass[ait_const_8bit]:=tai_const; + aiclass[ait_const_symbol]:=tai_const_symbol; + aiclass[ait_const_rva]:=tai_const_symbol; + aiclass[ait_real_32bit]:=tai_real_32bit; + aiclass[ait_real_64bit]:=tai_real_64bit; + aiclass[ait_real_80bit]:=tai_real_80bit; + aiclass[ait_comp_64bit]:=tai_comp_64bit; +{$ifdef GDB} + aiclass[ait_stabn]:=tai_stabn; + aiclass[ait_stabs]:=tai_stabs; + aiclass[ait_force_line]:=tai_force_line; + aiclass[ait_stab_function_name]:=tai_stab_function_name; +{$endif GDB} +{$ifdef alpha} + { the follow is for the DEC Alpha } + aiclass[ait_frame]:=tai_frame; + aiclass[ait_ent]:=tai_ent; +{$endif alpha} +{$ifdef m68k} +{$warning FIXME: tai_labeled_instruction doesn't exists} +// aiclass[ait_labeled_instruction]:=tai_labeled_instruction; +{$endif m68k} +{$ifdef ia64} + aiclass[ait_bundle]:=tai_bundle; + aiclass[ait_stop]:=tai_stop; +{$endif ia64} +{$ifdef SPARC} +{$WARNING FIXME: tai_labeled_instruction doesn't exists} +// aiclass[ait_labeled_instruction]:=tai_labeled_instruction; +{$endif SPARC} + aiclass[ait_cut]:=tai_cut; + aiclass[ait_regalloc]:=tai_regalloc; + aiclass[ait_tempalloc]:=tai_tempalloc; + aiclass[ait_marker]:=tai_marker; + end; + +end. +{ + $Log$ + Revision 1.1 2002-08-21 13:30:07 mazen + *** empty log message *** + + Revision 1.37 2002/08/18 20:06:25 peter + * inlining is now also allowed in interface + * renamed write/load to ppuwrite/ppuload + * tnode storing in ppu + * nld,ncon,nbas are already updated for storing in ppu + + Revision 1.36 2002/08/15 19:10:35 peter + * first things tai,tnode storing in ppu + + Revision 1.35 2002/08/14 19:14:39 carl + + fpu emulation support (generic and untested) + + Revision 1.34 2002/08/13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.33 2002/08/11 15:28:00 florian + + support of explicit type case ->pointer + (delphi mode only) + + Revision 1.32 2002/07/25 17:54:24 carl + + Extended is now CPU dependant (equal to bestrealtype) + + Revision 1.30 2002/07/07 09:52:32 florian + * powerpc target fixed, very simple units can be compiled + * some basic stuff for better callparanode handling, far from being finished + + Revision 1.29 2002/07/06 20:18:47 carl + + more SPARC patches from Mazen + + Revision 1.28 2002/07/04 20:43:02 florian + * first x86-64 patches + + Revision 1.27 2002/07/01 16:23:54 peter + * cg64 patch + * basics for currency + * asnode updates for class and interface (not finished) + + Revision 1.26 2002/05/18 13:34:16 peter + * readded missing revisions + + Revision 1.25 2002/05/16 19:46:44 carl + + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand + + try to fix temp allocation (still in ifdef) + + generic constructor calls + + start of tassembler / tmodulebase class cleanup + + Revision 1.23 2002/05/12 16:53:09 peter + * moved entry and exitcode to ncgutil and cgobj + * foreach gets extra argument for passing local data to the + iterator function + * -CR checks also class typecasts at runtime by changing them + into as + * fixed compiler to cycle with the -CR option + * fixed stabs with elf writer, finally the global variables can + be watched + * removed a lot of routines from cga unit and replaced them by + calls to cgobj + * u32bit-s32bit updates for and,or,xor nodes. When one element is + u32bit then the other is typecasted also to u32bit without giving + a rangecheck warning/error. + * fixed pascal calling method with reversing also the high tree in + the parast, detected by tcalcst3 test + + Revision 1.22 2002/01/24 12:33:53 jonas + * adapted ranges of native types to int64 (e.g. high cardinal is no + longer longint($ffffffff), but just $fffffff in psystem) + * small additional fix in 64bit rangecheck code generation for 32 bit + processors + * adaption of ranges required the matching talgorithm used for selecting + which overloaded procedure to call to be adapted. It should now always + select the closest match for ordinal parameters. + + inttostr(qword) in sysstr.inc/sysstrh.inc + + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous + fixes were required to be able to add them) + * is_in_limit() moved from ncal to types unit, should always be used + instead of direct comparisons of low/high values of orddefs because + qword is a special case + +} diff --git a/compiler/sparc/rgcpu.pas b/compiler/sparc/rgcpu.pas new file mode 100644 index 0000000000..436cdddbd0 --- /dev/null +++ b/compiler/sparc/rgcpu.pas @@ -0,0 +1,338 @@ +{*****************************************************************************} +{ File : rgcpu.pas } +{ Author : Mazen NEIFER } +{ Project : Free Pascal Compiler (FPC) } +{ Creation date : 2002\26\26 } +{ Last modification date : 2002\08\20 } +{ Licence : GPL } +{ Bug report : mazen.neifer.01@supaero.org } +{*****************************************************************************} +{ + $Id$ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the i386 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; + +{$INCLUDE fpcdefs.inc} + + interface + + uses + cpubase, + cpuinfo, + aasmcpu, + aasmtai, + cclasses,globtype,cgbase,aasmbase,rgobj; + + type + trgcpu = class(trgobj) + + { to keep the same allocation order as with the old routines } + function getregisterint(list: taasmoutput): tregister; override; + procedure ungetregisterint(list: taasmoutput; r : tregister); override; + function getexplicitregisterint(list: taasmoutput; r : tregister) : tregister; override; + + function getregisterfpu(list: taasmoutput) : tregister; override; + procedure ungetregisterfpu(list: taasmoutput; r : tregister); override; + + procedure ungetreference(list: taasmoutput; const ref : treference); override; + + { pushes and restores registers } + procedure pushusedregisters(list: taasmoutput; + var pushed : tpushedsaved;const s: tregisterset); + procedure popusedregisters(list: taasmoutput; + const pushed : tpushedsaved); + + procedure resetusableregisters;override; + + { corrects the fpu stack register by ofs } + function correct_fpuregister(r : tregister;ofs : byte) : tregister; + + fpuvaroffset : byte; + end; + + + implementation + + uses + systems, + globals,verbose,node, + cgobj,tgobj,cga; + + + function trgcpu.getregisterint(list: taasmoutput): tregister; + begin + if countunusedregsint=0 then + internalerror(10);(* +{$ifdef TEMPREGDEBUG} + if curptree^.usableregsint-countunusedregsint>curptree^.registers32 then + internalerror(10); +{$endif TEMPREGDEBUG} +{$ifdef EXTTEMPREGDEBUG} + if curptree^.usableregs-countunusedregistersint>curptree^^.reallyusedregs then + curptree^.reallyusedregs:=curptree^^.usableregs-countunusedregistersint; +{$endif EXTTEMPREGDEBUG} + dec(countunusedregsint); + if R_EAX in unusedregsint then + begin + exclude(unusedregsint,R_EAX); + include(usedinproc,R_EAX); + getregisterint:=R_EAX; +{$ifdef TEMPREGDEBUG} + reg_user[R_EAX]:=curptree^; +{$endif TEMPREGDEBUG} + exprasmlist.concat(tairegalloc.alloc(R_EAX)); + end + else if R_EDX in unusedregsint then + begin + exclude(unusedregsint,R_EDX); + include(usedinproc,R_EDX); + getregisterint:=R_EDX; +{$ifdef TEMPREGDEBUG} + reg_user[R_EDX]:=curptree^; +{$endif TEMPREGDEBUG} + exprasmlist.concat(tairegalloc.alloc(R_EDX)); + end + else if R_EBX in unusedregsint then + begin + exclude(unusedregsint,R_EBX); + include(usedinproc,R_EBX); + getregisterint:=R_EBX; +{$ifdef TEMPREGDEBUG} + reg_user[R_EBX]:=curptree^; +{$endif TEMPREGDEBUG} + exprasmlist.concat(tairegalloc.alloc(R_EBX)); + end + else if R_ECX in unusedregsint then + begin + exclude(unusedregsint,R_ECX); + include(usedinproc,R_ECX); + getregisterint:=R_ECX; +{$ifdef TEMPREGDEBUG} + reg_user[R_ECX]:=curptree^; +{$endif TEMPREGDEBUG} + exprasmlist.concat(tairegalloc.alloc(R_ECX)); + end + else internalerror(10); +{$ifdef TEMPREGDEBUG} + testregisters; +{$endif TEMPREGDEBUG}*) + end; + + procedure trgcpu.ungetregisterint(list: taasmoutput; r : tregister); + begin +{ if (r = R_EDI) or + ((not assigned(procinfo^._class)) and (r = R_ESI)) then + begin + list.concat(Tairegalloc.DeAlloc(r)); + exit; + end; + if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then + exit; + inherited ungetregisterint(list,r);} + end; + + + function trgcpu.getexplicitregisterint(list: taasmoutput; r : tregister) : tregister; + begin +{ if r in [R_ESI,R_EDI] then + begin + list.concat(Tairegalloc.Alloc(r)); + getexplicitregisterint := r; + exit; + end;} + result := inherited getexplicitregisterint(list,r); + end; + + + function trgcpu.getregisterfpu(list: taasmoutput) : tregister; + + begin + { note: don't return R_ST0, see comments above implementation of } + { a_loadfpu_* methods in cgcpu (JM) } +// result := R_ST; + end; + + + procedure trgcpu.ungetregisterfpu(list : taasmoutput; r : tregister); + + begin + { nothing to do, fpu stack management is handled by the load/ } + { store operations in cgcpu (JM) } + end; + + + procedure trgcpu.ungetreference(list: taasmoutput; const ref : treference); + + begin + ungetregisterint(list,ref.base); + ungetregisterint(list,ref.index); + end; + + + procedure trgcpu.pushusedregisters(list: taasmoutput; + var pushed : tpushedsaved; const s: tregisterset); + + var + r: tregister; + hr: treference; + begin + usedinproc:=usedinproc + s; +(* for r:=R_EAX to R_EBX do + begin + pushed[r].pushed:=false; + { if the register is used by the calling subroutine } + if not is_reg_var[r] and + (r in s) and + { and is present in use } + not(r in unusedregsint) then + begin + { then save it } + list.concat(Taicpu.Op_reg(A_PUSH,S_L,r)); + include(unusedregsint,r); + inc(countunusedregsint); + pushed[r].pushed:=true; + end; + end;*) +{$ifdef SUPPORT_MMX} + (*for r:=R_MM0 to R_MM6 do + begin + pushed[r].pushed:=false; + { if the register is used by the calling subroutine } + if not is_reg_var[r] and + (r in s) and + { and is present in use } + not(r in unusedregsmm) then + begin + list.concat(Taicpu.Op_const_reg(A_SUB,S_L,8,R_ESP)); + reference_reset_base(hr,R_ESP,0); + list.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,r,hr)); + include(unusedregsmm,r); + inc(countunusedregsmm); + pushed[r].pushed:=true; + end; + end;*) +{$endif SUPPORT_MMX} +{$ifdef TEMPREGDEBUG} + testregisters; +{$endif TEMPREGDEBUG} + end; + + + procedure trgcpu.popusedregisters(list: taasmoutput; + const pushed : tpushedsaved); + + var + r : tregister; +{$ifdef SUPPORT_MMX} + hr : treference; +{$endif SUPPORT_MMX} + begin + { restore in reverse order: } +{$ifdef SUPPORT_MMX} + for r:=R_MM6 downto R_MM0 do + if pushed[r].pushed then + begin + reference_reset_base(hr,R_ESP,0); + list.concat(Taicpu.Op_ref_reg( + A_MOVQ,S_NO,hr,r)); + list.concat(Taicpu.Op_const_reg( + A_ADD,S_L,8,R_ESP)); + if not (r in unusedregsmm) then + { internalerror(10) + in cg386cal we always restore regs + that appear as used + due to a unused tmep storage PM } + else + dec(countunusedregsmm); + exclude(unusedregsmm,r); + end; +{$endif SUPPORT_MMX} +(* for r:=R_EBX downto R_EAX do + if pushed[r].pushed then + begin + list.concat(Taicpu.Op_reg(A_POP,S_L,r)); + if not (r in unusedregsint) then + { internalerror(10) + in cg386cal we always restore regs + that appear as used + due to a unused tmep storage PM } + else + dec(countunusedregsint); + exclude(unusedregsint,r); + end;*) +{$ifdef TEMPREGDEBUG} + testregisters; +{$endif TEMPREGDEBUG} + end; + + procedure trgcpu.resetusableregisters; + + begin + inherited resetusableregisters; + fpuvaroffset := 0; + end; + + + function trgcpu.correct_fpuregister(r : tregister;ofs : byte) : tregister; + + begin + correct_fpuregister:=tregister(longint(r)+ofs); + end; + + +initialization + rg := trgcpu.create; +end. + +{ + $Log$ + Revision 1.1 2002-08-21 13:30:07 mazen + *** empty log message *** + + Revision 1.2 2002/04/02 17:11:39 peter + * tlocation,treference update + * LOC_CONSTANT added for better constant handling + * secondadd splitted in multiple routines + * location_force_reg added for loading a location to a register + of a specified size + * secondassignment parses now first the right and then the left node + (this is compatible with Kylix). This saves a lot of push/pop especially + with string operations + * adapted some routines to use the new cg methods + + Revision 1.1 2002/03/31 20:26:40 jonas + + a_loadfpu_* and a_loadmm_* methods in tcg + * register allocation is now handled by a class and is mostly processor + independent (+rgobj.pas and i386/rgcpu.pas) + * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas) + * some small improvements and fixes to the optimizer + * some register allocation fixes + * some fpuvaroffset fixes in the unary minus node + * fixed and optimized register saving/restoring for new/dispose nodes + * LOC_FPU locations now also require their "register" field to be set to + R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only) + - list field removed of the tnode class because it's not used currently + and can cause hard-to-find bugs + +}