1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy, projet Gallium, INRIA Rocquencourt */
6 /* Bill O'Farrell, IBM */
7 /* */
8 /* Copyright 2015 Institut National de Recherche en Informatique et */
9 /* en Automatique. */
10 /* Copyright 2015 IBM (Bill O'Farrell with help from Tristan Amini). */
11 /* */
12 /* All rights reserved. This file is distributed under the terms of */
13 /* the GNU Lesser General Public License version 2.1, with the */
14 /* special exception on linking described in the file LICENSE. */
15 /* */
16 /**************************************************************************/
17
18 #if defined(__PIC__)
19
20 #define Addrglobal(reg,glob) \
21 lgrl reg, glob@GOTENT
22 #else
23
24 #define Addrglobal(reg,glob) \
25 larl reg, glob
26 #endif
27
28 .set domain_curr_field, 0
29 #define DOMAIN_STATE(c_type, name) \
30 .equ domain_field_caml_##name, domain_curr_field ; \
31 .set domain_curr_field, domain_curr_field + 1
32 #include "../runtime/caml/domain_state.tbl"
33 #undef DOMAIN_STATE
34
35 #define Caml_state(var) 8*domain_field_caml_##var(%r10)
36
37 .section ".text"
38
39 /* Invoke the garbage collector. */
40
41 .globl caml_system__code_begin
42 caml_system__code_begin:
43
44 .globl caml_call_gc
45 .type caml_call_gc, @function
46 caml_call_gc:
47 /* Set up stack frame */
48 #define FRAMESIZE (16*8 + 16*8)
49 lay %r15, -FRAMESIZE(%r15)
50 /* Record return address into OCaml code */
51 stg %r14, Caml_state(last_return_address)
52 /* Record lowest stack address */
53 lay %r0, FRAMESIZE(%r15)
54 stg %r0, Caml_state(bottom_of_stack)
55 /* Record pointer to register array */
56 lay %r0, (8*16)(%r15)
57 stg %r0, Caml_state(gc_regs)
58 /* Save current allocation pointer for debugging purposes */
59 stg %r11, Caml_state(young_ptr)
60 /* Save exception pointer (if e.g. a sighandler raises) */
61 stg %r13, Caml_state(exception_pointer)
62 /* Save all registers used by the code generator */
63 stmg %r2,%r9, (8*16)(%r15)
64 stg %r12, (8*16 + 8*8)(%r15)
65 std %f0, 0(%r15)
66 std %f1, 8(%r15)
67 std %f2, 16(%r15)
68 std %f3, 24(%r15)
69 std %f4, 32(%r15)
70 std %f5, 40(%r15)
71 std %f6, 48(%r15)
72 std %f7, 56(%r15)
73 std %f8, 64(%r15)
74 std %f9, 72(%r15)
75 std %f10, 80(%r15)
76 std %f11, 88(%r15)
77 std %f12, 96(%r15)
78 std %f13, 108(%r15)
79 std %f14, 112(%r15)
80 std %f15, 120(%r15)
81 /* Call the GC */
82 lay %r15, -160(%r15)
83 stg %r15, 0(%r15)
84 brasl %r14, caml_garbage_collection@PLT
85 lay %r15, 160(%r15)
86 /* Reload new allocation pointer */
87 lg %r11, Caml_state(young_ptr)
88 /* Restore all regs used by the code generator */
89 lmg %r2,%r9, (8*16)(%r15)
90 lg %r12, (8*16 + 8*8)(%r15)
91 ld %f0, 0(%r15)
92 ld %f1, 8(%r15)
93 ld %f2, 16(%r15)
94 ld %f3, 24(%r15)
95 ld %f4, 32(%r15)
96 ld %f5, 40(%r15)
97 ld %f6, 48(%r15)
98 ld %f7, 56(%r15)
99 ld %f8, 64(%r15)
100 ld %f9, 72(%r15)
101 ld %f10, 80(%r15)
102 ld %f11, 88(%r15)
103 ld %f12, 96(%r15)
104 ld %f13, 108(%r15)
105 ld %f14, 112(%r15)
106 ld %f15, 120(%r15)
107 /* Return to caller */
108 lg %r1, Caml_state(last_return_address)
109 /* Deallocate stack frame */
110 lay %r15, FRAMESIZE(%r15)
111 /* Return */
112 br %r1
113
114 /* Call a C function from OCaml */
115
116 .globl caml_c_call
117 .type caml_c_call, @function
118 caml_c_call:
119 stg %r15, Caml_state(bottom_of_stack)
120 .L101:
121 /* Save return address */
122 ldgr %f15, %r14
123 /* Get ready to call C function (address in r7) */
124 /* Record lowest stack address and return address */
125 stg %r14, Caml_state(last_return_address)
126 /* Make the exception handler and alloc ptr available to the C code */
127 stg %r11, Caml_state(young_ptr)
128 stg %r13, Caml_state(exception_pointer)
129 /* Call the function */
130 basr %r14, %r7
131 /* restore return address */
132 lgdr %r14,%f15
133 /* Reload allocation pointer */
134 lg %r11, Caml_state(young_ptr)
135 /* Return to caller */
136 br %r14
137
138 /* Raise an exception from OCaml */
139 .globl caml_raise_exn
140 .type caml_raise_exn, @function
141 caml_raise_exn:
142 lg %r0, Caml_state(backtrace_active)
143 cgfi %r0, 0
144 jne .L110
145 .L111:
146 /* Pop trap frame */
147 lg %r1, 0(%r13)
148 lgr %r15, %r13
149 lg %r13, 8(13)
150 agfi %r15, 16
151 /* Branch to handler */
152 br %r1
153 .L110:
154 ldgr %f15, %r2 /* preserve exn bucket in callee-save reg */
155 /* arg1: exception bucket, already in r2 */
156 lgr %r3, %r14 /* arg2: PC of raise */
157 lgr %r4, %r15 /* arg3: SP of raise */
158 lgr %r5, %r13 /* arg4: SP of handler */
159 agfi %r15, -160 /* reserve stack space for C call */
160 brasl %r14, caml_stash_backtrace@PLT
161 agfi %r15, 160
162 lgdr %r2,%f15 /* restore exn bucket */
163 j .L111 /* raise the exn */
164
165 /* Raise an exception from C */
166
167 .globl caml_raise_exception
168 .type caml_raise_exception, @function
169 caml_raise_exception:
170 lgr %r10, %r2 /* Load domain state pointer */
171 lgr %r2, %r3 /* Move exception bucket to arg1 register */
172 lg %r0, Caml_state(backtrace_active)
173 cgfi %r0, 0
174 jne .L112
175 .L113:
176 /* Reload OCaml global registers */
177 lg %r15, Caml_state(exception_pointer)
178 lg %r11, Caml_state(young_ptr)
179 /* Pop trap frame */
180 lg %r1, 0(%r15)
181 lg %r13, 8(%r15)
182 agfi %r15, 16
183 /* Branch to handler */
184 br %r1;
185 .L112:
186 lgfi %r0, 0
187 stg %r0, Caml_state(backtrace_pos)
188 ldgr %f15,%r2 /* preserve exn bucket in callee-save reg */
189 /* arg1: exception bucket, already in r2 */
190 lg %r3, Caml_state(last_return_address) /* arg2: PC of raise */
191 lg %r4, Caml_state(bottom_of_stack) /* arg3: SP of raise */
192 lg %r5, Caml_state(exception_pointer) /* arg4: SP of handler */
193 /* reserve stack space for C call */
194 lay %r15, -160(%r15)
195 brasl %r14, caml_stash_backtrace@PLT
196 lay %r15, 160(%r15)
197 lgdr %r2,%f15 /* restore exn bucket */
198 j .L113 /* raise the exn */
199
200 /* Start the OCaml program */
201
202 .globl caml_start_program
203 .type caml_start_program, @function
204 caml_start_program:
205 /* Move Caml_state passed as first argument to r1 */
206 lgr %r1, %r2
207 Addrglobal(%r0, caml_program)
208
209 /* Code shared between caml_start_program and caml_callback */
210 .L102:
211 /* Allocate stack frame */
212 lay %r15, -144(%r15)
213 /* Save all callee-save registers + return address */
214 /* GPR 6..14 at sp + 0 ... sp + 64
215 FPR 10..15 at sp + 72 ... sp + 128 */
216 stmg %r6,%r14, 0(%r15)
217 std %f8, 72(%r15)
218 std %f9, 80(%r15)
219 std %f10, 88(%r15)
220 std %f11, 96(%r15)
221 std %f12, 104(%r15)
222 std %f13, 112(%r15)
223 std %f14, 120(%r15)
224 std %f15, 128(%r15)
225
226 /* Load Caml_state to r10 register */
227 lgr %r10, %r1
228 /* Set up a callback link */
229 lay %r15, -32(%r15)
230 lg %r1, Caml_state(bottom_of_stack)
231 stg %r1, 0(%r15)
232 lg %r1, Caml_state(last_return_address)
233 stg %r1, 8(%r15)
234 lg %r1, Caml_state(gc_regs)
235 stg %r1, 16(%r15)
236 /* Build an exception handler to catch exceptions escaping out of OCaml */
237 brasl %r14, .L103
238 j .L104
239 .L103:
240 lay %r15, -16(%r15)
241 stg %r14, 0(%r15)
242 lg %r1, Caml_state(exception_pointer)
243 stg %r1, 8(%r15)
244 lgr %r13, %r15
245 /* Reload allocation pointer */
246 lg %r11, Caml_state(young_ptr)
247 /* Call the OCaml code */
248 lgr %r1,%r0
249 basr %r14, %r1
250 .L105:
251 /* Pop the trap frame, restoring caml_exception_pointer */
252 lg %r0, 8(%r15)
253 stg %r0, Caml_state(exception_pointer)
254 la %r15, 16(%r15)
255 /* Pop the callback link, restoring the global variables */
256 .L106:
257 lg %r5, 0(%r15)
258 lg %r6, 8(%r15)
259 lg %r0, 16(%r15)
260 stg %r5, Caml_state(bottom_of_stack)
261 stg %r6, Caml_state(last_return_address)
262 stg %r0, Caml_state(gc_regs)
263 la %r15, 32(%r15)
264
265 /* Update allocation pointer */
266 stg %r11, Caml_state(young_ptr)
267
268 /* Restore registers */
269 lmg %r6,%r14, 0(%r15)
270 ld %f8, 72(%r15)
271 ld %f9, 80(%r15)
272 ld %f10, 88(%r15)
273 ld %f11, 96(%r15)
274 ld %f12, 104(%r15)
275 ld %f13, 112(%r15)
276 ld %f14, 120(%r15)
277 ld %f15, 128(%r15)
278
279 /* Return */
280 lay %r15, 144(%r15)
281 br %r14
282
283 /* The trap handler: */
284 .L104:
285 /* Update caml_exception_pointer */
286 stg %r13, Caml_state(exception_pointer)
287 /* Encode exception bucket as an exception result and return it */
288 oill %r2, 2
289 j .L106
290
291 /* Callback from C to OCaml */
292
293 .globl caml_callback_asm
294 .type caml_callback_asm, @function
295 caml_callback_asm:
296 /* Initial shuffling of arguments */
297 /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1) */
298 lgr %r1, %r2 /* r1 = Caml_state */
299 lg %r2, 0(%r4) /* r2 = Argument */
300 /* r3 = Closure */
301 lg %r0, 0(%r3) /* r0 = Code pointer */
302 j .L102
303
304 .globl caml_callback2_asm
305 .type caml_callback2_asm, @function
306 caml_callback2_asm:
307 /* Initial shuffling of arguments */
308 /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1, 8(r4) = arg2) */
309 lgr %r1, %r2 /* r1 = Caml_state */
310 lgr %r0, %r3
311 lg %r2, 0(%r4) /* r2 = First argument */
312 lg %r3, 8(%r4) /* r3 = Second argument */
313 lgr %r4, %r0 /* r4 = Closure */
314 Addrglobal(%r0, caml_apply2) /* r0 = Code pointer */
315 j .L102
316
317 .globl caml_callback3_asm
318 .type caml_callback3_asm, @function
319 caml_callback3_asm:
320 /* Initial shuffling of arguments */
321 /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1, 8(r4) = arg2,
322 16(r4) = arg3) */
323 lgr %r1, %r2 /* r1 = Caml_state */
324 lgr %r5, %r3 /* r5 = Closure */
325 lg %r2, 0(%r4) /* r2 = First argument */
326 lg %r3, 8(%r4) /* r3 = Second argument */
327 lg %r4, 16(%r4) /* r4 = Third argument */
328 Addrglobal(%r0, caml_apply3) /* r0 = Code pointer */
329 j .L102
330
331 .globl caml_ml_array_bound_error
332 .type caml_ml_array_bound_error, @function
333 caml_ml_array_bound_error:
334 /* Save return address before decrementing SP, otherwise
335 the frame descriptor for the call site is not correct */
336 stg %r15, Caml_state(bottom_of_stack)
337 lay %r15, -160(%r15) /* Reserve stack space for C call */
338 Addrglobal(%r7, caml_array_bound_error)
339 j .L101
340 .globl caml_system__code_end
341 caml_system__code_end:
342
343 /* Frame table */
344
345 .section ".data"
346 .align 8
347 .globl caml_system__frametable
348 .type caml_system__frametable, @object
349 caml_system__frametable:
350 .quad 1 /* one descriptor */
351 .quad .L105 /* return address into callback */
352 .short -1 /* negative size count => use callback link */
353 .short 0 /* no roots here */
354 .align 8
355
356 /* Mark stack as non-executable */
357 .section .note.GNU-stack,"",%progbits
358