1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
6(*                                                                        *)
7(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
8(*     en Automatique.                                                    *)
9(*                                                                        *)
10(*   All rights reserved.  This file is distributed under the terms of    *)
11(*   the GNU Lesser General Public License version 2.1, with the          *)
12(*   special exception on linking described in the file LICENSE.          *)
13(*                                                                        *)
14(**************************************************************************)
15
16(* The type of the instructions of the abstract machine *)
17
18open Lambda
19
20(* Structure of compilation environments *)
21
22type compilation_env =
23  { ce_stack: int Ident.tbl; (* Positions of variables in the stack *)
24    ce_heap: int Ident.tbl;  (* Structure of the heap-allocated env *)
25    ce_rec: int Ident.tbl }  (* Functions bound by the same let rec *)
26
27(* The ce_stack component gives locations of variables residing
28   in the stack. The locations are offsets w.r.t. the origin of the
29   stack frame.
30   The ce_heap component gives the positions of variables residing in the
31   heap-allocated environment.
32   The ce_rec component associate offsets to identifiers for functions
33   bound by the same let rec as the current function.  The offsets
34   are used by the OFFSETCLOSURE instruction to recover the closure
35   pointer of the desired function from the env register (which
36   points to the closure for the current function). *)
37
38(* Debugging events *)
39
40(* Warning: when you change these types, check byterun/backtrace.c *)
41type debug_event =
42  { mutable ev_pos: int;                (* Position in bytecode *)
43    ev_module: string;                  (* Name of defining module *)
44    ev_loc: Location.t;                 (* Location in source file *)
45    ev_kind: debug_event_kind;          (* Before/after event *)
46    ev_info: debug_event_info;          (* Extra information *)
47    ev_typenv: Env.summary;             (* Typing environment *)
48    ev_typsubst: Subst.t;               (* Substitution over types *)
49    ev_compenv: compilation_env;        (* Compilation environment *)
50    ev_stacksize: int;                  (* Size of stack frame *)
51    ev_repr: debug_event_repr }         (* Position of the representative *)
52
53and debug_event_kind =
54    Event_before
55  | Event_after of Types.type_expr
56  | Event_pseudo
57
58and debug_event_info =
59    Event_function
60  | Event_return of int
61  | Event_other
62
63and debug_event_repr =
64    Event_none
65  | Event_parent of int ref
66  | Event_child of int ref
67
68(* Abstract machine instructions *)
69
70type label = int                        (* Symbolic code labels *)
71
72type instruction =
73    Klabel of label
74  | Kacc of int
75  | Kenvacc of int
76  | Kpush
77  | Kpop of int
78  | Kassign of int
79  | Kpush_retaddr of label
80  | Kapply of int                       (* number of arguments *)
81  | Kappterm of int * int               (* number of arguments, slot size *)
82  | Kreturn of int                      (* slot size *)
83  | Krestart
84  | Kgrab of int                        (* number of arguments *)
85  | Kclosure of label * int
86  | Kclosurerec of label list * int
87  | Koffsetclosure of int
88  | Kgetglobal of Ident.t
89  | Ksetglobal of Ident.t
90  | Kconst of structured_constant
91  | Kmakeblock of int * int             (* size, tag *)
92  | Kmakefloatblock of int
93  | Kgetfield of int
94  | Ksetfield of int
95  | Kgetfloatfield of int
96  | Ksetfloatfield of int
97  | Kvectlength
98  | Kgetvectitem
99  | Ksetvectitem
100  | Kgetstringchar
101  | Ksetstringchar
102  | Kbranch of label
103  | Kbranchif of label
104  | Kbranchifnot of label
105  | Kstrictbranchif of label
106  | Kstrictbranchifnot of label
107  | Kswitch of label array * label array
108  | Kboolnot
109  | Kpushtrap of label
110  | Kpoptrap
111  | Kraise of raise_kind
112  | Kcheck_signals
113  | Kccall of string * int
114  | Knegint | Kaddint | Ksubint | Kmulint | Kdivint | Kmodint
115  | Kandint | Korint | Kxorint | Klslint | Klsrint | Kasrint
116  | Kintcomp of comparison
117  | Koffsetint of int
118  | Koffsetref of int
119  | Kisint
120  | Kisout
121  | Kgetmethod
122  | Kgetpubmet of int
123  | Kgetdynmet
124  | Kevent of debug_event
125  | Kstop
126
127val immed_min: int
128val immed_max: int
129