add the %int_as_pointer primitive

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

7 files changed, 13 insertions, 0 deletions

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 5b65b578b..7e585b5c1 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -1549,6 +1549,8 @@ and transl_prim_1 p arg dbg =
         Cop(Cload Double_u,
             [if n = 0 then ptr
                        else Cop(Cadda, [ptr; Cconst_int(n * size_float)])]))
+  | Pint_as_pointer ->
+     Cop(Cadda, [transl arg; Cconst_int (-1)])
   (* Exceptions *)
   | Praise k ->
       Cop(Craise (k, dbg), [transl arg])
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index f7bdd5d7c..1e73db4f3 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -401,6 +401,7 @@ let comp_primitive p args =
   | Pbigstring_set_64(_) -> Kccall("caml_ba_uint8_set64", 3)
   | Pbswap16 -> Kccall("caml_bswap16", 1)
   | Pbbswap(bi) -> comp_bint_primitive bi "bswap" args
+  | Pint_as_pointer -> Kccall("caml_int_as_pointer", 1)
   | _ -> fatal_error "Bytegen.comp_primitive"
 
 let is_immed n = immed_min <= n && n <= immed_max
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index f68588090..69a08db98 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -121,6 +121,8 @@ type primitive =
   (* byte swap *)
   | Pbswap16
   | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
+  | Pint_as_pointer
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index 8acb4cd03..f692f39a2 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -121,6 +121,8 @@ type primitive =
   (* byte swap *)
   | Pbswap16
   | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
+  | Pint_as_pointer
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index fd90caf59..d528a3574 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -237,6 +237,7 @@ let primitive ppf = function
      else fprintf ppf "bigarray.array1.set64"
   | Pbswap16 -> fprintf ppf "bswap16"
   | Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi
+  | Pint_as_pointer -> fprintf ppf "int_as_pointer"
 
 let rec lam ppf = function
   | Lvar id ->
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index eb60c0301..10c6ab711 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -311,6 +311,7 @@ let primitives_table = create_hashtable 57 [
   "%bswap_int32", Pbbswap(Pint32);
   "%bswap_int64", Pbbswap(Pint64);
   "%bswap_native", Pbbswap(Pnativeint);
+  "%int_as_pointer", Pint_as_pointer;
 ]
 
 let prim_makearray =
diff --git a/byterun/obj.c b/byterun/obj.c
index 1d7b57910..b045fee26 100644
--- a/byterun/obj.c
+++ b/byterun/obj.c
@@ -255,3 +255,7 @@ CAMLprim value caml_set_oo_id (value obj) {
   oo_last_id += 2;
   return obj;
 }
+
+CAMLprim value caml_int_as_pointer (value n) {
+  return n - 1;
+}