1 files changed, 211 insertions, 188 deletions

diff --git a/asmcomp/intel_masm.ml b/asmcomp/intel_masm.ml
index ad0a5c7b29..081f0f5d1f 100644
--- a/asmcomp/intel_masm.ml
+++ b/asmcomp/intel_masm.ml
@@ -36,17 +36,88 @@ let string_of_datatype_ptr = function
   | NEAR -> "NEAR PTR "
   | PROC -> "PROC PTR"
 
+let bprint_arg_mem b arch mem = match mem with
+
+  |  (ptr, reg1, 1, NoBase, 0) ->
+    Printf.bprintf b "%s[%s]"
+      (string_of_datatype_ptr ptr)
+      (string_of_register arch reg1);
+
+  |  (ptr, reg1, 1, NoBase, offset) ->
+    Printf.bprintf b "%s[%s%s%d]"
+      (string_of_datatype_ptr ptr)
+      (string_of_register arch reg1)
+      (if offset > 0 then "+" else "")
+      offset
+
+  |  (ptr, reg1, scale, NoBase, 0) ->
+    Printf.bprintf b "%s[%s*%d]"
+      (string_of_datatype_ptr ptr)
+      (string_of_register arch reg1)
+      scale
+  |  (ptr, reg1, scale, NoBase, offset) ->
+    Printf.bprintf b "%s[%s*%d%s%d]"
+      (string_of_datatype_ptr ptr)
+      (string_of_register arch reg1)
+      scale
+      (if offset > 0 then "+" else "")
+      offset
+  |  (ptr, reg1, 1, reg2, 0) ->
+    Printf.bprintf b "%s[%s+%s]"
+      (string_of_datatype_ptr ptr)
+      (match reg2 with
+	 NoBase -> assert false
+       | BaseReg reg2 ->
+         string_of_register arch reg2
+       | BaseSymbol s -> s)
+      (string_of_register arch reg1)
+  |  (ptr, reg1, 1, reg2, offset) ->
+    Printf.bprintf b "%s[%s+%s%s%d]"
+      (string_of_datatype_ptr ptr)
+      (match reg2 with
+	 NoBase -> assert false
+       | BaseReg reg2 ->
+         string_of_register arch reg2
+       | BaseSymbol s -> s)
+      (string_of_register arch reg1)
+      (if offset > 0 then "+" else "")
+      offset
+  |  (ptr, reg1, scale, reg2, 0) ->
+    Printf.bprintf b "%s[%s+%s*%d]"
+      (string_of_datatype_ptr ptr)
+      (match reg2 with
+	 NoBase -> assert false
+       | BaseReg reg2 ->
+         string_of_register arch reg2
+       | BaseSymbol s -> s)
+      (string_of_register arch reg1)
+      scale
+  |  (ptr, reg1, scale, reg2, offset) ->
+    Printf.bprintf b "%s[%s+%s*%d%s%d]"
+      (string_of_datatype_ptr ptr)
+      (match reg2 with
+	 NoBase -> assert false
+       | BaseReg reg2 ->
+         string_of_register arch reg2
+       | BaseSymbol s -> s)
+      (string_of_register arch reg1)
+      scale
+      (if offset > 0 then "+" else "")
+      offset
+
+
   let bprint_arg arch b ins arg =
     match arg with
-    | Constant int ->
+    | ConstantInt int ->
       Printf.bprintf b "%d" int
-    | ConstantNat int when ins.instr = MOVABSQ ->
-  (* force ml64 to use mov reg, imm64 instruction *)
-      Printf.bprintf b "0%nxH" int
     | ConstantNat int ->
-      Printf.bprintf b "%nd" int
-    | LabelPLT _ -> assert false
-    | LabelGOTPCREL _ -> assert false
+      begin match ins with
+        | MOVABSQ _ ->
+          (* force ml64 to use mov reg, imm64 instruction *)
+          Printf.bprintf b "0%nxH" int
+        | _ ->
+          Printf.bprintf b "%nd" int
+      end
     | LabelRel (ptr, string, 0) ->
       Printf.bprintf b "%s%s"  (string_of_datatype_ptr ptr) string
     | LabelRel ( ptr, string, i) ->
