Suppression de Cconst_pointer, redondant

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

asmcomp/cmm.ml

@@ -89,7 +89,6 @@ type expression =
   | Cconst_natint of nativeint
   | Cconst_float of string
   | Cconst_symbol of string
-  | Cconst_pointer of int
   | Cvar of Ident.t
   | Clet of Ident.t * expression * expression
   | Cassign of Ident.t * expression

asmcomp/cmm.mli

@@ -75,7 +75,6 @@ type expression =
   | Cconst_natint of nativeint
   | Cconst_float of string
   | Cconst_symbol of string
-  | Cconst_pointer of int
   | Cvar of Ident.t
   | Clet of Ident.t * expression * expression
   | Cassign of Ident.t * expression

asmcomp/cmmgen.ml

@@ -27,14 +27,12 @@ open Cmm
 
 let bind name arg fn =
   match arg with
-    Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _
-  | Cconst_pointer _ -> fn arg
+    Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _ -> fn arg
   | _ -> let id = Ident.create name in Clet(id, arg, fn (Cvar id))
 
 let bind_nonvar name arg fn =
   match arg with
-    Cconst_int _ | Cconst_natint _ | Cconst_symbol _ | Cconst_pointer _ ->
-      fn arg
+    Cconst_int _ | Cconst_natint _ | Cconst_symbol _ -> fn arg
   | _ -> let id = Ident.create name in Clet(id, arg, fn (Cvar id))
 
 (* Block headers. Meaning of the tag field:
@@ -214,11 +212,11 @@ let subst_boxed_float boxed_id unboxed_id exp =
 
 (* Unit *)
 
-let return_unit c = Csequence(c, Cconst_pointer 1)
+let return_unit c = Csequence(c, Cconst_int 1)
 
 let rec remove_unit = function
-    Cconst_pointer 1 -> Ctuple []
-  | Csequence(c, Cconst_pointer 1) -> c
+    Cconst_int 1 -> Ctuple []
+  | Csequence(c, Cconst_int 1) -> c
   | Csequence(c1, c2) ->
       Csequence(c1, remove_unit c2)
   | Cifthenelse(cond, ifso, ifnot) ->
@@ -407,7 +405,7 @@ let transl_constant = function
   | Const_base(Const_char c) ->
       Cconst_int(((Char.code c) lsl 1) + 1)
   | Const_pointer n ->
-      Cconst_pointer((n lsl 1) + 1)
+      int_const n
   | cst ->
       let lbl =
         try
@@ -1130,7 +1128,6 @@ and transl_prim_3 p arg1 arg2 arg3 =
   | _ ->
     fatal_error "Cmmgen.transl_prim_3"
 
-
 and transl_unbox_float = function
     Uconst(Const_base(Const_float f)) -> Cconst_float f
   | exp -> unbox_float(transl exp)

asmcomp/printcmm.ml

@@ -92,7 +92,6 @@ let rec expr ppf = function
   | Cconst_natint n -> print_string(Nativeint.to_string n)
   | Cconst_float s -> print_string s
   | Cconst_symbol s -> printf "\"%s\"" s
-  | Cconst_pointer n -> printf "%ia" n
   | Cvar id -> Ident.print id
   | Clet(id, def, (Clet(_, _, _) as body)) ->
       let print_binding id ppf def =

asmcomp/selectgen.ml

@@ -50,7 +50,7 @@ let oper_result_type = function
 let size_expr env exp =
   let rec size localenv = function
       Cconst_int _ | Cconst_natint _ -> Arch.size_int
-    | Cconst_symbol _ | Cconst_pointer _ -> Arch.size_addr
+    | Cconst_symbol _ -> Arch.size_addr
     | Cconst_float _ -> Arch.size_float
     | Cvar id ->
         begin try
@@ -87,7 +87,6 @@ let rec is_simple_expr = function
   | Cconst_natint _ -> true
   | Cconst_float _ -> true
   | Cconst_symbol _ -> true
-  | Cconst_pointer _ -> true
   | Cvar _ -> true
   | Ctuple el -> List.for_all is_simple_expr el
   | Clet(id, arg, body) -> is_simple_expr arg && is_simple_expr body
@@ -249,20 +248,14 @@ method select_operation op args =
 method private select_arith_comm op = function
     [arg; Cconst_int n] when self#is_immediate n ->
       (Iintop_imm(op, n), [arg])
-  | [arg; Cconst_pointer n] when self#is_immediate n ->
-      (Iintop_imm(op, n), [arg])
   | [Cconst_int n; arg] when self#is_immediate n ->
       (Iintop_imm(op, n), [arg])
-  | [Cconst_pointer n; arg] when self#is_immediate n ->
-      (Iintop_imm(op, n), [arg])
   | args ->
       (Iintop op, args)
 
 method private select_arith op = function
     [arg; Cconst_int n] when self#is_immediate n ->
       (Iintop_imm(op, n), [arg])
-  | [arg; Cconst_pointer n] when self#is_immediate n ->
-      (Iintop_imm(op, n), [arg])
   | args ->
       (Iintop op, args)
 
@@ -275,12 +268,8 @@ method private select_shift op = function
 method private select_arith_comp cmp = function
     [arg; Cconst_int n] when self#is_immediate n ->
       (Iintop_imm(Icomp cmp, n), [arg])
-  | [arg; Cconst_pointer n] when self#is_immediate n ->
-      (Iintop_imm(Icomp cmp, n), [arg])
   | [Cconst_int n; arg] when self#is_immediate n ->
       (Iintop_imm(Icomp(swap_intcomp cmp), n), [arg])
-  | [Cconst_pointer n; arg] when self#is_immediate n ->
-      (Iintop_imm(Icomp(swap_intcomp cmp), n), [arg])
   | args ->
       (Iintop(Icomp cmp), args)
 
@@ -291,15 +280,11 @@ method select_condition = function
       (Iinttest_imm(Isigned cmp, n), arg1)
   | Cop(Ccmpi cmp, [Cconst_int n; arg2]) when self#is_immediate n ->
       (Iinttest_imm(Isigned(swap_comparison cmp), n), arg2)
-  | Cop(Ccmpi cmp, [arg1; Cconst_pointer n]) when self#is_immediate n ->
-      (Iinttest_imm(Isigned cmp, n), arg1)
-  | Cop(Ccmpi cmp, [Cconst_pointer n; arg2]) when self#is_immediate n ->
-      (Iinttest_imm(Isigned(swap_comparison cmp), n), arg2)
   | Cop(Ccmpi cmp, args) ->
       (Iinttest(Isigned cmp), Ctuple args)
-  | Cop(Ccmpa cmp, [arg1; Cconst_pointer n]) when self#is_immediate n ->
+  | Cop(Ccmpa cmp, [arg1; Cconst_int n]) when self#is_immediate n ->
       (Iinttest_imm(Iunsigned cmp, n), arg1)
-  | Cop(Ccmpa cmp, [Cconst_pointer n; arg2]) when self#is_immediate n ->
+  | Cop(Ccmpa cmp, [Cconst_int n; arg2]) when self#is_immediate n ->
       (Iinttest_imm(Iunsigned(swap_comparison cmp), n), arg2)
   | Cop(Ccmpa cmp, args) ->
       (Iinttest(Iunsigned cmp), Ctuple args)
@@ -370,9 +355,6 @@ method emit_expr env exp =
   | Cconst_symbol n ->
       let r = Reg.createv typ_addr in
       self#insert_op (Iconst_symbol n) [||] r
-  | Cconst_pointer n ->
-      let r = Reg.createv typ_addr in
-      self#insert_op (Iconst_int(Nativeint.of_int n)) [||] r
   | Cvar v ->
       begin try
         Tbl.find v env