]> gitweb.factorcode.org Git - factor.git/commitdiff
Grab native stack pointer from signal handler
authorslava <slava@factorcode.org>
Mon, 18 Dec 2006 04:31:38 +0000 (04:31 +0000)
committerslava <slava@factorcode.org>
Mon, 18 Dec 2006 04:31:38 +0000 (04:31 +0000)
14 files changed:
TODO.txt
vm/alien.c
vm/compiler.c
vm/data_gc.c
vm/debug.c
vm/io.c
vm/mach_signal.c
vm/os-macosx.m
vm/os-unix.c
vm/os-unix.h
vm/os-windows.c
vm/run.c
vm/run.h
vm/types.c

index 1252cf948d3c247bafd9e2038e4c8175b99c7ba6..8c84b85adfc94221cb97d3bd9b4668ae30c33c95 100644 (file)
--- a/TODO.txt
+++ b/TODO.txt
 - variable width word wrap
 - graphical crossref tool
 - inspector where slot values can be changed
-- compiled call traces:
-  - should be independent of whenever the runtime was built with
-    -fomit-frame-pointer on ppc
-  - we don't know if signal handlers run with the same stack or not
+- compiled call traces do not work if the runtime is built with
+  -fomit-frame-pointer on ppc
 - use crc32 instead of modification date in reload-modules
 - models: don't do redundant work
 - top level window positioning on ms windows
