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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
open Lambda
type closure_entry =
| Free_variable of int
| Function of int
type closure_env =
| Not_in_closure
| In_closure of {
entries: closure_entry Ident.tbl;
env_pos: int;
}
type compilation_env =
{ ce_stack: int Ident.tbl;
ce_closure: closure_env }
type debug_event =
{ mutable ev_pos: int; (* Position in bytecode *)
ev_module: string; (* Name of defining module *)
ev_loc: Location.t; (* Location in source file *)
ev_kind: debug_event_kind; (* Before/after event *)
ev_defname: string; (* Enclosing definition *)
ev_info: debug_event_info; (* Extra information *)
ev_typenv: Env.summary; (* Typing environment *)
ev_typsubst: Subst.t; (* Substitution over types *)
ev_compenv: compilation_env; (* Compilation environment *)
ev_stacksize: int; (* Size of stack frame *)
ev_repr: debug_event_repr } (* Position of the representative *)
and debug_event_kind =
Event_before
| Event_after of Types.type_expr
| Event_pseudo
and debug_event_info =
Event_function
| Event_return of int
| Event_other
and debug_event_repr =
Event_none
| Event_parent of int ref
| Event_child of int ref
type label = int (* Symbolic code labels *)
type instruction =
Klabel of label
| Kacc of int
| Kenvacc of int
| Kpush
| Kpop of int
| Kassign of int
| Kpush_retaddr of label
| Kapply of int (* number of arguments *)
| Kappterm of int * int (* number of arguments, slot size *)
| Kreturn of int (* slot size *)
| Krestart
| Kgrab of int (* number of arguments *)
| Kclosure of label * int
| Kclosurerec of label list * int
| Koffsetclosure of int
| Kgetglobal of Ident.t
| Ksetglobal of Ident.t
| Kconst of structured_constant
| Kmakeblock of int * int (* size, tag *)
| Kmakefloatblock of int
| Kgetfield of int
| Ksetfield of int
| Kgetfloatfield of int
| Ksetfloatfield of int
| Kvectlength
| Kgetvectitem
| Ksetvectitem
| Kgetstringchar
| Kgetbyteschar
| Ksetbyteschar
| Kbranch of label
| Kbranchif of label
| Kbranchifnot of label
| Kstrictbranchif of label
| Kstrictbranchifnot of label
| Kswitch of label array * label array
| Kboolnot
| Kpushtrap of label
| Kpoptrap
| Kraise of raise_kind
| Kcheck_signals
| Kccall of string * int
| Knegint | Kaddint | Ksubint | Kmulint | Kdivint | Kmodint
| Kandint | Korint | Kxorint | Klslint | Klsrint | Kasrint
| Kintcomp of integer_comparison
| Koffsetint of int
| Koffsetref of int
| Kisint
| Kisout
| Kgetmethod
| Kgetpubmet of int
| Kgetdynmet
| Kevent of debug_event
| Kperform
| Kresume
| Kresumeterm of int
| Kreperformterm of int
| Kstop
let immed_min = -0x40000000
and immed_max = 0x3FFFFFFF
(* Actually the abstract machine accommodates -0x80000000 to 0x7FFFFFFF,
but these numbers overflow the OCaml type int if the compiler runs on
a 32-bit processor. *)
|
