ocaml/bytecomp/printinstr.ml

118 lines
4.9 KiB
OCaml

(***********************************************************************)
(* *)
(* Caml Special Light *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1995 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Pretty-print lists of instructions *)
open Format
open Lambda
open Instruct
let instruction = function
Klabel lbl -> print_string "L"; print_int lbl; print_string ":"
| Kacc n -> print_string "\tacc "; print_int n
| Kenvacc n -> print_string "\tenvacc "; print_int n
| Kpush -> print_string "\tpush"
| Kpop n -> print_string "\tpop "; print_int n
| Kassign n -> print_string "\tassign "; print_int n
| Kpush_retaddr lbl -> print_string "\tpush_retaddr L"; print_int lbl
| Kapply n -> print_string "\tapply "; print_int n
| Kappterm(n, m) ->
print_string "\tappterm "; print_int n; print_string ", "; print_int m
| Kreturn n -> print_string "\treturn "; print_int n
| Krestart -> print_string "\trestart"
| Kgrab n -> print_string "\tgrab "; print_int n
| Kclosure(lbl, n) ->
print_string "\tclosure L"; print_int lbl; print_string ", "; print_int n
| Kclosurerec(lbl, n) ->
print_string "\tclosurerec L"; print_int lbl;
print_string ", "; print_int n
| Kgetglobal id -> print_string "\tgetglobal "; Ident.print id
| Ksetglobal id -> print_string "\tsetglobal "; Ident.print id
| Kconst cst ->
open_hovbox 10; print_string "\tconst"; print_space();
Printlambda.structured_constant cst; close_box()
| Kmakeblock(n, m) ->
print_string "\tmakeblock "; print_int n; print_string ", "; print_int m
| Kgetfield n -> print_string "\tgetfield "; print_int n
| Ksetfield n -> print_string "\tsetfield "; print_int n
| Kdummy n -> print_string "\tdummy "; print_int n
| Kupdate n -> print_string "\tupdate"; print_int n
| Kvectlength -> print_string "\tvectlength"
| Kgetvectitem -> print_string "\tgetvectitem"
| Ksetvectitem -> print_string "\tsetvectitem"
| Kgetstringchar -> print_string "\tgetstringchar"
| Ksetstringchar -> print_string "\tsetstringchar"
| Kbranch lbl -> print_string "\tbranch L"; print_int lbl
| Kbranchif lbl -> print_string "\tbranchif L"; print_int lbl
| Kbranchifnot lbl -> print_string "\tbranchifnot L"; print_int lbl
| Kstrictbranchif lbl -> print_string "\tstrictbranchif L"; print_int lbl
| Kstrictbranchifnot lbl ->
print_string "\tstrictbranchifnot L"; print_int lbl
| Kswitch(consts, blocks) ->
open_hovbox 10;
print_string "\tswitch";
Array.iter (fun lbl -> print_space(); print_int lbl) consts;
print_string "/";
Array.iter (fun lbl -> print_space(); print_int lbl) blocks;
close_box()
| Ktranslate tbl ->
open_hovbox 10;
print_string "\ttranslate";
Array.iter
(fun (lo, hi, ofs) ->
print_space(); print_int lo; print_string "/";
print_int hi; print_string "/"; print_int ofs)
tbl;
close_box()
| Kboolnot -> print_string "\tboolnot"
| Kpushtrap lbl -> print_string "\tpushtrap L"; print_int lbl
| Kpoptrap -> print_string "\tpoptrap"
| Kraise -> print_string "\traise"
| Kcheck_signals -> print_string "\tcheck_signals"
| Kccall(s, n) ->
print_string "\tccall "; print_string s; print_string ", "; print_int n
| Knegint -> print_string "\tnegint"
| Kaddint -> print_string "\taddint"
| Ksubint -> print_string "\tsubint"
| Kmulint -> print_string "\tmulint"
| Kdivint -> print_string "\tdivint"
| Kmodint -> print_string "\tmodint"
| Kandint -> print_string "\tandint"
| Korint -> print_string "\torint"
| Kxorint -> print_string "\txorint"
| Klslint -> print_string "\tlslint"
| Klsrint -> print_string "\tlsrint"
| Kasrint -> print_string "\tasrint"
| Kintcomp Ceq -> print_string "\teqint"
| Kintcomp Cneq -> print_string "\tneqint"
| Kintcomp Clt -> print_string "\tltint"
| Kintcomp Cgt -> print_string "\tgtint"
| Kintcomp Cle -> print_string "\tleint"
| Kintcomp Cge -> print_string "\tgeint"
| Koffsetint n -> print_string "\toffsetint "; print_int n
| Koffsetref n -> print_string "\toffsetref "; print_int n
| Kstop -> print_string "\tstop"
let rec instruction_list = function
[] -> ()
| Klabel lbl :: il ->
print_string "L"; print_int lbl; print_string ":"; instruction_list il
| instr :: il ->
instruction instr; print_space(); instruction_list il
let instrlist il =
open_vbox 0;
instruction_list il;
close_box()