index 0d3ddef38509f244f203452ed9161754bd39923b..d08325064fdcf12e42520fd7093f766fb1ebc78e 100644 (file)
-#include "factor.h"\r
-\r
-/* test if alien is no longer valid (it survived an image save/load) */\r
-void primitive_expired(void)\r
-{\r
-       CELL object = dpeek();\r
-\r
-       if(type_of(object) == ALIEN_TYPE)\r
-       {\r
-               F_ALIEN *alien = untag_alien_fast(object);\r
-               drepl(tag_boolean(alien->expired));\r
-       }\r
-       else if(object == F)\r
-               drepl(T);\r
-       else\r
-               drepl(F);\r
-}\r
-\r
-/* gets the address of an object representing a C pointer */\r
-void *alien_offset(CELL object)\r
-{\r
-       F_ALIEN *alien;\r
-       F_ARRAY *array;\r
-\r
-       switch(type_of(object))\r
-       {\r
-       case BYTE_ARRAY_TYPE:\r
-               array = untag_array_fast(object);\r
-               return array + 1;\r
-       case ALIEN_TYPE:\r
-               alien = untag_alien_fast(object);\r
-               if(alien->expired)\r
-                       general_error(ERROR_EXPIRED,object,F,true);\r
-               return alien_offset(alien->alien) + alien->displacement;\r
-       case F_TYPE:\r
-               return NULL;\r
-       default:\r
-               type_error(ALIEN_TYPE,object);\r
-               return (void*)-1; /* can't happen */\r
-       }\r
-}\r
-\r
-/* pop an object representing a C pointer */\r
-void *unbox_alien(void)\r
-{\r
-       return alien_offset(dpop());\r
-}\r
-\r
-/* make an alien */\r
-CELL allot_alien(CELL delegate, CELL displacement)\r
-{\r
-       REGISTER_ROOT(delegate);\r
-       F_ALIEN *alien = allot_object(ALIEN_TYPE,sizeof(F_ALIEN));\r
-       UNREGISTER_ROOT(delegate);\r
-       alien->alien = delegate;\r
-       alien->displacement = displacement;\r
-       alien->expired = false;\r
-       return tag_object(alien);\r
-}\r
-\r
-/* make an alien and push */\r
-void box_alien(void* ptr)\r
-{\r
-       if(ptr == NULL)\r
-               dpush(F);\r
-       else\r
-               dpush(allot_alien(F,(CELL)ptr));\r
-}\r
-\r
-/* make an alien pointing at an offset of another alien */\r
-void primitive_displaced_alien(void)\r
-{\r
-       CELL alien = dpop();\r
-       CELL displacement = unbox_unsigned_cell();\r
-       if(alien == F && displacement == 0)\r
-               dpush(F);\r
-       else\r
-               dpush(allot_alien(alien,displacement));\r
-}\r
-\r
-/* address of an object representing a C pointer. Explicitly throw an error\r
-if the object is a byte array, as a sanity check. */\r
-void primitive_alien_address(void)\r
-{\r
-       CELL object = dpop();\r
-       if(type_of(object) == BYTE_ARRAY_TYPE)\r
-               type_error(ALIEN_TYPE,object);\r
-       else\r
-               box_unsigned_cell((CELL)alien_offset(object));\r
-}\r
-\r
-/* image loading */\r
-void fixup_alien(F_ALIEN *d)\r
-{\r
-       d->expired = true;\r
-}\r
-\r
-/* pop ( alien n ) from datastack, return alien's address plus n */\r
-INLINE void *alien_pointer(void)\r
-{\r
-       F_FIXNUM offset = unbox_signed_cell();\r
-       return unbox_alien() + offset;\r
-}\r
-\r
-/* define words to read/write values at an alien address */\r
-#define DEF_ALIEN_SLOT(name,type,boxer) \\r
-void primitive_alien_##name (void) \\r
-{ \\r
-       box_##boxer (*(type*)alien_pointer()); \\r
-} \\r
-void primitive_set_alien_##name (void) \\r
-{ \\r
-       type* ptr = alien_pointer(); \\r
-       type value = unbox_##boxer(); \\r
-       *ptr = value; \\r
-}\r
-\r
-DEF_ALIEN_SLOT(signed_cell,F_FIXNUM,signed_cell)\r
-DEF_ALIEN_SLOT(unsigned_cell,CELL,unsigned_cell)\r
-DEF_ALIEN_SLOT(signed_8,s64,signed_8)\r
-DEF_ALIEN_SLOT(unsigned_8,u64,unsigned_8)\r
-DEF_ALIEN_SLOT(signed_4,s32,signed_4)\r
-DEF_ALIEN_SLOT(unsigned_4,u32,unsigned_4)\r
-DEF_ALIEN_SLOT(signed_2,s16,signed_2)\r
-DEF_ALIEN_SLOT(unsigned_2,u16,unsigned_2)\r
-DEF_ALIEN_SLOT(signed_1,u8,signed_1)\r
-DEF_ALIEN_SLOT(unsigned_1,u8,unsigned_1)\r
-DEF_ALIEN_SLOT(float,float,float)\r
-DEF_ALIEN_SLOT(double,double,double)\r
-\r
-/* for FFI calls passing structs by value */\r
-void unbox_value_struct(void *dest, CELL size)\r
-{\r
-       memcpy(dest,unbox_alien(),size);\r
-}\r
-\r
-/* for FFI callbacks receiving structs by value */\r
-void box_value_struct(void *src, CELL size)\r
-{\r
-       F_ARRAY *array = allot_byte_array(size);\r
-       memcpy(array + 1,src,size);\r
-       dpush(tag_object(array));\r
-}\r
-\r
-/* for FFI calls returning an 8-byte struct. This only\r
-happens on Intel Mac OS X */\r
-void box_value_pair(CELL x, CELL y)\r
-{\r
-       F_ARRAY *array = allot_byte_array(2 * sizeof(CELL));\r
-       set_array_nth(array,0,x);\r
-       set_array_nth(array,1,y);\r
-       dpush(tag_object(array));\r
-}\r
-\r
-/* open a native library and push a handle */\r
-void primitive_dlopen(void)\r
-{\r
-       primitive_string_to_char_alien();\r
-       F_DLL* dll = allot_object(DLL_TYPE,sizeof(F_DLL));\r
-       dll->path = dpop();\r
-       ffi_dlopen(dll,true);\r
-       dpush(tag_object(dll));\r
-}\r
-\r
-/* look up a symbol in a native library */\r
-void primitive_dlsym(void)\r
-{\r
-       CELL dll = dpop();\r
-       REGISTER_ROOT(dll);\r
-       char *sym = unbox_char_string();\r
-       UNREGISTER_ROOT(dll);\r
-\r
-       F_DLL *d;\r
-\r
-       if(dll == F)\r
-               d = NULL;\r
-       else\r
-       {\r
-               d = untag_dll(dll);\r
-               if(d->dll == NULL)\r
-                       general_error(ERROR_EXPIRED,dll,F,true);\r
-       }\r
-\r
-       box_alien(ffi_dlsym(d,sym,true));\r
-}\r
-\r
-/* close a native library handle */\r
-void primitive_dlclose(void)\r
-{\r
-       ffi_dlclose(untag_dll(dpop()));\r
-}\r
+#include "factor.h"
+
+/* test if alien is no longer valid (it survived an image save/load) */
+void primitive_expired(void)
+{
+       CELL object = dpeek();
+
+       if(type_of(object) == ALIEN_TYPE)
+       {
+               F_ALIEN *alien = untag_alien_fast(object);
+               drepl(tag_boolean(alien->expired));
+       }
+       else if(object == F)
+               drepl(T);
+       else
+               drepl(F);
+}
+
+/* gets the address of an object representing a C pointer */
+void *alien_offset(CELL object)
+{
+       F_ALIEN *alien;
+       F_ARRAY *array;
+
+       switch(type_of(object))
+       {
+       case BYTE_ARRAY_TYPE:
+               array = untag_array_fast(object);
+               return array + 1;
+       case ALIEN_TYPE:
+               alien = untag_alien_fast(object);
+               if(alien->expired)
+                       simple_error(ERROR_EXPIRED,object,F);
+               return alien_offset(alien->alien) + alien->displacement;
+       case F_TYPE:
+               return NULL;
+       default:
+               type_error(ALIEN_TYPE,object);
+               return (void*)-1; /* can't happen */
+       }
+}
+
+/* pop an object representing a C pointer */
+void *unbox_alien(void)
+{
+       return alien_offset(dpop());
+}
+
+/* make an alien */
+CELL allot_alien(CELL delegate, CELL displacement)
+{
+       REGISTER_ROOT(delegate);
+       F_ALIEN *alien = allot_object(ALIEN_TYPE,sizeof(F_ALIEN));
+       UNREGISTER_ROOT(delegate);
+       alien->alien = delegate;
+       alien->displacement = displacement;
+       alien->expired = false;
+       return tag_object(alien);
+}
+
+/* make an alien and push */
+void box_alien(void* ptr)
+{
+       if(ptr == NULL)
+               dpush(F);
+       else
+               dpush(allot_alien(F,(CELL)ptr));
+}
+
+/* make an alien pointing at an offset of another alien */
+void primitive_displaced_alien(void)
+{
+       CELL alien = dpop();
+       CELL displacement = unbox_unsigned_cell();
+       if(alien == F && displacement == 0)
+               dpush(F);
+       else
+               dpush(allot_alien(alien,displacement));
+}
+
+/* address of an object representing a C pointer. Explicitly throw an error
+if the object is a byte array, as a sanity check. */
+void primitive_alien_address(void)
+{
+       CELL object = dpop();
+       if(type_of(object) == BYTE_ARRAY_TYPE)
+               type_error(ALIEN_TYPE,object);
+       else
+               box_unsigned_cell((CELL)alien_offset(object));
+}
+
+/* image loading */
+void fixup_alien(F_ALIEN *d)
+{
+       d->expired = true;
+}
+
+/* pop ( alien n ) from datastack, return alien's address plus n */
+INLINE void *alien_pointer(void)
+{
+       F_FIXNUM offset = unbox_signed_cell();
+       return unbox_alien() + offset;
+}
+
+/* define words to read/write values at an alien address */
+#define DEF_ALIEN_SLOT(name,type,boxer) \
+void primitive_alien_##name (void) \
+{ \
+       box_##boxer (*(type*)alien_pointer()); \
+} \
+void primitive_set_alien_##name (void) \
+{ \
+       type* ptr = alien_pointer(); \
+       type value = unbox_##boxer(); \
+       *ptr = value; \
+}
+
+DEF_ALIEN_SLOT(signed_cell,F_FIXNUM,signed_cell)
+DEF_ALIEN_SLOT(unsigned_cell,CELL,unsigned_cell)
+DEF_ALIEN_SLOT(signed_8,s64,signed_8)
+DEF_ALIEN_SLOT(unsigned_8,u64,unsigned_8)
+DEF_ALIEN_SLOT(signed_4,s32,signed_4)
+DEF_ALIEN_SLOT(unsigned_4,u32,unsigned_4)
+DEF_ALIEN_SLOT(signed_2,s16,signed_2)
+DEF_ALIEN_SLOT(unsigned_2,u16,unsigned_2)
+DEF_ALIEN_SLOT(signed_1,u8,signed_1)
+DEF_ALIEN_SLOT(unsigned_1,u8,unsigned_1)
+DEF_ALIEN_SLOT(float,float,float)
+DEF_ALIEN_SLOT(double,double,double)
+
+/* for FFI calls passing structs by value */
+void unbox_value_struct(void *dest, CELL size)
+{
+       memcpy(dest,unbox_alien(),size);
+}
+
+/* for FFI callbacks receiving structs by value */
+void box_value_struct(void *src, CELL size)
+{
+       F_ARRAY *array = allot_byte_array(size);
+       memcpy(array + 1,src,size);
+       dpush(tag_object(array));
+}
+
+/* for FFI calls returning an 8-byte struct. This only
+happens on Intel Mac OS X */
+void box_value_pair(CELL x, CELL y)
+{
+       F_ARRAY *array = allot_byte_array(2 * sizeof(CELL));
+       set_array_nth(array,0,x);
+       set_array_nth(array,1,y);
+       dpush(tag_object(array));
+}
+
+/* open a native library and push a handle */
+void primitive_dlopen(void)
+{
+       primitive_string_to_char_alien();
+       F_DLL* dll = allot_object(DLL_TYPE,sizeof(F_DLL));
+       dll->path = dpop();
+       ffi_dlopen(dll,true);
+       dpush(tag_object(dll));
+}
+
+/* look up a symbol in a native library */
+void primitive_dlsym(void)
+{
+       CELL dll = dpop();
+       REGISTER_ROOT(dll);
+       char *sym = unbox_char_string();
+       UNREGISTER_ROOT(dll);
+
+       F_DLL *d;
+
+       if(dll == F)
+               d = NULL;
+       else
+       {
+               d = untag_dll(dll);
+               if(d->dll == NULL)
+                       simple_error(ERROR_EXPIRED,dll,F);
+       }
+
+       box_alien(ffi_dlsym(d,sym,true));
+}
+
+/* close a native library handle */
+void primitive_dlclose(void)
+{
+       ffi_dlclose(untag_dll(dpop()));
+}
index 06fbbba1d99f8f3aed753d5d1b10b34e61307f67..1e24896973b00e51abee5278713c5ec324eea9e2 100644 (file)
@@ -4,7 +4,7 @@
 image load */
 void undefined_symbol(void)
 {
-       general_error(ERROR_UNDEFINED_SYMBOL,F,F,true);
+       simple_error(ERROR_UNDEFINED_SYMBOL,F,F);
 }
 
 #define CREF(array,i) ((CELL)(array) + CELLS * (i))
