Fix compatibility with ocaml 4.07 bytecode version.

bvaugon · Jan 8, 2019 · 9e71aea · 9e71aea
1 parent 8125e51
commit 9e71aea
Show file tree

Hide file tree

Showing 8 changed files with 27 additions and 39 deletions.
diff --git a/.gitignore b/.gitignore
@@ -1,2 +1,4 @@
 src/_build/
 src/config.ml
+etc/Makefile.conf
+etc/config.ml
diff --git a/VERSION b/VERSION
@@ -1 +1 @@
-2.1
+2.2
diff --git a/etc/Makefile.conf b/etc/Makefile.conf
diff --git a/etc/config.ml b/etc/config.ml
diff --git a/src/code.ml b/src/code.ml
@@ -205,8 +205,8 @@ let export oc code =
               | Vectlength            -> write 79
               | Getvectitem           -> write 80
               | Setvectitem           -> write 81
-              | Getstringchar         -> write 82
-              | Setstringchar         -> write 83
+              | Getbyteschar          -> write 82
+              | Setbyteschar          -> write 83
               | Branch ptr            -> write 84 ; write_ptr 1 ptr
               | Branchif ptr          -> write 85 ; write_ptr 1 ptr
               | Branchifnot ptr       -> write 86 ; write_ptr 1 ptr
@@ -268,6 +268,7 @@ let export oc code =
               | Break                 -> write 145
               | Reraise               -> write 146
               | Raisenotrace          -> write 147
+              | Getstringchar         -> write 148
             end;
             normal (succ i);
     and after_pop i acc =

diff --git a/src/index.ml b/src/index.ml
@@ -15,7 +15,7 @@ type section = Code | Dlpt | Dlls | Prim | Data | Symb | Crcs | Dbug
 
 type t = (section * int * int) list
 
-let magic_str = "Caml1999X011"
+let magic_str = "Caml1999X023"
 
 let parse ic =
   let magic_size = String.length magic_str in

diff --git a/src/instr.ml b/src/instr.ml
@@ -41,8 +41,8 @@ and bc =
   | Vectlength
   | Getvectitem
   | Setvectitem
-  | Getstringchar
-  | Setstringchar
+  | Getbyteschar
+  | Setbyteschar
   | Branch of ptr
   | Branchif of ptr
   | Branchifnot of ptr
@@ -51,8 +51,6 @@ and bc =
   | Pushtrap of ptr
   | Poptrap
   | Raise
-  | Reraise
-  | Raisenotrace
   | Checksignals
   | Ccall of int * int
   | Const of int
@@ -93,6 +91,9 @@ and bc =
   | Stop
   | Event
   | Break
+  | Reraise
+  | Raisenotrace
+  | Getstringchar
   | Nop
 ;;
 
@@ -195,8 +196,8 @@ let parse read =
         | 79 ->  [ Vectlength ]
         | 80 ->  [ Getvectitem ]
         | 81 ->  [ Setvectitem ]
-        | 82 ->  [ Getstringchar ]
-        | 83 ->  [ Setstringchar ]
+        | 82 ->  [ Getbyteschar ]
+        | 83 ->  [ Setbyteschar ]
         | 84 ->  [ Branch (read_ptr ()) ]
         | 85 ->  [ Branchif (read_ptr ()) ]
         | 86 ->  [ Branchifnot (read_ptr ()) ]
@@ -265,8 +266,9 @@ let parse read =
         | 143 -> [ Stop ]
         | 144 -> [ Event ]
         | 145 -> [ Break ]
-        | 146 ->  [ Reraise ]
-        | 147 ->  [ Raisenotrace ]
+        | 146 -> [ Reraise ]
+        | 147 -> [ Raisenotrace ]
+        | 148 -> [ Getstringchar ]
         | _ -> raise (Exn (Printf.sprintf "invalid opcode: %d" opcode))
       with End_of_file -> raise (Exn "unexpected end of code section")
     in
@@ -306,8 +308,8 @@ let print_bc oc bc =
     | Vectlength        -> Printf.fprintf oc "VECTLENGTH"
     | Getvectitem       -> Printf.fprintf oc "GETVECTITEM"
     | Setvectitem       -> Printf.fprintf oc "SETVECTITEM"
-    | Getstringchar     -> Printf.fprintf oc "GETSTRINGCHAR"
-    | Setstringchar     -> Printf.fprintf oc "SETSTRINGCHAR"
+    | Getbyteschar      -> Printf.fprintf oc "GETBYTESCHAR"
+    | Setbyteschar      -> Printf.fprintf oc "SETBYTESCHAR"
     | Branch ptr        -> Printf.fprintf oc "BRANCH %d" ptr.instr_ind
     | Branchif ptr      -> Printf.fprintf oc "BRANCHIF %d" ptr.instr_ind
     | Branchifnot ptr   -> Printf.fprintf oc "BRANCHIFNOT %d" ptr.instr_ind
