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/branches/SMLNJ/src/MLRISC/x86/x86.md
ViewVC logotype

View of /sml/branches/SMLNJ/src/MLRISC/x86/x86.md

Parent Directory Parent Directory | Revision Log Revision Log


Revision 410 - (download) (annotate)
Fri Sep 3 00:25:03 1999 UTC (20 years, 3 months ago)
File size: 8462 byte(s)
This commit was manufactured by cvs2svn to create branch 'SMLNJ'.
(* 
 * 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 = 32 cells of 32 bits in cellset called "register"
           assembly as
                    (fn 0 => "%eax"
                      | 1 => "%ecx"
                      | 2 => "%edx"
                      | 3 => "%ebx"
                      | 4 => "%esp"
                      | 5 => "%ebp"
                      | 6 => "%esi"
                      | 7 => "%edi"
                      | r => "%"^Int.toString r
                    )
   |  FP = 32 cells of 80 bits in cellset called "floating point register"
           assembly as (fn f => if f >= 0 andalso f < 8 
                                then "%st("^Int.toString f^")"
                                else "%f"^Int.toString f (* fake register *)
                       )  
   |  CC = cells of 32 bits in cellset called "condition code register"
           assembly as "cc"
   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 = esp
   and asmTmpR   = ~1 (* not used *)
   and fasmTmp   = ~1 (* not used *)

   structure Cells =
   struct
      fun zeroReg _ = NONE
   end
        

   (*
   semantics X86 =
   struct
      include "MD++/basis.md"
      open Basis
      structure Int32 = struct type int end
      type 'a option
   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	   
   | Const      of Constant.const  
   | ImmedLabel of LabelExp.labexp 
   | Relative   of int		
   | LabelEA	of LabelExp.labexp 
   | Direct     of $GP		   
   | FDirect    of $FP		   
   | Displace   of {base: $GP, disp:operand, mem:Region.region}
   | Indexed    of {base: $GP option, index: $GP, scale:int, disp:operand,
		    mem:Region.region}
  
  type ea = operand

  datatype binaryOp! = ADD | SUB  | AND | OR | XOR | SHL | SAR | SHR

  datatype multDivOp! = UMUL | IDIV | UDIV

  datatype unaryOp! = DEC | INC | NEG | NOT

  datatype move! = MOVL | MOVZX | MOVB

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

 (* The Intel manual is incorrect on the description of FDIV and FDIVR *)
  datatype fbinOp! = 
      FADDP  | FADD 
    | FMULP  | FMUL
    | FSUBP  | FSUB  		(* ST(1) := ST-ST(1); [pop] *)
    | FSUBRP | FSUBR		(* ST(1) := ST(1)-ST; [pop] *)
    | FDIVP  | FDIV		(* ST(1) := ST/ST(1); [pop] *)
    | FDIVRP | FDIVR 		(* ST(1) := ST(1)/ST; [pop] *)

  datatype funOp! = FABS | FCHS 

  end (* struct Instruction *)

  (* 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 = emit(if i < 0 then "-"^Int32.toString(~i)
			    else Int32.toString i)
     fun emit_src2 NONE = ()
       | emit_src2(SOME i) = (emit "$"; emitInt32 i; emit ", ")

     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.Const c) = emit_const c
       | eImmed(I.ImmedLabel lexp) = emit_labexp lexp
       | eImmed _ = error "eImmed"

     and emit_operand opn =
         case opn of
         I.Immed i => (emit "$"; emitInt32 i)
       | I.Const c => emit_const c
       | 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.FDirect f =>
            let val f' = regmap f
            in  if f' < (32+8) then emit_FP f' else emit_operand(memReg opn) end
       | I.Displace{base,disp=I.Immed(0),mem,...} => 
           (emit "("; emit_GP base; emit ")"; emit_region mem)
       | I.Displace{base,disp,mem,...} => 
           (eImmed disp; emit "("; emit_GP base; emit ")"; 
            emit_region mem)
       | I.Indexed{base=NONE,index,scale,disp,mem,...} =>
          (emit "("; emit_GP index; comma(); emitScale scale; emit ")";
           emit_region mem)
       | I.Indexed{base=SOME base,index,scale,disp,mem,...} =>
         (eOptionalDisp disp; emit "("; emit_GP base; 
	  comma(); emit_GP index; emitScale scale; emit ")";
          emit_region mem)
      and eOptionalDisp(I.Immed 0) = ()
        | eOptionalDisp(I.Const c) = emit(Constant.toString c)
        | eOptionalDisp(I.Immed i) = emitInt32 i
        | eOptionalDisp _ = error "eOptionalDisp"

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

      val emit_dst = emit_operand
      val emit_src = emit_operand
      val emit_opnd = emit_operand
      val emit_src1 = emit_operand
      val emit_rsrc = emit_operand
      val emit_lsrc = emit_operand
      val emit_addr = emit_operand
  end

 (* 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>, <stupidGas opnd>''

    | CALL of operand * C.cellset * C.cellset * Region.region
	``call\t<stupidGas operand><region>''

    | RET
	``ret''

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

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

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

    | BINARY of {binOp:binaryOp, src:operand, dst:operand}
	``<binOp>l\t<src>, <dst>''

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

    | MUL3 of {dst:int, src1:operand, src2: Int32.int option}
	``imul\t<src1>, <emit_src2 src2><dst>''

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

    | PUSH of operand
	``pushl\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}
	``<emitInstrs (Shuffle.shuffle{regmap,tmp,dst,src})>''
    | FCOPY of {dst: $FP list, src: $FP list, tmp:operand option}
	``<emitInstrs (Shuffle.shufflefp{regmap,tmp,dst,src})>''


   (* floating *)
    | FBINARY of {binOp:fbinOp, src:operand, dst:operand}
	``<binOp>\t<src>, <dst>''

    | FUNARY of funOp
	``<funOp>''

    | FUCOMPP
	``fucompp''

    | FXCH
	``fxch''

    | FSTP of operand
	``fstp\t<operand>''

    | FLD of operand
	``fld\t<operand>'' 

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

    | FNSTSW
	``fnstsw''

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

   (* annotations *)
    | ANNOTATION of {i:instruction, a:Annotations.annotation}
        ``<(emitInstr i; comment(Annotations.toString a))>''

    | GROUP of Annotations.annotation
        ``<comment(Annotations.toString annotation)>''
    
end


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