index f11a1c416ebfd7c286b444ea47bfc3eaa8e7c85b..451561dbd68bc8053dcad52ad54f955666c1397b 100644 (file)
@@ -114,7 +114,7 @@ void primitive_next_object(void)
        CELL type;
 
        if(!gc_off)
-               general_error(ERROR_HEAP_SCAN,F,F,true);
+               simple_error(ERROR_HEAP_SCAN,F,F);
 
        if(heap_scan_ptr >= tenured.here)
        {
index 76c02d379b6fdb903604f6fed137ab4ffb394d3e..3e5835f32efc446f79992477e66510ac222b5988 100644 (file)
@@ -235,7 +235,7 @@ void factorbug(void)
                        fprintf(stderr,"%lx\n",(CELL)CARD_TO_ADDR(card));
                }
                else if(strcmp(cmd,"t") == 0)
-                       general_error(ERROR_USER_INTERRUPT,F,F,true);
+                       simple_error(ERROR_USER_INTERRUPT,F,F);
                else if(strcmp(cmd,"q") == 0)
                        return;
                else if(strcmp(cmd,"x") == 0)
diff --git a/vm/io.c b/vm/io.c
index f576583ca29af6b50228664acf4b897a816274fe..fca66a0a8c40ef80ae263deec8fbbb6ca4d295da 100644 (file)
--- a/vm/io.c
+++ b/vm/io.c
@@ -21,7 +21,7 @@ void init_c_io(void)
 void io_error(void)
 {
        CELL error = tag_object(from_char_string(strerror(errno)));
-       general_error(ERROR_IO,error,F,true);
+       simple_error(ERROR_IO,error,F);
 }
 
 void primitive_fopen(void)