@@ -68,82 +139,21 @@ let string_of_datatype_ptr = function
     | Reg32 register32 ->
       Printf.bprintf b "%s" (string_of_register32 register32)
     | Reg register ->
-      Printf.bprintf b "%s" (arch.string_of_register register)
+      Printf.bprintf b "%s" (string_of_register arch register)
     | Regf registerf ->
       Printf.bprintf b "%s" (string_of_registerf registerf)
 
-    | Mem (ptr, reg1, 1, NoBase, 0) ->
-      Printf.bprintf b "%s[%s]"
-        (string_of_datatype_ptr ptr)
-        (arch.string_of_register reg1);
-
-    | Mem (ptr, reg1, 1, NoBase, offset) ->
-      Printf.bprintf b "%s[%s%s%d]"
-                  (string_of_datatype_ptr ptr)
-                  (arch.string_of_register reg1)
-                  (if offset > 0 then "+" else "")
-                  offset
-
-    | Mem (ptr, reg1, scale, NoBase, 0) ->
-      Printf.bprintf b "%s[%s*%d]"
-        (string_of_datatype_ptr ptr)
-        (arch.string_of_register reg1)
-        scale
-    | Mem (ptr, reg1, scale, NoBase, offset) ->
-      Printf.bprintf b "%s[%s*%d%s%d]"
-        (string_of_datatype_ptr ptr)
-        (arch.string_of_register reg1)
-        scale
-        (if offset > 0 then "+" else "")
-        offset
-    | Mem (ptr, reg1, 1, reg2, 0) ->
-      Printf.bprintf b "%s[%s+%s]"
-        (string_of_datatype_ptr ptr)
-        (match reg2 with
-	   NoBase -> assert false
-         | BaseReg reg2 ->
-           arch.string_of_register reg2
-        | BaseSymbol s -> s)
-        (arch.string_of_register reg1)
-    | Mem (ptr, reg1, 1, reg2, offset) ->
-      Printf.bprintf b "%s[%s+%s%s%d]"
-        (string_of_datatype_ptr ptr)
-        (match reg2 with
-	   NoBase -> assert false
-         | BaseReg reg2 ->
-           arch.string_of_register reg2
-        | BaseSymbol s -> s)
-        (arch.string_of_register reg1)
-        (if offset > 0 then "+" else "")
-        offset
-    | Mem (ptr, reg1, scale, reg2, 0) ->
-      Printf.bprintf b "%s[%s+%s*%d]"
-        (string_of_datatype_ptr ptr)
-        (match reg2 with
-	   NoBase -> assert false
-         | BaseReg reg2 ->
-           arch.string_of_register reg2
-        | BaseSymbol s -> s)
-        (arch.string_of_register reg1)
-        scale
-    | Mem (ptr, reg1, scale, reg2, offset) ->
-      Printf.bprintf b "%s[%s+%s*%d%s%d]"
-        (string_of_datatype_ptr ptr)
-        (match reg2 with
-	   NoBase -> assert false
-         | BaseReg reg2 ->
-           arch.string_of_register reg2
-        | BaseSymbol s -> s)
-        (arch.string_of_register reg1)
-        scale
-        (if offset > 0 then "+" else "")
-        offset
-
-let bprint_args arch b instr =
-  match instr with
-    { args = [||] } -> ()
-  | { args = [|arg|] } -> tab b; bprint_arg arch b instr arg
-  | { args = [|arg2; arg1|] } ->
+    | LabelPLT _ -> assert false
+    | LabelGOTPCREL _ -> assert false
+
+    | Mem ( ptr, r, scale, base, offset) ->
+      bprint_arg_mem b arch (ptr, r, scale, base, offset)
+
+let bprint_args arch b instr args =
+  match args with
+  | [] -> ()
+  | [ arg ] -> tab b; bprint_arg arch b instr arg
+  | [ arg2; arg1 ] ->
     tab b; bprint_arg arch b instr arg1;
     Buffer.add_char b ',';
     Buffer.add_char b ' ';
@@ -208,11 +218,15 @@ let buf_bytes_directive b directive s =
      if !pos >= 16 then begin pos := 0 end
    done
 
+
+
+let list_o arg = match arg with None -> [] | Some arg -> [arg]
+
 let bprint_instr_name b arch instr =
