diff --git a/compiler/compiler.pas b/compiler/compiler.pas index b2dd474b3c..43af17b891 100644 --- a/compiler/compiler.pas +++ b/compiler/compiler.pas @@ -209,6 +209,9 @@ uses {$ifdef powerpc} ,rappcgas {$endif powerpc} +{$ifdef x86_64} + ,rax64att +{$endif x86_64} {$ifdef arm} ,raarmgas {$endif arm} @@ -423,7 +426,11 @@ end; end. { $Log$ - Revision 1.43 2003-12-04 10:46:19 mazen + Revision 1.44 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.43 2003/12/04 10:46:19 mazen + added support for spac assembler reader Revision 1.42 2003/11/17 23:23:47 florian diff --git a/compiler/globals.pas b/compiler/globals.pas index 7cd2325c61..02040e0b81 100644 --- a/compiler/globals.pas +++ b/compiler/globals.pas @@ -1779,7 +1779,7 @@ implementation {$IFDEF testvarsets} initsetalloc:=0; {$ENDIF} - initasmmode:=asmmode_x8664_gas; + initasmmode:=asmmode_x86_64_gas; {$endif x86_64} initinterfacetype:=it_interfacecom; initdefproccall:=pocall_default; @@ -1796,7 +1796,11 @@ implementation end. { $Log$ - Revision 1.120 2004-01-12 16:36:53 peter + Revision 1.121 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.120 2004/01/12 16:36:53 peter * removed asmmode_direct Revision 1.119 2004/01/02 16:50:24 jonas diff --git a/compiler/i386/cgcpu.pas b/compiler/i386/cgcpu.pas index 832cc3fab3..1a5c8c19f8 100644 --- a/compiler/i386/cgcpu.pas +++ b/compiler/i386/cgcpu.pas @@ -40,7 +40,8 @@ unit cgcpu; type tcg386 = class(tcgx86) - class function reg_cgsize(const reg: tregister): tcgsize; override; + procedure init_register_allocators;override; + class function reg_cgsize(const reg: tregister): tcgsize; override; end; tcg64f386 = class(tcg64f32) @@ -57,7 +58,20 @@ unit cgcpu; uses globtype,globals,verbose,systems,cutils, symdef,symsym,defutil,paramgr, - tgobj; + rgcpu,rgx86,tgobj; + + + procedure Tcg386.init_register_allocators; + begin + inherited init_register_allocators; + if cs_create_pic in aktmoduleswitches then + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP,RS_EBX]) + else + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]); + rg[R_MMXREGISTER]:=trgcpu.create(R_MMXREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_sse_imreg,[]); + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_sse_imreg,[]); + rgfpu:=Trgx86fpu.create; + end; class function tcg386.reg_cgsize(const reg: tregister): tcgsize; @@ -232,7 +246,11 @@ begin end. { $Log$ - Revision 1.43 2004-01-12 16:39:40 peter + Revision 1.44 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.43 2004/01/12 16:39:40 peter * sparc updates, mostly float related Revision 1.42 2003/12/24 00:10:02 florian diff --git a/compiler/i386/cpubase.inc b/compiler/i386/cpubase.inc index 0f98af4647..25b4e3e85b 100644 --- a/compiler/i386/cpubase.inc +++ b/compiler/i386/cpubase.inc @@ -153,7 +153,7 @@ This value can be deduced from the CALLED_USED_REGISTERS array in the GCC source. } - std_saved_registers = [RS_ESI,RS_EDI,RS_EBX]; + saved_standard_registers : array[0..2] of tsuperregister = (RS_EBX,RS_ESI,RS_EDI); {# 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. @@ -165,7 +165,11 @@ { $Log$ - Revision 1.10 2003-10-17 14:38:32 peter + Revision 1.11 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.10 2003/10/17 14:38:32 peter * 64k registers supported * fixed some memory leaks diff --git a/compiler/i386/ra386att.pas b/compiler/i386/ra386att.pas index ba305a8206..9c7bb21d15 100644 --- a/compiler/i386/ra386att.pas +++ b/compiler/i386/ra386att.pas @@ -24,774 +24,20 @@ Unit ra386att; {$i fpcdefs.inc} -Interface - - uses - cpubase, - raatt,rax86; - - type - ti386attreader = class(tattreader) - ActOpsize : topsize; - function is_asmopcode(const s: string):boolean;override; - procedure handleopcode;override; - procedure BuildReference(oper : t386operand); - procedure BuildOperand(oper : t386operand); - procedure BuildOpCode(instr : t386instruction); - procedure handlepercent;override; - end; - - -Implementation + interface uses - { helpers } - cutils, - { global } - globtype,globals,verbose, - systems, - { aasm } - cpuinfo,aasmbase,aasmtai,aasmcpu, - { symtable } - symconst,symbase,symtype,symsym,symtable, - { parser } - scanner, - procinfo, - itcpugas, - rabase,rautils, - cgbase,cgobj - ; + rax86att; - procedure ti386attreader.handlepercent; - var - len : longint; - begin - len:=1; - actasmpattern[len]:='%'; - c:=current_scanner.asmgetchar; - { to be a register there must be a letter and not a number } - if c in ['0'..'9'] then - begin - actasmtoken:=AS_MOD; - end - else - begin - while c in ['a'..'z','A'..'Z','0'..'9'] do - Begin - inc(len); - actasmpattern[len]:=c; - c:=current_scanner.asmgetchar; - end; - actasmpattern[0]:=chr(len); - uppervar(actasmpattern); - if (actasmpattern = '%ST') and (c='(') then - Begin - actasmpattern:=actasmpattern+c; - c:=current_scanner.asmgetchar; - if c in ['0'..'9'] then - actasmpattern:=actasmpattern + c - else - Message(asmr_e_invalid_fpu_register); - c:=current_scanner.asmgetchar; - if c <> ')' then - Message(asmr_e_invalid_fpu_register) - else - Begin - actasmpattern:=actasmpattern + c; - c:=current_scanner.asmgetchar; { let us point to next character. } - end; - end; - if is_register(actasmpattern) then - exit; - Message(asmr_e_invalid_register); - actasmtoken:=raatt.AS_NONE; - end; + type + ti386attreader = class(tx86attreader) end; - Procedure ti386attreader.BuildReference(oper : t386operand); + implementation - procedure Consume_RParen; - begin - if actasmtoken <> AS_RPAREN then - Begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(true); - end - else - begin - Consume(AS_RPAREN); - if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then - Begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(true); - end; - end; - end; - - - procedure Consume_Scale; - var - l : longint; - begin - { we have to process the scaling } - l:=BuildConstExpression(false,true); - if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) then - oper.opr.ref.scalefactor:=l - else - Begin - Message(asmr_e_wrong_scale_factor); - oper.opr.ref.scalefactor:=0; - end; - end; - - - begin - oper.InitRef; - Consume(AS_LPAREN); - Case actasmtoken of - AS_INTNUM, - AS_MINUS, - AS_PLUS: { absolute offset, such as fs:(0x046c) } - Begin - { offset(offset) is invalid } - If oper.opr.Ref.Offset <> 0 Then - Begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(true); - End - Else - Begin - oper.opr.Ref.Offset:=BuildConstExpression(false,true); - Consume_RParen; - end; - exit; - End; - AS_REGISTER: { (reg ... } - Begin - { Check if there is already a base (mostly ebp,esp) than this is - not allowed, because it will give crashing code } - if ((oper.opr.typ=OPR_REFERENCE) and (oper.opr.ref.base<>NR_NO)) or - ((oper.opr.typ=OPR_LOCAL) and (oper.opr.localsym.localloc.loc<>LOC_REGISTER)) then - message(asmr_e_cannot_index_relative_var); - oper.opr.ref.base:=actasmregister; - Consume(AS_REGISTER); - { can either be a register or a right parenthesis } - { (reg) } - if actasmtoken=AS_RPAREN then - Begin - Consume_RParen; - exit; - end; - { (reg,reg .. } - Consume(AS_COMMA); - if actasmtoken=AS_REGISTER then - Begin - oper.opr.ref.index:=actasmregister; - Consume(AS_REGISTER); - { check for scaling ... } - case actasmtoken of - AS_RPAREN: - Begin - Consume_RParen; - exit; - end; - AS_COMMA: - Begin - Consume(AS_COMMA); - Consume_Scale; - Consume_RParen; - end; - else - Begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(false); - end; - end; { end case } - end - else - Begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(false); - end; - end; {end case } - AS_COMMA: { (, ... can either be scaling, or index } - Begin - Consume(AS_COMMA); - { Index } - if (actasmtoken=AS_REGISTER) then - Begin - oper.opr.ref.index:=actasmregister; - Consume(AS_REGISTER); - { check for scaling ... } - case actasmtoken of - AS_RPAREN: - Begin - Consume_RParen; - exit; - end; - AS_COMMA: - Begin - Consume(AS_COMMA); - Consume_Scale; - Consume_RParen; - end; - else - Begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(false); - end; - end; {end case } - end - { Scaling } - else - Begin - Consume_Scale; - Consume_RParen; - exit; - end; - end; - else - Begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(false); - end; - end; - end; - - - Procedure ti386attreader.BuildOperand(oper : t386operand); - var - tempstr, - expr : string; - typesize, - l,k : longint; - - - procedure AddLabelOperand(hl:tasmlabel); - begin - if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and - is_calljmp(actopcode) then - begin - oper.opr.typ:=OPR_SYMBOL; - oper.opr.symbol:=hl; - end - else - begin - oper.InitRef; - oper.opr.ref.symbol:=hl; - end; - end; - - - procedure MaybeRecordOffset; - var - hasdot : boolean; - l, - toffset, - tsize : longint; - begin - if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then - exit; - l:=0; - hasdot:=(actasmtoken=AS_DOT); - if hasdot then - begin - if expr<>'' then - begin - BuildRecordOffsetSize(expr,toffset,tsize); - inc(l,toffset); - oper.SetSize(tsize,true); - end; - end; - if actasmtoken in [AS_PLUS,AS_MINUS] then - inc(l,BuildConstExpression(true,false)); - case oper.opr.typ of - OPR_LOCAL : - begin - { don't allow direct access to fields of parameters, because that - will generate buggy code. Allow it only for explicit typecasting } - if hasdot and - (not oper.hastype) and - (tvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and - (current_procinfo.procdef.proccalloption<>pocall_register) then - Message(asmr_e_cannot_access_field_directly_for_parameters); - inc(oper.opr.localsymofs,l) - end; - OPR_CONSTANT : - inc(oper.opr.val,l); - OPR_REFERENCE : - inc(oper.opr.ref.offset,l); - else - internalerror(200309221); - end; - end; - - - function MaybeBuildReference:boolean; - { Try to create a reference, if not a reference is found then false - is returned } - begin - MaybeBuildReference:=true; - case actasmtoken of - AS_INTNUM, - AS_MINUS, - AS_PLUS: - Begin - oper.opr.ref.offset:=BuildConstExpression(True,False); - if actasmtoken<>AS_LPAREN then - Message(asmr_e_invalid_reference_syntax) - else - BuildReference(oper); - end; - AS_LPAREN: - BuildReference(oper); - AS_ID: { only a variable is allowed ... } - Begin - tempstr:=actasmpattern; - Consume(AS_ID); - { typecasting? } - if (actasmtoken=AS_LPAREN) and - SearchType(tempstr,typesize) then - begin - oper.hastype:=true; - Consume(AS_LPAREN); - BuildOperand(oper); - Consume(AS_RPAREN); - if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then - oper.SetSize(typesize,true); - end - else - if not oper.SetupVar(tempstr,false) then - Message1(sym_e_unknown_id,tempstr); - { record.field ? } - if actasmtoken=AS_DOT then - begin - BuildRecordOffsetSize(tempstr,l,k); - inc(oper.opr.ref.offset,l); - end; - case actasmtoken of - AS_END, - AS_SEPARATOR, - AS_COMMA: ; - AS_LPAREN: - BuildReference(oper); - else - Begin - Message(asmr_e_invalid_reference_syntax); - Consume(actasmtoken); - end; - end; {end case } - end; - else - MaybeBuildReference:=false; - end; { end case } - end; - - - const - regsize_2_size: array[S_B..S_L] of longint = (1,2,4); - var - tempreg : tregister; - hl : tasmlabel; - Begin - expr:=''; - case actasmtoken of - AS_LPAREN: { Memory reference or constant expression } - Begin - oper.InitRef; - BuildReference(oper); - end; - - AS_DOLLAR: { Constant expression } - Begin - Consume(AS_DOLLAR); - BuildConstantOperand(oper); - end; - - AS_INTNUM, - AS_MINUS, - AS_PLUS: - Begin - { Constant memory offset } - { This must absolutely be followed by ( } - oper.InitRef; - oper.opr.ref.offset:=BuildConstExpression(True,False); - if actasmtoken<>AS_LPAREN then - Message(asmr_e_invalid_reference_syntax) - else - BuildReference(oper); - end; - - AS_STAR: { Call from memory address } - Begin - Consume(AS_STAR); - if actasmtoken=AS_REGISTER then - begin - oper.opr.typ:=OPR_REGISTER; - oper.opr.reg:=actasmregister; - oper.SetSize(regsize_2_size[reg2opsize(actasmregister)],true); - Consume(AS_REGISTER); - end - else - begin - oper.InitRef; - if not MaybeBuildReference then - Message(asmr_e_syn_operand); - end; - { this is only allowed for call's and jmp's } - if not is_calljmp(actopcode) then - Message(asmr_e_syn_operand); - end; - - AS_ID: { A constant expression, or a Variable ref. } - Begin - { Local Label ? } - if is_locallabel(actasmpattern) then - begin - CreateLocalLabel(actasmpattern,hl,false); - Consume(AS_ID); - AddLabelOperand(hl); - end - else - { Check for label } - if SearchLabel(actasmpattern,hl,false) then - begin - Consume(AS_ID); - AddLabelOperand(hl); - end - else - { probably a variable or normal expression } - { or a procedure (such as in CALL ID) } - Begin - { is it a constant ? } - if SearchIConstant(actasmpattern,l) then - Begin - if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then - Message(asmr_e_invalid_operand_type); - BuildConstantOperand(oper); - end - else - begin - expr:=actasmpattern; - Consume(AS_ID); - { typecasting? } - if (actasmtoken=AS_LPAREN) and - SearchType(expr,typesize) then - begin - oper.hastype:=true; - Consume(AS_LPAREN); - BuildOperand(oper); - Consume(AS_RPAREN); - if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then - oper.SetSize(typesize,true); - end - else - begin - if oper.SetupVar(expr,false) then - begin - end - else - Begin - { look for special symbols ... } - if expr= '__HIGH' then - begin - consume(AS_LPAREN); - if not oper.setupvar('high'+actasmpattern,false) then - Message1(sym_e_unknown_id,'high'+actasmpattern); - consume(AS_ID); - consume(AS_RPAREN); - end - else - if expr = '__RESULT' then - oper.SetUpResult - else - if expr = '__SELF' then - oper.SetupSelf - else - if expr = '__OLDEBP' then - oper.SetupOldEBP - else - { check for direct symbolic names } - { only if compiling the system unit } - if (cs_compilesystem in aktmoduleswitches) then - begin - if not oper.SetupDirectVar(expr) then - Begin - { not found, finally ... add it anyways ... } - Message1(asmr_w_id_supposed_external,expr); - oper.InitRef; - oper.opr.ref.symbol:=objectlibrary.newasmsymbol(expr); - end; - end - else - Message1(sym_e_unknown_id,expr); - end; - end; - end; - if actasmtoken=AS_DOT then - MaybeRecordOffset; - { add a constant expression? } - if (actasmtoken=AS_PLUS) then - begin - l:=BuildConstExpression(true,false); - case oper.opr.typ of - OPR_CONSTANT : - inc(oper.opr.val,l); - OPR_LOCAL : - inc(oper.opr.localsymofs,l); - OPR_REFERENCE : - inc(oper.opr.ref.offset,l); - else - internalerror(200309202); - end; - end - end; - { Do we have a indexing reference, then parse it also } - if actasmtoken=AS_LPAREN then - BuildReference(oper); - end; - - AS_REGISTER: { Register, a variable reference or a constant reference } - Begin - { save the type of register used. } - tempreg:=actasmregister; - Consume(AS_REGISTER); - if actasmtoken = AS_COLON then - Begin - Consume(AS_COLON); - oper.InitRef; - oper.opr.ref.segment:=tempreg; - { This must absolutely be followed by a reference } - if not MaybeBuildReference then - Begin - Message(asmr_e_invalid_seg_override); - Consume(actasmtoken); - end; - end - { Simple register } - else if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then - Begin - if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then - Message(asmr_e_invalid_operand_type); - oper.opr.typ:=OPR_REGISTER; - oper.opr.reg:=tempreg; - oper.SetSize(tcgsize2size[cg.reg_cgsize(oper.opr.reg)],true); - end - else - Message(asmr_e_syn_operand); - end; - AS_END, - AS_SEPARATOR, - AS_COMMA: ; - else - Begin - Message(asmr_e_syn_operand); - Consume(actasmtoken); - end; - end; { end case } - end; - - - procedure ti386attreader.BuildOpCode(instr : t386instruction); - var - operandnum : longint; - PrefixOp,OverrideOp: tasmop; - Begin - PrefixOp:=A_None; - OverrideOp:=A_None; - { prefix seg opcode / prefix opcode } - repeat - if is_prefix(actopcode) then - begin - PrefixOp:=ActOpcode; - with instr do - begin - opcode:=ActOpcode; - condition:=ActCondition; - opsize:=ActOpsize; - ConcatInstruction(curlist); - end; - Consume(AS_OPCODE); - end - else - if is_override(actopcode) then - begin - OverrideOp:=ActOpcode; - with instr do - begin - opcode:=ActOpcode; - condition:=ActCondition; - opsize:=ActOpsize; - ConcatInstruction(curlist); - end; - Consume(AS_OPCODE); - end - else - break; - { allow for newline as in gas styled syntax } - while actasmtoken=AS_SEPARATOR do - Consume(AS_SEPARATOR); - until (actasmtoken<>AS_OPCODE); - { opcode } - if (actasmtoken<>AS_OPCODE) then - Begin - Message(asmr_e_invalid_or_missing_opcode); - RecoverConsume(true); - exit; - end; - { Fill the instr object with the current state } - with instr do - begin - Opcode:=ActOpcode; - condition:=ActCondition; - opsize:=ActOpsize; - end; - - { Valid combination of prefix/override and instruction ? } - - if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then - Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern); - - if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then - Message1(asmr_e_invalid_override_and_opcode,actasmpattern); - { We are reading operands, so opcode will be an AS_ID } - operandnum:=1; - Consume(AS_OPCODE); - { Zero operand opcode ? } - if actasmtoken in [AS_SEPARATOR,AS_END] then - begin - operandnum:=0; - exit; - end; - { Read the operands } - repeat - case actasmtoken of - AS_COMMA: { Operand delimiter } - Begin - if operandnum > Max_Operands then - Message(asmr_e_too_many_operands) - else - Inc(operandnum); - Consume(AS_COMMA); - end; - AS_SEPARATOR, - AS_END : { End of asm operands for this opcode } - begin - break; - end; - else - BuildOperand(instr.Operands[operandnum] as t386operand); - end; { end case } - until false; - instr.Ops:=operandnum; - end; - - - function ti386attreader.is_asmopcode(const s: string):boolean; - const - { We need first to check the long prefixes, else we get probs - with things like movsbl } - att_sizesuffixstr : array[0..9] of string[2] = ( - '','BW','BL','WL','B','W','L','S','Q','T' - ); - att_sizesuffix : array[0..9] of topsize = ( - S_NO,S_BW,S_BL,S_WL,S_B,S_W,S_L,S_FS,S_IQ,S_FX - ); - att_sizefpusuffix : array[0..9] of topsize = ( - S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_FL,S_FS,S_IQ,S_FX - ); - att_sizefpuintsuffix : array[0..9] of topsize = ( - S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_IL,S_IS,S_IQ,S_NO - ); - var - str2opentry: tstr2opentry; - cond : string[4]; - cnd : tasmcond; - len, - j, - sufidx : longint; - Begin - is_asmopcode:=FALSE; - - actopcode:=A_None; - actcondition:=C_None; - actopsize:=S_NO; - - { search for all possible suffixes } - for sufidx:=low(att_sizesuffixstr) to high(att_sizesuffixstr) do - begin - len:=length(s)-length(att_sizesuffixstr[sufidx]); - if copy(s,len+1,length(att_sizesuffixstr[sufidx]))=att_sizesuffixstr[sufidx] then - begin - { here we search the entire table... } - str2opentry:=nil; - if {(length(s)>0) and} (len>0) then - str2opentry:=tstr2opentry(iasmops.search(copy(s,1,len))); - if assigned(str2opentry) then - begin - actopcode:=str2opentry.op; - if gas_needsuffix[actopcode]=attsufFPU then - actopsize:=att_sizefpusuffix[sufidx] - else if gas_needsuffix[actopcode]=attsufFPUint then - actopsize:=att_sizefpuintsuffix[sufidx] - else - actopsize:=att_sizesuffix[sufidx]; - actasmtoken:=AS_OPCODE; - is_asmopcode:=TRUE; - exit; - end; - { not found, check condition opcodes } - j:=0; - while (j'' then - begin - for cnd:=low(TasmCond) to high(TasmCond) do - if Cond=Upper(cond2str[cnd]) then - begin - actopcode:=CondASmOp[j]; - if gas_needsuffix[actopcode]=attsufFPU then - actopsize:=att_sizefpusuffix[sufidx] - else if gas_needsuffix[actopcode]=attsufFPUint then - actopsize:=att_sizefpuintsuffix[sufidx] - else - actopsize:=att_sizesuffix[sufidx]; - actcondition:=cnd; - actasmtoken:=AS_OPCODE; - is_asmopcode:=TRUE; - exit; - end; - end; - end; - inc(j); - end; - end; - end; - end; - - - procedure ti386attreader.handleopcode; - var - instr : T386Instruction; - begin - instr:=T386Instruction.Create(T386Operand); - instr.OpOrder:=op_att; - BuildOpcode(instr); - instr.AddReferenceSizes; - instr.SetInstructionOpsize; - instr.CheckOperandSizes; - instr.ConcatInstruction(curlist); - instr.Free; - end; - - -{***************************************************************************** - Initialize -*****************************************************************************} + uses + rabase,systems; const asmmode_i386_att_info : tasmmodeinfo = @@ -806,191 +52,7 @@ initialization end. { $Log$ - Revision 1.58 2003-11-12 16:05:39 florian - * assembler readers OOPed - + typed currency constants - + typed 128 bit float constants if the CPU supports it - - Revision 1.57 2003/11/10 19:08:32 peter - * line numbering is now only done when #10, #10#13 is really parsed - instead of when it is the next character - - Revision 1.56 2003/10/29 16:47:18 peter - * fix field offset in reference - - Revision 1.55 2003/10/26 13:37:22 florian - * fixed web bug 2128 - - Revision 1.54 2003/10/24 17:39:03 peter - * more intel parser updates - - Revision 1.53 2003/10/23 17:19:44 peter - * typecasting fixes - * reference building more delphi compatible - - Revision 1.52 2003/10/20 19:29:35 peter - * fix check for register subscription of reference parameter - - Revision 1.51 2003/10/16 21:29:24 peter - + __HIGH() to retrieve high value - - Revision 1.50 2003/10/07 18:21:18 peter - * fix crash - * allow parameter subscription for register parameters - - Revision 1.49 2003/10/01 20:34:49 peter - * procinfo unit contains tprocinfo - * cginfo renamed to cgbase - * moved cgmessage to verbose - * fixed ppc and sparc compiles - - Revision 1.48 2003/09/23 20:37:53 peter - * fix global var+offset - - Revision 1.47 2003/09/23 17:56:06 peter - * locals and paras are allocated in the code generation - * tvarsym.localloc contains the location of para/local when - generating code for the current procedure - - Revision 1.46 2003/09/03 15:55:01 peter - * NEWRA branch merged - - Revision 1.45.2.2 2003/08/31 15:46:26 peter - * more updates for tregister - - Revision 1.45.2.1 2003/08/28 18:35:08 peter - * tregister changed to cardinal - - Revision 1.45 2003/05/30 23:57:08 peter - * more sparc cleanup - * accumulator removed, splitted in function_return_reg (called) and - function_result_reg (caller) - - Revision 1.44 2003/05/22 21:32:29 peter - * removed some unit dependencies - - Revision 1.43 2003/04/30 15:45:35 florian - * merged more x86-64/i386 code - - Revision 1.42 2003/04/25 12:04:31 florian - * merged agx64att and ag386att to x86/agx86att - - Revision 1.41 2003/04/21 20:05:10 peter - * removed some ie checks - - Revision 1.40 2003/03/18 18:15:53 peter - * changed reg2opsize to function - - Revision 1.39 2003/02/20 15:52:58 pierre - * fix a range check error - - Revision 1.38 2003/02/19 22:00:16 daniel - * Code generator converted to new register notation - - Horribily outdated todo.txt removed - - Revision 1.37 2003/02/03 22:47:14 daniel - - Removed reg_2_opsize array - - Revision 1.36 2003/01/08 18:43:57 daniel - * Tregister changed into a record - - Revision 1.35 2002/12/14 15:02:03 carl - * maxoperands -> max_operands (for portability in rautils.pas) - * fix some range-check errors with loadconst - + add ncgadd unit to m68k - * some bugfix of a_param_reg with LOC_CREFERENCE - - Revision 1.34 2002/12/01 22:08:34 carl - * some small cleanup (remove some specific operators which are not supported) - - Revision 1.33 2002/11/30 23:16:39 carl - - removed unused message - - Revision 1.32 2002/11/15 01:58:58 peter - * merged changes from 1.0.7 up to 04-11 - - -V option for generating bug report tracing - - more tracing for option parsing - - errors for cdecl and high() - - win32 import stabs - - win32 records<=8 are returned in eax:edx (turned off by default) - - heaptrc update - - more info for temp management in .s file with EXTDEBUG - - Revision 1.31 2002/09/03 16:26:28 daniel - * Make Tprocdef.defs protected - - Revision 1.30 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.29 2002/08/12 15:08:42 carl - + stab register indexes for powerpc (moved from gdb to cpubase) - + tprocessor enumeration moved to cpuinfo - + linker in target_info is now a class - * many many updates for m68k (will soon start to compile) - - removed some ifdef or correct them for correct cpu - - Revision 1.28 2002/08/11 14:32:31 peter - * renamed current_library to objectlibrary - - Revision 1.27 2002/08/11 13:24:17 peter - * saving of asmsymbols in ppu supported - * asmsymbollist global is removed and moved into a new class - tasmlibrarydata that will hold the info of a .a file which - corresponds with a single module. Added librarydata to tmodule - to keep the library info stored for the module. In the future the - objectfiles will also be stored to the tasmlibrarydata class - * all getlabel/newasmsymbol and friends are moved to the new class - - Revision 1.26 2002/07/26 21:15:44 florian - * rewrote the system handling - - Revision 1.25 2002/07/01 18:46:34 peter - * internal linker - * reorganized aasm layer - - Revision 1.24 2002/05/18 13:34:25 peter - * readded missing revisions - - Revision 1.23 2002/05/16 19:46:52 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.21 2002/04/15 19:12:09 carl - + target_info.size_of_pointer -> pointer_size - + some cleanup of unused types/variables - * move several constants from cpubase to their specific units - (where they are used) - + att_Reg2str -> gas_reg2str - + int_reg2str -> std_reg2str - - Revision 1.20 2002/04/14 17:01:52 carl - + att_reg2str -> gas_reg2str - - Revision 1.19 2002/04/04 19:06:13 peter - * removed unused units - * use tlocation.size in cg.a_*loc*() routines - - Revision 1.18 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.17 2002/03/28 20:48:25 carl - - remove go32v1 support - - Revision 1.16 2002/01/24 18:25:53 peter - * implicit result variable generation for assembler routines - * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead - + Revision 1.59 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related } diff --git a/compiler/i386/ra386int.pas b/compiler/i386/ra386int.pas index ef0c76b46c..61f22af3a7 100644 --- a/compiler/i386/ra386int.pas +++ b/compiler/i386/ra386int.pas @@ -65,10 +65,10 @@ Unit Ra386int; procedure BuildConstSymbolExpression(needofs,isref:boolean;var value:longint;var asmsym:string); function BuildConstExpression:longint; function BuildRefConstExpression:longint; - procedure BuildReference(oper : t386operand); - procedure BuildOperand(oper: t386operand); - procedure BuildConstantOperand(oper: t386operand); - procedure BuildOpCode(instr : t386instruction); + procedure BuildReference(oper : tx86operand); + procedure BuildOperand(oper: tx86operand); + procedure BuildConstantOperand(oper: tx86operand); + procedure BuildOpCode(instr : tx86instruction); procedure BuildConstant(maxvalue: longint); end; @@ -1028,7 +1028,7 @@ Unit Ra386int; end; - procedure ti386intreader.BuildReference(oper : t386operand); + procedure ti386intreader.BuildReference(oper : tx86operand); var k,l,scale : longint; tempstr,hs : string; @@ -1366,7 +1366,7 @@ Unit Ra386int; end; - Procedure ti386intreader.BuildConstantOperand(oper: t386operand); + Procedure ti386intreader.BuildConstantOperand(oper: tx86operand); var l : longint; tempstr : string; @@ -1393,7 +1393,7 @@ Unit Ra386int; end; - Procedure ti386intreader.BuildOperand(oper: t386operand); + Procedure ti386intreader.BuildOperand(oper: tx86operand); procedure AddLabelOperand(hl:tasmlabel); begin @@ -1634,7 +1634,7 @@ Unit Ra386int; end; - Procedure ti386intreader.BuildOpCode(instr : t386instruction); + Procedure ti386intreader.BuildOpCode(instr : tx86instruction); var PrefixOp,OverrideOp: tasmop; size, @@ -1751,7 +1751,7 @@ Unit Ra386int; Consume(AS_PTR); instr.Operands[operandnum].InitRef; end; - BuildOperand(instr.Operands[operandnum] as t386operand); + BuildOperand(instr.Operands[operandnum] as tx86operand); { now set the size which was specified by the override } instr.Operands[operandnum].setsize(size,true); end; @@ -1776,10 +1776,10 @@ Unit Ra386int; Consume(AS_PTR); instr.Operands[operandnum].InitRef; end; - BuildOperand(instr.Operands[operandnum] as t386operand); + BuildOperand(instr.Operands[operandnum] as tx86operand); end; else - BuildOperand(instr.Operands[operandnum] as t386operand); + BuildOperand(instr.Operands[operandnum] as tx86operand); end; { end case } until false; instr.Ops:=operandnum; @@ -1856,7 +1856,7 @@ Unit Ra386int; function ti386intreader.Assemble: tlinkedlist; Var hl : tasmlabel; - instr : T386Instruction; + instr : Tx86Instruction; Begin Message1(asmr_d_start_reading,'intel'); inexpression:=FALSE; @@ -1920,7 +1920,7 @@ Unit Ra386int; AS_OPCODE : Begin - instr:=T386Instruction.Create(T386Operand); + instr:=Tx86Instruction.Create(Tx86Operand); BuildOpcode(instr); with instr do begin @@ -1977,7 +1977,11 @@ begin end. { $Log$ - Revision 1.68 2003-11-29 20:13:25 florian + Revision 1.69 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.68 2003/11/29 20:13:25 florian * fixed several pi_do_call problems Revision 1.67 2003/11/29 15:53:06 florian diff --git a/compiler/systems.pas b/compiler/systems.pas index 054c5cc1e0..9cfca7193b 100644 --- a/compiler/systems.pas +++ b/compiler/systems.pas @@ -70,7 +70,7 @@ interface ,asmmode_ppc_motorola ,asmmode_arm_gas ,asmmode_sparc_gas - ,asmmode_x8664_gas + ,asmmode_x86_64_gas ); (* IMPORTANT NOTE: @@ -649,7 +649,11 @@ finalization end. { $Log$ - Revision 1.78 2004-01-12 16:39:40 peter + Revision 1.79 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.78 2004/01/12 16:39:40 peter * sparc updates, mostly float related Revision 1.77 2004/01/04 21:17:51 jonas diff --git a/compiler/x86/cgx86.pas b/compiler/x86/cgx86.pas index fc8982843c..e549d1ecb9 100644 --- a/compiler/x86/cgx86.pas +++ b/compiler/x86/cgx86.pas @@ -37,7 +37,6 @@ unit cgx86; type tcgx86 = class(tcg) rgfpu : Trgx86fpu; - procedure init_register_allocators;override; procedure done_register_allocators;override; function getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;override; @@ -188,19 +187,6 @@ unit cgx86; end; - procedure Tcgx86.init_register_allocators; - begin - inherited init_register_allocators; - if cs_create_pic in aktmoduleswitches then - rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP,RS_EBX]) - else - rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]); - rg[R_MMXREGISTER]:=trgcpu.create(R_MMXREGISTER,R_SUBNONE,[RS_MM0,RS_MM1,RS_MM2,RS_MM3,RS_MM4,RS_MM5,RS_MM6,RS_MM7],first_sse_imreg,[]); - rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,[RS_MM0,RS_MM1,RS_MM2,RS_MM3,RS_MM4,RS_MM5,RS_MM6,RS_MM7],first_sse_imreg,[]); - rgfpu:=Trgx86fpu.create; - end; - - procedure Tcgx86.done_register_allocators; begin rg[R_INTREGISTER].free; @@ -1806,63 +1792,45 @@ unit cgx86; var href : treference; size : longint; + r : integer; begin { Get temp } size:=0; - if RS_EBX in rg[R_INTREGISTER].used_in_proc then - inc(size,POINTER_SIZE); - if RS_ESI in rg[R_INTREGISTER].used_in_proc then - inc(size,POINTER_SIZE); - if RS_EDI in rg[R_INTREGISTER].used_in_proc then - inc(size,POINTER_SIZE); + for r:=low(saved_standard_registers) to high(saved_standard_registers) do + if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then + inc(size,POINTER_SIZE); if size>0 then begin tg.GetTemp(list,size,tt_noreuse,current_procinfo.save_regs_ref); { Copy registers to temp } href:=current_procinfo.save_regs_ref; - if RS_EBX in rg[R_INTREGISTER].used_in_proc then + + for r:=low(saved_standard_registers) to high(saved_standard_registers) do begin - a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_EBX,href); - inc(href.offset,POINTER_SIZE); - end; - if RS_ESI in rg[R_INTREGISTER].used_in_proc then - begin - a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_ESI,href); - inc(href.offset,POINTER_SIZE); - end; - if RS_EDI in rg[R_INTREGISTER].used_in_proc then - begin - a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_EDI,href); - inc(href.offset,POINTER_SIZE); + if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then + begin + a_load_reg_ref(list,OS_ADDR,OS_ADDR,newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE),href); + inc(href.offset,POINTER_SIZE); + end; + include(rg[R_INTREGISTER].preserved_by_proc,saved_standard_registers[r]); end; end; - include(rg[R_INTREGISTER].preserved_by_proc,RS_EBX); - include(rg[R_INTREGISTER].preserved_by_proc,RS_ESI); - include(rg[R_INTREGISTER].preserved_by_proc,RS_EDI); end; procedure tcgx86.g_restore_standard_registers(list:Taasmoutput); var href : treference; + r : integer; begin { Copy registers from temp } href:=current_procinfo.save_regs_ref; - if RS_EBX in rg[R_INTREGISTER].used_in_proc then - begin - a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EBX); - inc(href.offset,POINTER_SIZE); - end; - if RS_ESI in rg[R_INTREGISTER].used_in_proc then - begin - a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_ESI); - inc(href.offset,POINTER_SIZE); - end; - if RS_EDI in rg[R_INTREGISTER].used_in_proc then - begin - a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EDI); - inc(href.offset,POINTER_SIZE); - end; + for r:=low(saved_standard_registers) to high(saved_standard_registers) do + if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then + begin + a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE)); + inc(href.offset,POINTER_SIZE); + end; tg.UnGetTemp(list,current_procinfo.save_regs_ref); end; @@ -1927,7 +1895,11 @@ unit cgx86; end. { $Log$ - Revision 1.101 2004-01-14 21:43:54 peter + Revision 1.102 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.101 2004/01/14 21:43:54 peter * add release_openarrayvalue Revision 1.100 2003/12/26 14:02:30 peter diff --git a/compiler/x86/cpubase.pas b/compiler/x86/cpubase.pas index 801a042b63..f047a3af17 100644 --- a/compiler/x86/cpubase.pas +++ b/compiler/x86/cpubase.pas @@ -118,22 +118,22 @@ uses first_fpu_imreg = $08; { MM Super registers } - RS_MM0 = $00; - RS_MM1 = $01; - RS_MM2 = $02; - RS_MM3 = $03; - RS_MM4 = $04; - RS_MM5 = $05; - RS_MM6 = $06; - RS_MM7 = $07; - RS_MM8 = $08; - RS_MM9 = $09; - RS_MM10 = $0a; - RS_MM11 = $0b; - RS_MM12 = $0c; - RS_MM13 = $0d; - RS_MM14 = $0e; - RS_MM15 = $0f; + RS_XMM0 = $00; + RS_XMM1 = $01; + RS_XMM2 = $02; + RS_XMM3 = $03; + RS_XMM4 = $04; + RS_XMM5 = $05; + RS_XMM6 = $06; + RS_XMM7 = $07; + RS_XMM8 = $08; + RS_XMM9 = $09; + RS_XMM10 = $0a; + RS_XMM11 = $0b; + RS_XMM12 = $0c; + RS_XMM13 = $0d; + RS_XMM14 = $0e; + RS_XMM15 = $0f; { Number of first imaginary register } {$ifdef x86_64} @@ -535,7 +535,11 @@ implementation end. { $Log$ - Revision 1.35 2004-01-12 16:37:59 peter + Revision 1.36 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.35 2004/01/12 16:37:59 peter * moved spilling code from taicpu to rg Revision 1.34 2003/12/26 13:19:16 florian diff --git a/compiler/x86/radirect.pas b/compiler/x86/radirect.pas deleted file mode 100644 index f14e88d9df..0000000000 --- a/compiler/x86/radirect.pas +++ /dev/null @@ -1,500 +0,0 @@ -{ - $Id$ - Copyright (c) 1998-2002 by Florian Klaempfl - - Reads inline assembler and writes the lines direct to the output - - 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 radirect; - -{$i fpcdefs.inc} - -interface - - uses - node; - - function assemble : tnode; - - implementation - - uses - { common } - cutils, - { global } - globals,verbose, - systems, - { aasm } - aasmbase,aasmtai,aasmcpu, - { symtable } - symconst,symbase,symtype,symsym,symtable,defutil,paramgr, - { pass 1 } - nbas, - { parser } - scanner, - rax86, - { codegen } - cgbase,procinfo, - { constants } - itx86att, - cpubase - ; - - function assemble : tnode; - - var - uhs, - retstr,s,hs : string; - c : char; - ende : boolean; - srsym,sym : tsym; - srsymtable : tsymtable; - code : TAAsmoutput; - i,l : longint; - - procedure writeasmline; - var - i : longint; - begin - i:=length(s); - while (i>0) and (s[i] in [' ',#9]) do - dec(i); - s[0]:=chr(i); - if s<>'' then - code.concat(Tai_direct.Create(strpnew(s))); - s:=''; - end; - - begin - ende:=false; - s:=''; - if assigned(current_procinfo.procdef.funcretsym) and - is_fpu(current_procinfo.procdef.rettype.def) then - tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned; - c:=current_scanner.asmgetcharstart; - code:=TAAsmoutput.Create; - while not(ende) do - begin - { wrong placement - current_scanner.gettokenpos; } - case c of - 'A'..'Z','a'..'z','_' : begin - current_scanner.gettokenpos; - i:=0; - hs:=''; - while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z'))) - or ((ord(c)>=ord('a')) and (ord(c)<=ord('z'))) - or ((ord(c)>=ord('0')) and (ord(c)<=ord('9'))) - or (c='_') do - begin - inc(i); - hs[i]:=c; - c:=current_scanner.asmgetchar; - end; - hs[0]:=chr(i); - if upper(hs)='END' then - ende:=true - else - begin - if c=':' then - begin - searchsym(upper(hs),srsym,srsymtable); - if srsym<>nil then - if (srsym.typ = labelsym) then - Begin - hs:=tlabelsym(srsym).lab.name; - tlabelsym(srsym).lab.is_set:=true; - end - else - Message(asmr_w_using_defined_as_local); - end - else if upper(hs)='FWAIT' then - FwaitWarning - else - { access to local variables } - if assigned(current_procinfo.procdef) then - begin - { is the last written character an special } - { char ? } - if (s[length(s)]='%') and - (not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption)) and - ((pos('AX',upper(hs))>0) or - (pos('AL',upper(hs))>0)) then - tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned; - if (s[length(s)]<>'%') and - (s[length(s)]<>'$') and - (s[length(s)]<>'.') and - ((s[length(s)]<>'0') or (hs[1]<>'x')) then - begin - if assigned(current_procinfo.procdef.localst) and - (current_procinfo.procdef.localst.symtablelevel>=normal_function_level) then - sym:=tsym(current_procinfo.procdef.localst.search(upper(hs))) - else - sym:=nil; - if assigned(sym) then - begin - if (sym.typ = labelsym) then - Begin - hs:=tlabelsym(sym).lab.name; - end - else if sym.typ=varsym then - begin - {variables set are after a comma } - {like in movl %eax,I } - if pos(',',s) > 0 then - tvarsym(sym).varstate:=vs_used - else - if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then - Message1(sym_n_uninitialized_local_variable,hs); - if (vo_is_external in tvarsym(sym).varoptions) then - hs:=tvarsym(sym).mangledname - else - hs:='%%'+tvarsym(sym).name; - end - else - { call to local function } - if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or - (pos('LEA',upper(s))>0)) then - begin - hs:=tprocsym(sym).first_procdef.mangledname; - end; - end - else - begin - if assigned(current_procinfo.procdef.parast) then - sym:=tsym(current_procinfo.procdef.parast.search(upper(hs))) - else - sym:=nil; - if assigned(sym) then - begin - if sym.typ=varsym then - begin - hs:='%%'+tvarsym(sym).name; - if pos(',',s) > 0 then - tvarsym(sym).varstate:=vs_used; - end; - end - { I added that but it creates a problem in line.ppi - because there is a local label wbuffer and - a static variable WBUFFER ... - what would you decide, florian ?} - else - - begin - uhs:=upper(hs); - if (uhs='__SELF') then - begin - if assigned(current_procinfo.procdef._class) then - uhs:='self' - else - begin - Message(asmr_e_cannot_use_SELF_outside_a_method); - uhs:=''; - end; - end - else - if (uhs='__OLDEBP') then - begin - if current_procinfo.procdef.parast.symtablelevel>normal_function_level then - uhs:='parentframe' - else - begin - Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure); - uhs:=''; - end; - end - else - if uhs='__RESULT' then - begin - if (not is_void(current_procinfo.procdef.rettype.def)) then - uhs:='result' - else - begin - Message(asmr_e_void_function); - uhs:=''; - end; - end; - - if uhs<>'' then - searchsym(uhs,sym,srsymtable) - else - sym:=nil; - if assigned(sym) then - begin - case sym.owner.symtabletype of - globalsymtable, - staticsymtable : - begin - case sym.typ of - varsym : - begin - Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname); - hs:=tvarsym(sym).mangledname; - inc(tvarsym(sym).refs); - end; - typedconstsym : - begin - Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname); - hs:=ttypedconstsym(sym).mangledname; - end; - procsym : - begin - { procs can be called or the address can be loaded } - if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then - begin - if tprocsym(sym).procdef_count>1 then - Message1(asmr_w_direct_global_is_overloaded_func,hs); - Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname); - hs:=tprocsym(sym).first_procdef.mangledname; - end; - end; - else - Message(asmr_e_wrong_sym_type); - end; - end; - parasymtable, - localsymtable : - begin - case sym.typ of - varsym : - begin - hs:='%%'+tvarsym(sym).name; - inc(tvarsym(sym).refs); - end; - typedconstsym : - begin - Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname); - hs:=ttypedconstsym(sym).mangledname; - end; - else - Message(asmr_e_wrong_sym_type); - end; - end; - end; - end - end; - end; - end; - end; - s:=s+hs; - end; - end; - '{',';',#10,#13 : - begin - writeasmline; - c:=current_scanner.asmgetchar; - end; - #26 : - Message(scan_f_end_of_file); - else - begin - current_scanner.gettokenpos; - inc(byte(s[0])); - s[length(s)]:=c; - c:=current_scanner.asmgetchar; - end; - end; - end; - writeasmline; - assemble:=casmnode.create(code); - end; - - -{***************************************************************************** - Initialize -*****************************************************************************} - -const -{$ifdef x86_64} - asmmode_x86_64_direct_info : tasmmodeinfo = - ( - id : asmmode_direct; - idtxt : 'DIRECT' - ); -{$else x86_64} - asmmode_i386_direct_info : tasmmodeinfo = - ( - id : asmmode_direct; - idtxt : 'DIRECT' - ); -{$endif x86_64} - -initialization -{$ifdef x86_64} - RegisterAsmMode(asmmode_x86_64_direct_info); -{$else x86_64} - RegisterAsmMode(asmmode_i386_direct_info); -{$endif x86_64} -end. -{ - $Log$ - Revision 1.11 2003-11-10 19:08:32 peter - * line numbering is now only done when #10, #10#13 is really parsed - instead of when it is the next character - - Revision 1.10 2003/10/01 20:34:51 peter - * procinfo unit contains tprocinfo - * cginfo renamed to cgbase - * moved cgmessage to verbose - * fixed ppc and sparc compiles - - Revision 1.9 2003/09/23 17:56:06 peter - * locals and paras are allocated in the code generation - * tvarsym.localloc contains the location of para/local when - generating code for the current procedure - - Revision 1.8 2003/09/03 15:55:02 peter - * NEWRA branch merged - - Revision 1.7.2.1 2003/08/27 21:06:34 peter - * more updates - - Revision 1.7 2003/06/13 21:19:33 peter - * current_procdef removed, use current_procinfo.procdef instead - - Revision 1.6 2003/06/02 21:42:05 jonas - * function results can now also be regvars - - removed tprocinfo.return_offset, never use it again since it's invalid - if the result is a regvar - - Revision 1.5 2003/05/22 21:33:31 peter - * removed some unit dependencies - - Revision 1.4 2003/05/15 18:58:54 peter - * removed selfpointer_offset, vmtpointer_offset - * tvarsym.adjusted_address - * address in localsymtable is now in the real direction - * removed some obsolete globals - - Revision 1.3 2003/05/13 19:15:28 peter - * removed radirect - - Revision 1.2 2003/05/01 07:59:43 florian - * introduced defaultordconsttype to decribe the default size of ordinal constants - on 64 bit CPUs it's equal to cs64bitdef while on 32 bit CPUs it's equal to s32bitdef - + added defines CPU32 and CPU64 for 32 bit and 64 bit CPUs - * int64s/qwords are allowed as for loop counter on 64 bit CPUs - - Revision 1.1 2003/04/30 15:45:35 florian - * merged more x86-64/i386 code - - Revision 1.11 2003/04/27 11:21:36 peter - * aktprocdef renamed to current_procinfo.procdef - * procinfo renamed to current_procinfo - * procinfo will now be stored in current_module so it can be - cleaned up properly - * gen_main_procsym changed to create_main_proc and release_main_proc - to also generate a tprocinfo structure - * fixed unit implicit initfinal - - Revision 1.10 2003/04/27 07:29:52 peter - * current_procinfo.procdef cleanup, current_procinfo.procdef is now always nil when parsing - a new procdef declaration - * aktprocsym removed - * lexlevel removed, use symtable.symtablelevel instead - * implicit init/final code uses the normal genentry/genexit - * funcret state checking updated for new funcret handling - - Revision 1.9 2003/04/25 20:59:35 peter - * removed funcretn,funcretsym, function result is now in varsym - and aliases for result and function name are added using absolutesym - * vs_hidden parameter for funcret passed in parameter - * vs_hidden fixes - * writenode changed to printnode and released from extdebug - * -vp option added to generate a tree.log with the nodetree - * nicer printnode for statements, callnode - - Revision 1.8 2003/04/25 12:04:31 florian - * merged agx64att and ag386att to x86/agx86att - - Revision 1.7 2003/04/21 20:05:10 peter - * removed some ie checks - - Revision 1.6 2003/01/08 18:43:57 daniel - * Tregister changed into a record - - Revision 1.5 2002/11/25 17:43:27 peter - * splitted defbase in defutil,symutil,defcmp - * merged isconvertable and is_equal into compare_defs(_ext) - * made operator search faster by walking the list only once - - Revision 1.4 2002/11/18 17:32:00 peter - * pass proccalloption to ret_in_xxx and push_xxx functions - - Revision 1.3 2002/09/03 16:26:28 daniel - * Make Tprocdef.defs protected - - Revision 1.2 2002/08/17 09:23:47 florian - * first part of procinfo rewrite - - Revision 1.1 2002/08/10 14:47:50 carl - + moved target_cpu_string to cpuinfo - * renamed asmmode enum. - * assembler reader has now less ifdef's - * move from nppcmem.pas -> ncgmem.pas vec. node. - - Revision 1.21 2002/07/20 11:58:05 florian - * types.pas renamed to defbase.pas because D6 contains a types - unit so this would conflicts if D6 programms are compiled - + Willamette/SSE2 instructions to assembler added - - Revision 1.20 2002/07/11 14:41:34 florian - * start of the new generic parameter handling - - Revision 1.19 2002/07/01 18:46:34 peter - * internal linker - * reorganized aasm layer - - Revision 1.18 2002/05/18 13:34:26 peter - * readded missing revisions - - Revision 1.17 2002/05/16 19:46:52 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.15 2002/05/12 16:53:18 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.14 2002/04/15 19:12:09 carl - + target_info.size_of_pointer -> pointer_size - + some cleanup of unused types/variables - * move several constants from cpubase to their specific units - (where they are used) - + att_Reg2str -> gas_reg2str - + int_reg2str -> std_reg2str - - Revision 1.13 2002/04/14 17:01:52 carl - + att_reg2str -> gas_reg2str - -} diff --git a/compiler/x86/rax86.pas b/compiler/x86/rax86.pas index 2cf0668f21..924b94ba6b 100644 --- a/compiler/x86/rax86.pas +++ b/compiler/x86/rax86.pas @@ -41,13 +41,13 @@ Function CheckOverride(overrideop,op:tasmop): Boolean; Procedure FWaitWarning; type - T386Operand=class(TOperand) + Tx86Operand=class(TOperand) opsize : topsize; Procedure SetSize(_size:longint;force:boolean);override; Procedure SetCorrectSize(opcode:tasmop);override; end; - T386Instruction=class(TInstruction) + Tx86Instruction=class(TInstruction) OpOrder : TOperandOrder; opsize : topsize; constructor Create(optype : tcoperand);override; @@ -193,10 +193,10 @@ begin end; {***************************************************************************** - T386Operand + TX86Operand *****************************************************************************} -Procedure T386Operand.SetSize(_size:longint;force:boolean); +Procedure Tx86Operand.SetSize(_size:longint;force:boolean); begin inherited SetSize(_size,force); { OS_64 will be set to S_L and be fixed later @@ -205,7 +205,7 @@ begin end; -Procedure T386Operand.SetCorrectSize(opcode:tasmop); +Procedure Tx86Operand.SetCorrectSize(opcode:tasmop); begin if gas_needsuffix[opcode]=attsufFPU then begin @@ -229,14 +229,14 @@ end; T386Instruction *****************************************************************************} -constructor T386Instruction.Create(optype : tcoperand); +constructor Tx86Instruction.Create(optype : tcoperand); begin inherited Create(optype); Opsize:=S_NO; end; -procedure T386Instruction.SwapOperands; +procedure Tx86Instruction.SwapOperands; begin Inherited SwapOperands; { mark the correct order } @@ -247,7 +247,7 @@ begin end; -procedure T386Instruction.AddReferenceSizes; +procedure Tx86Instruction.AddReferenceSizes; { this will add the sizes for references like [esi] which do not have the size set yet, it will take only the size if the other operand is a register } @@ -256,69 +256,73 @@ var s : tasmsymbol; so : longint; begin - for i:=1to ops do - begin - operands[i].SetCorrectSize(opcode); - if t386operand(operands[i]).opsize=S_NO then + for i:=1 to ops do begin - case operands[i].Opr.Typ of - OPR_LOCAL, - OPR_REFERENCE : - begin - if i=2 then - operand2:=1 - else - operand2:=2; - if operand2A_MOVD) and - (opcode<>A_CVTSI2SS)) then - t386operand(operands[i]).opsize:=t386operand(operands[operand2]).opsize; + { Only allow register as operand to take the size from } + if operands[operand2].opr.typ=OPR_REGISTER then + begin + if ((opcode<>A_MOVD) and + (opcode<>A_CVTSI2SS)) then + tx86operand(operands[i]).opsize:=tx86operand(operands[operand2]).opsize; + end + else + begin + { if no register then take the opsize (which is available with ATT), + if not availble then give an error } + if opsize<>S_NO then + tx86operand(operands[i]).opsize:=opsize + else + begin + Message(asmr_e_unable_to_determine_reference_size); + { recovery } + tx86operand(operands[i]).opsize:=S_L; + end; + end; end - else - begin - { if no register then take the opsize (which is available with ATT), - if not availble then give an error } - if opsize<>S_NO then - t386operand(operands[i]).opsize:=opsize - else - begin - Message(asmr_e_unable_to_determine_reference_size); - { recovery } - t386operand(operands[i]).opsize:=S_L; - end; - end; - end - else - begin - if opsize<>S_NO then - t386operand(operands[i]).opsize:=opsize - end; + else + begin + if opsize<>S_NO then + tx86operand(operands[i]).opsize:=opsize + end; + end; + OPR_SYMBOL : + begin + { Fix lea which need a reference } + if opcode=A_LEA then + begin + s:=operands[i].opr.symbol; + so:=operands[i].opr.symofs; + operands[i].opr.typ:=OPR_REFERENCE; + Fillchar(operands[i].opr.ref,sizeof(treference),0); + operands[i].opr.ref.symbol:=s; + operands[i].opr.ref.offset:=so; + end; +{$ifdef x86_64} + tx86operand(operands[i]).opsize:=S_Q; +{$else x86_64} + tx86operand(operands[i]).opsize:=S_L; +{$endif x86_64} + end; end; - OPR_SYMBOL : - begin - { Fix lea which need a reference } - if opcode=A_LEA then - begin - s:=operands[i].opr.symbol; - so:=operands[i].opr.symofs; - operands[i].opr.typ:=OPR_REFERENCE; - Fillchar(operands[i].opr.ref,sizeof(treference),0); - operands[i].opr.ref.symbol:=s; - operands[i].opr.ref.offset:=so; - end; - t386operand(operands[i]).opsize:=S_L; - end; - end; + end; end; - end; end; -procedure T386Instruction.SetInstructionOpsize; +procedure Tx86Instruction.SetInstructionOpsize; begin if opsize<>S_NO then exit; @@ -335,21 +339,21 @@ begin is_segment_reg(operands[1].opr.reg) then opsize:=S_L else - opsize:=t386operand(operands[1]).opsize; + opsize:=tx86operand(operands[1]).opsize; end; 2 : begin case opcode of A_MOVZX,A_MOVSX : begin - case t386operand(operands[1]).opsize of + case tx86operand(operands[1]).opsize of S_W : - case t386operand(operands[2]).opsize of + case tx86operand(operands[2]).opsize of S_L : opsize:=S_WL; end; S_B : - case t386operand(operands[2]).opsize of + case tx86operand(operands[2]).opsize of S_W : opsize:=S_BW; S_L : @@ -361,18 +365,18 @@ begin 32 bit register or memory, so no opsize is correct here PM } exit; A_OUT : - opsize:=t386operand(operands[1]).opsize; + opsize:=tx86operand(operands[1]).opsize; else - opsize:=t386operand(operands[2]).opsize; + opsize:=tx86operand(operands[2]).opsize; end; end; 3 : - opsize:=t386operand(operands[3]).opsize; + opsize:=tx86operand(operands[3]).opsize; end; end; -procedure T386Instruction.CheckOperandSizes; +procedure Tx86Instruction.CheckOperandSizes; var sizeerr : boolean; i : longint; @@ -403,11 +407,11 @@ begin begin case opsize of S_BW : - sizeerr:=(t386operand(operands[1]).opsize<>S_B) or (t386operand(operands[2]).opsize<>S_W); + sizeerr:=(tx86operand(operands[1]).opsize<>S_B) or (tx86operand(operands[2]).opsize<>S_W); S_BL : - sizeerr:=(t386operand(operands[1]).opsize<>S_B) or (t386operand(operands[2]).opsize<>S_L); + sizeerr:=(tx86operand(operands[1]).opsize<>S_B) or (tx86operand(operands[2]).opsize<>S_L); S_WL : - sizeerr:=(t386operand(operands[1]).opsize<>S_W) or (t386operand(operands[2]).opsize<>S_L); + sizeerr:=(tx86operand(operands[1]).opsize<>S_W) or (tx86operand(operands[2]).opsize<>S_L); end; end; end @@ -416,8 +420,8 @@ begin for i:=1 to ops do begin if (operands[i].opr.typ<>OPR_CONSTANT) and - (t386operand(operands[i]).opsize in [S_B,S_W,S_L]) and - (t386operand(operands[i]).opsize<>opsize) then + (tx86operand(operands[i]).opsize in [S_B,S_W,S_L]) and + (tx86operand(operands[i]).opsize<>opsize) then sizeerr:=true; end; end; @@ -436,7 +440,7 @@ 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 T386Instruction.CheckNonCommutativeOpcodes; +procedure Tx86Instruction.CheckNonCommutativeOpcodes; begin if (OpOrder=op_intel) then SwapOperands; @@ -487,7 +491,7 @@ end; opcode Adding *****************************************************************************} -function T386Instruction.ConcatInstruction(p : taasmoutput) : tai; +function Tx86Instruction.ConcatInstruction(p : taasmoutput) : tai; var siz : topsize; i,asize : longint; @@ -502,21 +506,21 @@ begin else begin if (Ops=2) and (operands[1].opr.typ=OPR_REGISTER) then - siz:=t386operand(operands[1]).opsize + siz:=tx86operand(operands[1]).opsize else - siz:=t386operand(operands[Ops]).opsize; + siz:=tx86operand(operands[Ops]).opsize; { MOVD should be of size S_LQ or S_QL, but these do not exist PM } if (ops=2) and - (t386operand(operands[1]).opsize<>S_NO) and - (t386operand(operands[2]).opsize<>S_NO) and - (t386operand(operands[1]).opsize<>t386operand(operands[2]).opsize) then + (tx86operand(operands[1]).opsize<>S_NO) and + (tx86operand(operands[2]).opsize<>S_NO) and + (tx86operand(operands[1]).opsize<>tx86operand(operands[2]).opsize) then siz:=S_NO; end; if ((opcode=A_MOVD)or (opcode=A_CVTSI2SS)) and - ((t386operand(operands[1]).opsize=S_NO) or - (t386operand(operands[2]).opsize=S_NO)) then + ((tx86operand(operands[1]).opsize=S_NO) or + (tx86operand(operands[2]).opsize=S_NO)) then siz:=S_NO; { NASM does not support FADD without args as alias of FADDP @@ -721,7 +725,9 @@ begin begin { Check the instruction if it's valid } {$ifndef NOAG386BIN} +{$ifndef x86_64} ai.CheckIfValid; +{$endif x86_64} {$endif NOAG386BIN} p.concat(ai); end @@ -733,7 +739,11 @@ end; end. { $Log$ - Revision 1.15 2003-11-17 23:23:47 florian + Revision 1.16 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.15 2003/11/17 23:23:47 florian + first part of arm assembler reader Revision 1.14 2003/11/12 16:05:40 florian diff --git a/compiler/x86/rax86att.pas b/compiler/x86/rax86att.pas new file mode 100644 index 0000000000..b48bf41eb2 --- /dev/null +++ b/compiler/x86/rax86att.pas @@ -0,0 +1,986 @@ +{ + $Id$ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing for the x86 GNU AS styled inline assembler. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +Unit rax86att; + +{$i fpcdefs.inc} + +Interface + + uses + cpubase, + raatt,rax86; + + type + tx86attreader = class(tattreader) + ActOpsize : topsize; + function is_asmopcode(const s: string):boolean;override; + procedure handleopcode;override; + procedure BuildReference(oper : tx86operand); + procedure BuildOperand(oper : tx86operand); + procedure BuildOpCode(instr : tx86instruction); + procedure handlepercent;override; + end; + + +Implementation + + uses + { helpers } + cutils, + { global } + globtype,globals,verbose, + systems, + { aasm } + cpuinfo,aasmbase,aasmtai,aasmcpu, + { symtable } + symconst,symbase,symtype,symsym,symtable, + { parser } + scanner, + procinfo, + itcpugas, + rabase,rautils, + cgbase,cgobj + ; + + procedure tx86attreader.handlepercent; + var + len : longint; + begin + len:=1; + actasmpattern[len]:='%'; + c:=current_scanner.asmgetchar; + { to be a register there must be a letter and not a number } + if c in ['0'..'9'] then + begin + actasmtoken:=AS_MOD; + end + else + begin + while c in ['a'..'z','A'..'Z','0'..'9'] do + Begin + inc(len); + actasmpattern[len]:=c; + c:=current_scanner.asmgetchar; + end; + actasmpattern[0]:=chr(len); + uppervar(actasmpattern); + if (actasmpattern = '%ST') and (c='(') then + Begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + if c in ['0'..'9'] then + actasmpattern:=actasmpattern + c + else + Message(asmr_e_invalid_fpu_register); + c:=current_scanner.asmgetchar; + if c <> ')' then + Message(asmr_e_invalid_fpu_register) + else + Begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; { let us point to next character. } + end; + end; + if is_register(actasmpattern) then + exit; + Message(asmr_e_invalid_register); + actasmtoken:=raatt.AS_NONE; + end; + end; + + + Procedure tx86attreader.BuildReference(oper : tx86operand); + + procedure Consume_RParen; + begin + if actasmtoken <> AS_RPAREN then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end + else + begin + Consume(AS_RPAREN); + if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end; + end; + end; + + + procedure Consume_Scale; + var + l : longint; + begin + { we have to process the scaling } + l:=BuildConstExpression(false,true); + if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) then + oper.opr.ref.scalefactor:=l + else + Begin + Message(asmr_e_wrong_scale_factor); + oper.opr.ref.scalefactor:=0; + end; + end; + + + begin + oper.InitRef; + Consume(AS_LPAREN); + Case actasmtoken of + AS_INTNUM, + AS_MINUS, + AS_PLUS: { absolute offset, such as fs:(0x046c) } + Begin + { offset(offset) is invalid } + If oper.opr.Ref.Offset <> 0 Then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + End + Else + Begin + oper.opr.Ref.Offset:=BuildConstExpression(false,true); + Consume_RParen; + end; + exit; + End; + AS_REGISTER: { (reg ... } + Begin + { Check if there is already a base (mostly ebp,esp) than this is + not allowed, because it will give crashing code } + if ((oper.opr.typ=OPR_REFERENCE) and (oper.opr.ref.base<>NR_NO)) or + ((oper.opr.typ=OPR_LOCAL) and (oper.opr.localsym.localloc.loc<>LOC_REGISTER)) then + message(asmr_e_cannot_index_relative_var); + oper.opr.ref.base:=actasmregister; + Consume(AS_REGISTER); + { can either be a register or a right parenthesis } + { (reg) } + if actasmtoken=AS_RPAREN then + Begin + Consume_RParen; + exit; + end; + { (reg,reg .. } + Consume(AS_COMMA); + if actasmtoken=AS_REGISTER then + Begin + oper.opr.ref.index:=actasmregister; + Consume(AS_REGISTER); + { check for scaling ... } + case actasmtoken of + AS_RPAREN: + Begin + Consume_RParen; + exit; + end; + AS_COMMA: + Begin + Consume(AS_COMMA); + Consume_Scale; + Consume_RParen; + end; + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; { end case } + end + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; {end case } + AS_COMMA: { (, ... can either be scaling, or index } + Begin + Consume(AS_COMMA); + { Index } + if (actasmtoken=AS_REGISTER) then + Begin + oper.opr.ref.index:=actasmregister; + Consume(AS_REGISTER); + { check for scaling ... } + case actasmtoken of + AS_RPAREN: + Begin + Consume_RParen; + exit; + end; + AS_COMMA: + Begin + Consume(AS_COMMA); + Consume_Scale; + Consume_RParen; + end; + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; {end case } + end + { Scaling } + else + Begin + Consume_Scale; + Consume_RParen; + exit; + end; + end; + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; + end; + + + Procedure tx86attreader.BuildOperand(oper : tx86operand); + var + tempstr, + expr : string; + typesize, + l,k : longint; + + + procedure AddLabelOperand(hl:tasmlabel); + begin + if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and + is_calljmp(actopcode) then + begin + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symbol:=hl; + end + else + begin + oper.InitRef; + oper.opr.ref.symbol:=hl; + end; + end; + + + procedure MaybeRecordOffset; + var + hasdot : boolean; + l, + toffset, + tsize : longint; + begin + if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then + exit; + l:=0; + hasdot:=(actasmtoken=AS_DOT); + if hasdot then + begin + if expr<>'' then + begin + BuildRecordOffsetSize(expr,toffset,tsize); + inc(l,toffset); + oper.SetSize(tsize,true); + end; + end; + if actasmtoken in [AS_PLUS,AS_MINUS] then + inc(l,BuildConstExpression(true,false)); + case oper.opr.typ of + OPR_LOCAL : + begin + { don't allow direct access to fields of parameters, because that + will generate buggy code. Allow it only for explicit typecasting } + if hasdot and + (not oper.hastype) and + (tvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and + (current_procinfo.procdef.proccalloption<>pocall_register) then + Message(asmr_e_cannot_access_field_directly_for_parameters); + inc(oper.opr.localsymofs,l) + end; + OPR_CONSTANT : + inc(oper.opr.val,l); + OPR_REFERENCE : + inc(oper.opr.ref.offset,l); + else + internalerror(200309221); + end; + end; + + + function MaybeBuildReference:boolean; + { Try to create a reference, if not a reference is found then false + is returned } + begin + MaybeBuildReference:=true; + case actasmtoken of + AS_INTNUM, + AS_MINUS, + AS_PLUS: + Begin + oper.opr.ref.offset:=BuildConstExpression(True,False); + if actasmtoken<>AS_LPAREN then + Message(asmr_e_invalid_reference_syntax) + else + BuildReference(oper); + end; + AS_LPAREN: + BuildReference(oper); + AS_ID: { only a variable is allowed ... } + Begin + tempstr:=actasmpattern; + Consume(AS_ID); + { typecasting? } + if (actasmtoken=AS_LPAREN) and + SearchType(tempstr,typesize) then + begin + oper.hastype:=true; + Consume(AS_LPAREN); + BuildOperand(oper); + Consume(AS_RPAREN); + if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then + oper.SetSize(typesize,true); + end + else + if not oper.SetupVar(tempstr,false) then + Message1(sym_e_unknown_id,tempstr); + { record.field ? } + if actasmtoken=AS_DOT then + begin + BuildRecordOffsetSize(tempstr,l,k); + inc(oper.opr.ref.offset,l); + end; + case actasmtoken of + AS_END, + AS_SEPARATOR, + AS_COMMA: ; + AS_LPAREN: + BuildReference(oper); + else + Begin + Message(asmr_e_invalid_reference_syntax); + Consume(actasmtoken); + end; + end; {end case } + end; + else + MaybeBuildReference:=false; + end; { end case } + end; + + + const + regsize_2_size: array[S_B..S_L] of longint = (1,2,4); + var + tempreg : tregister; + hl : tasmlabel; + Begin + expr:=''; + case actasmtoken of + AS_LPAREN: { Memory reference or constant expression } + Begin + oper.InitRef; + BuildReference(oper); + end; + + AS_DOLLAR: { Constant expression } + Begin + Consume(AS_DOLLAR); + BuildConstantOperand(oper); + end; + + AS_INTNUM, + AS_MINUS, + AS_PLUS: + Begin + { Constant memory offset } + { This must absolutely be followed by ( } + oper.InitRef; + oper.opr.ref.offset:=BuildConstExpression(True,False); + if actasmtoken<>AS_LPAREN then + Message(asmr_e_invalid_reference_syntax) + else + BuildReference(oper); + end; + + AS_STAR: { Call from memory address } + Begin + Consume(AS_STAR); + if actasmtoken=AS_REGISTER then + begin + oper.opr.typ:=OPR_REGISTER; + oper.opr.reg:=actasmregister; + oper.SetSize(regsize_2_size[reg2opsize(actasmregister)],true); + Consume(AS_REGISTER); + end + else + begin + oper.InitRef; + if not MaybeBuildReference then + Message(asmr_e_syn_operand); + end; + { this is only allowed for call's and jmp's } + if not is_calljmp(actopcode) then + Message(asmr_e_syn_operand); + end; + + AS_ID: { A constant expression, or a Variable ref. } + Begin + { Local Label ? } + if is_locallabel(actasmpattern) then + begin + CreateLocalLabel(actasmpattern,hl,false); + Consume(AS_ID); + AddLabelOperand(hl); + end + else + { Check for label } + if SearchLabel(actasmpattern,hl,false) then + begin + Consume(AS_ID); + AddLabelOperand(hl); + end + else + { probably a variable or normal expression } + { or a procedure (such as in CALL ID) } + Begin + { is it a constant ? } + if SearchIConstant(actasmpattern,l) then + Begin + if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then + Message(asmr_e_invalid_operand_type); + BuildConstantOperand(oper); + end + else + begin + expr:=actasmpattern; + Consume(AS_ID); + { typecasting? } + if (actasmtoken=AS_LPAREN) and + SearchType(expr,typesize) then + begin + oper.hastype:=true; + Consume(AS_LPAREN); + BuildOperand(oper); + Consume(AS_RPAREN); + if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then + oper.SetSize(typesize,true); + end + else + begin + if oper.SetupVar(expr,false) then + begin + end + else + Begin + { look for special symbols ... } + if expr= '__HIGH' then + begin + consume(AS_LPAREN); + if not oper.setupvar('high'+actasmpattern,false) then + Message1(sym_e_unknown_id,'high'+actasmpattern); + consume(AS_ID); + consume(AS_RPAREN); + end + else + if expr = '__RESULT' then + oper.SetUpResult + else + if expr = '__SELF' then + oper.SetupSelf + else + if expr = '__OLDEBP' then + oper.SetupOldEBP + else + { check for direct symbolic names } + { only if compiling the system unit } + if (cs_compilesystem in aktmoduleswitches) then + begin + if not oper.SetupDirectVar(expr) then + Begin + { not found, finally ... add it anyways ... } + Message1(asmr_w_id_supposed_external,expr); + oper.InitRef; + oper.opr.ref.symbol:=objectlibrary.newasmsymbol(expr); + end; + end + else + Message1(sym_e_unknown_id,expr); + end; + end; + end; + if actasmtoken=AS_DOT then + MaybeRecordOffset; + { add a constant expression? } + if (actasmtoken=AS_PLUS) then + begin + l:=BuildConstExpression(true,false); + case oper.opr.typ of + OPR_CONSTANT : + inc(oper.opr.val,l); + OPR_LOCAL : + inc(oper.opr.localsymofs,l); + OPR_REFERENCE : + inc(oper.opr.ref.offset,l); + else + internalerror(200309202); + end; + end + end; + { Do we have a indexing reference, then parse it also } + if actasmtoken=AS_LPAREN then + BuildReference(oper); + end; + + AS_REGISTER: { Register, a variable reference or a constant reference } + Begin + { save the type of register used. } + tempreg:=actasmregister; + Consume(AS_REGISTER); + if actasmtoken = AS_COLON then + Begin + Consume(AS_COLON); + oper.InitRef; + oper.opr.ref.segment:=tempreg; + { This must absolutely be followed by a reference } + if not MaybeBuildReference then + Begin + Message(asmr_e_invalid_seg_override); + Consume(actasmtoken); + end; + end + { Simple register } + else if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then + Begin + if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then + Message(asmr_e_invalid_operand_type); + oper.opr.typ:=OPR_REGISTER; + oper.opr.reg:=tempreg; + oper.SetSize(tcgsize2size[cg.reg_cgsize(oper.opr.reg)],true); + end + else + Message(asmr_e_syn_operand); + end; + AS_END, + AS_SEPARATOR, + AS_COMMA: ; + else + Begin + Message(asmr_e_syn_operand); + Consume(actasmtoken); + end; + end; { end case } + end; + + + procedure tx86attreader.BuildOpCode(instr : tx86instruction); + var + operandnum : longint; + PrefixOp,OverrideOp: tasmop; + Begin + PrefixOp:=A_None; + OverrideOp:=A_None; + { prefix seg opcode / prefix opcode } + repeat + if is_prefix(actopcode) then + begin + PrefixOp:=ActOpcode; + with instr do + begin + opcode:=ActOpcode; + condition:=ActCondition; + opsize:=ActOpsize; + ConcatInstruction(curlist); + end; + Consume(AS_OPCODE); + end + else + if is_override(actopcode) then + begin + OverrideOp:=ActOpcode; + with instr do + begin + opcode:=ActOpcode; + condition:=ActCondition; + opsize:=ActOpsize; + ConcatInstruction(curlist); + end; + Consume(AS_OPCODE); + end + else + break; + { allow for newline as in gas styled syntax } + while actasmtoken=AS_SEPARATOR do + Consume(AS_SEPARATOR); + until (actasmtoken<>AS_OPCODE); + { opcode } + if (actasmtoken<>AS_OPCODE) then + Begin + Message(asmr_e_invalid_or_missing_opcode); + RecoverConsume(true); + exit; + end; + { Fill the instr object with the current state } + with instr do + begin + Opcode:=ActOpcode; + condition:=ActCondition; + opsize:=ActOpsize; + end; + + { Valid combination of prefix/override and instruction ? } + + if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then + Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern); + + if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then + Message1(asmr_e_invalid_override_and_opcode,actasmpattern); + { We are reading operands, so opcode will be an AS_ID } + operandnum:=1; + Consume(AS_OPCODE); + { Zero operand opcode ? } + if actasmtoken in [AS_SEPARATOR,AS_END] then + begin + operandnum:=0; + exit; + end; + { Read the operands } + repeat + case actasmtoken of + AS_COMMA: { Operand delimiter } + Begin + if operandnum > Max_Operands then + Message(asmr_e_too_many_operands) + else + Inc(operandnum); + Consume(AS_COMMA); + end; + AS_SEPARATOR, + AS_END : { End of asm operands for this opcode } + begin + break; + end; + else + BuildOperand(instr.Operands[operandnum] as tx86operand); + end; { end case } + until false; + instr.Ops:=operandnum; + end; + + + function tx86attreader.is_asmopcode(const s: string):boolean; + const + { We need first to check the long prefixes, else we get probs + with things like movsbl } + att_sizesuffixstr : array[0..9] of string[2] = ( + '','BW','BL','WL','B','W','L','S','Q','T' + ); + att_sizesuffix : array[0..9] of topsize = ( + S_NO,S_BW,S_BL,S_WL,S_B,S_W,S_L,S_FS,S_IQ,S_FX + ); + att_sizefpusuffix : array[0..9] of topsize = ( + S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_FL,S_FS,S_IQ,S_FX + ); + att_sizefpuintsuffix : array[0..9] of topsize = ( + S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_IL,S_IS,S_IQ,S_NO + ); + var + str2opentry: tstr2opentry; + cond : string[4]; + cnd : tasmcond; + len, + j, + sufidx : longint; + Begin + is_asmopcode:=FALSE; + + actopcode:=A_None; + actcondition:=C_None; + actopsize:=S_NO; + + { search for all possible suffixes } + for sufidx:=low(att_sizesuffixstr) to high(att_sizesuffixstr) do + begin + len:=length(s)-length(att_sizesuffixstr[sufidx]); + if copy(s,len+1,length(att_sizesuffixstr[sufidx]))=att_sizesuffixstr[sufidx] then + begin + { here we search the entire table... } + str2opentry:=nil; + if {(length(s)>0) and} (len>0) then + str2opentry:=tstr2opentry(iasmops.search(copy(s,1,len))); + if assigned(str2opentry) then + begin + actopcode:=str2opentry.op; + if gas_needsuffix[actopcode]=attsufFPU then + actopsize:=att_sizefpusuffix[sufidx] + else if gas_needsuffix[actopcode]=attsufFPUint then + actopsize:=att_sizefpuintsuffix[sufidx] + else + actopsize:=att_sizesuffix[sufidx]; + actasmtoken:=AS_OPCODE; + is_asmopcode:=TRUE; + exit; + end; + { not found, check condition opcodes } + j:=0; + while (j'' then + begin + for cnd:=low(TasmCond) to high(TasmCond) do + if Cond=Upper(cond2str[cnd]) then + begin + actopcode:=CondASmOp[j]; + if gas_needsuffix[actopcode]=attsufFPU then + actopsize:=att_sizefpusuffix[sufidx] + else if gas_needsuffix[actopcode]=attsufFPUint then + actopsize:=att_sizefpuintsuffix[sufidx] + else + actopsize:=att_sizesuffix[sufidx]; + actcondition:=cnd; + actasmtoken:=AS_OPCODE; + is_asmopcode:=TRUE; + exit; + end; + end; + end; + inc(j); + end; + end; + end; + end; + + + procedure tx86attreader.handleopcode; + var + instr : Tx86Instruction; + begin + instr:=Tx86Instruction.Create(Tx86Operand); + instr.OpOrder:=op_att; + BuildOpcode(instr); + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + instr.CheckOperandSizes; + instr.ConcatInstruction(curlist); + instr.Free; + end; + + +end. +{ + $Log$ + Revision 1.1 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.58 2003/11/12 16:05:39 florian + * assembler readers OOPed + + typed currency constants + + typed 128 bit float constants if the CPU supports it + + Revision 1.57 2003/11/10 19:08:32 peter + * line numbering is now only done when #10, #10#13 is really parsed + instead of when it is the next character + + Revision 1.56 2003/10/29 16:47:18 peter + * fix field offset in reference + + Revision 1.55 2003/10/26 13:37:22 florian + * fixed web bug 2128 + + Revision 1.54 2003/10/24 17:39:03 peter + * more intel parser updates + + Revision 1.53 2003/10/23 17:19:44 peter + * typecasting fixes + * reference building more delphi compatible + + Revision 1.52 2003/10/20 19:29:35 peter + * fix check for register subscription of reference parameter + + Revision 1.51 2003/10/16 21:29:24 peter + + __HIGH() to retrieve high value + + Revision 1.50 2003/10/07 18:21:18 peter + * fix crash + * allow parameter subscription for register parameters + + Revision 1.49 2003/10/01 20:34:49 peter + * procinfo unit contains tprocinfo + * cginfo renamed to cgbase + * moved cgmessage to verbose + * fixed ppc and sparc compiles + + Revision 1.48 2003/09/23 20:37:53 peter + * fix global var+offset + + Revision 1.47 2003/09/23 17:56:06 peter + * locals and paras are allocated in the code generation + * tvarsym.localloc contains the location of para/local when + generating code for the current procedure + + Revision 1.46 2003/09/03 15:55:01 peter + * NEWRA branch merged + + Revision 1.45.2.2 2003/08/31 15:46:26 peter + * more updates for tregister + + Revision 1.45.2.1 2003/08/28 18:35:08 peter + * tregister changed to cardinal + + Revision 1.45 2003/05/30 23:57:08 peter + * more sparc cleanup + * accumulator removed, splitted in function_return_reg (called) and + function_result_reg (caller) + + Revision 1.44 2003/05/22 21:32:29 peter + * removed some unit dependencies + + Revision 1.43 2003/04/30 15:45:35 florian + * merged more x86-64/i386 code + + Revision 1.42 2003/04/25 12:04:31 florian + * merged agx64att and ag386att to x86/agx86att + + Revision 1.41 2003/04/21 20:05:10 peter + * removed some ie checks + + Revision 1.40 2003/03/18 18:15:53 peter + * changed reg2opsize to function + + Revision 1.39 2003/02/20 15:52:58 pierre + * fix a range check error + + Revision 1.38 2003/02/19 22:00:16 daniel + * Code generator converted to new register notation + - Horribily outdated todo.txt removed + + Revision 1.37 2003/02/03 22:47:14 daniel + - Removed reg_2_opsize array + + Revision 1.36 2003/01/08 18:43:57 daniel + * Tregister changed into a record + + Revision 1.35 2002/12/14 15:02:03 carl + * maxoperands -> max_operands (for portability in rautils.pas) + * fix some range-check errors with loadconst + + add ncgadd unit to m68k + * some bugfix of a_param_reg with LOC_CREFERENCE + + Revision 1.34 2002/12/01 22:08:34 carl + * some small cleanup (remove some specific operators which are not supported) + + Revision 1.33 2002/11/30 23:16:39 carl + - removed unused message + + Revision 1.32 2002/11/15 01:58:58 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.31 2002/09/03 16:26:28 daniel + * Make Tprocdef.defs protected + + Revision 1.30 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.29 2002/08/12 15:08:42 carl + + stab register indexes for powerpc (moved from gdb to cpubase) + + tprocessor enumeration moved to cpuinfo + + linker in target_info is now a class + * many many updates for m68k (will soon start to compile) + - removed some ifdef or correct them for correct cpu + + Revision 1.28 2002/08/11 14:32:31 peter + * renamed current_library to objectlibrary + + Revision 1.27 2002/08/11 13:24:17 peter + * saving of asmsymbols in ppu supported + * asmsymbollist global is removed and moved into a new class + tasmlibrarydata that will hold the info of a .a file which + corresponds with a single module. Added librarydata to tmodule + to keep the library info stored for the module. In the future the + objectfiles will also be stored to the tasmlibrarydata class + * all getlabel/newasmsymbol and friends are moved to the new class + + Revision 1.26 2002/07/26 21:15:44 florian + * rewrote the system handling + + Revision 1.25 2002/07/01 18:46:34 peter + * internal linker + * reorganized aasm layer + + Revision 1.24 2002/05/18 13:34:25 peter + * readded missing revisions + + Revision 1.23 2002/05/16 19:46:52 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.21 2002/04/15 19:12:09 carl + + target_info.size_of_pointer -> pointer_size + + some cleanup of unused types/variables + * move several constants from cpubase to their specific units + (where they are used) + + att_Reg2str -> gas_reg2str + + int_reg2str -> std_reg2str + + Revision 1.20 2002/04/14 17:01:52 carl + + att_reg2str -> gas_reg2str + + Revision 1.19 2002/04/04 19:06:13 peter + * removed unused units + * use tlocation.size in cg.a_*loc*() routines + + Revision 1.18 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.17 2002/03/28 20:48:25 carl + - remove go32v1 support + + Revision 1.16 2002/01/24 18:25:53 peter + * implicit result variable generation for assembler routines + * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead + +} diff --git a/compiler/x86_64/cgcpu.pas b/compiler/x86_64/cgcpu.pas index a179fc8bb3..7122cd0737 100644 --- a/compiler/x86_64/cgcpu.pas +++ b/compiler/x86_64/cgcpu.pas @@ -32,10 +32,11 @@ unit cgcpu; cgbase,cgobj,cg64f64,cgx86, aasmbase,aasmtai,aasmcpu, cpubase,cpuinfo,cpupara, - node,symconst; + node,symconst,rgx86; type tcgx86_64 = class(tcgx86) + procedure init_register_allocators;override; class function reg_cgsize(const reg: tregister): tcgsize; override; procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override; end; @@ -48,6 +49,19 @@ unit cgcpu; rgobj,tgobj,rgcpu; + procedure Tcgx86_64.init_register_allocators; + begin + inherited init_register_allocators; + if cs_create_pic in aktmoduleswitches then + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP,RS_EBX]) + else + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]); + rg[R_MMXREGISTER]:=trgcpu.create(R_MMXREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_sse_imreg,[]); + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_sse_imreg,[]); + rgfpu:=Trgx86fpu.create; + end; + + class function tcgx86_64.reg_cgsize(const reg: tregister): tcgsize; const subreg2cgsize:array[Tsubregister] of Tcgsize = (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO); @@ -206,7 +220,11 @@ begin end. { $Log$ - Revision 1.8 2004-01-13 18:08:58 florian + Revision 1.9 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.8 2004/01/13 18:08:58 florian * x86-64 compilation fixed Revision 1.7 2003/12/24 01:47:23 florian diff --git a/compiler/x86_64/cpubase.inc b/compiler/x86_64/cpubase.inc index 55c02c9c5b..62d5765f18 100644 --- a/compiler/x86_64/cpubase.inc +++ b/compiler/x86_64/cpubase.inc @@ -123,7 +123,7 @@ const This value can be deduced from the CALLED_USED_REGISTERS array in the GCC source. } - std_saved_registers = [RS_ESI,RS_EDI,RS_EBX]; + saved_standard_registers : array[0..4] of tsuperregister = (RS_EBX,RS_R12,RS_R13,RS_R14,RS_R15); { 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. @@ -135,7 +135,11 @@ const { $Log$ - Revision 1.9 2003-12-22 19:00:17 florian + Revision 1.10 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.9 2003/12/22 19:00:17 florian * fixed some x86-64 issues Revision 1.8 2003/09/25 13:13:32 florian diff --git a/compiler/x86_64/cpupara.pas b/compiler/x86_64/cpupara.pas index 94e008b848..e794b1a500 100644 --- a/compiler/x86_64/cpupara.pas +++ b/compiler/x86_64/cpupara.pas @@ -49,11 +49,12 @@ unit cpupara; uses verbose, - cpuinfo,cgbase, + cpuinfo,cgbase,systems, defutil; const - intreg_nr2reg : array[1..6] of tsuperregister = (RS_RDI,RS_RSI,RS_RDX,RS_RCX,RS_R8,RS_R9); + paraintsupregs : array[0..5] of tsuperregister = (RS_RDI,RS_RSI,RS_RDX,RS_RCX,RS_R8,RS_R9); + parammsupregs : array[0..7] of tsuperregister = (RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7); function getparaloc(p : tdef) : tcgloc; @@ -120,15 +121,17 @@ unit cpupara; end; end; + function tx86_64paramanager.getintparaloc(calloption : tproccalloption; nr : longint): tparalocation; begin fillchar(result,sizeof(tparalocation),0); + result.size:=OS_INT; if nr<1 then internalerror(200304303) - else if nr<=6 then + else if nr<=high(paraintsupregs)+1 then begin result.loc:=LOC_REGISTER; - result.register:=newreg(R_INTREGISTER,intreg_nr2reg[nr],R_SUBWHOLE); + result.register:=newreg(R_INTREGISTER,paraintsupregs[nr-1],R_SUBWHOLE); end else begin @@ -140,11 +143,82 @@ unit cpupara; function tx86_64paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; + var + hp : tparaitem; + paraloc : tparalocation; + subreg : tsubregister; + pushaddr : boolean; + l,intparareg,mmparareg, + varalign, + paraalign, + parasize : longint; begin - { set default para_alignment to target_info.stackalignment } - { if para_alignment=0 then - para_alignment:=aktalignment.paraalign; - } + intparareg:=0; + mmparareg:=0; + parasize:=0; + paraalign:=get_para_align(p.proccalloption); + { Register parameters are assigned from left to right } + hp:=tparaitem(p.para.first); + while assigned(hp) do + begin + pushaddr:=push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption); + if pushaddr then + paraloc.size:=OS_ADDR + else + paraloc.size:=def_cgsize(hp.paratype.def); + paraloc.alignment:=paraalign; + if (intparareg<=high(paraintsupregs)) and + not( + ((hp.paratype.def.deftype in [floatdef,recorddef,arraydef]) and + (not pushaddr)) + ) then + begin + paraloc.loc:=LOC_REGISTER; + if paraloc.size=OS_NO then + subreg:=R_SUBWHOLE + else + subreg:=cgsize2subreg(paraloc.size); + paraloc.alignment:=paraalign; + paraloc.register:=newreg(R_INTREGISTER,paraintsupregs[intparareg],subreg); + inc(intparareg); + end + else if (mmparareg<=high(parammsupregs)) then + begin + end + else + begin + paraloc.loc:=LOC_REFERENCE; + if side=callerside then + paraloc.reference.index:=NR_STACK_POINTER_REG + else + paraloc.reference.index:=NR_FRAME_POINTER_REG; + l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption); + // varalign:=size_2_align(l); + paraloc.reference.offset:=parasize; + // varalign:=used_align(varalign,paraalign,paraalign); + // parasize:=align(parasize+l,varalign); + end; + hp.paraloc[side]:=paraloc; + hp:=tparaitem(hp.next); + end; + { Register parameters are assigned from left-to-right, adapt offset + for calleeside to be reversed } + hp:=tparaitem(p.para.first); + while assigned(hp) do + begin + if (hp.paraloc[side].loc=LOC_REFERENCE) then + begin + l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption); + // varalign:=used_align(size_2_align(l),paraalign,paraalign); + // l:=align(l,varalign); + hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l; + if side=calleeside then + inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset); + end; + hp:=tparaitem(hp.next); + end; + { We need to return the size allocated } + result:=parasize; end; @@ -153,7 +227,11 @@ begin end. { $Log$ - Revision 1.5 2003-12-24 00:10:03 florian + Revision 1.6 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related + + Revision 1.5 2003/12/24 00:10:03 florian - delete parameter in cg64 methods removed Revision 1.4 2003/04/30 20:53:32 florian diff --git a/compiler/x86_64/rax64att.pas b/compiler/x86_64/rax64att.pas new file mode 100644 index 0000000000..afd6a3dbda --- /dev/null +++ b/compiler/x86_64/rax64att.pas @@ -0,0 +1,76 @@ +{ + $Id$ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing for the i386 GNU AS styled inline assembler. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +Unit rax64att; + +{$i fpcdefs.inc} + + interface + + uses + rax86att; + + type + tx8664attreader = class(tx86attreader) + procedure handleopcode;override; + end; + + + implementation + + uses + rabase,systems,rax86,aasmcpu; + + procedure tx8664attreader.handleopcode; + var + instr : Tx86Instruction; + begin + instr:=Tx86Instruction.Create(Tx86Operand); + instr.OpOrder:=op_att; + BuildOpcode(instr); + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + { + instr.CheckOperandSizes; + } + instr.ConcatInstruction(curlist); + instr.Free; + end; + + +const + asmmode_x86_64_gas_info : tasmmodeinfo = + ( + id : asmmode_x86_64_gas; + idtxt : 'GAS'; + casmreader : tx8664attreader; + ); + +initialization + RegisterAsmMode(asmmode_x86_64_gas_info); +end. +{ + $Log$ + Revision 1.1 2004-01-14 23:39:05 florian + * another bunch of x86-64 fixes mainly calling convention and + assembler reader related +}