index 5c372322ffde92a14305895bc69acd2c24ec1dc7..80efd0e7cc0dad50f2df854f88340713a80090c8 100644 (file)
@@ -24,14 +24,14 @@ static mach_port_t our_exception_port;
 static void
 memory_protection_handler (void *fault_addr)
 {
-  memory_protection_error((CELL)fault_addr,SIGSEGV);
+  memory_protection_error((CELL)fault_addr,SIGSEGV,native_stack_pointer());
   abort ();
 }
 
 static void
 arithmetic_handler (void *ignore)
 {
-  signal_error(SIGFPE);
+  signal_error(SIGFPE,native_stack_pointer());
   abort ();
 }
 
index e9959c9e6474385ed50204181d5f68077fb5866e..952c06e5865afe32b9bafc3fff5031ff3fc8c252 100644 (file)
@@ -26,7 +26,7 @@ NS_DURING
                {
                        CELL e = error;
                        error = F;
-                       general_error(ERROR_OBJECTIVE_C,e,F,true);
+                       simple_error(ERROR_OBJECTIVE_C,e,F);
                }
 
                interpreter_loop();
index eda13839a258975ed55e25948c43a44402ea6407..8f46169d9d57e153ec9d088c195d6d68ad1e859f 100644 (file)
@@ -22,8 +22,8 @@ void ffi_dlopen(F_DLL *dll, bool error)
        {
                if(error)
                {
-                       general_error(ERROR_FFI,F,
-                               tag_object(from_char_string(dlerror())),true);
+                       simple_error(ERROR_FFI,F,
+                               tag_object(from_char_string(dlerror())));
                }
                else
                        dll->dll = NULL;
@@ -42,9 +42,9 @@ void *ffi_dlsym(F_DLL *dll, char *symbol, bool error)
        {
                if(error)
                {
-                       general_error(ERROR_FFI,
+                       simple_error(ERROR_FFI,
                                tag_object(from_char_string(symbol)),
-                               tag_object(from_char_string(dlerror())),true);
+                               tag_object(from_char_string(dlerror())));
                }
 
                return NULL;
@@ -56,8 +56,8 @@ void ffi_dlclose(F_DLL *dll)
 {
        if(dlclose(dll->dll))
        {
-               general_error(ERROR_FFI,tag_object(
-                       from_char_string(dlerror())),F,true);
+               simple_error(ERROR_FFI,tag_object(
+                       from_char_string(dlerror())),F);
        }
        dll->dll = NULL;
 }
@@ -158,14 +158,21 @@ void dealloc_segment(F_SEGMENT *block)
        free(block);
 }
 
-void memory_signal_handler(int signal, siginfo_t* siginfo, void* uap)
+INLINE F_STACK_FRAME *uap_stack_pointer(void *uap)
 {
-       memory_protection_error((CELL)siginfo->si_addr, signal);
+       ucontext_t *ucontext = (ucontext_t *)uap;
+       return (F_STACK_FRAME *)ucontext->uc_stack.ss_sp;
 }
 
-void misc_signal_handler(int signal, siginfo_t* siginfo, void* uap)
+void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
 {
-       signal_error(signal);
+       memory_protection_error((CELL)siginfo->si_addr,signal,
+               uap_stack_pointer(uap));
+}
+
+void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+{
+       signal_error(signal,uap_stack_pointer(uap));
 }
 
 static void sigaction_safe(int signum, const struct sigaction *act, struct sigaction *oldact)
@@ -174,7 +181,8 @@ static void sigaction_safe(int signum, const struct sigaction *act, struct sigac
        do
        {
                ret = sigaction(signum, act, oldact);
-       } while(ret == -1 && errno == EINTR);
+       }
+       while(ret == -1 && errno == EINTR);
 }
 
 void unix_init_signals(void)
