suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

increase stack safety margin for 64-bit platforms

Browse Source 
Make the stack-safety margin twice as big for 64-bit platforms
as 32-bit platforms. That was already done for Windows, but it's
also needed for Mac OS X. Also, double-check that there's a
good amount of space on the stack before calling a foreign
function.
This commit is contained in:
Matthew Flatt 2013-08-12 19:41:22 -06:00
parent d52ba1b5e7
commit b1e33773c6
7 changed files with 93 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
racket/src/foreign/foreign.c
View File

@ -99,7 +99,7 @@ static void overflow_error(const char *who, const char *op, intptr_t a, intptr_t
NULL);
}
intptr_t mult_check_overflow(const char *who, intptr_t a, intptr_t b)
static intptr_t mult_check_overflow(const char *who, intptr_t a, intptr_t b)
{
Scheme_Object *c;
c = scheme_bin_mult(scheme_make_integer(a), scheme_make_integer(b));
@ -108,7 +108,7 @@ intptr_t mult_check_overflow(const char *who, intptr_t a, intptr_t b)
return SCHEME_INT_VAL(c);
}
intptr_t add_check_overflow(const char *who, intptr_t a, intptr_t b)
static intptr_t add_check_overflow(const char *who, intptr_t a, intptr_t b)
{
Scheme_Object *c;
c = scheme_bin_plus(scheme_make_integer(a), scheme_make_integer(b));
@ -137,8 +137,8 @@ typedef BOOL (WINAPI *EnumProcessModules_t)(HANDLE hProcess,
EnumProcessModules_t _EnumProcessModules;
#include <tlhelp32.h>
BOOL mzEnumProcessModules(HANDLE hProcess, HMODULE* lphModule,
DWORD cb, LPDWORD lpcbNeeded)
static BOOL mzEnumProcessModules(HANDLE hProcess, HMODULE* lphModule,
DWORD cb, LPDWORD lpcbNeeded)
{
if (!epm_tried) {
HMODULE hm;
@ -603,7 +603,7 @@ static unsigned short *ucs4_string_or_null_to_utf16_pointer(Scheme_Object *ucs)
return ucs4_string_to_utf16_pointer(ucs);
}
Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
static Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
{
intptr_t ulen, end;
mzchar *res;
@ -1182,13 +1182,13 @@ static Scheme_Object *foreign_make_ctype(int argc, Scheme_Object *argv[])
#undef MYNAME
/* see below */
void free_libffi_type(void *ignored, void *p)
static void free_libffi_type(void *ignored, void *p)
{
free(((ffi_type*)p)->elements);
free(p);
}
void free_libffi_type_with_alignment(void *ignored, void *p)
static void free_libffi_type_with_alignment(void *ignored, void *p)
{
int i;
@ -1205,7 +1205,7 @@ static Scheme_Object *default_sym;
static Scheme_Object *stdcall_sym;
static Scheme_Object *sysv_sym;
ffi_abi sym_to_abi(char *who, Scheme_Object *sym)
static ffi_abi sym_to_abi(char *who, Scheme_Object *sym)
{
if (SCHEME_FALSEP(sym) || SAME_OBJ(sym, default_sym))
return FFI_DEFAULT_ABI;
@ -3272,7 +3272,7 @@ static void finish_ffi_call(ffi_cif *cif, void *c_func, intptr_t cfoff,
ffi_call(cif, (VoidFun)W_OFFSET(c_func, cfoff), p, avalues);
}
Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object *self)
static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object *self)
/* data := {name, c-function, itypes, otype, cif} */
{
Scheme_Object *data = SCHEME_PRIM_CLOSURE_ELS(self)[0];
@ -3394,6 +3394,34 @@ Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object *self)
return C2SCHEME(NULL, otype, p, 0, 1, 1);
}
static Scheme_Object *ffi_do_call_k()
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Object **argv, *self;
argv = (Scheme_Object **)p->ku.k.p1;
self = (Scheme_Object *)p->ku.k.p2;
p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL;
return ffi_do_call(p->ku.k.i1, argv, self);
}
static Scheme_Object *ffi_do_call_after_stack_check(int argc, Scheme_Object *argv[], Scheme_Object *self)
{
/* Make sure we have an extra-comfortable amount of space on the
stack before calling into foreign code: */
if (!scheme_no_stack_overflow && scheme_is_stack_too_shallow()) {
Scheme_Thread *p = scheme_current_thread;
p->ku.k.i1 = argc;
p->ku.k.p1 = argv;
p->ku.k.p2 = self;
return scheme_handle_stack_overflow(ffi_do_call_k);
} else
return ffi_do_call(argc, argv, self);
}
/* see below */
void free_fficall_data(void *data, void *p)
{
@ -3485,7 +3513,7 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
# endif /* MZ_USE_PLACES */
scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL);
a[0] = data;
return scheme_make_prim_closure_w_arity(ffi_do_call,
return scheme_make_prim_closure_w_arity(ffi_do_call_after_stack_check,
1, a,
SCHEME_BYTE_STR_VAL(name),
nargs, nargs);
@ -3516,7 +3544,7 @@ static ffi_callback_struct *extract_ffi_callback(void *userdata)
return data;
}
void ffi_do_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)
static void ffi_do_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)
{
ffi_callback_struct *data;
Scheme_Object *argv_stack[MAX_QUICK_ARGS];
@ -3661,7 +3689,7 @@ void scheme_check_foreign_work(void)
#endif
void ffi_queue_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)
static void ffi_queue_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)
XFORM_SKIP_PROC
{
#ifdef MZ_USE_MZRT
@ -3725,7 +3753,7 @@ typedef struct closure_and_cif_struct {
} closure_and_cif;
/* free the above */
void free_cl_cif_args(void *ignored, void *p)
static void free_cl_cif_args(void *ignored, void *p)
{
/*
scheme_warning("Releasing cl+cif+args %V %V (%d)",
@ -3740,7 +3768,7 @@ void free_cl_cif_args(void *ignored, void *p)
}
#ifdef MZ_USE_MZRT
void free_cl_cif_queue_args(void *ignored, void *p)
static void free_cl_cif_queue_args(void *ignored, void *p)
{
void *data = ((closure_and_cif*)p)->data, *constant_result;
void **q = (void **)data;

56
racket/src/foreign/foreign.rktc
View File

@ -102,7 +102,7 @@ static void overflow_error(const char *who, const char *op, intptr_t a, intptr_t
NULL);
}
intptr_t mult_check_overflow(const char *who, intptr_t a, intptr_t b)
static intptr_t mult_check_overflow(const char *who, intptr_t a, intptr_t b)
{
Scheme_Object *c;
c = scheme_bin_mult(scheme_make_integer(a), scheme_make_integer(b));
@ -111,7 +111,7 @@ intptr_t mult_check_overflow(const char *who, intptr_t a, intptr_t b)
return SCHEME_INT_VAL(c);
}
intptr_t add_check_overflow(const char *who, intptr_t a, intptr_t b)
static intptr_t add_check_overflow(const char *who, intptr_t a, intptr_t b)
{
Scheme_Object *c;
c = scheme_bin_plus(scheme_make_integer(a), scheme_make_integer(b));
@ -140,8 +140,8 @@ typedef BOOL (WINAPI *EnumProcessModules_t)(HANDLE hProcess,
EnumProcessModules_t _EnumProcessModules;
#include <tlhelp32.h>
BOOL mzEnumProcessModules(HANDLE hProcess, HMODULE* lphModule,
DWORD cb, LPDWORD lpcbNeeded)
static BOOL mzEnumProcessModules(HANDLE hProcess, HMODULE* lphModule,
DWORD cb, LPDWORD lpcbNeeded)
{
if (!epm_tried) {
HMODULE hm;
@ -520,7 +520,7 @@ static unsigned short *ucs4_string_or_null_to_utf16_pointer(Scheme_Object *ucs)
return ucs4_string_to_utf16_pointer(ucs);
}
Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
static Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
{
intptr_t ulen, end;
mzchar *res;
@ -1012,13 +1012,13 @@ XFORM_NONGCING static intptr_t ctype_sizeof(Scheme_Object *type)
}
/* see below */
void free_libffi_type(void *ignored, void *p)
static void free_libffi_type(void *ignored, void *p)
{
free(((ffi_type*)p)->elements);
free(p);
}
void free_libffi_type_with_alignment(void *ignored, void *p)
static void free_libffi_type_with_alignment(void *ignored, void *p)
{
int i;
@ -1033,7 +1033,7 @@ void free_libffi_type_with_alignment(void *ignored, void *p)
@defsymbols[default stdcall sysv]
ffi_abi sym_to_abi(char *who, Scheme_Object *sym)
static ffi_abi sym_to_abi(char *who, Scheme_Object *sym)
{
if (SCHEME_FALSEP(sym) || SAME_OBJ(sym, default_sym))
return FFI_DEFAULT_ABI;
@ -2479,7 +2479,7 @@ static void finish_ffi_call(ffi_cif *cif, void *c_func, intptr_t cfoff,
ffi_call(cif, (VoidFun)W_OFFSET(c_func, cfoff), p, avalues);
}
Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object *self)
static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object *self)
/* data := {name, c-function, itypes, otype, cif} */
{
Scheme_Object *data = SCHEME_PRIM_CLOSURE_ELS(self)[0];
@ -2601,6 +2601,34 @@ Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object *self)
return C2SCHEME(NULL, otype, p, 0, 1, 1);
}
static Scheme_Object *ffi_do_call_k()
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Object **argv, *self;
argv = (Scheme_Object **)p->ku.k.p1;
self = (Scheme_Object *)p->ku.k.p2;
p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL;
return ffi_do_call(p->ku.k.i1, argv, self);
}
static Scheme_Object *ffi_do_call_after_stack_check(int argc, Scheme_Object *argv[], Scheme_Object *self)
{
/* Make sure we have an extra-comfortable amount of space on the
stack before calling into foreign code: */
if (!scheme_no_stack_overflow && scheme_is_stack_too_shallow()) {
Scheme_Thread *p = scheme_current_thread;
p->ku.k.i1 = argc;
p->ku.k.p1 = argv;
p->ku.k.p2 = self;
return scheme_handle_stack_overflow(ffi_do_call_k);
} else
return ffi_do_call(argc, argv, self);
}
/* see below */
void free_fficall_data(void *data, void *p)
{
@ -2690,7 +2718,7 @@ static Scheme_Object *ffi_name = NULL;
}
scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL);
a[0] = data;
return scheme_make_prim_closure_w_arity(ffi_do_call,
return scheme_make_prim_closure_w_arity(ffi_do_call_after_stack_check,
1, a,
SCHEME_BYTE_STR_VAL(name),
nargs, nargs);
@ -2720,7 +2748,7 @@ static ffi_callback_struct *extract_ffi_callback(void *userdata)
return data;
}
void ffi_do_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)
static void ffi_do_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)
{
ffi_callback_struct *data;
Scheme_Object *argv_stack[MAX_QUICK_ARGS];
@ -2865,7 +2893,7 @@ void scheme_check_foreign_work(void)
#endif
void ffi_queue_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)
static void ffi_queue_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)
XFORM_SKIP_PROC
{
#ifdef MZ_USE_MZRT
@ -2929,7 +2957,7 @@ typedef struct closure_and_cif_struct {
} closure_and_cif;
/* free the above */
void free_cl_cif_args(void *ignored, void *p)
static void free_cl_cif_args(void *ignored, void *p)
{
/*
scheme_warning("Releasing cl+cif+args %V %V (%d)",
@ -2944,7 +2972,7 @@ void free_cl_cif_args(void *ignored, void *p)
}
#ifdef MZ_USE_MZRT
void free_cl_cif_queue_args(void *ignored, void *p)
static void free_cl_cif_queue_args(void *ignored, void *p)
{
void *data = ((closure_and_cif*)p)->data, *constant_result;
void **q = (void **)data;

6
racket/src/racket/sconfig.h
View File

@ -589,9 +589,6 @@
/* Default stack size is 1MB, but we try to read
the actual size from the executable on startup: */
# define WINDOWS_DEFAULT_STACK_SIZE 1048576
# ifdef _WIN64
# define STACK_SAFETY_MARGIN 100000
# endif
# ifndef _WIN64
# define USE_MZ_SETJMP
@ -1525,7 +1522,8 @@
/* STACK_SAFETY_MARGIN <X> sets the number of bytes that should be
available on the stack for "safety" to <X>. Used only if
DO_STACK_CHECK is used. STACK_SAFETY_MARGIN defaults to 50000. */
DO_STACK_CHECK is used. STACK_SAFETY_MARGIN defaults to 50000
for a 32-bit platform, twice as much for a 64-bit platform. */
/* UNIX_LIMIT_STACK <X> limits stack usage to <X> bytes. This may
be necessary to avoid GC-setup traversal over too much memory

6
racket/src/racket/src/schmach.h
View File

@ -46,5 +46,9 @@
#endif
#ifndef STACK_SAFETY_MARGIN
# define STACK_SAFETY_MARGIN 50000
# ifdef SIXTY_FOUR_BIT_INTEGERS
# define STACK_SAFETY_MARGIN 100000
# else
# define STACK_SAFETY_MARGIN 50000
# endif
#endif

1
racket/src/racket/src/schpriv.h
View File

@ -1493,6 +1493,7 @@ typedef struct Scheme_Object *(Scheme_Native_Proc)(void *d, int argc, struct Sch
/*========================================================================*/
Scheme_Object *scheme_handle_stack_overflow(Scheme_Object *(*k)(void));
int scheme_is_stack_too_shallow();
THREAD_LOCAL_DECL(extern struct Scheme_Overflow_Jmp *scheme_overflow_jmp);
THREAD_LOCAL_DECL(extern void *scheme_overflow_stack_start);

5
racket/src/racket/src/thread.c
View File

@ -3061,10 +3061,7 @@ void scheme_add_swap_out_callback(Scheme_Closure_Func f, Scheme_Object *data)
#ifdef DO_STACK_CHECK
# define THREAD_STACK_SPACE (STACK_SAFETY_MARGIN / 2)
int scheme_is_stack_too_shallow(void)
/* Make sure this function insn't inlined, mainly because
is_stack_too_shallow2() can get inlined, and it adds a lot
to the stack. */
int scheme_is_stack_too_shallow()
{
# define SCHEME_PLUS_STACK_DELTA(x) ((x) - THREAD_STACK_SPACE)
# include "mzstkchk.h"

1
racket/src/racket/uconfig.h
View File

@ -28,7 +28,6 @@
# define UNIX_FIND_STACK_BOUNDS
#endif
#define UNIX_STACK_MAXIMUM 8388608
#define STACK_SAFETY_MARGIN 50000
#define UNIX_DYNAMIC_LOAD