Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
master
Stephen Dolan 2020-05-19 14:31:08 +01:00 committed by GitHub
parent 8ce5231e3b
commit 2d92955749
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
17 changed files with 22 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
asmcomp/afl_instrument.ml
View File

@ -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 =

4
asmcomp/amd64/selection.ml
View File

@ -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

8
asmcomp/cmm.ml
View File

@ -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 ->

2
asmcomp/cmm.mli
View File

@ -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

12
asmcomp/cmm_helpers.ml
View File

@ -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 []
| 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_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_pointer (n, _), _dbg when (n land 1) = 1 ->
| Cconst_int (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 ->

16
asmcomp/cmmgen.ml
View File

@ -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)
else Cconst_natpointer
then Cconst_int((n lsl 1) + 1, dbg)
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_pointer (3, dbg))
dbg (Cconst_int (1, 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_pointer (1, dbg))
dbg (Cconst_int (3, 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_pointer (1, dbg))
dbg (Cconst_int (3, dbg))
dbg' (Cconst_int (1, dbg))
(* Integer operations *)
| Paddint ->
add_int_caml (transl env arg1) (transl env arg2) dbg

7
asmcomp/i386/selection.ml
View File

@ -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

2
asmcomp/printcmm.ml
View File

@ -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 =

32
asmcomp/selectgen.ml
View File

@ -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 _

2
asmcomp/strmatch.ml
View File

@ -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)

2
testsuite/tests/asmgen/soli.cmm
View File

@ -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)

2
testsuite/tests/formatting/test_locations.dlocations.ocamlopt.clambda.reference
View File

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

2
testsuite/tests/formatting/test_locations.dlocations.ocamlopt.flambda.reference
View File

@ -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)

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

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

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

@ -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)

3
testsuite/tools/lexcmm.mll
View File

@ -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' ]

2
testsuite/tools/parsecmm.mly
View File

@ -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 }