Domain state support for msvc32
parent
a27d53f379
commit
d227d36304
|
@ -976,7 +976,6 @@ let begin_assembly() =
|
|||
if system = S_win32 then begin
|
||||
D.mode386 ();
|
||||
D.model "FLAT";
|
||||
D.extrn "_caml_exception_pointer" DWORD;
|
||||
D.extrn "_caml_extra_params" DWORD;
|
||||
D.extrn "_caml_call_gc" PROC;
|
||||
D.extrn "_caml_c_call" PROC;
|
||||
|
@ -986,6 +985,7 @@ let begin_assembly() =
|
|||
D.extrn "_caml_alloc3" PROC;
|
||||
D.extrn "_caml_ml_array_bound_error" PROC;
|
||||
D.extrn "_caml_raise_exn" PROC;
|
||||
D.extrn "_Caml_state" DWORD;
|
||||
end;
|
||||
|
||||
D.data ();
|
||||
|
|
|
@ -203,7 +203,7 @@ endif
|
|||
clean:
|
||||
rm -f $(PROGRAMS) *.$(O) *.$(A) *.$(SO) ld.conf
|
||||
rm -f primitives prims.c caml/opnames.h caml/jumptbl.h
|
||||
rm -f caml/version.h domain_state.inc
|
||||
rm -f caml/version.h domain_state*.inc
|
||||
|
||||
.PHONY: distclean
|
||||
distclean: clean
|
||||
|
@ -358,10 +358,16 @@ $(foreach object_type,$(subst %,,$(object_types)), \
|
|||
%_libasmrunpic.o: %.S
|
||||
$(ASPP) $(ASPPFLAGS) $(SHAREDLIB_CFLAGS) -o $@ $<
|
||||
|
||||
domain_state.inc: caml/domain_state.tbl gen_domain_state_inc.awk
|
||||
awk -f gen_domain_state_inc.awk $< > $@
|
||||
domain_state64.inc: caml/domain_state.tbl gen_domain_state64_inc.awk
|
||||
awk -f gen_domain_state64_inc.awk $< > $@
|
||||
|
||||
%.obj: %.asm domain_state.inc
|
||||
domain_state32.inc: caml/domain_state.tbl gen_domain_state32_inc.awk
|
||||
awk -f gen_domain_state32_inc.awk $< > $@
|
||||
|
||||
amd64nt.obj: amd64nt.asm domain_state64.inc
|
||||
$(ASM)$@ $(ASMFLAGS) $<
|
||||
|
||||
i386nt.obj: i386nt.asm domain_state32.inc
|
||||
$(ASM)$@ $(ASMFLAGS) $<
|
||||
|
||||
%_libasmrunpic.obj: %.asm
|
||||
|
|
|
@ -31,7 +31,7 @@ IFDEF WITH_SPACETIME
|
|||
EXTRN caml_spacetime_c_to_ocaml: NEAR
|
||||
ENDIF
|
||||
|
||||
INCLUDE domain_state.inc
|
||||
INCLUDE domain_state64.inc
|
||||
|
||||
.CODE
|
||||
|
||||
|
|
|
@ -263,6 +263,7 @@ LBL(103):
|
|||
FUNCTION(caml_c_call)
|
||||
CFI_STARTPROC
|
||||
/* Record lowest stack address and return address */
|
||||
/* ecx and edx are destroyed at C call. Use them as temp. */
|
||||
movl G(Caml_state), %ecx
|
||||
movl (%esp), %edx
|
||||
movl %edx, CAML_STATE(last_return_address, %ecx)
|
||||
|
@ -437,11 +438,11 @@ FUNCTION(caml_callback3_asm)
|
|||
pushl %edi; CFI_ADJUST(4)
|
||||
pushl %ebp; CFI_ADJUST(4)
|
||||
/* Initial loading of arguments */
|
||||
movl 24(%esp), %edx /* closure */
|
||||
movl 24(%esp), %edx /* arg4: closure */
|
||||
movl 28(%esp), %edi /* arguments array */
|
||||
movl 0(%edi), %eax /* arg1: first argument */
|
||||
movl 4(%edi), %ebx /* arg2: second argument */
|
||||
movl 8(%edi), %ecx /* third argument */
|
||||
movl 8(%edi), %ecx /* arg3: third argument */
|
||||
movl $ G(caml_apply3), %esi /* code pointer */
|
||||
jmp LBL(106)
|
||||
CFI_ENDPROC
|
||||
|
|
|
@ -23,31 +23,29 @@
|
|||
EXTERN _caml_apply3: PROC
|
||||
EXTERN _caml_program: PROC
|
||||
EXTERN _caml_array_bound_error: PROC
|
||||
EXTERN _caml_young_limit: DWORD
|
||||
EXTERN _caml_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
|
||||
EXTERN _caml_backtrace_pos: DWORD
|
||||
EXTERN _caml_backtrace_active: DWORD
|
||||
EXTERN _caml_stash_backtrace: PROC
|
||||
EXTERN _Caml_state: DWORD
|
||||
|
||||
; Allocation
|
||||
|
||||
.CODE
|
||||
PUBLIC _caml_call_gc
|
||||
PUBLIC _caml_alloc1
|
||||
PUBLIC _caml_alloc2
|
||||
PUBLIC _caml_alloc3
|
||||
PUBLIC _caml_allocN
|
||||
PUBLIC _caml_call_gc
|
||||
|
||||
INCLUDE domain_state32.inc
|
||||
|
||||
_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
|
||||
push ebx ; make a tmp reg
|
||||
mov ebx, _Caml_state
|
||||
mov eax, [esp+4]
|
||||
Store_last_return_address ebx, eax
|
||||
lea eax, [esp+8]
|
||||
Store_bottom_of_stack ebx, eax
|
||||
pop ebx
|
||||
; Save all regs used by the code generator
|
||||
L105: push ebp
|
||||
push edi
|
||||
|
@ -56,7 +54,8 @@ L105: push ebp
|
|||
push ecx
|
||||
push ebx
|
||||
push eax
|
||||
mov _caml_gc_regs, esp
|
||||
mov ebx, _Caml_state
|
||||
Store_gc_regs ebx, esp
|
||||
; Call the garbage collector
|
||||
call _caml_garbage_collection
|
||||
; Restore all regs used by the code generator
|
||||
|
@ -72,64 +71,80 @@ L105: push ebp
|
|||
|
||||
ALIGN 4
|
||||
_caml_alloc1:
|
||||
mov eax, _caml_young_ptr
|
||||
push ebx ; make a tmp reg
|
||||
mov ebx, _Caml_state
|
||||
Load_young_ptr ebx, eax
|
||||
sub eax, 8
|
||||
cmp eax, _caml_young_limit
|
||||
Cmp_young_limit ebx, eax
|
||||
jb L100
|
||||
mov _caml_young_ptr, eax
|
||||
Store_young_ptr ebx, eax
|
||||
pop ebx
|
||||
ret
|
||||
L100: mov eax, [esp]
|
||||
mov _caml_last_return_address, eax
|
||||
lea eax, [esp+4]
|
||||
mov _caml_bottom_of_stack, eax
|
||||
L100: mov eax, [esp + 4]
|
||||
Store_last_return_address ebx, eax
|
||||
lea eax, [esp+8]
|
||||
Store_bottom_of_stack ebx, eax
|
||||
pop ebx
|
||||
call L105
|
||||
jmp _caml_alloc1
|
||||
|
||||
ALIGN 4
|
||||
_caml_alloc2:
|
||||
mov eax, _caml_young_ptr
|
||||
push ebx ; make a tmp reg
|
||||
mov ebx, _Caml_state
|
||||
Load_young_ptr ebx, eax
|
||||
sub eax, 12
|
||||
cmp eax, _caml_young_limit
|
||||
Cmp_young_limit ebx, eax
|
||||
jb L101
|
||||
mov _caml_young_ptr, eax
|
||||
Store_young_ptr ebx, eax
|
||||
pop ebx
|
||||
ret
|
||||
L101: mov eax, [esp]
|
||||
mov _caml_last_return_address, eax
|
||||
lea eax, [esp+4]
|
||||
mov _caml_bottom_of_stack, eax
|
||||
L101: mov eax, [esp+4]
|
||||
Store_last_return_address ebx, eax
|
||||
lea eax, [esp+8]
|
||||
Store_bottom_of_stack ebx, eax
|
||||
pop ebx
|
||||
call L105
|
||||
jmp _caml_alloc2
|
||||
|
||||
ALIGN 4
|
||||
_caml_alloc3:
|
||||
mov eax, _caml_young_ptr
|
||||
push ebx ; make a tmp reg
|
||||
mov ebx, _Caml_state
|
||||
Load_young_ptr ebx, eax
|
||||
sub eax, 16
|
||||
cmp eax, _caml_young_limit
|
||||
Cmp_young_limit ebx, eax
|
||||
jb L102
|
||||
mov _caml_young_ptr, eax
|
||||
Store_young_ptr ebx, eax
|
||||
pop ebx
|
||||
ret
|
||||
L102: mov eax, [esp]
|
||||
mov _caml_last_return_address, eax
|
||||
lea eax, [esp+4]
|
||||
mov _caml_bottom_of_stack, eax
|
||||
L102: mov eax, [esp+4]
|
||||
Store_last_return_address ebx, eax
|
||||
lea eax, [esp+8]
|
||||
Store_bottom_of_stack ebx, eax
|
||||
pop ebx
|
||||
call L105
|
||||
jmp _caml_alloc3
|
||||
|
||||
|
||||
ALIGN 4
|
||||
_caml_allocN:
|
||||
sub eax, _caml_young_ptr ; eax = size - young_ptr
|
||||
neg eax ; eax = young_ptr - size
|
||||
cmp eax, _caml_young_limit
|
||||
push eax ; Save desired size
|
||||
push ebx ; Make a tmp reg
|
||||
mov ebx, _Caml_state
|
||||
Sub_young_ptr ebx, eax ; eax = size - young_ptr
|
||||
neg eax ; eax = young_ptr - size
|
||||
Cmp_young_limit ebx, eax
|
||||
jb L103
|
||||
mov _caml_young_ptr, eax
|
||||
Store_young_ptr ebx, eax
|
||||
pop ebx
|
||||
add esp, 4 ; drop desired size
|
||||
ret
|
||||
L103: sub eax, _caml_young_ptr ; eax = - size
|
||||
neg eax ; eax = size
|
||||
push eax ; save desired size
|
||||
mov eax, [esp+4]
|
||||
mov _caml_last_return_address, eax
|
||||
lea eax, [esp+8]
|
||||
mov _caml_bottom_of_stack, eax
|
||||
L103: mov eax, [esp+8]
|
||||
Store_last_return_address ebx, eax
|
||||
lea eax, [esp+12]
|
||||
Store_bottom_of_stack ebx, eax
|
||||
pop ebx
|
||||
call L105
|
||||
pop eax ; recover desired size
|
||||
jmp _caml_allocN
|
||||
|
@ -140,10 +155,12 @@ L103: sub eax, _caml_young_ptr ; eax = - size
|
|||
ALIGN 4
|
||||
_caml_c_call:
|
||||
; Record lowest stack address and return address
|
||||
; ecx and edx are destroyed at C call. Use them as temp.
|
||||
mov ecx, _Caml_state
|
||||
mov edx, [esp]
|
||||
mov _caml_last_return_address, edx
|
||||
Store_last_return_address ecx, edx
|
||||
lea edx, [esp+4]
|
||||
mov _caml_bottom_of_stack, edx
|
||||
Store_bottom_of_stack ecx, edx
|
||||
; Call the function (address in %eax)
|
||||
jmp eax
|
||||
|
||||
|
@ -163,26 +180,29 @@ _caml_start_program:
|
|||
; Code shared between caml_start_program and callback*
|
||||
|
||||
L106:
|
||||
mov edi, _Caml_state
|
||||
; Build a callback link
|
||||
push _caml_gc_regs
|
||||
push _caml_last_return_address
|
||||
push _caml_bottom_of_stack
|
||||
Push_gc_regs edi
|
||||
Push_last_return_address edi
|
||||
Push_bottom_of_stack edi
|
||||
; Build an exception handler
|
||||
push L108
|
||||
push _caml_exception_pointer
|
||||
mov _caml_exception_pointer, esp
|
||||
Push_exception_pointer edi
|
||||
Store_exception_pointer edi, esp
|
||||
; Call the OCaml code
|
||||
call esi
|
||||
L107:
|
||||
mov edi, _Caml_state
|
||||
; Pop the exception handler
|
||||
pop _caml_exception_pointer
|
||||
pop esi ; dummy register
|
||||
Pop_exception_pointer edi
|
||||
add esp, 4
|
||||
L109:
|
||||
mov edi, _Caml_state
|
||||
; 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
|
||||
Pop_bottom_of_stack edi
|
||||
Pop_last_return_address edi
|
||||
Pop_gc_regs edi
|
||||
; Restore callee-save registers.
|
||||
pop ebp
|
||||
pop edi
|
||||
|
@ -201,16 +221,18 @@ L108:
|
|||
PUBLIC _caml_raise_exn
|
||||
ALIGN 4
|
||||
_caml_raise_exn:
|
||||
test _caml_backtrace_active, 1
|
||||
mov ebx, _Caml_state
|
||||
Load_backtrace_active ebx, ecx
|
||||
test ecx, 1
|
||||
jne L110
|
||||
mov esp, _caml_exception_pointer
|
||||
pop _caml_exception_pointer
|
||||
Load_exception_pointer ebx, esp
|
||||
Pop_exception_pointer ebx
|
||||
ret
|
||||
L110:
|
||||
mov esi, eax ; Save exception bucket in esi
|
||||
mov edi, _caml_exception_pointer ; SP of handler
|
||||
Load_exception_pointer ebx, edi ; SP of handler
|
||||
mov eax, [esp] ; PC of raise
|
||||
lea edx, [esp+4]
|
||||
lea edx, [esp+4] ; SP of raise
|
||||
push edi ; arg 4: SP of handler
|
||||
push edx ; arg 3: SP of raise
|
||||
push eax ; arg 2: PC of raise
|
||||
|
@ -218,7 +240,7 @@ L110:
|
|||
call _caml_stash_backtrace
|
||||
mov eax, esi ; recover exception bucket
|
||||
mov esp, edi ; cut the stack
|
||||
pop _caml_exception_pointer
|
||||
Pop_exception_pointer ebx
|
||||
ret
|
||||
|
||||
; Raise an exception from C
|
||||
|
@ -226,68 +248,73 @@ L110:
|
|||
PUBLIC _caml_raise_exception
|
||||
ALIGN 4
|
||||
_caml_raise_exception:
|
||||
test _caml_backtrace_active, 1
|
||||
mov ebx, _Caml_state
|
||||
Load_backtrace_active ebx, ecx
|
||||
test ecx, 1
|
||||
jne L112
|
||||
mov eax, [esp+4]
|
||||
mov esp, _caml_exception_pointer
|
||||
pop _caml_exception_pointer
|
||||
mov eax, [esp+8]
|
||||
Load_exception_pointer ebx, esp
|
||||
Pop_exception_pointer ebx
|
||||
ret
|
||||
L112:
|
||||
mov esi, [esp+4] ; Save exception bucket in esi
|
||||
push _caml_exception_pointer ; arg 4: SP of handler
|
||||
push _caml_bottom_of_stack ; arg 3: SP of raise
|
||||
push _caml_last_return_address ; arg 2: PC of raise
|
||||
mov esi, [esp+8] ; Save exception bucket in esi
|
||||
Push_exception_pointer ebx ; arg 4: SP of handler
|
||||
Push_bottom_of_stack ebx ; arg 3: SP of raise
|
||||
Push_last_return_address ebx ; arg 2: PC of raise
|
||||
push esi ; arg 1: exception bucket
|
||||
call _caml_stash_backtrace
|
||||
mov eax, esi ; recover exception bucket
|
||||
mov esp, _caml_exception_pointer ; cut the stack
|
||||
pop _caml_exception_pointer
|
||||
Load_exception_pointer ebx, esp ; cut the stack
|
||||
Pop_exception_pointer ebx
|
||||
ret
|
||||
|
||||
; Callback from C to OCaml
|
||||
|
||||
PUBLIC _caml_callback_exn
|
||||
PUBLIC _caml_callback_asm
|
||||
ALIGN 4
|
||||
_caml_callback_exn:
|
||||
_caml_callback_asm:
|
||||
; 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 ebx, [esp+24] ; arg2: closure
|
||||
mov edi, [esp+28] ; arguments array
|
||||
mov eax, [edi] ; arg1: argument
|
||||
mov esi, [ebx] ; code pointer
|
||||
jmp L106
|
||||
|
||||
PUBLIC _caml_callback2_exn
|
||||
PUBLIC _caml_callback2_asm
|
||||
ALIGN 4
|
||||
_caml_callback2_exn:
|
||||
_caml_callback2_asm:
|
||||
; 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 ecx, [esp+24] ; arg3: closure
|
||||
mov edi, [esp+28] ; arguments array
|
||||
mov eax, [edi] ; arg1: first argument
|
||||
mov ebx, [edi+4] ; arg2: second argument
|
||||
mov esi, offset _caml_apply2 ; code pointer
|
||||
jmp L106
|
||||
|
||||
PUBLIC _caml_callback3_exn
|
||||
PUBLIC _caml_callback3_asm
|
||||
ALIGN 4
|
||||
_caml_callback3_exn:
|
||||
_caml_callback3_asm:
|
||||
; 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 edx, [esp+24] ; arg4: closure
|
||||
mov edi, [esp+28] ; arguments array
|
||||
mov eax, [edi] ; arg1: first argument
|
||||
mov ebx, [edi+4] ; arg2: second argument
|
||||
mov ecx, [edi+8] ; arg3: third argument
|
||||
mov esi, offset _caml_apply3 ; code pointer
|
||||
jmp L106
|
||||
|
||||
|
|
Loading…
Reference in New Issue