{ $Id$ Copyright (c) 1999 by Florian Klaempfl 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 i386asm; interface uses cobjects, aasm,globals,verbose, i386base; {$ifndef NASMDEBUG} {$define OPTEA} {$define PASS2FLAG} {$endif ndef NASMDEBUG} {$ifndef TP} {$define ASMDEBUG} {$endif} const MaxPrefixes=4; type { this is for quicker determination of the operand type instead of using opertype and OT ... etc. } 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:preference); top_const : (val:longint); top_symbol : (sym:pasmsymbol;symofs:longint); end; pairegalloc = ^tairegalloc; tairegalloc = object(tai) allocation : boolean; reg : tregister; constructor alloc(r : tregister); constructor dealloc(r : tregister); end; paitempalloc = ^taitempalloc; taitempalloc = object(tai) allocation : boolean; temppos, tempsize : longint; constructor alloc(pos,size:longint); constructor dealloc(pos,size:longint); end; pai386 = ^tai386; tai386 = object(tai) opcode : tasmop; opsize : topsize; condition : TAsmCond; ops : longint; oper : array[0..2] of toper; constructor op_none(op : tasmop;_size : topsize); constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister); constructor op_const(op : tasmop;_size : topsize;_op1 : longint); constructor op_ref(op : tasmop;_size : topsize;_op1 : preference); constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : preference); constructor op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: longint); constructor op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister); constructor op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint); constructor op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference); constructor op_ref_reg(op : tasmop;_size : topsize;_op1 : preference;_op2 : tregister); { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) } constructor op_ref_ref(op : tasmop;_size : topsize;_op1,_op2 : preference); constructor op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister); constructor op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister); constructor op_const_ref_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference;_op3 : tregister); constructor op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister; _op3 : preference); constructor op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : preference); constructor op_sym(op : tasmop;_size : topsize;_op1 : pasmsymbol); constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint); constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister); constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference); procedure loadconst(opidx:longint;l:longint); procedure loadsymbol(opidx:longint;s:pasmsymbol;sofs:longint); procedure loadref(opidx:longint;p:preference); procedure loadreg(opidx:longint;r:tregister); procedure loadoper(opidx:longint;o:toper); procedure changeopsize(siz:topsize); destructor done;virtual; function getcopy:plinkedlist_item;virtual; public procedure SetCondition(c:TAsmCond); function Pass1(offset:longint):longint;virtual; procedure Pass2;virtual; function GetString:string; private segprefix : tregister; { next fields are filled in pass1, so pass2 is faster } insentry : PInsEntry; LastInsOffset, insoffset, inssize : longint; procedure init(op : tasmop;_size : topsize); { this need to be called by all constructor } function InsEnd:longint; procedure create_ot; function Matches(p:PInsEntry):longint; function calcsize(p:PInsEntry):longint; procedure gencode; function NeedAddrPrefix(opidx:byte):boolean; end; pai386_labeled = ^tai386_labeled; tai386_labeled = object(tai386) lab : plabel; constructor op_lab(op : tasmop; l : plabel); constructor op_cond_lab(op : tasmop; cond:tasmcond;l : plabel); destructor done;virtual; function Pass1(offset:longint):longint;virtual; procedure Pass2;virtual; end; implementation uses og386; {***************************************************************************** TaiRegAlloc *****************************************************************************} constructor tairegalloc.alloc(r : tregister); begin inherited init; typ:=ait_regalloc; allocation:=true; reg:=r; end; constructor tairegalloc.dealloc(r : tregister); begin inherited init; typ:=ait_regalloc; allocation:=false; reg:=r; end; {***************************************************************************** TaiTempAlloc *****************************************************************************} constructor taitempalloc.alloc(pos,size:longint); begin inherited init; typ:=ait_tempalloc; allocation:=true; temppos:=pos; tempsize:=size; end; constructor taitempalloc.dealloc(pos,size:longint); begin inherited init; typ:=ait_tempalloc; allocation:=false; temppos:=pos; tempsize:=size; end; {***************************************************************************** Tai386 Constructors *****************************************************************************} procedure tai386.loadconst(opidx:longint;l:longint); begin if opidx>=ops then ops:=opidx+1; with oper[opidx] do begin if typ=top_ref then disposereference(ref); val:=l; typ:=top_const; end; end; procedure tai386.loadsymbol(opidx:longint;s:pasmsymbol;sofs:longint); begin if opidx>=ops then ops:=opidx+1; with oper[opidx] do begin if typ=top_ref then disposereference(ref); sym:=s; symofs:=sofs; typ:=top_symbol; end; end; procedure tai386.loadref(opidx:longint;p:preference); begin if opidx>=ops then ops:=opidx+1; with oper[opidx] do begin if typ=top_ref then disposereference(ref); if p^.is_immediate then begin {$ifdef ASMDEBUG1} Comment(V_Warning,'Reference immediate'); {$endif} val:=p^.offset; disposereference(p); typ:=top_const; end else begin ref:=p; if not(ref^.segment in [R_DS,R_NO,R_DEFAULT_SEG]) then segprefix:=ref^.segment; typ:=top_ref; end; end; end; procedure tai386.loadreg(opidx:longint;r:tregister); begin if opidx>=ops then ops:=opidx+1; with oper[opidx] do begin if typ=top_ref then disposereference(ref); reg:=r; typ:=top_reg; end; end; procedure tai386.loadoper(opidx:longint;o:toper); begin if opidx>=ops then ops:=opidx+1; if oper[opidx].typ=top_ref then disposereference(oper[opidx].ref); oper[opidx]:=o; { copy also the reference } if oper[opidx].typ=top_ref then oper[opidx].ref:=newreference(o.ref^); end; procedure tai386.changeopsize(siz:topsize); begin opsize:=siz; end; procedure tai386.init(op : tasmop;_size : topsize); begin typ:=ait_instruction; insentry:=nil; LastInsOffset:=-1; InsOffset:=0; segprefix:=R_NO; opcode:=op; opsize:=_size; ops:=0; fillchar(oper,sizeof(oper),0); end; constructor tai386.op_none(op : tasmop;_size : topsize); begin inherited init; init(op,_size); end; constructor tai386.op_reg(op : tasmop;_size : topsize;_op1 : tregister); begin inherited init; init(op,_size); ops:=1; loadreg(0,_op1); end; constructor tai386.op_const(op : tasmop;_size : topsize;_op1 : longint); begin inherited init; init(op,_size); ops:=1; loadconst(0,_op1); end; constructor tai386.op_ref(op : tasmop;_size : topsize;_op1 : preference); begin inherited init; init(op,_size); ops:=1; loadref(0,_op1); end; constructor tai386.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); begin inherited init; init(op,_size); ops:=2; loadreg(0,_op1); loadreg(1,_op2); end; constructor tai386.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: longint); begin inherited init; init(op,_size); ops:=2; loadreg(0,_op1); loadconst(1,_op2); end; constructor tai386.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : preference); begin inherited init; init(op,_size); ops:=2; loadreg(0,_op1); loadref(1,_op2); end; constructor tai386.op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister); begin inherited init; init(op,_size); ops:=2; loadconst(0,_op1); loadreg(1,_op2); end; constructor tai386.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint); begin inherited init; init(op,_size); ops:=2; loadconst(0,_op1); loadconst(1,_op2); end; constructor tai386.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference); begin inherited init; init(op,_size); ops:=2; loadconst(0,_op1); loadref(1,_op2); end; constructor tai386.op_ref_reg(op : tasmop;_size : topsize;_op1 : preference;_op2 : tregister); begin inherited init; init(op,_size); ops:=2; loadref(0,_op1); loadreg(1,_op2); end; constructor tai386.op_ref_ref(op : tasmop;_size : topsize;_op1,_op2 : preference); begin inherited init; init(op,_size); ops:=2; loadref(0,_op1); loadref(1,_op2); end; constructor tai386.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister); begin inherited init; init(op,_size); ops:=3; loadreg(0,_op1); loadreg(1,_op2); loadreg(2,_op3); end; constructor tai386.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister); begin inherited init; init(op,_size); ops:=3; loadconst(0,_op1); loadreg(1,_op2); loadreg(2,_op3); end; constructor tai386.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;_op3 : preference); begin inherited init; init(op,_size); ops:=3; loadreg(0,_op1); loadreg(1,_op2); loadref(2,_op3); end; constructor tai386.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference;_op3 : tregister); begin inherited init; init(op,_size); ops:=3; loadconst(0,_op1); loadref(1,_op2); loadreg(2,_op3); end; constructor tai386.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : preference); begin inherited init; init(op,_size); ops:=3; loadconst(0,_op1); loadreg(1,_op2); loadref(2,_op3); end; constructor tai386.op_sym(op : tasmop;_size : topsize;_op1 : pasmsymbol); begin inherited init; init(op,_size); ops:=1; loadsymbol(0,_op1,0); end; constructor tai386.op_sym_ofs(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint); begin inherited init; init(op,_size); ops:=1; loadsymbol(0,_op1,_op1ofs); end; constructor tai386.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister); begin inherited init; init(op,_size); ops:=2; loadsymbol(0,_op1,_op1ofs); loadreg(1,_op2); end; constructor tai386.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference); begin inherited init; init(op,_size); ops:=2; loadsymbol(0,_op1,_op1ofs); loadref(0,_op2); end; destructor tai386.done; var i : longint; begin for i:=1 to ops do if (oper[i-1].typ=top_ref) then dispose(oper[i-1].ref); inherited done; end; function tai386.getcopy:plinkedlist_item; var i : longint; p : plinkedlist_item; begin p:=inherited getcopy; { make a copy of the references } for i:=1 to ops do if (pai386(p)^.oper[i-1].typ=top_ref) then begin new(pai386(p)^.oper[i-1].ref); pai386(p)^.oper[i-1].ref^:=oper[i-1].ref^; end; getcopy:=p; end; procedure tai386.SetCondition(c:TAsmCond); begin condition:=c; end; function tai386.GetString:string; {$ifdef ASMDEBUG} var i : longint; s : string; {$endif} begin {$ifdef ASMDEBUG} s:='['+int_op2str[opcode]; for i:=1to ops do begin if i=1 then s:=s+' ' else s:=s+','; { type } if (oper[i-1].ot and OT_REGISTER)<>0 then s:=s+'reg' else if (oper[i-1].ot and OT_IMMEDIATE)<>0 then s:=s+'imm' else if (oper[i-1].ot and OT_MEMORY)<>0 then s:=s+'mem' else s:=s+'???'; { size } 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; GetString:=s+']'; {$else} GetString:=''; {$endif ASMDEBUG} end; {***************************************************************************** Assembler *****************************************************************************} type ea=packed record sib_present : boolean; bytes : byte; size : byte; modrm : byte; sib : byte; end; procedure tai386.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:=reg_2_type[reg]; top_ref : begin { create ot field } ot:=OT_MEMORY or opsize_2_type[i,opsize]; if (ref^.base=R_NO) and (ref^.index=R_NO) then ot:=ot or OT_MEM_OFFS; { handle also the offsetfixup } inc(ref^.offset,ref^.offsetfixup); ref^.offsetfixup:=0; { 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 (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 (l<>-1) and (not assigned(sym) or (sym^.typ<>AS_EXTERNAL)) 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 tai386.InsEnd:longint; begin InsEnd:=InsOffset+InsSize; end; function tai386.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,siz,oprs : 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 } siz:=$ffffffff; if (p^.flags and IF_SB)<>0 then siz:=OT_BITS8 else if (p^.flags and IF_SW)<>0 then siz:=OT_BITS16 else if (p^.flags and IF_SD)<>0 then siz:=OT_BITS32 else 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 siz:=p^.optypes[i] and OT_SIZE_MASK; break; end; end; { Check operand sizes } for i:=0to 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))<>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)<(oper[i].ot and OT_SIZE_MASK)) then Matches:=2; end; end; function tai386.Pass1(offset:longint):longint; var m,i,size_prob : longint; p : toper; 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; { 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; { create the .ot fields } create_ot; { 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; { Lookup opcode in the table } InsSize:=-1; size_prob:=0; i:=instabcache^[opcode]; if i=-1 then begin Comment(V_Warning,'opcode not in the table !'); exit; end; insentry:=@instab[i]; while (insentry^.opcode=opcode) do begin m:=matches(insentry); if m=100 then begin InsSize:=calcsize(insentry); if not(segprefix in [R_NO,R_DEFAULT_SEG]) then inc(InsSize); Pass1:=InsSize; LastInsOffset:=InsOffset; exit; end; inc(i); insentry:=@instab[i]; end; if insentry^.opcode<>opcode then begin case size_prob of 1 : Comment(V_Warning,GetString+' operation size not specified'); 2 : Comment(V_Warning,GetString+' mismatch in operand sizes'); else Comment(V_Warning,GetString+' invalid combination of opcode and operands'); end; end; { No instruction found, set insentry to nil and inssize to -1 } insentry:=nil; inssize:=-1; LastInsOffset:=-1; end; procedure tai386.Pass2; var c : longint; begin { error in pass1 ? } if insentry=nil then exit; aktfilepos:=fileinfo; { Segment override } if not(segprefix in [R_NO,R_DEFAULT_SEG]) then begin case segprefix of R_CS : c:=$2e; R_DS : c:=$3e; R_ES : c:=$26; R_FS : c:=$64; R_GS : c:=$65; R_SS : c:=$36; end; objectoutput^.writebytes(c,1); { fix the offset for GenNode } inc(InsOffset); end; { Generate the instruction } GenCode; end; function tai386.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_ST0,R_MM0 : regval:=0; R_ECX,R_CX,R_CL,R_CS,R_DR1,R_ST1,R_MM1 : regval:=1; R_EDX,R_DX,R_DL,R_SS,R_CR2,R_DR2,R_ST2,R_MM2 : regval:=2; R_EBX,R_BX,R_BL,R_DS,R_CR3,R_DR3,R_TR3,R_ST3,R_MM3 : regval:=3; R_ESP,R_SP,R_AH,R_FS,R_CR4,R_TR4,R_ST4,R_MM4 : regval:=4; R_EBP,R_BP,R_CH,R_GS,R_TR5,R_ST5,R_MM5 : regval:=5; R_ESI,R_SI,R_DH,R_DR6,R_TR6,R_ST6,R_MM6 : regval:=6; R_EDI,R_DI,R_BH,R_DR7,R_TR7,R_ST7,R_MM7 : regval:=7; else begin Comment(V_Warning,'invalid register operand given to regval()'); regval:=0; end; end; end; function process_ea(const input:toper;var output:ea;rfield:longint):boolean; const regs : array[0..31] of tregister=( R_MM0, R_EAX, R_AX, R_AL, R_MM1, R_ECX, R_CX, R_CL, R_MM2, R_EDX, R_DX, R_DL, R_MM3, R_EBX, R_BX, R_BL, R_MM4, R_ESP, R_SP, R_AH, R_MM5, R_EBP, R_BP, R_CH, R_MM6, R_ESI, R_SI, R_DH, R_MM7, R_EDI, R_DI, R_BH ); var j : longint; i,b : tregister; sym : pasmsymbol; 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 2); 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; 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 Comment(V_Warning,'16 bit ea 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 tai386.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, 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 : ; 216 : begin inc(codes); inc(len); end; 224,225,226 : begin Comment(V_Warning,'not supported'); 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 Comment(V_Warning,'invalid effective address') else inc(len,ea_data.size); end else begin Comment(V_Warning,'internal instruction table corrupt: instruction code '+tostr(c)+' given'); end; end; end; until false; calcsize:=len; end; procedure tai386.GenCode; { * the actual codes (C syntax, i.e. octal): * \0 - terminates the code. (Unless it's a literal of course.) * \1, \2, \3 - that many literal bytes follow in the code stream * \4, \6 - the POP/PUSH (respectively) codes for CS, DS, ES, SS * (POP is never used for CS) depending on operand 0 * \5, \7 - the second byte of POP/PUSH codes for FS, GS, depending * on operand 0 * \10, \11, \12 - a literal byte follows in the code stream, to be added * to the register value of operand 0, 1 or 2 * \17 - encodes the literal byte 0. (Some compilers don't take * kindly to a zero byte in the _middle_ of a compile time * string constant, so I had to put this hack in.) * \14, \15, \16 - a signed byte immediate operand, from operand 0, 1 or 2 * \20, \21, \22 - a byte immediate operand, from operand 0, 1 or 2 * \24, \25, \26 - an unsigned byte immediate operand, from operand 0, 1 or 2 * \30, \31, \32 - a word immediate operand, from operand 0, 1 or 2 * \34, \35, \36 - select between \3[012] and \4[012] depending on 16/32 bit * assembly mode or the address-size override on the operand * \37 - a word constant, from the _segment_ part of operand 0 * \40, \41, \42 - a long immediate operand, from operand 0, 1 or 2 * \50, \51, \52 - a byte relative operand, from operand 0, 1 or 2 * \60, \61, \62 - a word relative operand, from operand 0, 1 or 2 * \64, \65, \66 - select between \6[012] and \7[012] depending on 16/32 bit * assembly mode or the address-size override on the operand * \70, \71, \72 - a long relative operand, from operand 0, 1 or 2 * \1ab - a ModRM, calculated on EA in operand a, with the spare * field the register value of operand b. * \2ab - a ModRM, calculated on EA in operand a, with the spare * field equal to digit b. * \30x - might be an 0x67 byte, depending on the address size of * the memory reference in operand x. * \310 - indicates fixed 16-bit address size, i.e. optional 0x67. * \311 - indicates fixed 32-bit address size, i.e. optional 0x67. * \320 - indicates fixed 16-bit operand size, i.e. optional 0x66. * \321 - indicates fixed 32-bit operand size, i.e. optional 0x66. * \322 - indicates that this instruction is only valid when the * operand size is the default (instruction to disassembler, * generates no code in the assembler) * \330 - a literal byte follows in the code stream, to be added * to the condition code value of the instruction. * \340 - reserve bytes of uninitialised storage. * Operand 0 had better be a segmentless constant. } var currval : longint; currsym : pasmsymbol; procedure getvalsym(opidx:longint); begin case oper[opidx].typ of top_ref : begin currval:=oper[opidx].ref^.offset; currsym:=oper[opidx].ref^.symbol; end; top_const : begin currval:=oper[opidx].val; currsym:=nil; end; top_symbol : begin currval:=oper[opidx].symofs; currsym:=oper[opidx].sym; end; else Comment(V_Error,'immediate or reference expected'); end; end; const CondVal:array[TAsmCond] of byte=($0, $7, $3, $2, $6, $2, $4, $F, $D, $C, $E, $6, $2, $3, $7, $3, $5, $E, $C, $D, $F, $1, $B, $9, $5, $0, $A, $A, $B, $8, $4); var c : byte; pb, codes : pchar; bytes : array[0..3] of byte; rfield, data,s,opidx : longint; ea_data : ea; begin codes:=insentry^.code; repeat c:=ord(codes^); inc(codes); case c of 0 : break; 1,2,3 : begin objectoutput^.writebytes(codes^,c); inc(codes,c); end; 4,6 : begin case oper[0].reg of R_CS : begin if c=4 then bytes[0]:=$f else bytes[0]:=$e; end; R_DEFAULT_SEG, R_DS : begin if c=4 then bytes[0]:=$1f else bytes[0]:=$1e; end; R_ES : begin if c=4 then bytes[0]:=$7 else bytes[0]:=$6; end; R_SS : begin if c=4 then bytes[0]:=$17 else bytes[0]:=$16; end; else Comment(V_Warning,'bizarre 8086 segment register received'); end; objectoutput^.writebytes(bytes,1); end; 5,7 : begin case oper[0].reg of R_FS : begin if c=5 then bytes[0]:=$a1 else bytes[0]:=$a0; end; R_GS : begin if c=5 then bytes[0]:=$a9 else bytes[0]:=$a8; end; else Comment(V_Warning,'bizarre 386 segment register received'); end; objectoutput^.writebytes(bytes,1); end; 8,9,10 : begin bytes[0]:=ord(codes^)+regval(oper[c-8].reg); inc(codes); objectoutput^.writebytes(bytes,1); end; 15 : begin bytes[0]:=0; objectoutput^.writebytes(bytes,1); end; 12,13,14 : begin getvalsym(c-12); if (currval<-128) or (currval>127) then Comment(V_Warning,'signed byte value exceeds bounds '+tostr(currval)); if assigned(currsym) then objectoutput^.writereloc(currval,1,currsym,relative_false) else objectoutput^.writebytes(currval,1); end; 16,17,18 : begin getvalsym(c-16); if (currval<-256) or (currval>255) then Comment(V_Warning,'byte value exceeds bounds '+tostr(currval)); if assigned(currsym) then objectoutput^.writereloc(currval,1,currsym,relative_false) else objectoutput^.writebytes(currval,1); end; 20,21,22 : begin getvalsym(c-20); if (currval<0) or (currval>255) then Comment(V_Warning,'unsigned byte value exceeds bounds '+tostr(currval)); if assigned(currsym) then objectoutput^.writereloc(currval,1,currsym,relative_false) else objectoutput^.writebytes(currval,1); end; 24,25,26 : begin getvalsym(c-24); if (currval<-65536) or (currval>65535) then Comment(V_Warning,'word value exceeds bounds '+tostr(currval)); if assigned(currsym) then objectoutput^.writereloc(currval,2,currsym,relative_false) else objectoutput^.writebytes(currval,2); end; 31 : begin Comment(V_Warning,'not supported'); end; 28,29,30 : begin getvalsym(c-28); if assigned(currsym) then objectoutput^.writereloc(currval,4,currsym,relative_false) else objectoutput^.writebytes(currval,4); end; 32,33,34 : begin getvalsym(c-32); if assigned(currsym) then objectoutput^.writereloc(currval,4,currsym,relative_false) else objectoutput^.writebytes(currval,4); end; 40,41,42 : begin getvalsym(c-40); data:=currval-insend; if assigned(currsym) then inc(data,currsym^.address); if (data>127) or (data<-128) then Comment(V_Warning,'short jump is out of range '+tostr(data)); objectoutput^.writebytes(data,1); end; 48,49,50 : begin Comment(V_Warning,'rel2adr not supported'); end; 52,53,54 : begin getvalsym(c-52); if assigned(currsym) then objectoutput^.writereloc(currval,4,currsym,relative_true) else objectoutput^.writereloc(currval-insend,4,nil,relative_false) end; 56,57,58 : begin getvalsym(c-56); if assigned(currsym) then objectoutput^.writereloc(currval,4,currsym,relative_true) else objectoutput^.writereloc(currval-insend,4,nil,relative_false) end; 192,193,194 : begin if NeedAddrPrefix(c-192) then begin bytes[0]:=$67; objectoutput^.writebytes(bytes,1); end; end; 200 : begin bytes[0]:=$67; objectoutput^.writebytes(bytes,1); end; 201 : begin end; 202 : begin end; 208 : begin bytes[0]:=$66; objectoutput^.writebytes(bytes,1); end; 209 : begin end; 210 : begin end; 216 : begin bytes[0]:=ord(codes^)+condval[condition]; inc(codes); objectoutput^.writebytes(bytes,1); end; 224,225,226 : begin Comment(V_Warning,'not supported'); end else begin if (c>=64) and (c<=191) then begin if (c<127) then begin if (oper[c and 7].typ=top_reg) then rfield:=regval(oper[c and 7].reg) else rfield:=regval(oper[c and 7].ref^.base); end else rfield:=c and 7; opidx:=(c shr 3) and 7; if not process_ea(oper[opidx], ea_data, rfield) then Comment(V_Warning,'invalid effective address'); pb:=@bytes; pb^:=chr(ea_data.modrm); inc(pb); if ea_data.sib_present then begin pb^:=chr(ea_data.sib); inc(pb); end; s:=pb-pchar(@bytes); objectoutput^.writebytes(bytes,s); case ea_data.bytes of 0 : ; 1 : begin if (oper[opidx].ot and OT_MEMORY)=OT_MEMORY then objectoutput^.writereloc(oper[opidx].ref^.offset,1,oper[opidx].ref^.symbol,relative_false) else begin bytes[0]:=oper[opidx].ref^.offset; objectoutput^.writebytes(bytes,1); end; inc(s); end; 2,4 : begin objectoutput^.writereloc(oper[opidx].ref^.offset,ea_data.bytes, oper[opidx].ref^.symbol,relative_false); inc(s,ea_data.bytes); end; end; end else begin Comment(V_Warning,'internal instruction table corrupt: instruction code '+tostr(c)+' given'); end; end; end; until false; end; {***************************************************************************** Tai_Labeled *****************************************************************************} constructor tai386_labeled.op_lab(op : tasmop; l : plabel); begin inherited op_none(op,S_NO); typ:=ait_labeled_instruction; lab:=l; lab^.is_used:=true; inc(lab^.refcount); end; constructor tai386_labeled.op_cond_lab(op : tasmop; cond:tasmcond;l : plabel); begin inherited op_none(op,S_NO); condition:=cond; typ:=ait_labeled_instruction; lab:=l; lab^.is_used:=true; inc(lab^.refcount); end; destructor tai386_labeled.done; begin dec(lab^.refcount); if lab^.refcount=0 then Begin lab^.is_used := False; If Not(lab^.is_set) Then Dispose(lab); End; inherited done; end; function tai386_labeled.Pass1(offset:longint):longint; begin { Only create the Operand if it's not set yet } ops:=1; loadsymbol(0,nil,lab^.address); Pass1:=inherited Pass1(offset); end; procedure tai386_labeled.Pass2; begin { update the address which can be changed if it was a forward reference } oper[0].symofs:=lab^.address; inherited Pass2; end; end. { $Log$ Revision 1.3 1999-05-02 22:41:53 peter * moved section names to systems * fixed nasm,intel writer Revision 1.2 1999/05/02 21:33:52 florian * several bugs regarding -Or fixed Revision 1.1 1999/05/01 13:24:23 peter * merged nasm compiler * old asm moved to oldasm/ Revision 1.18 1999/04/16 11:49:51 peter + tempalloc + -at to show temp alloc info in .s file Revision 1.17 1999/04/16 09:35:11 pierre + tai constructors needed for SHRD and IMUL added Revision 1.16 1999/04/01 21:58:21 peter * small fixes for proces_ea Revision 1.15 1999/03/31 13:55:32 peter * assembler inlining working for ag386bin Revision 1.14 1999/03/29 16:05:49 peter * optimizer working for ag386bin Revision 1.13 1999/03/26 00:01:11 peter * first things for optimizer (compiles but cycle crashes) Revision 1.12 1999/03/12 00:20:04 pierre + win32 output working ! Revision 1.11 1999/03/10 13:41:08 pierre + partial implementation for win32 ! winhello works but pp still does not ! Revision 1.10 1999/03/09 19:25:24 peter * only pass jmp's a second time in pass1 Revision 1.9 1999/03/08 14:51:06 peter + smartlinking for ag386bin Revision 1.8 1999/03/06 17:24:19 peter * rewritten intel parser a lot, especially reference reading * size checking added for asm parsers Revision 1.7 1999/03/02 02:56:19 peter + stabs support for binary writers * more fixes and missing updates from the previous commit :( Revision 1.6 1999/03/01 15:46:21 peter * ag386bin finally make cycles correct * prefixes are now also normal opcodes Revision 1.5 1999/02/26 00:48:28 peter * assembler writers fixed for ag386bin Revision 1.4 1999/02/25 21:03:02 peter * ag386bin updates + coff writer Revision 1.3 1999/02/22 02:44:17 peter * ag386bin doesn't use i386.pas anymore Revision 1.2 1999/02/22 02:16:02 peter * updates for ag386bin Revision 1.1 1999/02/16 17:59:37 peter + initial files }