index 1196e1de59601a77c5e8a8128d542cdc83504203..ca0e6f52b2bff8a92f12b252e32b8f307cabf02f 100644 (file)
@@ -5,6 +5,7 @@
 #include <unistd.h>
 #include <sys/time.h>
 #include <dlfcn.h>
+#include <ucontext.h>
 
 #define DLLEXPORT
 #define SETJMP(jmpbuf) sigsetjmp(jmpbuf,1)
index b61f373adc800604bf3984970c2b25c14100db0d..2001662ee1f790fa788274dd057c840c88666da2 100644 (file)
@@ -48,7 +48,8 @@ void ffi_dlopen (F_DLL *dll, bool error)
        {
                dll->dll = NULL;
                if(error)
-                       general_error(ERROR_FFI, F, tag_object(get_error_message()),true);
+                       simple_error(ERROR_FFI,F,
+                               tag_object(get_error_message()));
                else
                        return;
        }
@@ -65,9 +66,9 @@ void *ffi_dlsym (F_DLL *dll, char *symbol, bool error)
        if (!sym)
        {
                if(error)
-                       general_error(ERROR_FFI,
+                       simple_error(ERROR_FFI,
                                tag_object(from_char_string(symbol)),
-                               tag_object(get_error_message()),true);
+                               tag_object(get_error_message()));
                else
                        return NULL;
        }
