aboutsummaryrefslogtreecommitdiffhomepage
path: root/kernel
diff options
context:
space:
mode:
authorGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2017-02-23 04:09:33 +0100
committerGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2017-03-14 22:19:18 +0100
commit581b8d52fe93d666045d4878a1b48dad916451ec (patch)
tree86214fc4f3bb19ab83b78f4226b372746062c7e7 /kernel
parent6098d329afc1e212ff866212a8f7815969a460ad (diff)
[safe_string] kernel/cemitcodes
The `emitcodes` string type was used in both a functional and an imperative way, so we have to handle it with care in order to preserve the previous optimizations and semantics.
Diffstat (limited to 'kernel')
-rw-r--r--kernel/cemitcodes.ml39
1 files changed, 25 insertions, 14 deletions
diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml
index ad7a41a34..a0a13174f 100644
--- a/kernel/cemitcodes.ml
+++ b/kernel/cemitcodes.ml
@@ -24,33 +24,45 @@ type reloc_info =
type patch = reloc_info * int
let patch_char4 buff pos c1 c2 c3 c4 =
- String.unsafe_set buff pos c1;
- String.unsafe_set buff (pos + 1) c2;
- String.unsafe_set buff (pos + 2) c3;
- String.unsafe_set buff (pos + 3) c4
+ Bytes.unsafe_set buff pos c1;
+ Bytes.unsafe_set buff (pos + 1) c2;
+ Bytes.unsafe_set buff (pos + 2) c3;
+ Bytes.unsafe_set buff (pos + 3) c4
let patch buff (pos, n) =
patch_char4 buff pos
(Char.unsafe_chr n) (Char.unsafe_chr (n asr 8)) (Char.unsafe_chr (n asr 16))
(Char.unsafe_chr (n asr 24))
+(* val patch_int : emitcodes -> ((\*pos*\)int * int) list -> emitcodes *)
let patch_int buff patches =
(* copy code *before* patching because of nested evaluations:
the code we are patching might be called (and thus "concurrently" patched)
and results in wrong results. Side-effects... *)
- let buff = String.copy buff in
+ let buff = Bytes.of_string buff in
let () = List.iter (fun p -> patch buff p) patches in
- buff
+ (* Note: we follow the apporach suggested by Gabriel Scherer in
+ PR#136 here, and use unsafe as we own buff.
+
+ The crux of the question that avoids defining emitcodes just as a
+ Byte.t is the call to hcons in to_memory below. Even if disabling
+ this optimization has no visible time impact, test data shows
+ that the optimization is indeed triggered quite often so we
+ choose ugliness over altering the semantics.
+
+ Handle with care.
+ *)
+ Bytes.unsafe_to_string buff
(* Buffering of bytecode *)
-let out_buffer = ref(String.create 1024)
+let out_buffer = ref(Bytes.create 1024)
and out_position = ref 0
let out_word b1 b2 b3 b4 =
let p = !out_position in
- if p >= String.length !out_buffer then begin
- let len = String.length !out_buffer in
+ if p >= Bytes.length !out_buffer then begin
+ let len = Bytes.length !out_buffer in
let new_len =
if len <= Sys.max_string_length / 2
then 2 * len
@@ -58,8 +70,8 @@ let out_word b1 b2 b3 b4 =
if len = Sys.max_string_length
then invalid_arg "String.create" (* Pas la bonne exception .... *)
else Sys.max_string_length in
- let new_buffer = String.create new_len in
- String.blit !out_buffer 0 new_buffer 0 len;
+ let new_buffer = Bytes.create new_len in
+ Bytes.blit !out_buffer 0 new_buffer 0 len;
out_buffer := new_buffer
end;
patch_char4 !out_buffer p (Char.unsafe_chr b1)
@@ -305,7 +317,7 @@ let init () =
label_table := Array.make 16 (Label_undefined []);
reloc_info := []
-type emitcodes = string
+type emitcodes = String.t
let length = String.length
@@ -369,9 +381,8 @@ let to_memory (init_code, fun_code, fv) =
init();
emit init_code;
emit fun_code;
- let code = String.create !out_position in
- String.unsafe_blit !out_buffer 0 code 0 !out_position;
(** Later uses of this string are all purely functional *)
+ let code = Bytes.sub_string !out_buffer 0 !out_position in
let code = CString.hcons code in
let reloc = List.rev !reloc_info in
Array.iter (fun lbl ->