-  match instr.instr with
+  match instr with
     Global s ->
     Printf.bprintf b "\tPUBLIC\t%s" s
-  | Align (data,n) ->
+  | Align (_data,n) ->
     Printf.bprintf b "\tALIGN\t%d" n
   | NewLabel (s, NO) ->
     Printf.bprintf b "%s:" s
@@ -241,130 +255,139 @@ let bprint_instr_name b arch instr =
   | Bytes s -> buf_bytes_directive b "BYTE" s
 
   | _ ->
-    let name =
-      match instr.instr with
+    let name, args =
+      match instr with
 	Global _ | Align _
       | NewLabel _ | Comment _
       | Specific _ | End
       | Segment _ | Constant _
       | Bytes _ | Space _ | External _
         -> assert false
-      | Set -> ".set"
-      | NOP -> "nop"
-
-      | NEG ->  "neg"
-      | ADD _ ->  "add"
-      | SUB _ ->   "sub"
-      | XOR _ ->   "xor"
-      | OR _ ->    "or"
-      | AND _ ->   "and"
-      | CMP _ ->  "cmp"
-
-      | MOVABSQ -> "mov"
-
-      | LEAVE -> "leave"
-      | SAR _ ->  "sar"
-      | SHR _ ->  "shr"
-      | SAL _ ->  "sal"
-
-      | FSTP _ -> "fstp"
-      | FSTPS -> "fstps"
-      | FILD _ -> "fild"
-      | FCOMPP -> "fcompp"
-      | FCOMPL -> "fcomp"
-      | FLDL -> "fld"
-      | FLDS -> "flds"
-      | FLDCW -> "fldcw"
-      | FISTP _ -> "fistp"
-
-      | FNSTSW -> "fnstsw"
-      | FNSTCW -> "fnstcw"
-
-      | FCHS -> "fchs"
-      | FABS -> "fabs"
-      | FADDL | FADDP | FADDS -> "fadd"
-      | FSUBL | FSUBP | FSUBS -> "fsub"
-      | FMULL | FMULP | FMULS -> "fmul"
-      | FDIVL | FDIVP | FDIVS  -> "fdiv"
-      | FSUBRL | FSUBRP | FSUBRS -> "fsubr"
-      | FDIVRL | FDIVRP | FDIVRS -> "fdivr"
-
-      | INC _ ->  "inc"
-      | DEC _ ->  "dec"
-
-      | IMUL _ ->  "imul"
-      | IDIV _ ->  "idiv"
+      | Set (arg1, arg2) -> ".set", [ arg1; arg2 ]
+
+
+      | NEG arg ->  "neg", [arg]
+      | NOP -> "nop", []
+      | ADD (_s, arg1, arg2) ->  "add", [arg1; arg2]
+      | SUB (_s, arg1, arg2) ->   "sub", [arg1; arg2]
+      | XOR (_s, arg1, arg2) ->   "xor", [arg1; arg2]
+      | OR (_s, arg1, arg2) ->    "or", [arg1; arg2]
+      | AND (_s, arg1, arg2) ->   "and", [arg1; arg2]
+      | CMP (_s, arg1, arg2) ->  "cmp", [arg1; arg2]
+
+      | MOVABSQ (arg1, arg2) -> "mov", [ arg1; arg2]
+
+      | LEAVE -> "leave", []
+      | SAR (_s, arg1, arg2) ->  "sar", [arg1; arg2]
+      | SHR (_s, arg1, arg2) ->  "shr", [arg1; arg2]
+      | SAL (_s, arg1, arg2) ->  "sal", [arg1; arg2]
+
+      | FSTP (_, arg) -> "fstp", [ arg ]
+      | FSTPS arg -> "fstps", [ arg]
+      | FILD (_, arg) -> "fild", [arg]
+      | FCOMPP -> "fcompp", []
+      | FCOMPL arg -> "fcomp", [ arg ]
+      | FLDL arg -> "fld", [ arg ]
+      | FLDS arg -> "flds", [ arg]
+      | FLDCW arg -> "fldcw", [ arg ]
+      | FISTP (_, arg) -> "fistp", [ arg]
+
+      | FNSTSW arg -> "fnstsw", [ arg ]
+      | FNSTCW arg -> "fnstcw", [ arg ]
+
+      | FCHS arg -> "fchs", list_o arg
+      | FABS arg -> "fabs", list_o arg
+      | FADDL arg | FADDS arg -> "fadd", list_o arg
+      | FSUBL arg | FSUBS arg -> "fsub", list_o arg
+      | FMULL arg | FMULS arg -> "fmul", list_o arg
+      | FDIVL arg | FDIVS  arg -> "fdiv", list_o arg
+      | FSUBRL arg | FSUBRS arg -> "fsubr", list_o arg
+      | FDIVRL arg | FDIVRS arg -> "fdivr", list_o arg
+
+      | FADDP (arg1, arg2)  -> "faddp", [ arg1; arg2 ]
+      | FSUBP (arg1, arg2)  -> "fsubp", [ arg1; arg2 ]
+      | FMULP (arg1, arg2)  -> "fmulp", [ arg1; arg2 ]
+      | FDIVP (arg1, arg2)  -> "fdivp", [ arg1; arg2 ]
+      | FSUBRP (arg1, arg2)  -> "fsubrp", [ arg1; arg2 ]
+      | FDIVRP (arg1, arg2)  -> "fdivrp", [ arg1; arg2 ]
+
+      | INC (_s, arg) ->  "inc", [ arg ]
+      | DEC (_s, arg) ->  "dec", [ arg ]
+
+      | IMUL (_s, arg1, arg2) ->  "imul", arg1 :: list_o arg2
+      | IDIV (_s, arg) ->  "idiv", [ arg ]
       | HLT -> assert false
