Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/MLRISC/x86/x86.md
ViewVC logotype

View of /sml/trunk/src/MLRISC/x86/x86.md

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (download) (annotate)
Thu Jun 1 18:34:03 2000 UTC (19 years, 1 month ago) by monnier
File size: 15099 byte(s)
bring revisions from the vendor branch to the trunk
(* 
 * 32bit, x86 instruction set.
 *)
architecture X86 = 
struct

  name "X86"

  superscalar

  little endian (* is this right??? *)

  lowercase assembly

    (*
    * Assembly note:
    * Note: we are using the AT&T syntax (for Linux) and not the intel syntax
    * memory operands have the form:
    *       section:disp(base, index, scale)
    * Most of the complication is actually in emiting the correct
    * operand syntax.
    *)

    (* Note: While the x86 has only 8 integer and 8 floating point registers,
     * the SMLNJ compiler fakes it by assuming that it has 32 integer
     * and 32 floating point registers.  That's why we 
     *)

   storage
      GP "r" = 32 cells of 32 bits in cellset called "register"
                assembly as
                    (fn (0,8)  => "%al"
                      | (0,16) => "%ax"
                      | (0,32) => "%eax"
                      | (1,8)  => "%cl"
                      | (1,16) => "%cx"
                      | (1,32) => "%ecx"
                      | (2,8)  => "%dl"
                      | (2,16) => "%dx"
                      | (2,32) => "%edx"
                      | (3,8)  => "%bl"
                      | (3,16) => "%bx"
                      | (3,32) => "%ebx"
                      | (4,16) => "%sp"
                      | (4,32) => "%esp"
                      | (5,16) => "%bp"
                      | (5,32) => "%ebp"
                      | (6,16) => "%si"
                      | (6,32) => "%esi"
                      | (7,16) => "%di"
                      | (7,32) => "%edi"
                      | (r,_) => "%"^Int.toString r
                    )
   |  FP "f" = 32 cells of 80 bits in cellset called "floating point register"
               assembly as (fn (0,_) => "%st"
                             | (f,_) => 
                                if f < 8 then "%st("^Int.toString f^")"
                                else "%f"^Int.toString f 
                                     (* pseudo register *)
                           )
   |  CC "cc" = cells of 32 bits in cellset called "condition code register"
                assembly as "cc"
   |  MEM "m" = cells of 8 bits called "memory"
                assembly as (fn (r,_) => "m"^Int.toString r)
   |  CTRL "ctrl" = cells of 8 bits called "control"
                assembly as (fn (r,_) => "ctrl"^Int.toString r)

   locations
       eax     = $GP[0]
   and ecx     = $GP[1]
   and edx     = $GP[2]
   and ebx     = $GP[3]
   and esp     = $GP[4]
   and ebp     = $GP[5]
   and esi     = $GP[6]
   and edi     = $GP[7]
   and stackptrR = $GP[4]
   and ST(x)   = $FP[x]
   and asmTmpR   = ~1 (* not used *)
   and fasmTmp   = ~1 (* not used *)

   structure RTL =
   struct
   end 

   structure Instruction = struct
 (* An effective address can be any combination of
  *  base + index*scale + disp 
  *   or
  *   B + I*SCALE + DISP
  *
  * where any component is optional. The operand datatype captures
  * all these combinations.
  *
  *  DISP 	    == Immed | ImmedLabel | Const
  *  B		    == Displace{base=B, disp=0}
  *  B+DISP	    == Displace{base=B, disp=DISP}
  *  I*SCALE+DISP   == Indexed{base=NONE, index=I, scale=SCALE, disp=D}
  *  B+I*SCALE+DISP == Indexed{base=SOME B, index=I, scale=SCALE, disp=DISP}
  *
  *  Note1: The index register cannot be EBP.
  *         The disp field must be one of Immed, ImmedLabel,  or Const.
  *)

  (* Note: Relative is only generated after sdi resolution *)
  datatype operand =
     Immed      of Int32.int	   
   | ImmedLabel of LabelExp.labexp 
   | Relative   of int		
   | LabelEA	of LabelExp.labexp 
   | Direct     of $GP		   
   | FDirect    of $FP		   
   | ST         of $FP		   
   | MemReg     of int (* pseudo memory register *)
   | Displace   of {base: $GP, disp:operand, mem:Region.region}
   | Indexed    of {base: $GP option, index: $GP, scale:int, disp:operand,
		    mem:Region.region}

  type addressing_mode = operand
  
  type ea = operand

  datatype cond! = 
      EQ "e" | NE | LT "l" | LE | GT "g" | GE 
    | B  | BE (* below *)   | A  | AE (* above *) 
    | C  | NC (* if carry *)| P  | NP (* if parity *)
    | O  | NO (* overflow *) 

      (* LOCK can only be used in front of
       *                      (Intel ordering, not gasm ordering)
       * ADC, ADD, AND, BT   mem, reg/imm
       * BTS, BTR, BTC, OR   mem, reg/imm
       * SBB, SUB, XOR       mem, reg/imm
       * XCHG                reg, mem
       * XCHG                mem, reg
       * DEC, INC, NEG, NOT  mem
       *)

  datatype binaryOp! = 
     ADDL | SUBL | ANDL | ORL | XORL | SHLL | SARL | SHRL | ADCL | SBBL 
   | ADDW | SUBW | ANDW | ORW | XORW | SHLW | SARW | SHRW 
   | ADDB | SUBB | ANDB | ORB | XORB | SHLB | SARB | SHRB
   | BTSW | BTCW | BTRW | BTSL | BTCL | BTRL 
   | ROLW | RORW | ROLL | RORL
   | XCHGB | XCHGW | XCHGL 

   | LOCK_ADCW "lock\n\tadcw"
   | LOCK_ADCL "lock\n\tadcl"
   | LOCK_ADDW "lock\n\taddw"
   | LOCK_ADDL "lock\n\taddl"
   | LOCK_ANBW "lock\n\tanbw"
   | LOCK_ANBL "lock\n\tanbl"
   | LOCK_ANDW "lock\n\tandw"
   | LOCK_ANDL "lock\n\tandl"
   | LOCK_BTSW "lock\n\tbtsw"
   | LOCK_BTSL "lock\n\tbtsl"
   | LOCK_BTRW "lock\n\tbtrw"
   | LOCK_BTRL "lock\n\tbtrl"
   | LOCK_BTCW "lock\n\tbtcw"
   | LOCK_BTCL "lock\n\tbtcl"
   | LOCK_ORW  "lock\n\torw"
   | LOCK_ORL  "lock\n\torl"
   | LOCK_SBBW "lock\n\tsbbw"
   | LOCK_SBBL "lock\n\tsbbl"
   | LOCK_SUBW "lock\n\tsubw"
   | LOCK_SUBL "lock\n\tsubl"
   | LOCK_XORW "lock\n\txorw"
   | LOCK_XORL "lock\n\txorl"
   | LOCK_XCHGB "lock\n\txchgb"
   | LOCK_XCHGW "lock\n\txchgw"
   | LOCK_XCHGL "lock\n\txchgl"

  datatype multDivOp! = MULL | IDIVL | DIVL

  datatype unaryOp! = DECL | INCL | NEGL | NOTL | NOTW | NOTB 
                    | LOCK_DECL "lock\n\tdecl"
                    | LOCK_INCL "lock\n\tincl"
                    | LOCK_NEGL "lock\n\tnegl"
                    | LOCK_NOTL "lock\n\tnotl"

  datatype bitOp! = BTW | BTL 
                  | LOCK_BTW "lock\n\tbtw"
                  | LOCK_BTL "lock\n\tbtl"

  datatype move! = MOVL 
                 | MOVB             
                 | MOVW             
                 | MOVSWL | MOVZWL  (* word -> long *) 
                 | MOVSBL | MOVZBL  (* byte -> long *)

 (* The Intel manual is incorrect on the description of FDIV and FDIVR *)
  datatype fbinOp! = 
      FADDP   | FADDS    
    | FMULP   | FMULS   
              | FCOMS    
              | FCOMPS    
    | FSUBP   | FSUBS  	(* ST(1) := ST-ST(1); [pop] *)
    | FSUBRP  | FSUBRS 	(* ST(1) := ST(1)-ST; [pop] *)
    | FDIVP   | FDIVS   (* ST(1) := ST/ST(1); [pop] *)
    | FDIVRP  | FDIVRS 	(* ST(1) := ST(1)/ST; [pop] *)
              | FADDL  
              | FMULL 
              | FCOML    
              | FCOMPL    
              | FSUBL 	(* ST(1) := ST-ST(1); [pop] *)
              | FSUBRL 	(* ST(1) := ST(1)-ST; [pop] *)
              | FDIVL   (* ST(1) := ST/ST(1); [pop] *)
              | FDIVRL 	(* ST(1) := ST(1)/ST; [pop] *)

  datatype fibinOp! =
      FIADDS | FIMULS   | FICOMS | FICOMPS
    | FISUBS | FISUBRS	| FIDIVS | FIDIVRS 
    | FIADDL | FIMULL   | FICOML | FICOMPL
    | FISUBL | FISUBRL  | FIDIVL | FIDIVRL

  datatype funOp! = FABS | FCHS 
                  | FSIN | FCOS | FTAN 
                  | FSCALE | FRNDINT | FSQRT
	          | FTST | FXAM 
                  | FINCSTP | FDECSTP

  datatype fenvOp! = FLDENV | FNLDENV | FSTENV | FNSTENV

  end (* struct Instruction *)

  (*
   * Instruction encoding on the x86
   * Because of variable width instructions.
   * We decompose each byte field into a seperate format first, then combine
   * then to form the real instructions
   *)
  instruction formats 8 bits 
    modrm{mod:2, reg:3, rm:3}
  | sib{ss:2, index:3, base:3}  
  | immed8{imm:8}

  instruction formats 32 bits
    immed32{imm:32}

  (* A bunch of routines for emitting assembly *)
  functor Assembly
     (structure MemRegs : MEMORY_REGISTERS where I = Instr) =
  struct
     val memReg = MemRegs.memReg regmap
     fun emitInt32 i = 
     let val s = Int32.toString i
         val s = if i >= 0 then s else "-"^String.substring(s,1,size s-1)
     in  emit s end
		
     fun emitScale 0 = emit "1"
       | emitScale 1 = emit "2"
       | emitScale 2 = emit "4"
       | emitScale 3 = emit "8"
       | emitScale _ = error "emitScale"

     and eImmed(I.Immed (i)) = emitInt32 i
       | eImmed(I.ImmedLabel lexp) = emit_labexp lexp
       | eImmed _ = error "eImmed"

     and emit_operand opn =
         case opn of
         I.Immed i => (emit "$"; emitInt32 i)
       | I.ImmedLabel lexp => (emit "$"; emit_labexp lexp)
       | I.LabelEA le => emit_labexp le
       | I.Relative _ => error "emit_operand"
       | I.Direct r => emit_GP r
       | I.MemReg r => emit_operand(memReg opn)
       | I.ST f => emit_FP f
       | I.FDirect f => emit_operand(memReg opn)
       | I.Displace{base,disp,mem,...} => 
           (emit_disp disp; emit "("; emit_GP base; emit ")"; 
            emit_region mem)
       | I.Indexed{base,index,scale,disp,mem,...} =>
          (emit_disp disp; emit "("; 
           case base of
             NONE => ()
           | SOME base => emit_GP base;
           comma();
           emit_GP index; comma(); 
           emitScale scale; emit ")"; emit_region mem)

      and emit_disp(I.Immed 0) = ()
        | emit_disp(I.Immed i) = emitInt32 i
        | emit_disp(I.ImmedLabel lexp) = emit_labexp lexp
        | emit_disp _ = error "emit_disp"

     (* The gas assembler does not like the "$" prefix for immediate
      * labels in certain instructions. 
      *)
      fun stupidGas(I.ImmedLabel lexp) = emit_labexp lexp
        | stupidGas opnd = (emit "*"; emit_operand opnd)

     (* Display the floating point binary opcode *)
      fun isMemOpnd(I.MemReg _) = true
        | isMemOpnd(I.FDirect f) = true
        | isMemOpnd(I.LabelEA _) = true
        | isMemOpnd(I.Displace _) = true
        | isMemOpnd(I.Indexed _) = true
        | isMemOpnd _ = false
      fun chop fbinOp =
          let val n = size fbinOp
          in  case Char.toLower(String.sub(fbinOp,n-1)) of
                (#"s" | #"l") => String.substring(fbinOp,0,n-1)
              | _ => fbinOp
          end

      val emit_dst = emit_operand
      val emit_src = emit_operand
      val emit_opnd = emit_operand
      val emit_rsrc = emit_operand
      val emit_lsrc = emit_operand
      val emit_addr = emit_operand
      val emit_src1 = emit_operand
  end (* Instruction *)

 (* many of these instructions imply certain register usages *)
  instruction 
      NOP
	``nop''

    | JMP of operand * Label.label list
	``jmp\t<stupidGas operand>''

    | JCC of {cond:cond, opnd:operand}
	``j<cond>\t<stupidGas opnd>''

    | CALL of operand * C.cellset * C.cellset * Region.region
	``call\t<stupidGas operand><region><
          emit_defs(cellset1)><
          emit_uses(cellset2)>''

    | ENTER of {src1:operand, src2:operand} 
	``enter\t<emit_operand src1>, <emit_operand src2>''

    | LEAVE
	``leave''

    | RET of operand option
	``ret<case operand of NONE => () 
                            | SOME e => (emit "\t"; emit_operand e)>''

   (* integer *)
    | MOVE of {mvOp:move, src:operand, dst:operand}
	``<mvOp>\t<src>, <dst>''

    | LEA of {r32: $GP, addr: operand}
	``leal\t<addr>, <r32>''

    | CMPL of {lsrc: operand, rsrc: operand}
	``cmpl\t<rsrc>, <lsrc>''

    | CMPW of {lsrc: operand, rsrc: operand}
	``cmpb\t<rsrc>, <lsrc>''

    | CMPB of {lsrc: operand, rsrc: operand}
	``cmpb\t<rsrc>, <lsrc>''

    | TESTL of {lsrc: operand, rsrc: operand}
	``testl\t<rsrc>, <lsrc>''

    | TESTW of {lsrc: operand, rsrc: operand}
	``testw\t<rsrc>, <lsrc>''

    | TESTB of {lsrc: operand, rsrc: operand}
	``testb\t<rsrc>, <lsrc>''

    | BITOP of {bitOp:bitOp, lsrc: operand, rsrc: operand}
	``<bitOp>\t<rsrc>, <lsrc>''

    | BINARY of {binOp:binaryOp, src:operand, dst:operand}
	asm: (case (src,binOp) of
               (I.Direct _,
               (I.SARL | I.SHRL | I.SHLL |
                I.SARW | I.SHRW | I.SHLW |
                I.SARB | I.SHRB | I.SHLB)) => ``<binOp>\t%cl, <dst>''
             | _ => ``<binOp>\t<src>, <dst>''
             )

    | MULTDIV of {multDivOp:multDivOp, src:operand}
	``<multDivOp>\t<src>''

    | MUL3 of {dst: $GP, src2: Int32.int option, src1:operand}
        (* Fermin: constant operand must go first *)
        asm: (case src2 of 
                NONE => ``imul\t<src1>, <dst>''
              | SOME i => ``imul\t$<emitInt32 i>, <src1>, <dst>''
             )

    | UNARY of {unOp:unaryOp, opnd:operand}
	``<unOp>\t<opnd>''

      (* set byte on condition code; note that
       * this only sets the low order byte, so it also
       * uses its operand.
       *)
    | SET of {cond:cond, opnd:operand}
	 ``set<cond>\t<opnd>''

        (* conditional move; Pentium Pro or higher only 
         * Destination must be a register. 
         *)
    | CMOV of {cond:cond, src:operand, dst: $GP} 
	``cmov<cond>\t<src>, <dst>''

    | PUSHL of operand
	``pushl\t<operand>''

    | PUSHW of operand
	``pushw\t<operand>''

    | PUSHB of operand
	``pushb\t<operand>''

    | POP of operand
	``popl\t<operand>''

    | CDQ
	``cdq''

    | INTO
	``into''

   (* parallel copies *)
    | COPY of {dst: $GP list, src: $GP list, tmp:operand option}
	asm: emitInstrs (Shuffle.shuffle{regmap,tmp,dst,src})

    | FCOPY of {dst: $FP list, src: $FP list, tmp:operand option}
	asm: emitInstrs (Shuffle.shufflefp{regmap,tmp,dst,src})

   (* floating *)
    | FBINARY of {binOp:fbinOp, src:operand, dst:operand}
	asm: (if isMemOpnd src then ``<binOp>\t<src>''
              else ``<emit(chop(asm_fbinOp binOp))>\t<src>, <dst>''
             )

    | FIBINARY of {binOp:fibinOp, src:operand}
	asm: ``<binOp>\t<src>'' (* the implied destination is %ST(0) *)

    | FUNARY of funOp
	``<funOp>''

    | FUCOMPP
	``fucompp''

    | FCOMPP
	``fcompp''

    | FXCH of {opnd: $FP}
	asm: (``fxch\t''; if opnd = C.ST(1) then () else ``<opnd>'')

    | FSTPL of operand
	``fstpl\t<operand>''

    | FSTPS of operand
	``fstps\t<operand>''

    | FSTPT of operand
	``fstps\t<operand>''

    | FSTL of operand
	``fstl\t<operand>''

    | FSTS of operand
	``fsts\t<operand>''

    | FLD1
	``fld1''

    | FLDL2E
	``fldl2e''

    | FLDL2T
	``fldl2t''

    | FLDLG2
	``fldlg2''

    | FLDLN2
	``fldln2''

    | FLDPI
	``fldpi''

    | FLDZ
	``fldz''

    | FLDL of operand
	``fldl\t<operand>'' 

    | FLDS of operand
	``flds\t<operand>'' 

    | FLDT of operand
	``fldt\t<operand>'' 

    | FILD of operand
	``fild\t<operand>''

    | FILDL of operand
	``fildl\t<operand>''

    | FILDLL of operand
	``fildll\t<operand>''

    | FNSTSW
	``fnstsw''

    | FENV of {fenvOp:fenvOp, opnd:operand} (* load/store environment *)
	``<fenvOp>\t<opnd>''

   (* misc *)
    | SAHF
	``sahf''

   (* annotations *)
    | ANNOTATION of {i:instruction, a:Annotations.annotation}
        asm: (comment(Annotations.toString a); nl(); emitInstr i)

    | SOURCE of {}
        asm: ``source''
        mc:  ()

    | SINK of {}
        asm: ``sink''
        mc:  ()

    | PHI of {}
        asm: ``phi''
        mc:  ()

end


root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0