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
|
/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1998 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$ */
/* Asm part of the runtime system, ARM processor */
trap_ptr .req r11
alloc_ptr .req r8
alloc_limit .req r9
sp .req r13
lr .req r14
pc .req r15
.text
/* Allocation functions and GC interface */
.global caml_call_gc
caml_call_gc:
/* Record return address */
/* We can use r10 as a temp reg since it's not live here */
ldr r10, .Lcaml_last_return_address
str lr, [r10, #0]
/* Branch to shared GC code */
bl .Linvoke_gc
/* Restart allocation sequence (4 instructions before) */
sub lr, lr, #16
mov pc, lr
.global caml_alloc1
caml_alloc1:
ldr r10, [alloc_limit, #0]
sub alloc_ptr, alloc_ptr, #8
cmp alloc_ptr, r10
movcs pc, lr /* Return if alloc_ptr >= alloc_limit */
/* Record return address */
ldr r10, .Lcaml_last_return_address
str lr, [r10, #0]
/* Invoke GC */
bl .Linvoke_gc
/* Try again */
b caml_alloc1
.global caml_alloc2
caml_alloc2:
ldr r10, [alloc_limit, #0]
sub alloc_ptr, alloc_ptr, #12
cmp alloc_ptr, r10
movcs pc, lr /* Return if alloc_ptr >= alloc_limit */
/* Record return address */
ldr r10, .Lcaml_last_return_address
str lr, [r10, #0]
/* Invoke GC */
bl .Linvoke_gc
/* Try again */
b caml_alloc2
.global caml_alloc3
caml_alloc3:
ldr r10, [alloc_limit, #0]
sub alloc_ptr, alloc_ptr, #16
cmp alloc_ptr, r10
movcs pc, lr /* Return if alloc_ptr >= alloc_limit */
/* Record return address */
ldr r10, .Lcaml_last_return_address
str lr, [r10, #0]
/* Invoke GC */
bl .Linvoke_gc
/* Try again */
b caml_alloc3
.global caml_allocN
caml_allocN:
str r12, [sp, #-4]!
ldr r12, [alloc_limit, #0]
sub alloc_ptr, alloc_ptr, r10
cmp alloc_ptr, r12
ldr r12, [sp], #4
movcs pc, lr /* Return if alloc_ptr >= alloc_limit */
/* Record return address and desired size */
ldr alloc_limit, .Lcaml_last_return_address
str lr, [alloc_limit, #0]
str r10, .Lcaml_requested_size
/* Invoke GC */
bl .Linvoke_gc
/* Try again */
ldr r10, .Lcaml_requested_size
b caml_allocN
/* Shared code to invoke the GC */
.Linvoke_gc:
/* Record lowest stack address */
ldr r10, .Lcaml_bottom_of_stack
str sp, [r10, #0]
/* Save integer registers and return address on stack */
stmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r10,r12,lr}
/* Store pointer to saved integer registers in caml_gc_regs */
ldr r10, .Lcaml_gc_regs
str sp, [r10, #0]
/* Save non-callee-save float registers */
stfd f0, [sp, #-8]!
stfd f1, [sp, #-8]!
stfd f2, [sp, #-8]!
stfd f3, [sp, #-8]!
/* Save current allocation pointer for debugging purposes */
ldr r10, .Lcaml_young_ptr
str alloc_ptr, [r10, #0]
/* Save trap pointer in case an exception is raised during GC */
ldr r10, .Lcaml_exception_pointer
str trap_ptr, [r10, #0]
/* Call the garbage collector */
bl caml_garbage_collection
/* Restore the registers from the stack */
ldfd f4, [sp], #8
ldfd f5, [sp], #8
ldfd f6, [sp], #8
ldfd f7, [sp], #8
ldmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r10,r12}
/* Reload return address */
ldr r10, .Lcaml_last_return_address
ldr lr, [r10, #0]
/* Say that we are back into Caml code */
mov alloc_ptr, #0
str alloc_ptr, [r10, #0]
/* Reload new allocation pointer and allocation limit */
ldr r10, .Lcaml_young_ptr
ldr alloc_ptr, [r10, #0]
ldr alloc_limit, .Lcaml_young_limit
/* Return to caller */
ldmfd sp!, {pc}
/* Call a C function from Caml */
/* Function to call is in r10 */
.global caml_c_call
caml_c_call:
/* Preserve return address in callee-save register r4 */
mov r4, lr
/* Record lowest stack address and return address */
ldr r5, .Lcaml_last_return_address
ldr r6, .Lcaml_bottom_of_stack
str lr, [r5, #0]
str sp, [r6, #0]
/* Make the exception handler and alloc ptr available to the C code */
ldr r6, .Lcaml_young_ptr
ldr r7, .Lcaml_exception_pointer
str alloc_ptr, [r6, #0]
str trap_ptr, [r7, #0]
/* Call the function */
mov lr, pc
mov pc, r10
/* Reload alloc ptr */
ldr alloc_ptr, [r6, #0] /* r6 still points to caml_young_ptr */
/* Say that we are back into Caml code */
mov r6, #0
str r6, [r5, #0] /* r5 still points to caml_last_return_address */
/* Return */
mov pc, r4
/* Start the Caml program */
.global caml_start_program
caml_start_program:
ldr r10, .Lcaml_program
/* Code shared with caml_callback* */
/* Address of Caml code to call is in r10 */
/* Arguments to the Caml code are in r0...r3 */
.Ljump_to_caml:
/* Save return address and callee-save registers */
stmfd sp!, {r4,r5,r6,r7,r8,r9,r11,lr}
stfd f7, [sp, #-8]!
stfd f6, [sp, #-8]!
stfd f5, [sp, #-8]!
stfd f4, [sp, #-8]!
/* Setup a callback link on the stack */
sub sp, sp, #4*3
ldr r4, .Lcaml_bottom_of_stack
ldr r4, [r4, #0]
str r4, [sp, #0]
ldr r4, .Lcaml_last_return_address
ldr r4, [r4, #0]
str r4, [sp, #4]
ldr r4, .Lcaml_gc_regs
ldr r4, [r4, #0]
str r4, [sp, #8]
/* Setup a trap frame to catch exceptions escaping the Caml code */
sub sp, sp, #4*2
ldr r4, .Lcaml_exception_pointer
ldr r4, [r4, #0]
str r4, [sp, #0]
ldr r4, .LLtrap_handler
str r4, [sp, #4]
mov trap_ptr, sp
/* Reload allocation pointers */
ldr r4, .Lcaml_young_ptr
ldr alloc_ptr, [r4, #0]
ldr alloc_limit, .Lcaml_young_limit
/* We are back into Caml code */
ldr r4, .Lcaml_last_return_address
mov r5, #0
str r5, [r4, #0]
/* Call the Caml code */
mov lr, pc
mov pc, r10
.Lcaml_retaddr:
/* Pop the trap frame, restoring caml_exception_pointer */
ldr r4, .Lcaml_exception_pointer
ldr r5, [sp, #0]
str r5, [r4, #0]
add sp, sp, #2 * 4
/* Pop the callback link, restoring the global variables */
.Lreturn_result:
ldr r4, .Lcaml_bottom_of_stack
ldr r5, [sp, #0]
str r5, [r4, #0]
ldr r4, .Lcaml_last_return_address
ldr r5, [sp, #4]
str r5, [r4, #0]
ldr r4, .Lcaml_gc_regs
ldr r5, [sp, #8]
str r5, [r4, #0]
add sp, sp, #4*3
/* Update allocation pointer */
ldr r4, .Lcaml_young_ptr
str alloc_ptr, [r4, #0]
/* Reload callee-save registers and return */
ldfd f4, [sp], #8
ldfd f5, [sp], #8
ldfd f6, [sp], #8
ldfd f7, [sp], #8
ldmfd sp!, {r4,r5,r6,r7,r8,r9,r11,pc}
/* The trap handler */
.Ltrap_handler:
/* Save exception pointer */
ldr r4, .Lcaml_exception_pointer
str trap_ptr, [r4, #0]
/* Encode exception bucket as an exception result */
orr r0, r0, #2
/* Return it */
b .Lreturn_result
/* Raise an exception from C */
.global caml_raise_exception
caml_raise_exception:
/* Reload Caml allocation pointers */
ldr r1, .Lcaml_young_ptr
ldr alloc_ptr, [r1, #0]
ldr alloc_limit, .Lcaml_young_limit
/* Say we're back into Caml */
ldr r1, .Lcaml_last_return_address
mov r2, #0
str r2, [r1, #0]
/* Cut stack at current trap handler */
ldr r1, .Lcaml_exception_pointer
ldr sp, [r1, #0]
/* Pop previous handler and addr of trap, and jump to it */
ldmfd sp!, {trap_ptr, pc}
/* Callback from C to Caml */
.global caml_callback_exn
caml_callback_exn:
/* Initial shuffling of arguments (r0 = closure, r1 = first arg) */
mov r10, r0
mov r0, r1 /* r0 = first arg */
mov r1, r10 /* r1 = closure environment */
ldr r10, [r10, #0] /* code pointer */
b .Ljump_to_caml
.global caml_callback2_exn
caml_callback2_exn:
/* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */
mov r10, r0
mov r0, r1 /* r0 = first arg */
mov r1, r2 /* r1 = second arg */
mov r2, r10 /* r2 = closure environment */
ldr r10, .Lcaml_apply2
b .Ljump_to_caml
.global caml_callback3_exn
caml_callback3_exn:
/* Initial shuffling of arguments */
/* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */
mov r10, r0
mov r0, r1 /* r0 = first arg */
mov r1, r2 /* r1 = second arg */
mov r2, r3 /* r2 = third arg */
mov r3, r10 /* r3 = closure environment */
ldr r10, .Lcaml_apply3
b .Ljump_to_caml
.global caml_ml_array_bound_error
caml_ml_array_bound_error:
/* Load address of [caml_array_bound_error] in r10 */
ldr r10, .Lcaml_array_bound_error
/* Call that function */
b caml_c_call
/* Global references */
.Lcaml_last_return_address: .word caml_last_return_address
.Lcaml_bottom_of_stack: .word caml_bottom_of_stack
.Lcaml_gc_regs: .word caml_gc_regs
.Lcaml_young_ptr: .word caml_young_ptr
.Lcaml_young_limit: .word caml_young_limit
.Lcaml_exception_pointer: .word caml_exception_pointer
.Lcaml_program: .word caml_program
.LLtrap_handler: .word .Ltrap_handler
.Lcaml_apply2: .word caml_apply2
.Lcaml_apply3: .word caml_apply3
.Lcaml_requested_size: .word 0
.Lcaml_array_bound_error: .word caml_array_bound_error
/* GC roots for callback */
.data
.global caml_system__frametable
caml_system__frametable:
.word 1 /* one descriptor */
.word .Lcaml_retaddr /* return address into callback */
.short -1 /* negative frame size => use callback link */
.short 0 /* no roots */
.align 2
|