-      | MOV _ ->  "mov"
-
-      | MOVZX _ ->  "movzx"
-      | MOVSX _ ->  "movsx"
-      | MOVSS ->  "movss"
-      | MOVSXD ->  "movsxd"
-
-      | MOVSD ->  "movsd"
-      | ADDSD ->  "addsd"
-      | SUBSD ->  "subsd"
-      | MULSD ->  "mulsd"
-      | DIVSD ->  "divsd"
-      | SQRTSD -> "sqrtsd"
+      | MOV (_s, arg1, arg2) ->  "mov", [ arg1; arg2]
+
+      | MOVZX (_, _, arg1, arg2) ->  "movzx", [ arg1; arg2]
+      | MOVSX (_, _, arg1, arg2) ->  "movsx",  [ arg1; arg2]
+      | MOVSS (arg1, arg2) ->  "movss", [ arg1; arg2 ]
+      | MOVSXD (arg1, arg2) ->  "movsxd", [ arg1; arg2 ]
+
+      | MOVSD (arg1, arg2) ->  "movsd", [ arg1; arg2 ]
+      | ADDSD (arg1, arg2) ->  "addsd", [ arg1 ; arg2 ]
+      | SUBSD (arg1, arg2) ->  "subsd", [ arg1 ; arg2 ]
+      | MULSD (arg1, arg2) ->  "mulsd", [ arg1 ; arg2 ]
+      | DIVSD (arg1, arg2) ->  "divsd", [ arg1 ; arg2 ]
+      | SQRTSD (arg1, arg2) -> "sqrtsd", [ arg1; arg2]
       | ROUNDSD rounding ->
 	Printf.sprintf "roundsd.%s" (match rounding with
 	    RoundDown -> "down"
 	  | RoundUp -> "up"
 	  | RoundTruncate -> "trunc"
-	  | RoundNearest -> "near")
-      | CVTSS2SD ->  "cvtss2sd"
-      | CVTSD2SS ->  "cvtsd2ss"
-      | CVTSI2SD ->  "cvtsi2sd"
-      | CVTSD2SI ->  "cvtsd2si"
-      | CVTSI2SDQ ->  "cvtsi2sdq"
-      | CVTTSD2SI ->  "cvttsd2si"
-      | UCOMISD ->  "ucomisd"
-      | COMISD ->  "comisd"
-
-      | FLD1 -> "fld1"
-      | FPATAN -> "fpatan"
-      | FPTAN -> "fptan"
-      | FCOS -> "fcos"
-      | FLDLN2 -> "fldln2"
-      | FLDLG2 -> "fldlg2"
-      | FXCH -> "fxch"
-      | FYL2X -> "fyl2x"
-      | FSIN -> "fsin"
-      | FSQRT -> "fsqrt"
-      | FLDZ -> "fldz"
-
-      | CALL  ->  "call"
-      | JMP _ ->  "jmp"
-      | RET ->  "ret"
-      | PUSH _ ->  "push"
-      | POP _ ->  "pop"
-
-      | TEST _ ->  "test"
-      | SET condition ->
-	Printf.sprintf  "set%s" (string_of_condition condition)
-      | J (_,condition) ->
-	Printf.sprintf  "j%s" (string_of_condition condition)
+	  | RoundNearest -> "near"), []
+      | CVTSS2SD (arg1, arg2) ->  "cvtss2sd", [ arg1; arg2 ]
+      | CVTSD2SS (arg1, arg2) ->  "cvtsd2ss", [ arg1; arg2 ]
+      | CVTSI2SD (arg1, arg2) ->  "cvtsi2sd", [ arg1; arg2 ]
+      | CVTSD2SI (arg1, arg2) ->  "cvtsd2si", [ arg1; arg2 ]
+      | CVTSI2SDQ (arg1, arg2) ->  "cvtsi2sdq", [ arg1; arg2 ]
+      | CVTTSD2SI (arg1, arg2) ->  "cvttsd2si", [ arg1; arg2 ]
+      | UCOMISD (arg1, arg2) ->  "ucomisd", [ arg1; arg2]
+      | COMISD (arg1, arg2) ->  "comisd", [arg1; arg2]
+
+      | FLD1 -> "fld1", []
+      | FPATAN -> "fpatan", []
+      | FPTAN -> "fptan", []
+      | FCOS -> "fcos", []
+      | FLDLN2 -> "fldln2", []
+      | FLDLG2 -> "fldlg2", []
+      | FXCH arg -> "fxch", list_o arg
+      | FYL2X -> "fyl2x", []
+      | FSIN -> "fsin", []
+      | FSQRT -> "fsqrt", []
+      | FLDZ -> "fldz", []
+
+      | CALL arg  ->  "call", [ arg ]
+      | JMP (_, arg) ->  "jmp", [ arg]
+      | RET ->  "ret", []
+      | PUSH (_, arg) ->  "push", [arg]
+      | POP (_, arg) ->  "pop", [arg]
+
+      | TEST (_s, arg1, arg2) ->  "test", [arg1; arg2]
+      | SET (condition, arg) ->
+	Printf.sprintf  "set%s" (string_of_condition condition), [ arg ]
+      | J (_,condition, arg) ->
+	Printf.sprintf  "j%s" (string_of_condition condition), [ arg ]
 
       | CMOV condition ->