@@ -222,7 +223,8 @@ void seh_call(void (*func)(), exception_handler_t *handler)
 
 static long exception_handler(PEXCEPTION_RECORD rec, void *frame, void *ctx, void *dispatch)
 {
-       memory_protection_error(rec->ExceptionInformation[1], SIGSEGV);
+       memory_protection_error(rec->ExceptionInformation[1],
+               SIGSEGV,native_stack_pointer());
        return -1; /* unreachable */
 }
 
index 1cf4a55c2e00be6de96142ed31dac00a8735dafe..eb3887aa55b55321afed04f0399b8e3b445edbf9 100644 (file)
--- a/vm/run.c
+++ b/vm/run.c
@@ -75,7 +75,7 @@ void interpreter_loop(void)
                                if(stack_chain->next)
                                        return;
 
-                               general_error(ERROR_CS_UNDERFLOW,F,F,false);
+                               simple_error(ERROR_CS_UNDERFLOW,F,F);
                        }
 
                        callframe_end = get(cs);
@@ -121,7 +121,7 @@ void run_callback(CELL quot)
 /* XT of deferred words */
 void undefined(F_WORD* word)
 {
-       general_error(ERROR_UNDEFINED_WORD,tag_word(word),F,true);
+       simple_error(ERROR_UNDEFINED_WORD,tag_word(word),F);
 }
 
 /* XT of compound definitions */
@@ -258,14 +258,13 @@ void early_error(CELL error)
 }
 
 /* allocates memory */
-CELL allot_native_stack_trace(void)
+CELL allot_native_stack_trace(F_STACK_FRAME *stack)
 {
-       F_STACK_FRAME *frame = native_stack_pointer();
        GROWABLE_ARRAY(array);
 
-       while(frame < stack_chain->native_stack_pointer)
+       while(stack < stack_chain->native_stack_pointer)
        {
-               CELL return_address = RETURN_ADDRESS(frame);
+               CELL return_address = RETURN_ADDRESS(stack);
 
                if(return_address >= compiling.base
                        && return_address <= compiling.limit)
@@ -276,16 +275,16 @@ CELL allot_native_stack_trace(void)
                        GROWABLE_ADD(array,cell);
                }
 
-               F_STACK_FRAME *prev = PREVIOUS_FRAME(frame);
+               F_STACK_FRAME *prev = PREVIOUS_FRAME(stack);
 
-               if(prev <= frame)
+               if(prev <= stack)
                {
                        fprintf(stderr,"*** Unusual C stack layout (why?)\n");
                        fflush(stderr);
                        break;
                }
 
-               frame = prev;
+               stack = prev;
        }
 
        GROWABLE_TRIM(array);
