Remove Const_pointer (#9578)

Since #9316 was merged, Cconst_pointer is compiled in exactly the same way as Cconst_int. This commit removes the now-redundant Cconst_pointer and Cconst_natpointer.

asmcomp/afl_instrument.ml

@@ -91,7 +91,7 @@ and instrument = function
 
   (* these are base cases and have no logging *)
   | Cconst_int _ | Cconst_natint _ | Cconst_float _
-  | Cconst_symbol _ | Cconst_pointer _ | Cconst_natpointer _
+  | Cconst_symbol _
   | Cblockheader _ | Cvar _ as c -> c
 
 let instrument_function c dbg =

asmcomp/amd64/selection.ml

@@ -176,10 +176,6 @@ method! select_store is_assign addr exp =
   | (Cblockheader(n, _dbg))
       when self#is_immediate_natint n && not Config.spacetime ->
       (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
-  | Cconst_pointer (n, _dbg) when self#is_immediate n ->
-      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
-  | Cconst_natpointer (n, _dbg) when self#is_immediate_natint n ->
-      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
   | _ ->
       super#select_store is_assign addr exp
 

asmcomp/cmm.ml

@@ -147,8 +147,6 @@ type expression =
   | Cconst_natint of nativeint * Debuginfo.t
   | Cconst_float of float * Debuginfo.t
   | Cconst_symbol of string * Debuginfo.t
-  | Cconst_pointer of int * Debuginfo.t
-  | Cconst_natpointer of nativeint * Debuginfo.t
   | Cblockheader of nativeint * Debuginfo.t
   | Cvar of Backend_var.t
   | Clet of Backend_var.With_provenance.t * expression * expression
@@ -237,8 +235,6 @@ let iter_shallow_tail f = function
   | Cconst_natint _
   | Cconst_float _
   | Cconst_symbol _
-  | Cconst_pointer _
-  | Cconst_natpointer _
   | Cblockheader _
   | Cvar _
   | Cassign _
@@ -276,8 +272,6 @@ let rec map_tail f = function
   | Cconst_natint _
   | Cconst_float _
   | Cconst_symbol _
-  | Cconst_pointer _
-  | Cconst_natpointer _
   | Cblockheader _
   | Cvar _
   | Cassign _
@@ -315,8 +309,6 @@ let map_shallow f = function
   | Cconst_natint _
   | Cconst_float _
   | Cconst_symbol _
-  | Cconst_pointer _
-  | Cconst_natpointer _
   | Cblockheader _
   | Cvar _
     as c ->

asmcomp/cmm.mli

@@ -154,8 +154,6 @@ and expression =
   | Cconst_natint of nativeint * Debuginfo.t
   | Cconst_float of float * Debuginfo.t
   | Cconst_symbol of string * Debuginfo.t
-  | Cconst_pointer of int * Debuginfo.t
-  | Cconst_natpointer of nativeint * Debuginfo.t
   | Cblockheader of nativeint * Debuginfo.t
   | Cvar of Backend_var.t
   | Clet of Backend_var.With_provenance.t * expression * expression

asmcomp/cmm_helpers.ml

@@ -25,7 +25,6 @@ open Arch
 let bind name arg fn =
   match arg with
     Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _
-  | Cconst_pointer _ | Cconst_natpointer _
   | Cblockheader _ -> fn arg
   | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
 
@@ -37,7 +36,6 @@ let bind_load name arg fn =
 let bind_nonvar name arg fn =
   match arg with
     Cconst_int _ | Cconst_natint _ | Cconst_symbol _
-  | Cconst_pointer _ | Cconst_natpointer _
   | Cblockheader _ -> fn arg
   | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
 
@@ -559,11 +557,11 @@ let complex_im c dbg = Cop(Cload (Double_u, Immutable),
 
 (* Unit *)
 
-let return_unit dbg c = Csequence(c, Cconst_pointer (1, dbg))
+let return_unit dbg c = Csequence(c, Cconst_int (1, dbg))
 
 let rec remove_unit = function
-    Cconst_pointer (1, _) -> Ctuple []
+    Cconst_int (1, _) -> Ctuple []
-  | Csequence(c, Cconst_pointer (1, _)) -> c
+  | Csequence(c, Cconst_int (1, _)) -> c
   | Csequence(c1, c2) ->
       Csequence(c1, remove_unit c2)
   | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
@@ -1408,11 +1406,9 @@ let make_switch arg cases actions dbg =
     function
     (* Constant integers loaded from a table should end in 1,
        so that Cload never produces untagged integers *)
-    | Cconst_int     (n, _), _dbg
+    | Cconst_int     (n, _), _dbg when (n land 1) = 1 ->
-    | Cconst_pointer (n, _), _dbg when (n land 1) = 1 ->
         Some (Cint (Nativeint.of_int n))
     | Cconst_natint     (n, _), _dbg
-    | Cconst_natpointer (n, _), _dbg
       when Nativeint.(to_int (logand n one) = 1) ->
         Some (Cint n)
     | Cconst_symbol (s,_), _dbg ->

asmcomp/cmmgen.ml

@@ -180,8 +180,8 @@ let transl_constant dbg = function
       int_const dbg n
   | Uconst_ptr n ->
       if n <= max_repr_int && n >= min_repr_int
-      then Cconst_pointer((n lsl 1) + 1, dbg)
+      then Cconst_int((n lsl 1) + 1, dbg)
-      else Cconst_natpointer
+      else Cconst_natint
               (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n,
                dbg)
   | Uconst_ref (label, _) ->
@@ -810,8 +810,8 @@ and transl_prim_1 env p arg dbg =
   | Pnot ->
       transl_if env Then_false_else_true
         dbg arg
-        dbg (Cconst_pointer (1, dbg))
+        dbg (Cconst_int (1, dbg))
-        dbg (Cconst_pointer (3, dbg))
+        dbg (Cconst_int (3, dbg))
   (* Test integer/block *)
   | Pisint ->
       tag_int(Cop(Cand, [transl env arg; Cconst_int (1, dbg)], dbg)) dbg
@@ -870,8 +870,8 @@ and transl_prim_2 env p arg1 arg2 dbg =
       transl_sequand env Then_true_else_false
         dbg arg1
         dbg' arg2
-        dbg (Cconst_pointer (3, dbg))
+        dbg (Cconst_int (3, dbg))
-        dbg' (Cconst_pointer (1, dbg))
+        dbg' (Cconst_int (1, dbg))
       (* let id = V.create_local "res1" in
       Clet(id, transl env arg1,
            Cifthenelse(test_bool dbg (Cvar id), transl env arg2, Cvar id)) *)
@@ -880,8 +880,8 @@ and transl_prim_2 env p arg1 arg2 dbg =
       transl_sequor env Then_true_else_false
         dbg arg1
         dbg' arg2
-        dbg (Cconst_pointer (3, dbg))
+        dbg (Cconst_int (3, dbg))
-        dbg' (Cconst_pointer (1, dbg))
+        dbg' (Cconst_int (1, dbg))
   (* Integer operations *)
   | Paddint ->
       add_int_caml (transl env arg1) (transl env arg2) dbg

asmcomp/i386/selection.ml

@@ -196,10 +196,6 @@ method! select_store is_assign addr exp =
       (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
   | (Cconst_natint (n, _) | Cblockheader (n, _)) ->
       (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
-  | Cconst_pointer (n, _) ->
-      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
-  | Cconst_natpointer (n, _) ->
-      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
   | Cconst_symbol (s, _) ->
       (Ispecific(Istore_symbol(s, addr, is_assign)), Ctuple [])
   | _ ->
@@ -289,9 +285,6 @@ method select_push exp =
   match exp with
     Cconst_int (n, _) -> (Ispecific(Ipush_int(Nativeint.of_int n)), Ctuple [])
   | Cconst_natint (n, _) -> (Ispecific(Ipush_int n), Ctuple [])
-  | Cconst_pointer (n, _) ->
-      (Ispecific(Ipush_int(Nativeint.of_int n)), Ctuple [])
-  | Cconst_natpointer (n, _) -> (Ispecific(Ipush_int n), Ctuple [])
   | Cconst_symbol (s, _) -> (Ispecific(Ipush_symbol s), Ctuple [])
   | Cop(Cload ((Word_int | Word_val as chunk), _), [loc], _) ->
       let (addr, arg) = self#select_addressing chunk loc in

asmcomp/printcmm.ml

@@ -151,8 +151,6 @@ let rec expr ppf = function
       (Nativeint.to_string n) (location d)
   | Cconst_float (n, _dbg) -> fprintf ppf "%F" n
   | Cconst_symbol (s, _dbg) -> fprintf ppf "\"%s\"" s
-  | Cconst_pointer (n, _dbg) -> fprintf ppf "%ia" n
-  | Cconst_natpointer (n, _dbg) -> fprintf ppf "%sa" (Nativeint.to_string n)
   | Cvar id -> V.print ppf id
   | Clet(id, def, (Clet(_, _, _) as body)) ->
       let print_binding id ppf def =

asmcomp/selectgen.ml

@@ -104,7 +104,7 @@ let size_machtype mty =
 let size_expr (env:environment) exp =
   let rec size localenv = function
       Cconst_int _ | Cconst_natint _ -> Arch.size_int
-    | Cconst_symbol _ | Cconst_pointer _ | Cconst_natpointer _ ->
+    | Cconst_symbol _ ->
         Arch.size_addr
     | Cconst_float _ -> Arch.size_float
     | Cblockheader _ -> Arch.size_int
@@ -314,8 +314,6 @@ method is_simple_expr = function
   | Cconst_natint _ -> true
   | Cconst_float _ -> true
   | Cconst_symbol _ -> true
-  | Cconst_pointer _ -> true
-  | Cconst_natpointer _ -> true
   | Cblockheader _ -> true
   | Cvar _ -> true
   | Ctuple el -> List.for_all self#is_simple_expr el
@@ -352,7 +350,7 @@ method effects_of exp =
   let module EC = Effect_and_coeffect in
   match exp with
   | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
-  | Cconst_pointer _ | Cconst_natpointer _ | Cblockheader _
+  | Cblockheader _
   | Cvar _ -> EC.none
   | Ctuple el -> EC.join_list_map el self#effects_of
   | Clet (_id, arg, body) | Clet_mut (_id, _, arg, body) ->
@@ -506,20 +504,14 @@ method select_operation op args _dbg =
 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)
 
@@ -532,12 +524,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)
 
@@ -548,18 +536,10 @@ 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_integer_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_integer_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 ->
-      (Iinttest_imm(Iunsigned cmp, n), arg1)
   | 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 ->
-      (Iinttest_imm(Iunsigned(swap_integer_comparison cmp), n), arg2)
   | Cop(Ccmpa cmp, [Cconst_int (n, _); arg2], _) when self#is_immediate n ->
       (Iinttest_imm(Iunsigned(swap_integer_comparison cmp), n), arg2)
   | Cop(Ccmpa cmp, args, _) ->
@@ -672,12 +652,6 @@ method emit_expr (env:environment) exp =
          adding this register to the frame table would be redundant *)
       let r = self#regs_for typ_int in
       Some(self#insert_op env (Iconst_symbol n) [||] r)
-  | Cconst_pointer (n, _dbg) ->
-      let r = self#regs_for typ_int in
-      Some(self#insert_op env (Iconst_int(Nativeint.of_int n)) [||] r)
-  | Cconst_natpointer (n, _dbg) ->
-      let r = self#regs_for typ_int in
-      Some(self#insert_op env (Iconst_int n) [||] r)
   | Cblockheader(n, dbg) ->
       self#emit_blockheader env n dbg
   | Cvar v ->
@@ -1221,7 +1195,7 @@ method emit_tail (env:environment) exp =
       end
   | Cop _
   | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
-  | Cconst_pointer _ | Cconst_natpointer _ | Cblockheader _
+  | Cblockheader _
   | Cvar _
   | Cassign _
   | Ctuple _

asmcomp/strmatch.ml

@@ -88,7 +88,7 @@ module Make(I:I) = struct
   let mk_cmp_gen cmp_op id nat ifso ifnot =
     let dbg = Debuginfo.none in
     let test =
-      Cop (Ccmpi cmp_op, [ Cvar id; Cconst_natpointer (nat, dbg) ], dbg)
+      Cop (Ccmpi cmp_op, [ Cvar id; Cconst_natint (nat, dbg) ], dbg)
     in
     Cifthenelse (test, dbg, ifso, dbg, ifnot, dbg)
 

testsuite/tests/asmgen/soli.cmm

@@ -72,7 +72,7 @@ arguments = "-DUNIT_INT -DFUN=solitaire main.c"
                                  (intaset (addraref "board" i1) j1 1)
                                  (intaset (addraref "board" i2) j2 2)
                                  (if (app "solve" (+ m 1) int)
-                                     (raise_notrace 0a)
+                                     (raise_notrace 0)
                                    [])
                                  (intaset (addraref "board" i) j 2)
                                  (intaset (addraref "board" i1) j1 2)

testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference

@@ -26,6 +26,6 @@ cmm:
 (function camlTest_locations__entry ()
  (let clos "camlTest_locations__1"
    (store val(root-init) "camlTest_locations" clos))
- 1a)
+ 1)
 
 (data)

testsuite/tests/formatting/test_locations.dlocations.ocamlopt.flambda.reference

@@ -33,6 +33,6 @@ cmm:
  "camlTest_locations":
  addr "camlTest_locations__fib_5_closure")
 (data)
-(function camlTest_locations__entry () 1a)
+(function camlTest_locations__entry () 1)
 
 (data)

testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.clambda.reference

@@ -23,6 +23,6 @@ cmm:
 (function camlTest_locations__entry ()
  (let clos "camlTest_locations__1"
    (store val(root-init) "camlTest_locations" clos))
- 1a)
+ 1)
 
 (data)

testsuite/tests/formatting/test_locations.dno-locations.ocamlopt.flambda.reference

@@ -25,6 +25,6 @@ cmm:
  "camlTest_locations":
  addr "camlTest_locations__fib_5_closure")
 (data)
-(function camlTest_locations__entry () 1a)
+(function camlTest_locations__entry () 1)
 
 (data)

testsuite/tools/lexcmm.mll

@@ -191,9 +191,6 @@ rule token = parse
   | '-'? (['0'-'9']+ | "0x" ['0'-'9' 'a'-'f' 'A'-'F']+
                      | "0o" ['0'-'7']+ | "0b" ['0'-'1']+)
       { INTCONST(int_of_string(Lexing.lexeme lexbuf)) }
-  | '-'? ['0'-'9']+ 'a'
-      { let s = Lexing.lexeme lexbuf in
-        POINTER(int_of_string(String.sub s 0 (String.length s - 1))) }
   | '-'? ['0'-'9']+ ('.' ['0'-'9']*)? (['e' 'E'] ['+' '-']? ['0'-'9']+)?
       { FLOATCONST(Lexing.lexeme lexbuf) }
   | ['A'-'Z' 'a'-'z' '\223'-'\246' '\248'-'\255' ]

testsuite/tools/parsecmm.mly

@@ -133,7 +133,6 @@ let access_array base numelt size =
 %token NLEF
 %token NLTF
 %token OR
-%token <int> POINTER
 %token PROJ
 %token <Lambda.raise_kind> RAISE
 %token RBRACKET
@@ -211,7 +210,6 @@ expr:
     INTCONST    { Cconst_int ($1, debuginfo ()) }
   | FLOATCONST  { Cconst_float (float_of_string $1, debuginfo ()) }
   | STRING      { Cconst_symbol ($1, debuginfo ()) }
-  | POINTER     { Cconst_pointer ($1, debuginfo ()) }
   | IDENT       { Cvar(find_ident $1) }
   | LBRACKET RBRACKET { Ctuple [] }
   | LPAREN LET letdef sequence RPAREN { make_letdef $3 $4 }