-	Printf.sprintf "cmov%s" (string_of_condition condition)
-      | XORPD ->  "xorpd"
-      | ANDPD ->  "andpd"
-      | MOVLPD ->  "movlpd"
-      | MOVAPD ->  "movapd"
-      | CLTD -> "cdq"
-
-      | LEA _ ->  "lea"
-      | CQTO ->  "cqo"
-      | XCHG -> "xchg"
-      | BSWAP -> "bswap"
+	Printf.sprintf "cmov%s" (string_of_condition condition), []
+      | XORPD (arg1, arg2) ->  "xorpd", [ arg1; arg2 ]
+      | ANDPD (arg1, arg2) ->  "andpd", [ arg1; arg2 ]
+      | MOVLPD (arg1, arg2) ->  "movlpd", [ arg1; arg2 ]
+      | MOVAPD (arg1, arg2) ->  "movapd", [ arg1; arg2 ]
+      | CLTD -> "cdq", []
+
+      | LEA (_s, arg1, arg2) ->  "lea", [arg1; arg2]
+      | CQTO ->  "cqo", []
+      | XCHG (arg1, arg2) -> "xchg", [ arg1; arg2 ]
+      | BSWAP arg -> "bswap", [ arg ]
 
     in
-    bprint b name
+    bprint b name;
+    bprint_args arch b instr args;
+()
 
 let bprint_instr b arch instr =
   bprint_instr_name b arch instr;
-  bprint_args arch b instr;
   Buffer.add_string b "\n"