@@ -293,12 +292,12 @@ CELL allot_native_stack_trace(void)
        return tag_object(array);
 }
 
-void throw_error(CELL error, bool keep_stacks)
+void throw_error(CELL error, bool keep_stacks, F_STACK_FRAME *native_stack)
 {
        early_error(error);
 
        REGISTER_ROOT(error);
-       thrown_native_stack_trace = allot_native_stack_trace();
+       thrown_native_stack_trace = allot_native_stack_trace(native_stack);
        UNREGISTER_ROOT(error);
 
        throwing = true;
@@ -313,7 +312,7 @@ void throw_error(CELL error, bool keep_stacks)
 
 void primitive_throw(void)
 {
-       throw_error(dpop(),true);
+       throw_error(dpop(),true,native_stack_pointer());
 }
 
 void primitive_die(void)
@@ -321,51 +320,57 @@ void primitive_die(void)
        factorbug();
 }
 
-void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2, bool keep_stacks)
+void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2,
+       bool keep_stacks, F_STACK_FRAME *native_stack)
 {
        throw_error(allot_array_4(userenv[ERROR_ENV],
-               tag_fixnum(error),arg1,arg2),keep_stacks);
+               tag_fixnum(error),arg1,arg2),keep_stacks,native_stack);
 }
 
-void memory_protection_error(CELL addr, int signal)
+void simple_error(F_ERRORTYPE error, CELL arg1, CELL arg2)
+{
+       general_error(error,arg1,arg2,true,native_stack_pointer());
+}
+
+void memory_protection_error(CELL addr, int signal, F_STACK_FRAME *native_stack)
 {
        gc_off = true;
 
        if(in_page(addr, ds_bot, 0, -1))
-               general_error(ERROR_DS_UNDERFLOW,F,F,false);
+               general_error(ERROR_DS_UNDERFLOW,F,F,false,native_stack);
        else if(in_page(addr, ds_bot, ds_size, 0))
-               general_error(ERROR_DS_OVERFLOW,F,F,false);
+               general_error(ERROR_DS_OVERFLOW,F,F,false,native_stack);
        else if(in_page(addr, rs_bot, 0, -1))
-               general_error(ERROR_RS_UNDERFLOW,F,F,false);
+               general_error(ERROR_RS_UNDERFLOW,F,F,false,native_stack);
        else if(in_page(addr, rs_bot, rs_size, 0))
-               general_error(ERROR_RS_OVERFLOW,F,F,false);
+               general_error(ERROR_RS_OVERFLOW,F,F,false,native_stack);
        else if(in_page(addr, cs_bot, 0, -1))
-               general_error(ERROR_CS_UNDERFLOW,F,F,false);
+               general_error(ERROR_CS_UNDERFLOW,F,F,false,native_stack);
        else if(in_page(addr, cs_bot, cs_size, 0))
-               general_error(ERROR_CS_OVERFLOW,F,F,false);
+               general_error(ERROR_CS_OVERFLOW,F,F,false,native_stack);
        else if(in_page(addr, nursery.limit, 0, 0))
                critical_error("Out of memory in allot",0);
 
-       signal_error(signal);
+       signal_error(signal,native_stack);
 }
 
