Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Domain state support for i386

master
KC Sivaramakrishnan 2019-06-15 09:11:51 +05:30
parent 4dab86ad54
commit fdd4d73b43
5 changed files with 158 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
asmcomp/i386/emit.mlp
View File

@ -137,6 +137,12 @@ let register_name r =
let sym32 ?ofs s = mem_sym ?ofs DWORD (emit_symbol s)
let domain_field f r =
mem32 DWORD (Domainstate.idx_of_field f * 8) r
let load_domain_state r =
I.mov (sym32 "Caml_state") r
let reg = function
| { loc = Reg r } -> register_name r
| { loc = Stack(Incoming n | Outgoing n) } when n < 0 ->
@ -609,13 +615,14 @@ let emit_instr fallthrough i =
if !fastcode_flag then begin
let lbl_redo = new_label() in
def_label lbl_redo;
I.mov (sym32 "caml_young_ptr") eax;
load_domain_state ebx;
I.mov (domain_field Domain_young_ptr RBX) eax;
I.sub (int n) eax;
I.cmp (sym32 "caml_young_limit") eax;
I.cmp (domain_field Domain_young_limit RBX) eax;
let lbl_call_gc = new_label() in
let lbl_frame = record_frame_label i.live false Debuginfo.none in
I.jb (label lbl_call_gc);
I.mov eax (sym32 "caml_young_ptr");
I.mov eax (domain_field Domain_young_ptr RBX);
I.lea (mem32 NONE 4 RAX) (reg i.res.(0));
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
@ -865,23 +872,39 @@ let emit_instr fallthrough i =
I.push (label lbl_handler);
if trap_frame_size > 8 then
I.sub (int (trap_frame_size - 8)) esp;
I.push (sym32 "caml_exception_pointer");
load_domain_state edx;
I.push (domain_field Domain_exception_pointer RDX);
cfi_adjust_cfa_offset trap_frame_size;
I.mov esp (sym32 "caml_exception_pointer");
I.mov esp (domain_field Domain_exception_pointer RDX);
I.mov (int 23) edx;
stack_offset := !stack_offset + trap_frame_size
| Lpoptrap ->
I.pop (sym32 "caml_exception_pointer");
I.add (int (trap_frame_size - 4)) esp;
I.push ecx;
I.push edx;
I.mov (mem32 DWORD 8 RSP) ecx;
load_domain_state edx;
I.mov ecx (domain_field Domain_exception_pointer RDX);
I.pop edx;
I.pop ecx;
I.add (int trap_frame_size) esp;
cfi_adjust_cfa_offset (-trap_frame_size);
stack_offset := !stack_offset - trap_frame_size
| Lraise k ->
begin match k with
| Cmm.Raise_withtrace ->
| Lambda.Raise_regular ->
load_domain_state ebx;
I.mov (int 0) (domain_field Domain_backtrace_pos RBX);
I.mov (int 43) ebx;
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg
| Cmm.Raise_notrace ->
I.mov (sym32 "caml_exception_pointer") esp;
I.pop (sym32 "caml_exception_pointer");
| Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg
| Lambda.Raise_notrace ->
load_domain_state ebx;
I.mov (domain_field Domain_exception_pointer RBX) esp;
I.pop (domain_field Domain_exception_pointer RBX);
I.mov (int 59) ebx;
if trap_frame_size > 8 then
I.add (int (trap_frame_size - 8)) esp;
I.pop ebx;
@ -958,8 +981,6 @@ let begin_assembly() =
if system = S_win32 then begin
D.mode386 ();
D.model "FLAT";
D.extrn "_caml_young_ptr" DWORD;
D.extrn "_caml_young_limit" DWORD;
D.extrn "_caml_exception_pointer" DWORD;
D.extrn "_caml_extra_params" DWORD;
D.extrn "_caml_call_gc" PROC;

5
asmcomp/i386/proc.ml
View File

@ -88,6 +88,7 @@ let phys_reg n =
if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
let eax = phys_reg 0
let ebx = phys_reg 1
let ecx = phys_reg 2
let edx = phys_reg 3
@ -204,10 +205,12 @@ let destroyed_at_oper = function
all_phys_regs
| Iop(Iextcall { alloc = false; }) -> destroyed_at_c_call
| Iop(Iintop(Idiv | Imod)) -> [| eax; edx |]
| Iop(Ialloc _ | Iintop Imulh) -> [| eax |]
| Iop(Ialloc _) -> [| eax; ebx |]
| Iop(Iintop Imulh) -> [| eax |]
| Iop(Iintop(Icomp _) | Iintop_imm(Icomp _, _)) -> [| eax |]
| Iop(Iintoffloat) -> [| eax |]
| Iifthenelse(Ifloattest _, _, _) -> [| eax |]
| Itrywith _ -> [| edx |]
| _ -> [||]
let destroyed_at_raise = all_phys_regs

2
runtime/caml/domain_state.h
View File

@ -42,4 +42,6 @@ CAML_STATIC_ASSERT(
(Domain_state_num_fields
) * 8);
CAMLextern caml_domain_state* Caml_state;
#endif /* CAML_STATE_H */

193
runtime/i386.S
View File

@ -82,6 +82,18 @@
#define STACK_PROBE_SIZE 16384
#endif
#define CAML_CONFIG_H_NO_TYPEDEFS
#include "../runtime/caml/config.h"
.set domain_curr_field, 0
#define DOMAIN_STATE(c_type, name) \
.equ domain_field_caml_##name, domain_curr_field ; \
.set domain_curr_field, domain_curr_field + 1
#include "../runtime/caml/domain_state.tbl"
#undef DOMAIN_STATE
#define CAML_STATE(var,reg) 8*domain_field_caml_##var(reg)
/* PR#6038: GCC and Clang seem to require 16-byte alignment nowadays,
even if only MacOS X's ABI formally requires it. */
#define ALIGN_STACK(amount) subl $ amount, %esp ; CFI_ADJUST(amount)
@ -105,10 +117,13 @@ G(caml_system__code_begin):
FUNCTION(caml_call_gc)
CFI_STARTPROC
/* Record lowest stack address and return address */
movl 0(%esp), %eax
movl %eax, G(caml_last_return_address)
leal 4(%esp), %eax
movl %eax, G(caml_bottom_of_stack)
pushl %ebx; CFI_ADJUST(4)
movl G(Caml_state), %ebx
movl 4(%esp), %eax
movl %eax, CAML_STATE(last_return_address, %ebx)
leal 8(%esp), %eax
movl %eax, CAML_STATE(bottom_of_stack, %ebx)
popl %ebx; CFI_ADJUST(-4)
LBL(105):
#if !defined(SYS_mingw) && !defined(SYS_cygwin)
/* Touch the stack to trigger a recoverable segfault
@ -125,7 +140,8 @@ LBL(105):
pushl %ecx; CFI_ADJUST(4)
pushl %ebx; CFI_ADJUST(4)
pushl %eax; CFI_ADJUST(4)
movl %esp, G(caml_gc_regs)
movl G(Caml_state), %ebx
movl %esp, CAML_STATE(gc_regs, %ebx)
/* MacOSX note: 16-alignment of stack preserved at this point */
/* Call the garbage collector */
call G(caml_garbage_collection)
@ -144,17 +160,21 @@ LBL(105):
FUNCTION(caml_alloc1)
CFI_STARTPROC
movl G(caml_young_ptr), %eax
pushl %ebx; CFI_ADJUST(4)
movl G(Caml_state), %ebx
movl CAML_STATE(young_ptr, %ebx), %eax
subl $8, %eax
cmpl G(caml_young_limit), %eax
cmpl CAML_STATE(young_limit, %ebx), %eax
jb LBL(100)
movl %eax, G(caml_young_ptr)
movl %eax, CAML_STATE(young_ptr, %ebx)
popl %ebx; CFI_ADJUST(-4)
ret
LBL(100):
movl 0(%esp), %eax
movl %eax, G(caml_last_return_address)
leal 4(%esp), %eax
movl %eax, G(caml_bottom_of_stack)
movl 4(%esp), %eax
movl %eax, CAML_STATE(last_return_address, %ebx)
leal 8(%esp), %eax
movl %eax, CAML_STATE(bottom_of_stack, %ebx)
popl %ebx; CFI_ADJUST(-4)
ALIGN_STACK(12)
call LBL(105)
UNDO_ALIGN_STACK(12)
@ -164,17 +184,21 @@ LBL(100):
FUNCTION(caml_alloc2)
CFI_STARTPROC
movl G(caml_young_ptr), %eax
pushl %ebx; CFI_ADJUST(4)
movl G(Caml_state), %ebx
movl CAML_STATE(young_ptr, %ebx), %eax
subl $12, %eax
cmpl G(caml_young_limit), %eax
cmpl CAML_STATE(young_limit, %ebx), %eax
jb LBL(101)
movl %eax, G(caml_young_ptr)
movl %eax, CAML_STATE(young_ptr, %ebx)
popl %ebx; CFI_ADJUST(-4)
ret
LBL(101):
movl 0(%esp), %eax
movl %eax, G(caml_last_return_address)
leal 4(%esp), %eax
movl %eax, G(caml_bottom_of_stack)
movl 4(%esp), %eax
movl %eax, CAML_STATE(last_return_address, %ebx)
leal 8(%esp), %eax
movl %eax, CAML_STATE(bottom_of_stack, %ebx)
popl %ebx; CFI_ADJUST(-4)
ALIGN_STACK(12)
call LBL(105)
UNDO_ALIGN_STACK(12)
@ -184,17 +208,21 @@ LBL(101):
FUNCTION(caml_alloc3)
CFI_STARTPROC
movl G(caml_young_ptr), %eax
pushl %ebx; CFI_ADJUST(4)
movl G(Caml_state), %ebx
movl CAML_STATE(young_ptr, %ebx), %eax
subl $16, %eax
cmpl G(caml_young_limit), %eax
cmpl CAML_STATE(young_limit, %ebx), %eax
jb LBL(102)
movl %eax, G(caml_young_ptr)
movl %eax, CAML_STATE(young_ptr, %ebx)
popl %ebx; CFI_ADJUST(-4)
ret
LBL(102):
movl 0(%esp), %eax
movl %eax, G(caml_last_return_address)
leal 4(%esp), %eax
movl %eax, G(caml_bottom_of_stack)
movl 4(%esp), %eax
movl %eax, CAML_STATE(last_return_address, %ebx)
leal 8(%esp), %eax
movl %eax, CAML_STATE(bottom_of_stack, %ebx)
popl %ebx; CFI_ADJUST(-4)
ALIGN_STACK(12)
call LBL(105)
UNDO_ALIGN_STACK(12)
@ -204,20 +232,23 @@ LBL(102):
FUNCTION(caml_allocN)
CFI_STARTPROC
subl G(caml_young_ptr), %eax /* eax = size - caml_young_ptr */
pushl %eax; CFI_ADJUST(4) /* saved desired size */
pushl %ebx; CFI_ADJUST(4)
movl G(Caml_state), %ebx
subl CAML_STATE(young_ptr, %ebx), %eax /* eax = size - caml_young_ptr */
negl %eax /* eax = caml_young_ptr - size */
cmpl G(caml_young_limit), %eax
cmpl CAML_STATE(young_limit, %ebx), %eax
jb LBL(103)
movl %eax, G(caml_young_ptr)
movl %eax, CAML_STATE(young_ptr, %ebx)
popl %ebx; CFI_ADJUST(-4)
addl $4, %esp; CFI_ADJUST(-4) /* drop desired size */
ret
LBL(103):
subl G(caml_young_ptr), %eax /* eax = - size */
negl %eax /* eax = size */
pushl %eax; CFI_ADJUST(4) /* save desired size */
movl 4(%esp), %eax
movl %eax, G(caml_last_return_address)
leal 8(%esp), %eax
movl %eax, G(caml_bottom_of_stack)
movl 8(%esp), %eax
movl %eax, CAML_STATE(last_return_address, %ebx)
leal 12(%esp), %eax
movl %eax, CAML_STATE(bottom_of_stack, %ebx)
popl %ebx; CFI_ADJUST(-4)
ALIGN_STACK(8)
call LBL(105)
UNDO_ALIGN_STACK(8)
@ -231,10 +262,11 @@ LBL(103):
FUNCTION(caml_c_call)
CFI_STARTPROC
/* Record lowest stack address and return address */
movl G(Caml_state), %ecx
movl (%esp), %edx
movl %edx, G(caml_last_return_address)
movl %edx, CAML_STATE(last_return_address, %ecx)
leal 4(%esp), %edx
movl %edx, G(caml_bottom_of_stack)
movl %edx, CAML_STATE(bottom_of_stack, %ecx)
#if !defined(SYS_mingw) && !defined(SYS_cygwin)
/* Touch the stack to trigger a recoverable segfault
if insufficient space remains */
@ -260,27 +292,30 @@ FUNCTION(caml_start_program)
movl $ G(caml_program), %esi
/* Common code for caml_start_program and caml_callback* */
LBL(106):
movl G(Caml_state), %edi
/* Build a callback link */
pushl G(caml_gc_regs); CFI_ADJUST(4)
pushl G(caml_last_return_address); CFI_ADJUST(4)
pushl G(caml_bottom_of_stack); CFI_ADJUST(4)
pushl CAML_STATE(gc_regs, %edi); CFI_ADJUST(4)
pushl CAML_STATE(last_return_address, %edi); CFI_ADJUST(4)
pushl CAML_STATE(bottom_of_stack, %edi); CFI_ADJUST(4)
/* Note: 16-alignment preserved on MacOSX at this point */
/* Build an exception handler */
pushl $ LBL(108); CFI_ADJUST(4)
ALIGN_STACK(8)
pushl G(caml_exception_pointer); CFI_ADJUST(4)
movl %esp, G(caml_exception_pointer)
pushl CAML_STATE(exception_pointer, %edi); CFI_ADJUST(4)
movl %esp, CAML_STATE(exception_pointer, %edi)
/* Call the OCaml code */
call *%esi
LBL(107):
movl G(Caml_state), %edi
/* Pop the exception handler */
popl G(caml_exception_pointer); CFI_ADJUST(-4)
popl CAML_STATE(exception_pointer, %edi); CFI_ADJUST(-4)
addl $12, %esp ; CFI_ADJUST(-12)
LBL(109):
movl G(Caml_state), %edi /* Reload for LBL(109) entry */
/* Pop the callback link, restoring the global variables */
popl G(caml_bottom_of_stack); CFI_ADJUST(-4)
popl G(caml_last_return_address); CFI_ADJUST(-4)
popl G(caml_gc_regs); CFI_ADJUST(-4)
popl CAML_STATE(bottom_of_stack, %edi); CFI_ADJUST(-4)
popl CAML_STATE(last_return_address, %edi); CFI_ADJUST(-4)
popl CAML_STATE(gc_regs, %edi); CFI_ADJUST(-4)
/* Restore callee-save registers. */
popl %ebp; CFI_ADJUST(-4)
popl %edi; CFI_ADJUST(-4)
@ -300,15 +335,16 @@ LBL(108):
FUNCTION(caml_raise_exn)
CFI_STARTPROC
testl $1, G(caml_backtrace_active)
movl G(Caml_state), %ebx
testl $1, CAML_STATE(backtrace_active, %ebx)
jne LBL(110)
movl G(caml_exception_pointer), %esp
popl G(caml_exception_pointer); CFI_ADJUST(-4)
movl CAML_STATE(exception_pointer, %ebx), %esp
popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
UNDO_ALIGN_STACK(8)
ret
LBL(110):
movl %eax, %esi /* Save exception bucket in esi */
movl G(caml_exception_pointer), %edi /* SP of handler */
movl CAML_STATE(exception_pointer, %ebx), %edi /* SP of handler */
movl 0(%esp), %eax /* PC of raise */
leal 4(%esp), %edx /* SP of raise */
ALIGN_STACK(12)
@ -319,7 +355,7 @@ LBL(110):
call G(caml_stash_backtrace)
movl %esi, %eax /* Recover exception bucket */
movl %edi, %esp
popl G(caml_exception_pointer); CFI_ADJUST(-4)
popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
UNDO_ALIGN_STACK(8)
ret
CFI_ENDPROC
@ -329,24 +365,25 @@ LBL(110):
FUNCTION(caml_raise_exception)
CFI_STARTPROC
testl $1, G(caml_backtrace_active)
movl G(Caml_state), %ebx
testl $1, CAML_STATE(backtrace_active, %ebx)
jne LBL(112)
movl 4(%esp), %eax
movl G(caml_exception_pointer), %esp
popl G(caml_exception_pointer); CFI_ADJUST(-4)
movl 8(%esp), %eax
movl CAML_STATE(exception_pointer, %ebx), %esp
popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
UNDO_ALIGN_STACK(8)
ret
LBL(112):
movl 4(%esp), %esi /* Save exception bucket in esi */
movl 8(%esp), %esi /* Save exception bucket in esi */
ALIGN_STACK(12)
pushl G(caml_exception_pointer); CFI_ADJUST(4) /* 4: sp of handler */
pushl G(caml_bottom_of_stack); CFI_ADJUST(4) /* 3: sp of raise */
pushl G(caml_last_return_address); CFI_ADJUST(4)/* 2: pc of raise */
pushl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(4) /* 4: sp of handler */
pushl CAML_STATE(bottom_of_stack, %ebx); CFI_ADJUST(4) /* 3: sp of raise */
pushl CAML_STATE(last_return_address, %ebx); CFI_ADJUST(4)/* 2: pc of raise */
pushl %esi; CFI_ADJUST(4) /* 1: exception bucket */
call G(caml_stash_backtrace)
movl %esi, %eax /* Recover exception bucket */
movl G(caml_exception_pointer), %esp
popl G(caml_exception_pointer); CFI_ADJUST(-4)
movl CAML_STATE(exception_pointer, %ebx), %esp
popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4)
UNDO_ALIGN_STACK(8)
ret
CFI_ENDPROC
@ -354,7 +391,7 @@ LBL(112):
/* Callback from C to OCaml */
FUNCTION(caml_callback_exn)
FUNCTION(caml_callback_asm)
CFI_STARTPROC
/* Save callee-save registers */
pushl %ebx; CFI_ADJUST(4)
@ -362,14 +399,15 @@ FUNCTION(caml_callback_exn)
pushl %edi; CFI_ADJUST(4)
pushl %ebp; CFI_ADJUST(4)
/* Initial loading of arguments */
movl 20(%esp), %ebx /* closure */
movl 24(%esp), %eax /* argument */
movl 24(%esp), %ebx /* arg2: closure */
movl 28(%esp), %edi /* arguments array */
movl 0(%edi), %eax /* arg1: argument */
movl 0(%ebx), %esi /* code pointer */
jmp LBL(106)
CFI_ENDPROC
ENDFUNCTION(caml_callback_exn)
FUNCTION(caml_callback2_exn)
FUNCTION(caml_callback2_asm)
CFI_STARTPROC
/* Save callee-save registers */
pushl %ebx; CFI_ADJUST(4)
@ -377,15 +415,16 @@ FUNCTION(caml_callback2_exn)
pushl %edi; CFI_ADJUST(4)
pushl %ebp; CFI_ADJUST(4)
/* Initial loading of arguments */
movl 20(%esp), %ecx /* closure */
movl 24(%esp), %eax /* first argument */
movl 28(%esp), %ebx /* second argument */
movl 24(%esp), %ecx /* arg3: closure */
movl 28(%esp), %edi /* arguments array */
movl 0(%edi), %eax /* arg1: first argument */
movl 4(%edi), %ebx /* arg2: second argument */
movl $ G(caml_apply2), %esi /* code pointer */
jmp LBL(106)
CFI_ENDPROC
ENDFUNCTION(caml_callback2_exn)
FUNCTION(caml_callback3_exn)
FUNCTION(caml_callback3_asm)
CFI_STARTPROC
/* Save callee-save registers */
pushl %ebx; CFI_ADJUST(4)
@ -393,10 +432,11 @@ FUNCTION(caml_callback3_exn)
pushl %edi; CFI_ADJUST(4)
pushl %ebp; CFI_ADJUST(4)
/* Initial loading of arguments */
movl 20(%esp), %edx /* closure */
movl 24(%esp), %eax /* first argument */
movl 28(%esp), %ebx /* second argument */
movl 32(%esp), %ecx /* third argument */
movl 24(%esp), %edx /* 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 $ G(caml_apply3), %esi /* code pointer */
jmp LBL(106)
CFI_ENDPROC
@ -414,10 +454,11 @@ FUNCTION(caml_ml_array_bound_error)
ffree %st(6)
ffree %st(7)
/* Record lowest stack address and return address */
movl G(Caml_state), %ebx
movl (%esp), %edx
movl %edx, G(caml_last_return_address)
movl %edx, CAML_STATE(last_return_address, %ebx)
leal 4(%esp), %edx
movl %edx, G(caml_bottom_of_stack)
movl %edx, CAML_STATE(bottom_of_stack, %ebx)
/* Re-align the stack */
andl $-16, %esp
/* Branch to [caml_array_bound_error] (never returns) */

4
testsuite/tools/asmgen_i386.S
View File

@ -49,9 +49,7 @@ G(call_gen_code):
G(caml_c_call):
jmp *%eax
.comm G(caml_exception_pointer), 4
.comm G(young_ptr), 4
.comm G(young_start), 4
.comm G(Caml_state), 4
/* Some tests are designed to cause registers to spill; on
* x86 we require the caml_extra_params symbol from the RTS. */