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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
/*********************************************************************/
/* */
/* Objective Caml */
/* */
/* 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 Library General Public License, with */
/* the special exception on linking described in file ../LICENSE. */
/* */
/*********************************************************************/
/* $Id$ */
.macro Addrglobal /* reg, glob */
addis $0, 0, ha16($1)
addi $0, $0, lo16($1)
.endmacro
.macro Loadglobal /* reg,glob,tmp */
addis $2, 0, ha16($1)
lwz $0, lo16($1)($2)
.endmacro
.macro Storeglobal /* reg,glob,tmp */
addis $2, 0, ha16($1)
stw $0, lo16($1)($2)
.endmacro
.text
/* Invoke the garbage collector. */
.globl _caml_call_gc
_caml_call_gc:
/* Set up stack frame */
stwu r1, -0x1A0(r1)
/* 0x1A0 = 4*32 (int regs) + 8*32 (float regs) + 32 (space for C call) */
/* Record return address into Caml code */
mflr r0
Storeglobal r0, _caml_last_return_address, r11
/* Record lowest stack address */
addi r0, r1, 0x1A0
Storeglobal r0, _caml_bottom_of_stack, r11
/* Record pointer to register array */
addi r0, r1, 8*32 + 32
Storeglobal r0, _caml_gc_regs, r11
/* Save current allocation pointer for debugging purposes */
Storeglobal r31, _caml_young_ptr, r11
/* Save exception pointer (if e.g. a sighandler raises) */
Storeglobal r29, _caml_exception_pointer, r11
/* Save all registers used by the code generator */
addi r11, r1, 8*32 + 32 - 4
stwu r3, 4(r11)
stwu r4, 4(r11)
stwu r5, 4(r11)
stwu r6, 4(r11)
stwu r7, 4(r11)
stwu r8, 4(r11)
stwu r9, 4(r11)
stwu r10, 4(r11)
stwu r14, 4(r11)
stwu r15, 4(r11)
stwu r16, 4(r11)
stwu r17, 4(r11)
stwu r18, 4(r11)
stwu r19, 4(r11)
stwu r20, 4(r11)
stwu r21, 4(r11)
stwu r22, 4(r11)
stwu r23, 4(r11)
stwu r24, 4(r11)
stwu r25, 4(r11)
stwu r26, 4(r11)
stwu r27, 4(r11)
stwu r28, 4(r11)
addi r11, r1, 32 - 8
stfdu f1, 8(r11)
stfdu f2, 8(r11)
stfdu f3, 8(r11)
stfdu f4, 8(r11)
stfdu f5, 8(r11)
stfdu f6, 8(r11)
stfdu f7, 8(r11)
stfdu f8, 8(r11)
stfdu f9, 8(r11)
stfdu f10, 8(r11)
stfdu f11, 8(r11)
stfdu f12, 8(r11)
stfdu f13, 8(r11)
stfdu f14, 8(r11)
stfdu f15, 8(r11)
stfdu f16, 8(r11)
stfdu f17, 8(r11)
stfdu f18, 8(r11)
stfdu f19, 8(r11)
stfdu f20, 8(r11)
stfdu f21, 8(r11)
stfdu f22, 8(r11)
stfdu f23, 8(r11)
stfdu f24, 8(r11)
stfdu f25, 8(r11)
stfdu f26, 8(r11)
stfdu f27, 8(r11)
stfdu f28, 8(r11)
stfdu f29, 8(r11)
stfdu f30, 8(r11)
stfdu f31, 8(r11)
/* Call the GC */
bl _caml_garbage_collection
/* Reload new allocation pointer and allocation limit */
Loadglobal r31, _caml_young_ptr, r11
Loadglobal r30, _caml_young_limit, r11
/* Restore all regs used by the code generator */
addi r11, r1, 8*32 + 32 - 4
lwzu r3, 4(r11)
lwzu r4, 4(r11)
lwzu r5, 4(r11)
lwzu r6, 4(r11)
lwzu r7, 4(r11)
lwzu r8, 4(r11)
lwzu r9, 4(r11)
lwzu r10, 4(r11)
lwzu r14, 4(r11)
lwzu r15, 4(r11)
lwzu r16, 4(r11)
lwzu r17, 4(r11)
lwzu r18, 4(r11)
lwzu r19, 4(r11)
lwzu r20, 4(r11)
lwzu r21, 4(r11)
lwzu r22, 4(r11)
lwzu r23, 4(r11)
lwzu r24, 4(r11)
lwzu r25, 4(r11)
lwzu r26, 4(r11)
lwzu r27, 4(r11)
lwzu r28, 4(r11)
addi r11, r1, 32 - 8
lfdu f1, 8(r11)
lfdu f2, 8(r11)
lfdu f3, 8(r11)
lfdu f4, 8(r11)
lfdu f5, 8(r11)
lfdu f6, 8(r11)
lfdu f7, 8(r11)
lfdu f8, 8(r11)
lfdu f9, 8(r11)
lfdu f10, 8(r11)
lfdu f11, 8(r11)
lfdu f12, 8(r11)
lfdu f13, 8(r11)
lfdu f14, 8(r11)
lfdu f15, 8(r11)
lfdu f16, 8(r11)
lfdu f17, 8(r11)
lfdu f18, 8(r11)
lfdu f19, 8(r11)
lfdu f20, 8(r11)
lfdu f21, 8(r11)
lfdu f22, 8(r11)
lfdu f23, 8(r11)
lfdu f24, 8(r11)
lfdu f25, 8(r11)
lfdu f26, 8(r11)
lfdu f27, 8(r11)
lfdu f28, 8(r11)
lfdu f29, 8(r11)
lfdu f30, 8(r11)
lfdu f31, 8(r11)
/* Return to caller, restarting the allocation */
Loadglobal r0, _caml_last_return_address, r11
addic r0, r0, -16 /* Restart the allocation (4 instructions) */
mtlr r0
/* Say we are back into Caml code */
li r12, 0
Storeglobal r12, _caml_last_return_address, r11
/* Deallocate stack frame */
addi r1, r1, 0x1A0
/* Return */
blr
/* Call a C function from Caml */
.globl _caml_c_call
_caml_c_call:
/* Save return address */
mflr r25
/* Get ready to call C function (address in 11) */
mtctr r11
/* Record lowest stack address and return address */
Storeglobal r1, _caml_bottom_of_stack, r12
Storeglobal r25, _caml_last_return_address, r12
/* Make the exception handler and alloc ptr available to the C code */
Storeglobal r31, _caml_young_ptr, r11
Storeglobal r29, _caml_exception_pointer, r11
/* Call the function (address in link register) */
bctrl
/* Restore return address (in 25, preserved by the C function) */
mtlr r25
/* Reload allocation pointer and allocation limit*/
Loadglobal r31, _caml_young_ptr, r11
Loadglobal r30, _caml_young_limit, r11
/* Say we are back into Caml code */
li r12, 0
Storeglobal r12, _caml_last_return_address, r11
/* Return to caller */
blr
/* Raise an exception from C */
.globl _caml_raise_exception
_caml_raise_exception:
/* Reload Caml global registers */
Loadglobal r1, _caml_exception_pointer, r11
Loadglobal r31, _caml_young_ptr, r11
Loadglobal r30, _caml_young_limit, r11
/* Say we are back into Caml code */
li r0, 0
Storeglobal r0, _caml_last_return_address, r11
/* Pop trap frame */
lwz r0, 0(r1)
lwz r29, 4(r1)
mtlr r0
addi r1, r1, 16
/* Branch to handler */
blr
/* Start the Caml program */
.globl _caml_start_program
_caml_start_program:
Addrglobal r12, _caml_program
/* Code shared between caml_start_program and caml_callback */
L102:
/* Allocate and link stack frame */
stwu r1, -256(r1)
/* Save return address */
mflr r0
stw r0, 256+4(r1)
/* Save all callee-save registers */
/* GPR 14 at sp+16 ... GPR 31 at sp+84
FPR 14 at sp+92 ... FPR 31 at sp+228 */
addi r11, r1, 16-4
stwu r14, 4(r11)
stwu r15, 4(r11)
stwu r16, 4(r11)
stwu r17, 4(r11)
stwu r18, 4(r11)
stwu r19, 4(r11)
stwu r20, 4(r11)
stwu r21, 4(r11)
stwu r22, 4(r11)
stwu r23, 4(r11)
stwu r24, 4(r11)
stwu r25, 4(r11)
stwu r26, 4(r11)
stwu r27, 4(r11)
stwu r28, 4(r11)
stwu r29, 4(r11)
stwu r30, 4(r11)
stwu r31, 4(r11)
stfdu f14, 8(r11)
stfdu f15, 8(r11)
stfdu f16, 8(r11)
stfdu f17, 8(r11)
stfdu f18, 8(r11)
stfdu f19, 8(r11)
stfdu f20, 8(r11)
stfdu f21, 8(r11)
stfdu f22, 8(r11)
stfdu f23, 8(r11)
stfdu f24, 8(r11)
stfdu f25, 8(r11)
stfdu f26, 8(r11)
stfdu f27, 8(r11)
stfdu f28, 8(r11)
stfdu f29, 8(r11)
stfdu f30, 8(r11)
stfdu f31, 8(r11)
/* Set up a callback link */
addi r1, r1, -16
Loadglobal r9, _caml_bottom_of_stack, r11
Loadglobal r10, _caml_last_return_address, r11
Loadglobal r11, _caml_gc_regs, r11
stw r9, 0(r1)
stw r10, 4(r1)
stw r11, 8(r1)
/* Build an exception handler to catch exceptions escaping out of Caml */
bl L103
b L104
L103:
addi r1, r1, -16
mflr r0
stw r0, 0(r1)
Loadglobal r11, _caml_exception_pointer, r11
stw r11, 4(r1)
mr r29, r1
/* Reload allocation pointers */
Loadglobal r31, _caml_young_ptr, r11
Loadglobal r30, _caml_young_limit, r11
/* Say we are back into Caml code */
li r0, 0
Storeglobal r0, _caml_last_return_address, r11
/* Call the Caml code */
mtctr r12
L105:
bctrl
/* Pop the trap frame, restoring caml_exception_pointer */
lwz r9, 4(r1)
Storeglobal r9, _caml_exception_pointer, r11
addi r1, r1, 16
/* Pop the callback link, restoring the global variables */
L106:
lwz r9, 0(r1)
lwz r10, 4(r1)
lwz r11, 8(r1)
Storeglobal r9, _caml_bottom_of_stack, r12
Storeglobal r10, _caml_last_return_address, r12
Storeglobal r11, _caml_gc_regs, r12
addi r1, r1, 16
/* Update allocation pointer */
Storeglobal r31, _caml_young_ptr, r11
/* Restore callee-save registers */
addi r11, r1, 16-4
lwzu r14, 4(r11)
lwzu r15, 4(r11)
lwzu r16, 4(r11)
lwzu r17, 4(r11)
lwzu r18, 4(r11)
lwzu r19, 4(r11)
lwzu r20, 4(r11)
lwzu r21, 4(r11)
lwzu r22, 4(r11)
lwzu r23, 4(r11)
lwzu r24, 4(r11)
lwzu r25, 4(r11)
lwzu r26, 4(r11)
lwzu r27, 4(r11)
lwzu r28, 4(r11)
lwzu r29, 4(r11)
lwzu r30, 4(r11)
lwzu r31, 4(r11)
lfdu f14, 8(r11)
lfdu f15, 8(r11)
lfdu f16, 8(r11)
lfdu f17, 8(r11)
lfdu f18, 8(r11)
lfdu f19, 8(r11)
lfdu f20, 8(r11)
lfdu f21, 8(r11)
lfdu f22, 8(r11)
lfdu f23, 8(r11)
lfdu f24, 8(r11)
lfdu f25, 8(r11)
lfdu f26, 8(r11)
lfdu f27, 8(r11)
lfdu f28, 8(r11)
lfdu f29, 8(r11)
lfdu f30, 8(r11)
lfdu f31, 8(r11)
/* Reload return address */
lwz r0, 256+4(r1)
mtlr r0
/* Return */
addi r1, r1, 256
blr
/* The trap handler: */
L104:
/* Update caml_exception_pointer */
Storeglobal r29, _caml_exception_pointer, r11
/* Encode exception bucket as an exception result and return it */
ori r3, r3, 2
b L106
/* Callback from C to Caml */
.globl _caml_callback_exn
_caml_callback_exn:
/* Initial shuffling of arguments */
mr r0, r3 /* Closure */
mr r3, r4 /* Argument */
mr r4, r0
lwz r12, 0(r4) /* Code pointer */
b L102
.globl _caml_callback2_exn
_caml_callback2_exn:
mr r0, r3 /* Closure */
mr r3, r4 /* First argument */
mr r4, r5 /* Second argument */
mr r5, r0
Addrglobal r12, _caml_apply2
b L102
.globl _caml_callback3_exn
_caml_callback3_exn:
mr r0, r3 /* Closure */
mr r3, r4 /* First argument */
mr r4, r5 /* Second argument */
mr r5, r6 /* Third argument */
mr r6, r0
Addrglobal r12, _caml_apply3
b L102
/* Frame table */
.const
.globl _caml_system__frametable
_caml_system__frametable:
.long 1 /* one descriptor */
.long L105 + 4 /* return address into callback */
.short -1 /* negative size count => use callback link */
.short 0 /* no roots here */
|