-void signal_error(int signal)
+void signal_error(int signal, F_STACK_FRAME *native_stack)
 {
        gc_off = true;
-       general_error(ERROR_SIGNAL,tag_fixnum(signal),F,false);
+       general_error(ERROR_SIGNAL,tag_fixnum(signal),F,false,native_stack);
 }
 
 void type_error(CELL type, CELL tagged)
 {
-       general_error(ERROR_TYPE,tag_fixnum(type),tagged,true);
+       simple_error(ERROR_TYPE,tag_fixnum(type),tagged);
 }
 
 void divide_by_zero_error(void)
 {
-       general_error(ERROR_DIVIDE_BY_ZERO,F,F,true);
+       simple_error(ERROR_DIVIDE_BY_ZERO,F,F);
 }
 
 void memory_error(void)
 {
-       general_error(ERROR_MEMORY,F,F,true);
+       simple_error(ERROR_MEMORY,F,F);
 }
index 59f0864572682441dd785a16e7c81c8b03f9d592..e0a9c7783ccc59d8e3b9b9cd5fd835c4d034b7cf 100644 (file)
--- a/vm/run.h
+++ b/vm/run.h
@@ -188,11 +188,13 @@ CELL thrown_rs;
 
 void fatal_error(char* msg, CELL tagged);
 void critical_error(char* msg, CELL tagged);
-void throw_error(CELL error, bool keep_stacks);
+void throw_error(CELL error, bool keep_stacks, F_STACK_FRAME *native_stack);
 void early_error(CELL error);
-void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2, bool keep_stacks);
-void memory_protection_error(CELL addr, int signal);
-void signal_error(int signal);
+void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2,
+       bool keep_stacks, F_STACK_FRAME *native_stack);
+void simple_error(F_ERRORTYPE error, CELL arg1, CELL arg2);
+void memory_protection_error(CELL addr, int signal, F_STACK_FRAME *native_stacks);
+void signal_error(int signal, F_STACK_FRAME *native_stack);
 void type_error(CELL type, CELL tagged);
 void divide_by_zero_error(void);
 void memory_error(void);
index bbeb90ff8bf7fe3ed581810609be9e3408814c98..a7b5d259d2c8e7b94fed5e91c7377b4c36f2e1b0 100644 (file)
@@ -20,7 +20,7 @@ F_ARRAY *allot_array_internal(CELL type, F_FIXNUM capacity)
 
        if(capacity < 0)
        {
-               general_error(ERROR_NEGATIVE_ARRAY_SIZE,allot_integer(capacity),F,true);
+               simple_error(ERROR_NEGATIVE_ARRAY_SIZE,allot_integer(capacity),F);
                return NULL;
        }
        else
@@ -48,7 +48,7 @@ F_ARRAY *allot_byte_array(F_FIXNUM size)
 {
        if(size < 0)
        {
-               general_error(ERROR_NEGATIVE_ARRAY_SIZE,allot_integer(size),F,true);
+               simple_error(ERROR_NEGATIVE_ARRAY_SIZE,allot_integer(size),F);
                return NULL;
        }
 
@@ -144,7 +144,7 @@ F_STRING* allot_string_internal(F_FIXNUM capacity)
 
        if(capacity < 0)
        {
-               general_error(ERROR_NEGATIVE_ARRAY_SIZE,allot_integer(capacity),F,true);
+               simple_error(ERROR_NEGATIVE_ARRAY_SIZE,allot_integer(capacity),F);
                return NULL;
        }
        else
@@ -309,7 +309,7 @@ F_ARRAY *allot_c_string(CELL capacity, CELL size)
                CELL capacity = string_capacity(s); \
                F_ARRAY *_c_str; \
                if(check && !check_string(s,sizeof(type))) \
-                       general_error(ERROR_C_STRING,tag_object(s),F,true); \
+                       simple_error(ERROR_C_STRING,tag_object(s),F); \
                REGISTER_STRING(s); \
                _c_str = allot_c_string(capacity,sizeof(type)); \
                UNREGISTER_STRING(s); \
@@ -323,7 +323,7 @@ F_ARRAY *allot_c_string(CELL capacity, CELL size)
                if(sizeof(type) == sizeof(u16)) \
                { \
                        if(check && !check_string(s,sizeof(type))) \
-                               general_error(ERROR_C_STRING,tag_object(s),F,true); \
+                               simple_error(ERROR_C_STRING,tag_object(s),F); \
                        return (type*)(s + 1); \
                } \
                else \