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
|
;*********************************************************************
;
; 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$
; Asm part of the runtime system, Intel 386 processor, Intel syntax
.386
.MODEL FLAT
EXTERN _garbage_collection: PROC
EXTERN _mlraise: PROC
EXTERN _caml_apply2: PROC
EXTERN _caml_apply3: PROC
EXTERN _caml_program: PROC
EXTERN _array_bound_error: PROC
EXTERN _young_limit: DWORD
EXTERN _young_ptr: DWORD
EXTERN _caml_bottom_of_stack: DWORD
EXTERN _caml_last_return_address: DWORD
EXTERN _caml_gc_regs: DWORD
EXTERN _caml_exception_pointer: DWORD
; Allocation
.CODE
PUBLIC _caml_alloc1
PUBLIC _caml_alloc2
PUBLIC _caml_alloc3
PUBLIC _caml_alloc
PUBLIC _caml_call_gc
_caml_call_gc:
; Record lowest stack address and return address
mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
mov _caml_bottom_of_stack, eax
; Save all regs used by the code generator
L105: push ebp
push edi
push esi
push edx
push ecx
push ebx
push eax
mov _caml_gc_regs, esp
; Call the garbage collector
call _garbage_collection
; Restore all regs used by the code generator
pop eax
pop ebx
pop ecx
pop edx
pop esi
pop edi
pop ebp
; Return to caller
ret
ALIGN 4
_caml_alloc1:
mov eax, _young_ptr
sub eax, 8
mov _young_ptr, eax
cmp eax, _young_limit
jb L100
ret
L100: mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
mov _caml_bottom_of_stack, eax
call L105
jmp _caml_alloc1
ALIGN 4
_caml_alloc2:
mov eax, _young_ptr
sub eax, 12
mov _young_ptr, eax
cmp eax, _young_limit
jb L101
ret
L101: mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
mov _caml_bottom_of_stack, eax
call L105
jmp _caml_alloc2
ALIGN 4
_caml_alloc3:
mov eax, _young_ptr
sub eax, 16
mov _young_ptr, eax
cmp eax, _young_limit
jb L102
ret
L102: mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
mov _caml_bottom_of_stack, eax
call L105
jmp _caml_alloc3
ALIGN 4
_caml_alloc:
sub eax, _young_ptr ; eax = size - young_ptr
neg eax ; eax = young_ptr - size
cmp eax, _young_limit
jb L103
mov _young_ptr, eax
ret
L103: sub eax, _young_ptr ; eax = - size
neg eax ; eax = size
push eax ; save desired size
sub _young_ptr, eax ; must update young_ptr
mov eax, [esp+4]
mov _caml_last_return_address, eax
lea eax, [esp+8]
mov _caml_bottom_of_stack, eax
call L105
pop eax ; recover desired size
jmp _caml_alloc
; Call a C function from Caml
PUBLIC _caml_c_call
ALIGN 4
_caml_c_call:
; Record lowest stack address and return address
mov edx, [esp]
mov _caml_last_return_address, edx
lea edx, [esp+4]
mov _caml_bottom_of_stack, edx
; Call the function (address in %eax)
jmp eax
; Start the Caml program
PUBLIC _caml_start_program
ALIGN 4
_caml_start_program:
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial code pointer is caml_program
mov esi, offset _caml_program
; Code shared between caml_start_program and callback*
L106:
; Build a callback link
push _caml_gc_regs
push _caml_last_return_address
push _caml_bottom_of_stack
; Build an exception handler
push L108
push _caml_exception_pointer
mov _caml_exception_pointer, esp
; Call the Caml code
call esi
L107:
; Pop the exception handler
pop _caml_exception_pointer
pop esi ; dummy register
L109:
; Pop the callback link, restoring the global variables
; used by caml_c_call
pop _caml_bottom_of_stack
pop _caml_last_return_address
pop _caml_gc_regs
; Restore callee-save registers.
pop ebp
pop edi
pop esi
pop ebx
; Return to caller.
ret
L108:
; Exception handler
; Mark the bucket as an exception result and return it
or eax, 2
jmp L109
; Raise an exception from C
PUBLIC _raise_caml_exception
ALIGN 4
_raise_caml_exception:
mov eax, [esp+4]
mov esp, _caml_exception_pointer
pop _caml_exception_pointer
ret
; Callback from C to Caml
PUBLIC _callback_exn
ALIGN 4
_callback_exn:
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial loading of arguments
mov ebx, [esp+20] ; closure
mov eax, [esp+24] ; argument
mov esi, [ebx] ; code pointer
jmp L106
PUBLIC _callback2_exn
ALIGN 4
_callback2_exn:
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial loading of arguments
mov ecx, [esp+20] ; closure
mov eax, [esp+24] ; first argument
mov ebx, [esp+28] ; second argument
mov esi, offset _caml_apply2 ; code pointer
jmp L106
PUBLIC _callback3_exn
ALIGN 4
_callback3_exn:
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial loading of arguments
mov edx, [esp+20] ; closure
mov eax, [esp+24] ; first argument
mov ebx, [esp+28] ; second argument
mov ecx, [esp+32] ; third argument
mov esi, offset _caml_apply3 ; code pointer
jmp L106
PUBLIC _caml_array_bound_error
ALIGN 4
_caml_array_bound_error:
; Empty the floating-point stack
ffree st(0)
ffree st(1)
ffree st(2)
ffree st(3)
ffree st(4)
ffree st(5)
ffree st(6)
ffree st(7)
; Branch to array_bound_error
jmp _array_bound_error
.DATA
PUBLIC _system__frametable
_system__frametable LABEL DWORD
DWORD 1 ; one descriptor
DWORD L107 ; return address into callback
WORD -1 ; negative frame size => use callback link
WORD 0 ; no roots here
END
|
