mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 23:32:17 -08:00
Code Issues Projects Releases Packages Wiki Activity

When we are using an alternative stack for processing SIGSEGV, we cannot execute arbitrary lisp code there -- instead, jump to the outermost prompt.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-09-25 18:44:15 +02:00
parent c36eb22e73
commit 95f98db71c
3 changed files with 35 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/c/main.d
View file

@ -536,9 +536,6 @@ cl_boot(int argc, char **argv)
#endif
GC_enable();
/* Create tag to jump to when aborting */
ECL_SET(env, @'si::*quit-tag*', @'si::*quit-tag*');
/*
* Initialize default pathnames
*/

2
src/c/symbols_list2.h
View file

@ -1835,5 +1835,7 @@ cl_symbols[] = {
{EXT_ "WITH-LOCAL-INTERRUPTS",NULL},
{EXT_ "ALLOW-WITH-INTERRUPTS",NULL},
{SYS_ "*QUIT-TAG*",NULL},
/* Tag for end of list */
{NULL,NULL}};

39
src/c/unixint.d
View file

@ -246,7 +246,7 @@ interrupts_disabled_by_lisp(cl_env_ptr the_env)
}
static void
jump_to_sigsegv_handler(cl_env_ptr the_env)
jump_to_sigsegv_handler(cl_env_ptr the_env, const char *message)
{
/*
* Right now we have no means of specifying a jump point
@ -255,10 +255,18 @@ jump_to_sigsegv_handler(cl_env_ptr the_env)
* someone to intercept this jump.
*/
ecl_frame_ptr destination;
cl_object tag = SYM_VAL(@'si::*quit-tag*');
cl_object tag;
/*
* We output the error message with very low level routines
* because we can not risk another stack overflow.
*/
writestr_stream(message, cl_core.error_output);
tag = ECL_SYM_VAL(the_env, @'si::*quit-tag*');
the_env->nvalues = 0;
if (tag) {
destination = ecl_frs_sch(SYM_VAL(@'si::*quit-tag*'));
destination = frs_sch(tag);
if (destination) {
ecl_unwind(the_env, destination);
}
@ -524,6 +532,16 @@ handler_fn_protype(non_evil_signal_handler, int sig, siginfo_t *siginfo, void *d
static void
handler_fn_protype(sigsegv_handler, int sig, siginfo_t *info, void *aux)
{
static const char *stack_overflow_msg =
"\n;;;\n;;; Stack overflow.\n"
";;; Jumping to the outermost toplevel prompt\n"
";;;\n\n";
static const char *segv_msg =
"\n;;;\n"
";;; Detected access to protected memory, "
"also kwown as 'segmentation fault'.\n"
";;; Jumping to the outermost toplevel prompt\n"
";;;\n\n";
cl_env_ptr the_env;
reinstall_signal(sig, sigsegv_handler);
if (!ecl_get_option(ECL_OPT_BOOTED)) {
@ -536,18 +554,27 @@ handler_fn_protype(sigsegv_handler, int sig, siginfo_t *info, void *aux)
if ((char*)info->si_addr > the_env->cs_barrier &&
(char*)info->si_addr <= the_env->cs_org) {
unblock_signal(SIGSEGV);
jump_to_sigsegv_handler(the_env);
jump_to_sigsegv_handler(the_env, stack_overflow_msg);
return;
}
# else
if ((char*)info->si_addr < the_env->cs_barrier &&
(char*)info->si_addr >= the_env->cs_org) {
unblock_signal(SIGSEGV);
jump_to_sigsegv_handler(the_env);
jump_to_sigsegv_handler(the_env, stack_overflow_msg);
return;
}
# endif
# ifdef SA_ONSTACK
/* The handler is executed in an externally allocated stack, and
* thus it is not safe to execute lisp code here. We just bounce
* up to the outermost toplevel.
*/
unblock_signal(SIGSEGV);
jump_to_sigsegv_handler(the_env, segv_msg);
# else
handle_or_queue(@'ext::segmentation-violation', SIGSEGV);
# endif
#else
/*
* We cannot distinguish between a stack overflow and a simple
@ -555,7 +582,7 @@ handler_fn_protype(sigsegv_handler, int sig, siginfo_t *info, void *aux)
* the outermost handler.
*/
unblock_signal(SIGSEGV);
jump_to_sigsegv_handler(the_env);
jump_to_sigsegv_handler(the_env, segv_msg);
#endif
}