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 (* Representation of machine code by sequences of pseudoinstructions *)
17
18 type label = Cmm.label
19
20 type integer_comparison =
21 Isigned of Cmm.integer_comparison
22 | Iunsigned of Cmm.integer_comparison
23
24 type integer_operation =
25 Iadd | Isub | Imul | Imulh | Idiv | Imod
26 | Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
27 | Icomp of integer_comparison
28 | Icheckbound of { label_after_error : label option;
29 spacetime_index : int; }
30
31 type float_comparison = Cmm.float_comparison
32
33 type test =
34 Itruetest
35 | Ifalsetest
36 | Iinttest of integer_comparison
37 | Iinttest_imm of integer_comparison * int
38 | Ifloattest of float_comparison
39 | Ioddtest
40 | Ieventest
41
42 type operation =
43 Imove
44 | Ispill
45 | Ireload
46 | Iconst_int of nativeint
47 | Iconst_float of int64
48 | Iconst_symbol of string
49 | Icall_ind of { label_after : label; }
50 | Icall_imm of { func : string; label_after : label; }
51 | Itailcall_ind of { label_after : label; }
52 | Itailcall_imm of { func : string; label_after : label; }
53 | Iextcall of { func : string; alloc : bool; label_after : label; }
54 | Istackoffset of int
55 | Iload of Cmm.memory_chunk * Arch.addressing_mode
56 | Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
57 | Ialloc of { bytes : int; label_after_call_gc : label option;
58 spacetime_index : int; }
59 | Iintop of integer_operation
60 | Iintop_imm of integer_operation * int
61 | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
62 | Ifloatofint | Iintoffloat
63 | Ispecific of Arch.specific_operation
64 | Iname_for_debugger of { ident : Backend_var.t; which_parameter : int option;
65 provenance : unit option; is_assignment : bool; }
66
67 type instruction =
68 { desc: instruction_desc;
69 next: instruction;
70 arg: Reg.t array;
71 res: Reg.t array;
72 dbg: Debuginfo.t;
73 mutable live: Reg.Set.t;
74 mutable available_before: Reg_availability_set.t;
75 mutable available_across: Reg_availability_set.t option;
76 }
77
78 and instruction_desc =
79 Iend
80 | Iop of operation
81 | Ireturn
82 | Iifthenelse of test * instruction * instruction
83 | Iswitch of int array * instruction array
84 | Icatch of Cmm.rec_flag * (int * instruction) list * instruction
85 | Iexit of int
86 | Itrywith of instruction * instruction
87 | Iraise of Lambda.raise_kind
88
89 type spacetime_part_of_shape =
90 | Direct_call_point of { callee : string; }
91 | Indirect_call_point
92 | Allocation_point
93
94 type spacetime_shape = (spacetime_part_of_shape * Cmm.label) list
95
96 type fundecl =
97 { fun_name: string;
98 fun_args: Reg.t array;
99 fun_body: instruction;
100 fun_codegen_options : Cmm.codegen_option list;
101 fun_dbg : Debuginfo.t;
102 fun_spacetime_shape : spacetime_shape option;
103 fun_num_stack_slots: int array;
104 fun_contains_calls: bool;
105 }
106
107 let rec dummy_instr =
108 { desc = Iend;
109 next = dummy_instr;
110 arg = [||];
111 res = [||];
112 dbg = Debuginfo.none;
113 live = Reg.Set.empty;
114 available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
115 available_across = None;
116 }
117
118 let end_instr () =
119 { desc = Iend;
120 next = dummy_instr;
121 arg = [||];
122 res = [||];
123 dbg = Debuginfo.none;
124 live = Reg.Set.empty;
125 available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
126 available_across = None;
127 }
128
129 let instr_cons d a r n =
130 { desc = d; next = n; arg = a; res = r;
131 dbg = Debuginfo.none; live = Reg.Set.empty;
132 available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
133 available_across = None;
134 }
135
136 let instr_cons_debug d a r dbg n =
137 { desc = d; next = n; arg = a; res = r; dbg = dbg; live = Reg.Set.empty;
138 available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
139 available_across = None;
140 }
141
142 let rec instr_iter f i =
143 match i.desc with
144 Iend -> ()
145 | _ ->
146 f i;
147 match i.desc with
148 Iend -> ()
149 | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) -> ()
150 | Iifthenelse(_tst, ifso, ifnot) ->
151 instr_iter f ifso; instr_iter f ifnot; instr_iter f i.next
152 | Iswitch(_index, cases) ->
153 for i = 0 to Array.length cases - 1 do
154 instr_iter f cases.(i)
155 done;
156 instr_iter f i.next
157 | Icatch(_, handlers, body) ->
158 instr_iter f body;
159 List.iter (fun (_n, handler) -> instr_iter f handler) handlers;
160 instr_iter f i.next
161 | Iexit _ -> ()
162 | Itrywith(body, handler) ->
163 instr_iter f body; instr_iter f handler; instr_iter f i.next
164 | Iraise _ -> ()
165 | _ ->
166 instr_iter f i.next
167
168 let spacetime_node_hole_pointer_is_live_before insn =
169 match insn.desc with
170 | Iop op ->
171 begin match op with
172 | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ -> true
173 | Iextcall { alloc; } -> alloc
174 | Ialloc _ ->
175 (* Allocations are special: the call to [caml_call_gc] requires some
176 instrumentation code immediately prior, but this is not inserted until
177 the emitter (since the call is not visible prior to that in any IR).
178 As such, none of the Mach / Linearize analyses will ever see that
179 we use the node hole pointer for these, and we do not need to say
180 that it is live at such points. *)
181 false
182 | Iintop op | Iintop_imm (op, _) ->
183 begin match op with
184 | Icheckbound _
185 (* [Icheckbound] doesn't need to return [true] for the same reason as
186 [Ialloc]. *)
187 | Iadd | Isub | Imul | Imulh | Idiv | Imod
188 | Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
189 | Icomp _ -> false
190 end
191 | Ispecific specific_op ->
192 Arch.spacetime_node_hole_pointer_is_live_before specific_op
193 | Imove | Ispill | Ireload | Iconst_int _ | Iconst_float _
194 | Iconst_symbol _ | Istackoffset _ | Iload _ | Istore _
195 | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
196 | Ifloatofint | Iintoffloat
197 | Iname_for_debugger _ -> false
198 end
199 | Iend | Ireturn | Iifthenelse _ | Iswitch _ | Icatch _
200 | Iexit _ | Itrywith _ | Iraise _ -> false
201
202 let operation_can_raise op =
203 match op with
204 | Icall_ind _ | Icall_imm _ | Iextcall _
205 | Iintop (Icheckbound _) | Iintop_imm (Icheckbound _, _)
206 | Ialloc _ -> true
207 | _ -> false
208