diff options
Diffstat (limited to 'kernel/cemitcodes.ml')
| -rw-r--r-- | kernel/cemitcodes.ml | 31 |
1 files changed, 29 insertions, 2 deletions
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. *) |