diff --git a/runtime/i386nt.asm b/runtime/i386nt.asm index 548aa9dcb..52cd2109d 100644 --- a/runtime/i386nt.asm +++ b/runtime/i386nt.asm @@ -26,9 +26,14 @@ EXTERN _caml_stash_backtrace: PROC EXTERN _Caml_state: DWORD + .CODE + + PUBLIC _caml_system__code_begin +_caml_system__code_begin: + ret ; just one instruction, so that debuggers don't display + ; caml_system__code_begin instead of caml_call_gc ; Allocation - .CODE PUBLIC _caml_call_gc PUBLIC _caml_alloc1 PUBLIC _caml_alloc2 @@ -292,6 +297,9 @@ _caml_ml_array_bound_error: mov eax, offset _caml_array_bound_error jmp _caml_c_call + PUBLIC _caml_system__code_end +_caml_system__code_end: + .DATA PUBLIC _caml_system__frametable _caml_system__frametable LABEL DWORD diff --git a/runtime/signals_nat.c b/runtime/signals_nat.c index f17efade3..9ee2b2647 100644 --- a/runtime/signals_nat.c +++ b/runtime/signals_nat.c @@ -26,6 +26,7 @@ #include #include #include +#include "caml/codefrag.h" #include "caml/fail.h" #include "caml/memory.h" #include "caml/osdeps.h" @@ -49,18 +50,6 @@ extern signal_handler caml_win32_signal(int sig, signal_handler action); extern void caml_win32_overflow_detection(); #endif -extern char * caml_code_area_start, * caml_code_area_end; -extern char caml_system__code_begin, caml_system__code_end; - -/* Do not use the macro from address_class.h here. */ -#undef Is_in_code_area -#define Is_in_code_area(pc) \ - ( ((char *)(pc) >= caml_code_area_start && \ - (char *)(pc) <= caml_code_area_end) \ -|| ((char *)(pc) >= &caml_system__code_begin && \ - (char *)(pc) <= &caml_system__code_end) \ -|| (Classify_addr(pc) & In_code_area) ) - /* This routine is the common entry point for garbage collection and signal handling. It can trigger a callback to OCaml code. With system threads, this callback can cause a context switch. @@ -119,7 +108,7 @@ DECLARE_SIGNAL_HANDLER(handle_signal) Use the signal context to modify that register too, but only if we are inside OCaml code (not inside C code). */ #if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT) - if (Is_in_code_area(CONTEXT_PC)) + if (caml_find_code_fragment_by_pc((char *) CONTEXT_PC) != NULL) CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit; #endif } @@ -226,7 +215,7 @@ DECLARE_SIGNAL_HANDLER(segv_handler) && fault_addr < Caml_state->top_of_stack && (uintnat)fault_addr >= CONTEXT_SP - EXTRA_STACK #ifdef CONTEXT_PC - && Is_in_code_area(CONTEXT_PC) + && caml_find_code_fragment_by_pc((char *) CONTEXT_PC) != NULL #endif ) { #ifdef RETURN_AFTER_STACK_OVERFLOW diff --git a/runtime/startup_nat.c b/runtime/startup_nat.c index c0a200630..4e5926499 100644 --- a/runtime/startup_nat.c +++ b/runtime/startup_nat.c @@ -48,6 +48,7 @@ extern int caml_parser_trace; char * caml_code_area_start, * caml_code_area_end; +extern char caml_system__code_begin, caml_system__code_end; /* Initialize the atom table and the static data and code area limits. */ @@ -81,6 +82,10 @@ static void init_static(void) caml_register_code_fragment(caml_code_area_start, caml_code_area_end, DIGEST_LATER, NULL); + /* Also register the glue code written in assembly */ + caml_register_code_fragment(&caml_system__code_begin, + &caml_system__code_end, + DIGEST_IGNORE, NULL); } /* These are termination hooks used by the systhreads library */ diff --git a/runtime/win32.c b/runtime/win32.c index 9c5f7fc21..948d03c3d 100644 --- a/runtime/win32.c +++ b/runtime/win32.c @@ -38,7 +38,7 @@ #include #include #include "caml/alloc.h" -#include "caml/address_class.h" +#include "caml/codefrag.h" #include "caml/fail.h" #include "caml/io.h" #include "caml/memory.h" @@ -539,7 +539,8 @@ static LONG CALLBACK DWORD *ctx_ip = &(ctx->Eip); DWORD *ctx_sp = &(ctx->Esp); - if (code == EXCEPTION_STACK_OVERFLOW && Is_in_code_area (*ctx_ip)) + if (code == EXCEPTION_STACK_OVERFLOW && + caml_find_code_fragment_by_pc((char *) (*ctx_ip)) != NULL) { uintnat faulting_address; uintnat * alt_esp; @@ -561,24 +562,14 @@ static LONG CALLBACK #else -/* Do not use the macro from address_class.h here. */ -#undef Is_in_code_area -#define Is_in_code_area(pc) \ - ( ((char *)(pc) >= caml_code_area_start && \ - (char *)(pc) <= caml_code_area_end) \ -|| ((char *)(pc) >= &caml_system__code_begin && \ - (char *)(pc) <= &caml_system__code_end) \ -|| (Classify_addr(pc) & In_code_area) ) -extern char caml_system__code_begin, caml_system__code_end; - - static LONG CALLBACK caml_stack_overflow_VEH (EXCEPTION_POINTERS* exn_info) { DWORD code = exn_info->ExceptionRecord->ExceptionCode; CONTEXT *ctx = exn_info->ContextRecord; - if (code == EXCEPTION_STACK_OVERFLOW && Is_in_code_area (ctx->Rip)) + if (code == EXCEPTION_STACK_OVERFLOW && + caml_find_code_fragment_by_pc((char *) (ctx->Rip)) != NULL) { uintnat faulting_address; uintnat * alt_rsp;