diff options
| author |  Samuel Mimram <smimram@debian.org> | 2006-11-21 21:38:49 +0000 |
|---|---|---|
| committer | Samuel Mimram <smimram@debian.org> | 2006-11-21 21:38:49 +0000 |
| commit | 208a0f7bfa5249f9795e6e225f309cbe715c0fad (patch) | |
| tree | 591e9e512063e34099782e2518573f15ffeac003 /kernel/cemitcodes.ml | |
| parent | de0085539583f59dc7c4bf4e272e18711d565466 (diff) | |
Imported Upstream version 8.1~gammaupstream/8.1.gamma
Diffstat (limited to 'kernel/cemitcodes.ml')
| -rw-r--r-- | kernel/cemitcodes.ml | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml index cccb1844..71a9aa0e 100644 --- a/kernel/cemitcodes.ml +++ b/kernel/cemitcodes.ml @@ -149,8 +149,6 @@ let emit_instr = function out opGRAB; out_int n | Kgrabrec(rec_arg) -> out opGRABREC; out_int rec_arg - | Kcograb n -> - out opCOGRAB; out_int n | Kclosure(lbl, n) -> out opCLOSURE; out_int n; out_label lbl | Kclosurerec(nfv,init,lbl_types,lbl_bodies) -> @@ -160,6 +158,13 @@ let emit_instr = function Array.iter (out_label_with_orig org) lbl_types; let org = !out_position in Array.iter (out_label_with_orig org) lbl_bodies + | Kclosurecofix(nfv,init,lbl_types,lbl_bodies) -> + out opCLOSURECOFIX;out_int (Array.length lbl_bodies); + out_int nfv; out_int init; + let org = !out_position in + Array.iter (out_label_with_orig org) lbl_types; + let org = !out_position in + Array.iter (out_label_with_orig org) lbl_bodies | Kgetglobal q -> out opGETGLOBAL; slot_for_getglobal q | Kconst((Const_b0 i)) -> @@ -178,16 +183,20 @@ let emit_instr = function out opMAKESWITCHBLOCK; out_label typlbl; out_label swlbl; slot_for_annot annot;out_int sz - | Kforce -> - out opFORCE | Kswitch (tbl_const, tbl_block) -> out opSWITCH; out_int (Array.length tbl_const + (Array.length tbl_block lsl 16)); let org = !out_position in Array.iter (out_label_with_orig org) tbl_const; Array.iter (out_label_with_orig org) tbl_block - | Kpushfield n -> - out opPUSHFIELD;out_int n + | Kpushfields n -> + out opPUSHFIELDS;out_int n + | Kfield n -> + if n <= 1 then out (opGETFIELD0+n) + else (out opGETFIELD;out_int n) + | Ksetfield n -> + if n <= 1 then out (opSETFIELD0+n) + else (out opSETFIELD;out_int n) | Kstop -> out opSTOP | Ksequence _ -> raise (Invalid_argument "Cemitcodes.emit_instr") |