Verified Commit e086a5fa authored by Camil Staps's avatar Camil Staps 🚀

Add a stack of jmp_buf restore points for segfaults when hyperstrict interpretation is used

parent 659f4bfa
......@@ -18,7 +18,7 @@ defaultDeserializationSettings :: DeserializationSettings
= DV_ParseError
| DV_HeapFull
| DV_StackOverflow // unused for now; see TODO in interpret.c
| DV_StackOverflow
| DV_Halt
| DV_IllegalInstruction
| DV_HostHeapFull
......
......@@ -106,7 +106,7 @@ deserialize` strict dsets {graph,descinfo,modules,bytecode} thisexe w
# graph_node = string_to_interpreter int_syms graph ie_settings
#! (ie,_) = make_finalizer ie_settings
# ie = {ie_finalizer=ie, ie_snode_ptr=0, ie_snodes=create_array_ 1}
= (Just (interpret ie (Finalizer 0 0 graph_node)), w)
= (Just (interpret ie (Finalizer 0 0 (graph_node + if strict 1 0))), w)
where
getInterpreterSymbols :: !Pointer -> [Symbol]
getInterpreterSymbols pgm = takeWhile (\s -> size s.symbol_name <> 0)
......
......@@ -2,6 +2,7 @@ SHELL:=bash
CPM:=cpm
override CFLAGS:=\
-std=c99\
-D_XOPEN_SOURCE=500\
-Wall\
-Wno-strict-aliasing\
-Werror\
......
......@@ -73,6 +73,7 @@ struct interpretation_environment *build_interpretation_environment(
#if DEBUG_CLEAN_LINKS > 0
EPRINTF("Building interpretation_environment %p\n",ie);
#endif
install_interpreter_segv_handler();
return ie;
}
......@@ -310,8 +311,10 @@ void *get_interpretation_environment_finalizer(void) {
void interpreter_finalizer(BC_WORD interpret_node) {
}
static inline int interpret_ie(struct interpretation_environment *ie, BC_WORD *pc) {
static inline int interpret_ie(struct interpretation_environment *ie,
BC_WORD *pc, int create_restore_point) {
return interpret(ie,
create_restore_point,
ie->stack, ie->stack_size,
ie->heap, ie->heap_size,
ie->asp, ie->bsp, ie->csp, ie->hp,
......@@ -762,7 +765,7 @@ static BC_WORD *translate_descriptor(struct program *program, BC_WORD *descripto
}
static inline void restore_and_translate_descriptors(struct InterpretationEnvironment *clean_ie,
struct program *program, BC_WORD *node) {
struct program *program, BC_WORD *node, BC_WORD add_to_interpreter_indirections) {
BC_WORD descriptor=node[0];
if (!(descriptor & 1))
......@@ -809,7 +812,7 @@ static inline void restore_and_translate_descriptors(struct InterpretationEnviro
* The original descriptor is at host_node[2][2][1], but because we
* know how these nodes are built above this is always host_node[7]. */
node[0]=host_node[7];
host_node[7]=(BC_WORD)node;
host_node[7]=(BC_WORD)node+add_to_interpreter_indirections;
return;
}
......@@ -854,7 +857,7 @@ static inline void restore_and_translate_descriptors(struct InterpretationEnviro
if (elem_desc==0) { /* boxed array */
BC_WORD **array=(BC_WORD**)&node[3];
for (int len=node[1]-1; len>=0; len--)
restore_and_translate_descriptors(clean_ie, program, array[len]);
restore_and_translate_descriptors(clean_ie, program, array[len], add_to_interpreter_indirections);
} else {
int16_t elem_ab_arity=((int16_t*)elem_desc)[-1];
if (elem_ab_arity>0) { /* unboxed records */
......@@ -867,7 +870,7 @@ static inline void restore_and_translate_descriptors(struct InterpretationEnviro
node+=3;
for (int i=0; i<size; i++) {
for (int a=0; a<elem_a_arity; a++)
restore_and_translate_descriptors(clean_ie, program, (BC_WORD*)node[a]);
restore_and_translate_descriptors(clean_ie, program, (BC_WORD*)node[a], add_to_interpreter_indirections);
node+=elem_ab_arity;
}
}
......@@ -877,17 +880,17 @@ static inline void restore_and_translate_descriptors(struct InterpretationEnviro
return;
}
restore_and_translate_descriptors(clean_ie, program, (BC_WORD*)node[1]);
restore_and_translate_descriptors(clean_ie, program, (BC_WORD*)node[1], add_to_interpreter_indirections);
if (a_arity==1)
return;
if (ab_arity==2)
restore_and_translate_descriptors(clean_ie, program, (BC_WORD*)node[2]);
restore_and_translate_descriptors(clean_ie, program, (BC_WORD*)node[2], add_to_interpreter_indirections);
else {
BC_WORD **rest=(BC_WORD**)node[2];
for (int i=0; i<a_arity-1; i++)
restore_and_translate_descriptors(clean_ie, program, rest[i]);
restore_and_translate_descriptors(clean_ie, program, rest[i], add_to_interpreter_indirections);
}
}
......@@ -900,7 +903,7 @@ static int evaluate_all_children(struct interpretation_environment *ie) {
BC_WORD *node=(BC_WORD*)ie->asp[0];
if (!(node[0] & 2)) {
if (interpret_ie(ie, (BC_WORD*)node[0]) != 0) {
if (interpret_ie(ie, (BC_WORD*)node[0], 0) != 0) {
ie->asp=start_a_stack;
EPRINTF("Failed to interpret\n");
return -1;
......@@ -991,7 +994,7 @@ int copy_to_host_or_garbage_collect(struct interpretation_environment *ie,
EXIT(NULL,1);
}
restore_and_translate_descriptors(ie->host->clean_ie, ie->program, node);
restore_and_translate_descriptors(ie->host->clean_ie, ie->program, node, hyperstrict_if_requested && ie->options.hyperstrict);
return words_used;
}
......@@ -1010,7 +1013,8 @@ BC_WORD copy_interpreter_to_host(void *__dummy_0, void *__dummy_1,
struct InterpretationEnvironment *clean_ie, struct finalizers *node_finalizer) {
#endif
struct interpretation_environment *ie = (struct interpretation_environment*) clean_ie->__ie_finalizer->cur->arg;
BC_WORD *node = (BC_WORD*) node_finalizer->cur->arg;
int with_error_reporting=node_finalizer->cur->arg&1;
BC_WORD *node = (BC_WORD*)(node_finalizer->cur->arg&-2);
BC_WORD *old_asp=ie->asp;
......@@ -1036,7 +1040,7 @@ BC_WORD copy_interpreter_to_host(void *__dummy_0, void *__dummy_1,
EPRINTF("\tInterpreting...\n");
#endif
*ie->asp = (BC_WORD) node;
if (interpret_ie(ie, (BC_WORD*) node[0]) != 0) {
if (interpret_ie(ie, (BC_WORD*) node[0], with_error_reporting) != 0) {
EPRINTF("Failed to interpret\n");
return -1;
}
......@@ -1049,7 +1053,7 @@ BC_WORD copy_interpreter_to_host(void *__dummy_0, void *__dummy_1,
EXIT(NULL,1);
}
return copy_to_host_or_garbage_collect(ie, (BC_WORD**)&__interpret__copy__node__asm_redirect_node, node, 1);
return copy_to_host_or_garbage_collect(ie, (BC_WORD**)&__interpret__copy__node__asm_redirect_node, node, with_error_reporting);
}
/**
......@@ -1070,7 +1074,8 @@ BC_WORD copy_interpreter_to_host_n(void *__dummy_0, void *__dummy_1,
struct InterpretationEnvironment *clean_ie, int n_args) {
#endif
struct interpretation_environment *ie = (struct interpretation_environment*) clean_ie->__ie_finalizer->cur->arg;
BC_WORD *node = (BC_WORD*) node_finalizer->cur->arg;
int with_error_reporting=node_finalizer->cur->arg&1;
BC_WORD *node = (BC_WORD*)(node_finalizer->cur->arg&-2);
BC_WORD *old_asp=ie->asp;
......@@ -1095,7 +1100,7 @@ BC_WORD copy_interpreter_to_host_n(void *__dummy_0, void *__dummy_1,
}
/* Update address since garbage collection may have run during copying */
node=(BC_WORD*)node_finalizer->cur->arg;
node=(BC_WORD*)(node_finalizer->cur->arg&-2);
*++ie->asp=(BC_WORD)node;
BC_WORD bootstrap[2];
......@@ -1118,7 +1123,7 @@ BC_WORD copy_interpreter_to_host_n(void *__dummy_0, void *__dummy_1,
bootstrap[1]=n_args+1;
}
if (interpret_ie(ie, bootstrap) != 0) {
if (interpret_ie(ie, bootstrap, with_error_reporting) != 0) {
EPRINTF("Failed to interpret\n");
__interpret__copy__node__asm_redirect_node=interpret_error-1;
return 0;
......@@ -1131,5 +1136,5 @@ BC_WORD copy_interpreter_to_host_n(void *__dummy_0, void *__dummy_1,
EXIT(NULL,1);
}
return copy_to_host_or_garbage_collect(ie, (BC_WORD**)&__interpret__copy__node__asm_redirect_node, node, 1);
return copy_to_host_or_garbage_collect(ie, (BC_WORD**)&__interpret__copy__node__asm_redirect_node, node, with_error_reporting);
}
......@@ -614,6 +614,10 @@ void scroll_heap_window(int up, int left) {
REFRESH_HEAP(heap_line, heap_col);
}
#ifdef POSIX
# include <setjmp.h>
jmp_buf segfault_restore_point;
#endif
void debugger_show_node_as_tree(BC_WORD *node, int max_depth) {
wmove(win_heap, 0, 0);
#ifdef POSIX
......
......@@ -77,11 +77,16 @@ BC_WORD *collect_copy(BC_WORD *stack, BC_WORD *asp,
struct finalizers *finalizers = NULL;
while ((finalizers = next_interpreter_finalizer(finalizers)) != NULL) {
# if DEBUG_GARBAGE_COLLECTOR > 2
EPRINTF("\t%p -> %p\n", (void*)finalizers->cur->arg, ((void**)finalizers->cur->arg)[1]);
EPRINTF("\t%p -> %p\n", (void*)finalizers->cur->arg, ((void**)(finalizers->cur->arg&-2))[1]);
# endif
if (!on_heap(finalizers->cur->arg, old_heap, heap_size))
continue;
BC_WORD *temp = (BC_WORD*) finalizers->cur->arg;
BC_WORD *temp = (BC_WORD*)(finalizers->cur->arg&-2);
/* LSB of the reference is set for hyperstrict references; we store
* this information temporarily in the function argument of the
* finalizer because the LSB is now used for pointer reversal */
if (finalizers->cur->arg&1)
finalizers->cur->fun = (void(*)(BC_WORD))((BC_WORD)finalizers->cur->fun+1);
finalizers->cur->arg = *temp;
*temp = (BC_WORD) (&finalizers->cur->arg) | 1;
}
......@@ -108,7 +113,13 @@ BC_WORD *collect_copy(BC_WORD *stack, BC_WORD *asp,
#endif
BC_WORD *temp = (BC_WORD*) (node[0] ^ 1);
node[0] = *temp;
*temp = (BC_WORD) new_heap;
#ifdef LINK_CLEAN_RUNTIME
/* see remark about hyperstrict references above */
if (temp[-1]==((BC_WORD)(&interpreter_finalizer)+1))
*temp = (BC_WORD) new_heap|1;
else
#endif
*temp = (BC_WORD) new_heap;
}
#if DEBUG_GARBAGE_COLLECTOR > 2
EPRINTF("\tDealing with %p -> %p -> %p\n", (void*) node, (void*) node[0], (void*) *(BC_WORD*)(node[0] ^ 1));
......
......@@ -165,7 +165,7 @@ void mark_cafs(void **cafs, BC_WORD *heap, size_t heap_size, struct nodes_set *s
void mark_host_references(BC_WORD *heap, size_t heap_size, struct nodes_set *set) {
struct finalizers *finalizers = NULL;
while ((finalizers = next_interpreter_finalizer(finalizers)) != NULL)
add_grey_node(set, (BC_WORD*) finalizers->cur->arg, heap, heap_size);
add_grey_node(set, (BC_WORD*)(finalizers->cur->arg&-2), heap, heap_size);
}
#endif
......
......@@ -237,25 +237,48 @@ static BC_WORD *asp, *bsp, *csp, *hp = NULL;
#ifdef POSIX
# include <signal.h>
# ifdef DEBUG_CURSES
jmp_buf segfault_restore_point;
# include <setjmp.h>
struct segfault_restore_points {
jmp_buf restore_point;
# ifdef LINK_CLEAN_RUNTIME
BC_WORD *host_a_ptr;
# endif
struct segfault_restore_points *prev;
};
struct segfault_restore_points *segfault_restore_points=NULL;
void handle_segv(int sig) {
if (asp >= csp) {
EPRINTF("A/C-stack overflow\n");
} else {
# ifdef DEBUG_CURSES
siglongjmp(segfault_restore_point, SIGSEGV);
# ifndef DEBUG_CURSES
EPRINTF("Segmentation fault in interpreter\n");
# ifdef LINK_CLEAN_RUNTIME
interpret_error=&e__ABC_PInterpreter__dDV__StackOverflow;
# endif
# endif
EPRINTF("Untracable segmentation fault\n");
}
/* TODO: if LINK_CLEAN_RUNTIME and ie->options.hyperstrict are set, we
* should attempt to go back to the host and return DV_StackOverflow. */
EXIT(NULL,1);
siglongjmp(segfault_restore_points->restore_point, SIGSEGV);
}
#endif
void install_interpreter_segv_handler(void) {
#if defined(POSIX) && !defined(MACH_O64)
/* TODO: check why this breaks on Mac */
struct sigaltstack signal_stack;
signal_stack.ss_sp=safe_malloc(SIGSTKSZ);
signal_stack.ss_size=SIGSTKSZ;
signal_stack.ss_flags=0;
if (sigaltstack(&signal_stack,NULL) == -1)
perror("sigaltstack");
struct sigaction segv_handler;
segv_handler.sa_handler=handle_segv;
sigemptyset(&segv_handler.sa_mask);
segv_handler.sa_flags=SA_ONSTACK;
if (sigaction(SIGSEGV, &segv_handler, NULL) == -1)
perror("sigaction");
#else
EPRINTF("warning: interpreter does not recover from segfaults on this platform\n");
#endif
}
#ifdef COMPUTED_GOTOS
void *instruction_labels[CMAX];
#endif
......@@ -263,6 +286,7 @@ void *instruction_labels[CMAX];
int interpret(
#ifdef LINK_CLEAN_RUNTIME
struct interpretation_environment *ie,
int create_restore_point,
#else
struct program *program,
#endif
......@@ -303,11 +327,16 @@ int interpret(
BC_WORD_S heap_free = heap + heap_size - hp;
#endif
#if defined(POSIX) && !defined(MACH_O64)
/* TODO: check why this breaks on Mac */
if (signal(SIGSEGV, handle_segv) == SIG_ERR) {
perror("sigaction");
return 1;
#ifdef LINK_CLEAN_RUNTIME
if (create_restore_point) {
struct segfault_restore_points *new=safe_malloc(sizeof(struct segfault_restore_points));
new->prev=segfault_restore_points;
new->host_a_ptr=ie->host->host_a_ptr;
segfault_restore_points=new;
if (sigsetjmp(new->restore_point, 1) != 0) {
ie->host->host_a_ptr=segfault_restore_points->host_a_ptr;
goto eval_to_hnf_return_failure;
}
}
#endif
......@@ -322,12 +351,20 @@ int interpret(
pc=_pc;
if (0) {
#ifdef LINK_CLEAN_RUNTIME
struct segfault_restore_points *old;
#endif
eval_to_hnf_return:
#ifdef LINK_CLEAN_RUNTIME
ie->asp = asp;
ie->bsp = bsp;
ie->csp = csp;
ie->hp = hp;
if (create_restore_point) {
old=segfault_restore_points;
segfault_restore_points=old->prev;
free(old);
}
#endif
return 0;
#ifdef LINK_CLEAN_RUNTIME
......@@ -336,6 +373,11 @@ eval_to_hnf_return_failure:
ie->bsp = bsp;
ie->csp = csp;
ie->hp = hp;
if (create_restore_point) {
old=segfault_restore_points;
segfault_restore_points=old->prev;
free(old);
}
return -1;
#endif
}
......@@ -399,6 +441,7 @@ eval_to_hnf_return_failure:
EXIT(ie,1);
#ifdef LINK_CLEAN_RUNTIME
interpret_error=&e__ABC_PInterpreter__dDV__HeapFull;
goto eval_to_hnf_return_failure;
#endif
return 1;
#ifdef DEBUG_GARBAGE_COLLECTOR
......@@ -498,6 +541,8 @@ int main(int argc, char **argv) {
BC_WORD *bsp = &stack[stack_size];
BC_WORD *csp = &stack[stack_size >> 1];
install_interpreter_segv_handler();
#ifdef DEBUG_CURSES
init_debugger(state.program, stack, asp, bsp, csp, heap, heap_size);
#endif
......
......@@ -88,13 +88,10 @@ extern BC_WORD Fjmp_ap[64];
extern void* __interpreter_indirection[9];
#if defined(POSIX) && defined(DEBUG_CURSES)
# include <setjmp.h>
extern jmp_buf segfault_restore_point;
#endif
#define A_STACK_CANARY 0x87654321 /* random value to check whether the A-stack overflew */
void install_interpreter_segv_handler(void);
#ifdef COMPUTED_GOTOS
# include "abc_instructions.h"
extern void *instruction_labels[CMAX];
......@@ -132,6 +129,7 @@ extern void *instruction_labels[CMAX];
int interpret(
#ifdef LINK_CLEAN_RUNTIME
struct interpretation_environment *ie,
int create_restore_point,
#else
struct program *program,
#endif
......
[(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),DV_HeapFull,(DV_Ok 37),(DV_Ok 37)]
[(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),DV_StackOverflow,(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),(DV_Ok 37),DV_HeapFull,(DV_Ok 37),(DV_Ok 37)]
......@@ -34,7 +34,7 @@ where
(Int Int Int -> DeserializedValue Int)
([Int] -> DeserializedValue Int)
(A.a: [a] -> DeserializedValue [a])
(A.a b: (a (DeserializedValue b) -> b) b [a] -> DeserializedValue b)
(A.a b: (a b -> b) b [a] -> DeserializedValue b)
((Int -> Int) -> DeserializedValue Int)
((Int Int Int -> Int) -> DeserializedValue Int)
(A.a b: (a -> b) [a] -> DeserializedValue [b])
......@@ -60,7 +60,8 @@ where
, ap1 (\x -> x - 5)
, ap1 (flip (-) 5)
, ap3 (\x y z -> 10*x + 3*y + z)
, foldr (\x (DV_Ok y) -> x + y) 0 [1,2,3,4,5,6,7,8,1]
, foldr (\x y -> x + y) 0 [1,2,3,4,5,6,7,8,1]
, foldr (\x y -> x + y) 0 [1..]
, toInt <$> last <$> rev [TestA,TestB]
, length <$> toList <$> reverse_string "0123456789012345678901234567890123456"
, length <$> toList <$> reverse_array {#i \\ i <- [0..36]}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment