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

Use type Obj.raw_data to represent code pointers in the REPL trace facility 

Using Obj.t is incorrect in no-naked-pointer mode, as it exposes
code pointers as OCaml values.
master
Xavier Leroy 2020-06-08 19:44:48 +02:00
parent ec33006c0a
commit c2db3288c1
4 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bytecomp/meta.ml
View File

@ -23,7 +23,7 @@ external reify_bytecode :
= "caml_reify_bytecode"
external release_bytecode : bytecode -> unit
= "caml_static_release_bytecode"
external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
external invoke_traced_function : Obj.raw_data -> Obj.t -> Obj.t -> Obj.t
= "caml_invoke_traced_function"
external get_section_table : unit -> (string * Obj.t) list
= "caml_get_section_table"

2
bytecomp/meta.mli
View File

@ -25,7 +25,7 @@ external reify_bytecode :
= "caml_reify_bytecode"
external release_bytecode : bytecode -> unit
= "caml_static_release_bytecode"
external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
external invoke_traced_function : Obj.raw_data -> Obj.t -> Obj.t -> Obj.t
= "caml_invoke_traced_function"
external get_section_table : unit -> (string * Obj.t) list
= "caml_get_section_table"

2
runtime/meta.c
View File

@ -231,7 +231,7 @@ CAMLprim value caml_invoke_traced_function(value codeptr, value env, value arg)
Caml_state->extern_sp -= 4;
nsp = Caml_state->extern_sp;
for (i = 0; i < 7; i++) nsp[i] = osp[i];
nsp[7] = codeptr;
nsp[7] = (value) Nativeint_val(codeptr);
nsp[8] = env;
nsp[9] = Val_int(0);
nsp[10] = arg;

10
toplevel/trace.ml
View File

@ -21,7 +21,7 @@ open Longident
open Types
open Toploop
type codeptr = Obj.t
type codeptr = Obj.raw_data
type traced_function =
{ path: Path.t; (* Name under which it is traced *)
@ -42,9 +42,13 @@ let is_traced clos =
(* Get or overwrite the code pointer of a closure *)
let get_code_pointer cls = Obj.field cls 0
let get_code_pointer cls =
assert (let t = Obj.tag cls in t = Obj.closure_tag || t = Obj.infix_tag);
Obj.raw_field cls 0
let set_code_pointer cls ptr = Obj.set_field cls 0 ptr
let set_code_pointer cls ptr =
assert (let t = Obj.tag cls in t = Obj.closure_tag || t = Obj.infix_tag);
Obj.set_raw_field cls 0 ptr
(* Call a traced function (use old code pointer, but new closure as
environment so that recursive calls are also traced).