diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index c150a85eb1..0052dd34f2 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -74,23 +74,27 @@ SYMBOL: jit-dispatch SYMBOL: jit-epilog SYMBOL: jit-return +! Default definition for undefined words +SYMBOL: undefined-quot + : userenv-offset ( symbol -- n ) { { bootstrap-boot-quot 20 } { bootstrap-global 21 } { jit-code-format 22 } - { jit-prolog 24 } - { jit-word-primitive-jump 25 } - { jit-word-primitive-call 26 } - { jit-word-jump 27 } - { jit-word-call 28 } - { jit-push-literal 30 } - { jit-if-word 31 } - { jit-if-jump 32 } - { jit-dispatch-word 34 } - { jit-dispatch 35 } - { jit-epilog 36 } - { jit-return 37 } + { jit-prolog 23 } + { jit-word-primitive-jump 24 } + { jit-word-primitive-call 25 } + { jit-word-jump 26 } + { jit-word-call 27 } + { jit-push-literal 28 } + { jit-if-word 29 } + { jit-if-jump 30 } + { jit-dispatch-word 31 } + { jit-dispatch 32 } + { jit-epilog 33 } + { jit-return 34 } + { undefined-quot 37 } } at header-size + ; : emit ( cell -- ) image get push ; @@ -364,6 +368,7 @@ M: curry ' : emit-jit-data ( -- ) \ if jit-if-word set \ dispatch jit-dispatch-word set + [ undefined ] undefined-quot set { jit-code-format jit-prolog @@ -378,6 +383,7 @@ M: curry ' jit-dispatch jit-epilog jit-return + undefined-quot } [ emit-userenv ] each ; : fixup-header ( -- ) diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 82277be78c..8e05044223 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -1,6 +1,6 @@ USING: arrays generic assocs kernel math namespaces sequences tools.test words definitions parser quotations -vocabs continuations ; +vocabs continuations tuples ; IN: temporary [ 4 ] [ @@ -34,7 +34,7 @@ DEFER: plist-test [ [ t ] [ \ array? "array?" "arrays" lookup = ] unit-test - "test-scope" "scratchpad" create drop + [ ] [ "test-scope" "scratchpad" create drop ] unit-test ] with-scope [ "test-scope" ] [ @@ -52,7 +52,7 @@ DEFER: plist-test [ t ] [ \ colon-def compound? ] unit-test SYMBOL: a-symbol -[ f ] [ \ a-symbol compound? ] unit-test +[ t ] [ \ a-symbol compound? ] unit-test [ t ] [ \ a-symbol symbol? ] unit-test ! See if redefining a generic as a colon def clears some @@ -126,7 +126,7 @@ M: array freakish ; [ t ] [ \ bar \ freakish usage member? ] unit-test DEFER: x -[ t ] [ [ x ] catch third \ x eq? ] unit-test +[ t ] [ [ x ] catch undefined? ] unit-test [ ] [ "no-loc" "temporary" create drop ] unit-test [ f ] [ "no-loc" "temporary" lookup where ] unit-test @@ -156,3 +156,8 @@ SYMBOL: quot-uses-b ] unit-test [ { + } ] [ \ quot-uses-b uses ] unit-test + +[ t ] [ + [ "IN: temporary : undef-test ; << undef-test >>" eval ] catch + [ undefined? ] is? +] unit-test diff --git a/core/words/words.factor b/core/words/words.factor index 3fba06b816..baec10a821 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -25,15 +25,13 @@ M: compound definer drop \ : \ ; ; M: compound definition word-def ; -TUPLE: undefined word ; +TUPLE: undefined ; -: undefined ( word -- * ) \ undefined construct-boa throw ; +: undefined ( -- * ) \ undefined construct-empty throw ; PREDICATE: compound deferred ( obj -- ? ) - dup [ undefined ] curry swap word-def sequence= ; - + word-def [ undefined ] = ; M: deferred definer drop \ DEFER: f ; - M: deferred definition drop f ; PREDICATE: compound symbol ( obj -- ? ) @@ -110,9 +108,6 @@ PRIVATE> : define-compound ( word def -- ) [ ] like define ; -: undefine ( word -- ) - dup [ undefined ] curry define-compound ; - : define-declared ( word def effect -- ) pick swap "declared-effect" set-word-prop define-compound ; @@ -144,11 +139,8 @@ PRIVATE> : reset-generic ( word -- ) dup reset-word { "methods" "combination" } reset-props ; -: ( name -- word ) - f dup undefine ; - : gensym ( -- word ) - "G:" \ gensym counter number>string append ; + "G:" \ gensym counter number>string append f ; : define-temp ( quot -- word ) gensym dup rot define-compound ; @@ -165,7 +157,7 @@ TUPLE: check-create name vocab ; : create ( name vocab -- word ) check-create 2dup lookup - dup [ 2nip ] [ drop dup reveal dup undefine ] if ; + dup [ 2nip ] [ drop dup reveal ] if ; : constructor-word ( name vocab -- word ) >r "<" swap ">" 3append r> create ; diff --git a/vm/factor.c b/vm/factor.c index 864293e2f3..7b74ef6532 100755 --- a/vm/factor.c +++ b/vm/factor.c @@ -35,6 +35,8 @@ void do_stage1_init(void) fprintf(stderr,"*** Starting stage 2 early init...\n"); fflush(stderr); + jit_compile(userenv[UNDEFINED_ENV]); + begin_scan(); CELL obj; diff --git a/vm/run.h b/vm/run.h index 62d6cca23e..f7668483ba 100755 --- a/vm/run.h +++ b/vm/run.h @@ -34,26 +34,22 @@ typedef enum { /* Used by the JIT compiler */ JIT_CODE_FORMAT = 22, - UNUSED_0, JIT_PROLOG, JIT_WORD_PRIMITIVE_JUMP, JIT_WORD_PRIMITIVE_CALL, JIT_WORD_JUMP, JIT_WORD_CALL, - UNUSED_1, JIT_PUSH_LITERAL, JIT_IF_WORD, JIT_IF_JUMP, - UNUSED_2, JIT_DISPATCH_WORD, JIT_DISPATCH, JIT_EPILOG, JIT_RETURN, - /* Profiler support */ + UNDEFINED_ENV = 37, /* default quotation for undefined words */ PROFILING_ENV = 38, /* is the profiler on? */ - - STAGE2_ENV = 39 /* Have we bootstrapped? */ + STAGE2_ENV = 39 /* have we bootstrapped? */ } F_ENVTYPE; #define FIRST_SAVE_ENV BOOT_ENV diff --git a/vm/types.c b/vm/types.c index aad2be8a1c..b5bf1a7449 100755 --- a/vm/types.c +++ b/vm/types.c @@ -495,11 +495,11 @@ F_WORD *allot_word(CELL vocab, CELL name) word->hashcode = tag_fixnum(rand()); word->vocabulary = vocab; word->name = name; - word->def = F; + word->def = userenv[UNDEFINED_ENV]; word->props = F; word->counter = tag_fixnum(0); word->compiledp = F; - word->xt = NULL; + default_word_xt(word); return word; }