diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 8fdd3f4457..aa4050f0f3 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -6,7 +6,6 @@ - jvm factor -- still supporting httpd? - make inferior.factor nicer to use - telnetd printing signal 13, and other problems -- check error callstack, not enough >pop>? + docs: @@ -74,7 +73,6 @@ - namespace clone drops static var bindings - ditch expand - set-object-path -- more readable traces - telnetd: send errors on socket - contains ==> contains? diff --git a/library/continuations.factor b/library/continuations.factor index dd60d07f79..b4fcd482a5 100644 --- a/library/continuations.factor +++ b/library/continuations.factor @@ -68,10 +68,3 @@ USE: vectors #! the point after the callcc1 call, and places X at the top #! of the original datastack. [ [ continue1 ] (callcc) ] reify ; - -: suspend ( -- ) - "top-level-continuation" get dup [ - call - ] [ - toplevel - ] ifte ; diff --git a/library/errors.factor b/library/errors.factor index 85c249d9b4..5c64680145 100644 --- a/library/errors.factor +++ b/library/errors.factor @@ -53,8 +53,8 @@ USE: vectors "error-line" set "error-col" set "error" set - datastack >pop> "error-datastack" set - callstack >pop> >pop> "error-callstack" set + datastack "error-datastack" set + callstack "error-callstack" set namestack "error-namestack" set catchstack "error-catchstack" set ] bind diff --git a/library/init.factor b/library/init.factor index 3c37c7b811..af60b40055 100644 --- a/library/init.factor +++ b/library/init.factor @@ -117,5 +117,8 @@ USE: words [ interpreter-loop ] [ - [ default-error-handler suspend ] when* + [ + default-error-handler + "top-level-continuation" get call + ] when* ] catch ; diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor index 82819170d0..38139df60e 100644 --- a/library/platform/native/boot-stage2.factor +++ b/library/platform/native/boot-stage2.factor @@ -72,12 +72,12 @@ USE: stdio "/library/platform/native/parse-syntax.factor" "/library/platform/native/parse-stream.factor" "/library/platform/native/unparser.factor" - "/library/format.factor" + "/library/styles.factor" "/library/vocabulary-style.factor" "/library/prettyprint.factor" - "/library/debugger.factor" "/library/platform/native/debugger.factor" + "/library/debugger.factor" "/library/platform/native/init.factor" "/library/math/math.factor" diff --git a/library/platform/native/boot.factor b/library/platform/native/boot.factor index 92c5f8dc21..c59fc8f255 100644 --- a/library/platform/native/boot.factor +++ b/library/platform/native/boot.factor @@ -66,13 +66,8 @@ primitives, "/library/platform/native/parser.factor" "/library/platform/native/parse-syntax.factor" "/library/platform/native/parse-stream.factor" - "/library/platform/native/unparser.factor" "/library/format.factor" - "/library/styles.factor" - "/library/vocabulary-style.factor" - "/library/prettyprint.factor" - "/library/debugger.factor" - "/library/platform/native/debugger.factor" + "/library/platform/native/unparser.factor" "/library/platform/native/init.factor" ] [ cross-compile-resource diff --git a/library/platform/native/debugger.factor b/library/platform/native/debugger.factor index 1f43ca1a81..00d1286e9f 100644 --- a/library/platform/native/debugger.factor +++ b/library/platform/native/debugger.factor @@ -94,6 +94,7 @@ USE: vectors signal-error io-task-twice-error no-io-tasks-error + profiling-disabled-error } vector-nth execute ; : kernel-error? ( obj -- ? ) diff --git a/library/platform/native/errors.factor b/library/platform/native/errors.factor index b77fc5db2e..1531c5e0c7 100644 --- a/library/platform/native/errors.factor +++ b/library/platform/native/errors.factor @@ -35,12 +35,3 @@ USE: vectors : catchstack ( -- cs ) catchstack* clone ; : set-catchstack* ( cs -- ) 6 setenv ; : set-catchstack ( cs -- ) clone set-catchstack* ; - -DEFER: >c -DEFER: throw - -: init-errors ( -- ) - 64 set-catchstack* - [ 1 exit* ] >c ( last resort ) - [ default-error-handler 1 exit* ] >c - [ throw ] 5 setenv ( kernel calls on error ) ; diff --git a/library/platform/native/init-stage2.factor b/library/platform/native/init-stage2.factor index 41fa06735b..c1750ebea9 100644 --- a/library/platform/native/init-stage2.factor +++ b/library/platform/native/init-stage2.factor @@ -41,11 +41,17 @@ USE: words : cli-args ( -- args ) 10 getenv ; +: init-error-handler ( -- ) + [ 1 exit* ] >c ( last resort ) + [ default-error-handler 1 exit* ] >c + [ throw ] 5 setenv ( kernel calls on error ) ; + : warm-boot ( -- ) #! A fully bootstrapped image has this as the boot #! quotation. boot + init-error-handler init-random "stdio" get "stdio" set diff --git a/library/platform/native/init.factor b/library/platform/native/init.factor index 79b3d08a61..8a560249be 100644 --- a/library/platform/native/init.factor +++ b/library/platform/native/init.factor @@ -35,6 +35,10 @@ USE: stdio USE: streams USE: threads USE: words +USE: vectors + +: init-errors ( -- ) + 64 set-catchstack* ; : init-gc ( -- ) [ garbage-collection ] 7 setenv ; @@ -42,10 +46,10 @@ USE: words : boot ( -- ) #! Initialize an interpreter with the basic services. init-gc + init-errors init-namespaces init-threads init-stdio - init-errors "HOME" os-env [ "." ] unless* "~" set 10 "base" set "/" "/" set diff --git a/library/platform/native/kernel.factor b/library/platform/native/kernel.factor index d27fd6a7a4..f194c5788f 100644 --- a/library/platform/native/kernel.factor +++ b/library/platform/native/kernel.factor @@ -25,15 +25,9 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -IN: namespaces -DEFER: init-namespaces - IN: vectors DEFER: vector= -IN: errors -DEFER: init-errors - IN: kernel USE: arithmetic USE: combinators @@ -105,12 +99,6 @@ USE: vectors [ 103 | "fixnum/bignum/ratio/float/complex" ] ] assoc ; -: toplevel ( -- ) - init-namespaces - init-errors - 0 set-datastack - 0 set-callstack ; - : java? f ; : native? t ; diff --git a/native/error.c b/native/error.c index dff9bcc960..bbd86945ff 100644 --- a/native/error.c +++ b/native/error.c @@ -30,11 +30,6 @@ void throw_error(CELL error) dpush(error); /* Execute the 'throw' word */ call(userenv[BREAK_ENV]); - if(callframe == 0) - { - /* Crash at startup */ - fatal_error("Error thrown before BREAK_ENV set",error); - } /* Return to run() method */ siglongjmp(toplevel,1); @@ -43,6 +38,20 @@ void throw_error(CELL error) void general_error(CELL error, CELL tagged) { CONS* c = cons(error,tag_cons(cons(tagged,F))); + if(userenv[BREAK_ENV] == 0) + { + /* Crash at startup */ + fprintf(stderr,"Error thrown before BREAK_ENV set\n"); + fprintf(stderr,"Error #%d\n",to_fixnum(error)); + if(error == ERROR_TYPE) + { + fprintf(stderr,"Type #%d\n",to_fixnum( + untag_cons(tagged)->car)); + fprintf(stderr,"Got type #%d\n",type_of( + untag_cons(tagged)->cdr)); + } + exit(1); + } throw_error(tag_cons(c)); } diff --git a/native/factor.h b/native/factor.h index 22477b32e0..3596e125b8 100644 --- a/native/factor.h +++ b/native/factor.h @@ -40,8 +40,8 @@ typedef unsigned short CHAR; and allows profiling. */ #define EXTRA_CALL_INFO -#include "error.h" #include "memory.h" +#include "error.h" #include "gc.h" #include "types.h" #include "array.h" diff --git a/native/run.c b/native/run.c index 48ffd4e699..1ed97fa9c1 100644 --- a/native/run.c +++ b/native/run.c @@ -129,7 +129,7 @@ void primitive_setenv(void) void primitive_profiling(void) { #ifndef EXTRA_CALL_INFO - general_error(PROFILING_DISABLED,F); + general_error(ERROR_PROFILING_DISABLED,F); #else CELL d = dpop(); if(d == F) diff --git a/native/run.h b/native/run.h index 7ccd4eafb8..94c5ad0d0d 100644 --- a/native/run.h +++ b/native/run.h @@ -43,11 +43,6 @@ CELL userenv[USER_ENV]; /* This ensures that words in the user's interpreter do not count */ CELL profile_depth; -void signal_handler(int signal, siginfo_t* siginfo, void* uap); -void profiling_step(int signal, siginfo_t* siginfo, void* uap); -void init_signals(void); -void clear_environment(void); - INLINE CELL dpop(void) { ds -= CELLS; @@ -100,6 +95,11 @@ INLINE void call(CELL quot) callframe = quot; } +void signal_handler(int signal, siginfo_t* siginfo, void* uap); +void profiling_step(int signal, siginfo_t* siginfo, void* uap); +void init_signals(void); +void clear_environment(void); + void run(void); void undefined(void); void docol(void); diff --git a/native/stack.h b/native/stack.h index f6e2c4c25c..209455161d 100644 --- a/native/stack.h +++ b/native/stack.h @@ -1,5 +1,5 @@ -#define STACK_UNDERFLOW(stack,bot) ((stack) < UNTAG(bot) + sizeof(ARRAY)) -#define STACK_OVERFLOW(stack,bot) ((stack) >= UNTAG(bot) + object_size(bot)) +#define STACK_UNDERFLOW(stack,bot) ((stack) < UNTAG(bot)) +#define STACK_OVERFLOW(stack,bot) ((stack) >= UNTAG(bot) + STACK_SIZE) void reset_datastack(void); void reset_callstack(void);