@@ -321,8 +323,6 @@ let print_bc oc bc =
     | Pushtrap ptr      -> Printf.fprintf oc "PUSHTRAP %d" ptr.instr_ind
     | Poptrap           -> Printf.fprintf oc "POPTRAP"
     | Raise             -> Printf.fprintf oc "RAISE"
-    | Reraise           -> Printf.fprintf oc "RERAISE"
-    | Raisenotrace      -> Printf.fprintf oc "RAISENOTRACE"
     | Checksignals      -> Printf.fprintf oc "CHECKSIGNALS"
     | Ccall (n, ind)    -> Printf.fprintf oc "CCALL %d %d" n ind
     | Const n           -> Printf.fprintf oc "CONST %d" n
@@ -363,5 +363,8 @@ let print_bc oc bc =
     | Stop              -> Printf.fprintf oc "STOP"
     | Event             -> Printf.fprintf oc "EVENT"
     | Break             -> Printf.fprintf oc "BREAK"
+    | Reraise           -> Printf.fprintf oc "RERAISE"
+    | Raisenotrace      -> Printf.fprintf oc "RAISENOTRACE"
+    | Getstringchar     -> Printf.fprintf oc "GETSTRINGCHAR"
     | Nop               -> Printf.fprintf oc "NOP"
 ;;
diff --git a/src/step2.ml b/src/step2.ml
@@ -16,7 +16,7 @@ let is_removable prim bc =
     | Ccall (_, p) -> Prim.no_side_effect prim.(p)
     | Pop _ | Apply _ | Pushtrap _ | Poptrap | Raise | Reraise
     | Raisenotrace | Offsetclosure _ | Offsetref _ | Checksignals
-    | Event | Break | Setglobal _ | Setvectitem | Setstringchar
+    | Event | Break | Setglobal _ | Setvectitem | Setbyteschar
     | Branch _ | Switch (_, _) | Setfield _ | Setfloatfield _
     | Blint (_, _) | Bleint (_, _) | Bgtint (_, _) | Bgeint (_, _)
     | Beq (_, _) | Bneq (_, _) | Bultint (_, _) | Bugeint (_, _)
@@ -146,7 +146,7 @@ let compute_deps code =
           use_accu (); f (succ i) s i z;
         | Acc n ->
           use_stack n; f (succ i) s i z;
-        | Setvectitem | Setstringchar ->
+        | Setvectitem | Setbyteschar ->
           use_accu (); use_stack 0; use_stack 1;
           f (succ i) (pop s 2) i (z - 2);
         | Branch ptr ->
@@ -158,7 +158,7 @@ let compute_deps code =
           f (succ i) (pop s (n - 1)) i (z - n + 1);
         | Addint | Subint | Mulint | Divint | Modint | Andint | Orint | Xorint
         | Lslint | Lsrint | Asrint | Eq | Neq | Ltint | Leint | Gtint | Geint
-        | Setfield _ | Setfloatfield _ | Getvectitem | Getstringchar
+        | Setfield _ | Setfloatfield _ | Getvectitem | Getbyteschar | Getstringchar
         | Ultint | Ugeint ->
           use_accu (); use_stack 0; f (succ i) (pop s 1) i (z - 1);
         | Blint (_, ptr) | Bleint (_, ptr) | Bgtint (_, ptr) | Bgeint (_, ptr)
@@ -242,15 +242,15 @@ let clean_code code stacks in_main cleanables blocked =
             | Addint | Subint | Mulint | Divint | Modint | Andint | Orint
             | Xorint | Lslint | Lsrint | Asrint | Eq | Neq | Ltint | Leint
             | Gtint | Geint | Ultint | Ugeint | Getvectitem
-            | Getstringchar ->
+            | Getstringchar | Getbyteschar ->
               Pop (compute_new_stack_top_size 1)
             | Ccall (n, _) | Makeblock (n, _) | Makefloatblock n ->
               Pop (compute_new_stack_top_size (n - 1))
             | Closure (n, _) ->
               Pop (compute_new_stack_top_size (max (n - 1) 0))
             | Pop _ | Apply _ | Pushtrap _ | Poptrap | Raise | Reraise
             | Raisenotrace | Offsetclosure _ | Offsetref _ | Checksignals
-            | Event | Break | Setglobal _ | Setvectitem | Setstringchar
+            | Event | Break | Setglobal _ | Setvectitem | Setbyteschar
             | Branch _ | Switch (_, _) | Setfield _ | Setfloatfield _
             | Blint (_, _) | Bleint (_, _) | Bgtint (_, _) | Bgeint (_, _)
             | Beq (_, _) | Bneq (_, _) | Bultint (_, _) | Bugeint (_, _)