1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
(***********************************************************************)
(* *)
(* 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()
| 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
| Kgetmethod -> print_string "\tgetmethod"
| 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()
|
