Traitement plus uniforme des load et des store. Ajout load/store sur int32 et float32

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2785 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

asmcomp/alpha/arch.ml

@@ -27,6 +27,7 @@ type addressing_mode =
 type specific_operation =
     Iadd4 | Iadd8 | Isub4 | Isub8       (* Scaled adds and subs *)
   | Ireloadgp of bool                   (* The ldgp instruction *)
+  | Itrunc32                            (* Truncate 64-bit int to 32 bit *)
 
 (* Sizes, endianness *)
 
@@ -67,6 +68,7 @@ let print_specific_operation printreg op arg =
   | Isub4 -> printreg arg.(0); print_string " * 4 - "; printreg arg.(1)
   | Isub8 -> printreg arg.(0); print_string " * 8 - "; printreg arg.(1)
   | Ireloadgp _ -> print_string "ldgp"
+  | Itrunc32 -> print_string "truncate32 "; printreg arg.(0)
 
 (* Distinguish between the Digital assembler and other assemblers (e.g. gas) *)
 

asmcomp/alpha/emit.mlp

@@ -442,20 +442,30 @@ let emit_instr i =
         `	lda	$sp, {emit_int (-n)}($sp)\n`;
         stack_offset := !stack_offset + n
     | Lop(Iload(chunk, addr)) ->
+        let dest = i.res.(0) in
         let load_instr =
           match chunk with
-            Word -> if i.res.(0).typ = Float then "ldt" else "ldq"
           | Byte_unsigned -> "ldbu"
           | Byte_signed -> "ldb"
           | Sixteen_unsigned -> "ldwu"
-          | Sixteen_signed -> "ldw" in
-        `	{emit_string load_instr}	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`
+          | Sixteen_signed -> "ldw"
+          | Thirtytwo_unsigned -> "ldl"
+          | Thirtytwo_signed -> "ldl"
+          | Word -> "ldq"
+          | Single -> "lds"
+          | Double -> "ldt" in
+        `	{emit_string load_instr}	{emit_reg dest}, {emit_addressing addr i.arg 0}\n`;
+        if chunk = Thirtytwo_unsigned then
+          `	zapnot	{emit_reg dest}, 15, {emit_reg dest}\n`
     | Lop(Istore(chunk, addr)) ->
         let store_instr =
           match chunk with
-            Word -> if i.arg.(0).typ = Float then "stt" else "stq"
           | Byte_unsigned | Byte_signed -> "stb"
-          | Sixteen_unsigned | Sixteen_signed -> "stw" in
+          | Sixteen_unsigned | Sixteen_signed -> "stw"
+          | Thirtytwo_unsigned | Thirtytwo_signed -> "stl"
+          | Word -> "stq"
+          | Single -> "sts"
+          | Double -> "stt" in
         `	{emit_string store_instr}	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
     | Lop(Ialloc n) ->
         if !fastcode_flag then begin
@@ -562,6 +572,8 @@ let emit_instr i =
         `	ldgp	$gp, 0($26)\n`;
         if marked_r26 then
           `	bic	$gp, 1, $gp\n`
+    | Lop(Ispecific Itrunc32) ->
+        `	addl	{emit_reg i.arg.(0)}, 0, {emit_reg i.res.(0)}\n`
     | Lop(Ispecific sop) ->
         let instr = name_for_specific_operation sop in
         `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
@@ -744,6 +756,8 @@ let emit_item = function
       `	.byte	{emit_int n}\n`
   | Cint16 n ->
       `	.word	{emit_int n}\n`
+  | Cint32 n ->
+      `	.long	{emit_int n}\n`
   | Cint n ->
       if digital_asm then
         `	.quad	{emit_nativeint n}\n`
@@ -751,7 +765,9 @@ let emit_item = function
         (* Work around a bug in gas regarding the parsing of
            long decimal constants *)
         `	.quad	{emit_string(Nativeint.to_hexa_string n)}\n`
-  | Cfloat f ->
+  | Csingle f ->
+      `	.float	{emit_string f}\n`
+  | Cdouble f ->
       `	.double	{emit_string f}\n`
   | Csymbol_address s ->
       `	.quad	{emit_symbol s}\n`

asmcomp/alpha/selection.ml

@@ -62,6 +62,9 @@ method select_operation op args =
       (Ispecific(if shift = 2 then Isub4 else Isub8), [arg1; arg2])
   | (Csubi, [Cop(Cmuli, [Cconst_int(4|8 as mult); arg1]); arg2]) ->
       (Ispecific(if mult = 4 then Isub4 else Isub8), [arg1; arg2])
+    (* Recognize truncation/normalization of 64-bit integers to 32 bits *)
+  | (Casr, [Cop(Clsl, [arg; Cconst_int 32]); Cconst_int 32]) ->
+      (Ispecific Itrunc32, [arg])
     (* Work around various limitations of the GNU assembler *)
   | ((Caddi|Cadda), [arg1; Cconst_int n])
     when not (self#is_immediate n) && self#is_immediate (-n) ->