From a0cfa4f118023d35b767a999d5a2ac4b082857b4 Mon Sep 17 00:00:00 2001
From: Samuel Mimram <smimram@debian.org>
Date: Fri, 25 Jul 2008 15:12:53 +0200
Subject: Imported Upstream version 8.2~beta3+dfsg

---
 kernel/cemitcodes.ml | 31 +++++++++++++++++++++++++++++--
 1 file changed, 29 insertions(+), 2 deletions(-)

(limited to 'kernel/cemitcodes.ml')

diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml
index 4e09a0ed..7617c454 100644
--- a/kernel/cemitcodes.ml
+++ b/kernel/cemitcodes.ml
@@ -23,6 +23,7 @@ let patch_int buff pos n =
 
 let out_buffer = ref(String.create 1024)
 and out_position = ref 0
+
 (*
 let out_word b1 b2 b3 b4 =
   let p = !out_position in
@@ -38,6 +39,7 @@ let out_word b1 b2 b3 b4 =
   String.unsafe_set !out_buffer (p+3) (Char.unsafe_chr b4);
   out_position := p + 4
 *)
+
 let out_word b1 b2 b3 b4 =
   let p = !out_position in
   if p >= String.length !out_buffer then begin
@@ -60,6 +62,7 @@ let out_word b1 b2 b3 b4 =
   String.unsafe_set !out_buffer (p+3) (Char.unsafe_chr b4);
   out_position := p + 4
 
+
 let out opcode =
   out_word opcode 0 0 0
 
@@ -108,7 +111,10 @@ let out_label_with_orig orig lbl =
     Label_defined def ->
       out_int((def - orig) asr 2)
   | Label_undefined patchlist ->
-      if patchlist = [] then
+      (* spiwack: patchlist is supposed to be non-empty all the time
+         thus I commented that out. If there is no problem I suggest
+         removing it for next release (cur: 8.1) *)
+      (*if patchlist = [] then *)
 	(!label_table).(lbl) <-
           Label_undefined((!out_position, orig) :: patchlist);
       out_int 0
@@ -219,9 +225,30 @@ let emit_instr = function
   | Ksetfield n ->
       if n <= 1 then out (opSETFIELD0+n) 
       else (out opSETFIELD;out_int n)
+  | Ksequence _ -> raise (Invalid_argument "Cemitcodes.emit_instr")
+  (* spiwack *)
+  | Kbranch lbl -> out opBRANCH; out_label lbl
+  | Kaddint31 -> out opADDINT31
+  | Kaddcint31 -> out opADDCINT31
+  | Kaddcarrycint31 -> out opADDCARRYCINT31
+  | Ksubint31 -> out opSUBINT31
+  | Ksubcint31 -> out opSUBCINT31
+  | Ksubcarrycint31 -> out opSUBCARRYCINT31
+  | Kmulint31 -> out opMULINT31
+  | Kmulcint31 -> out opMULCINT31
+  | Kdiv21int31 -> out opDIV21INT31
+  | Kdivint31 -> out opDIVINT31
+  | Kaddmuldivint31 -> out opADDMULDIVINT31
+  | Kcompareint31 -> out opCOMPAREINT31
+  | Khead0int31 -> out opHEAD0INT31
+  | Ktail0int31 -> out opTAIL0INT31
+  | Kisconst lbl -> out opISCONST; out_label lbl
+  | Kareconst(n,lbl) -> out opARECONST; out_int n; out_label lbl
+  | Kcompint31 -> out opCOMPINT31
+  | Kdecompint31 -> out opDECOMPINT31
+  (*/spiwack *)
   | Kstop -> 
       out opSTOP
-  | Ksequence _ -> raise (Invalid_argument "Cemitcodes.emit_instr")
 
 (* Emission of a list of instructions. Include some peephole optimization. *)
 
-- 
cgit v1.2.3