Fix implementation of deferred words

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-prolog 23 }
-        { jit-word-primitive-jump 25 }
+        { jit-word-primitive-jump 24 }
-        { jit-word-primitive-call 26 }
+        { jit-word-primitive-call 25 }
-        { jit-word-jump 27 }
+        { jit-word-jump 26 }
-        { jit-word-call 28 }
+        { jit-word-call 27 }
-        { jit-push-literal 30 }
+        { jit-push-literal 28 }
-        { jit-if-word 31 }
+        { jit-if-word 29 }
-        { jit-if-jump 32 }
+        { jit-if-jump 30 }
-        { jit-dispatch-word 34 }
+        { jit-dispatch-word 31 }
-        { jit-dispatch 35 }
+        { jit-dispatch 32 }
-        { jit-epilog 36 }
+        { jit-epilog 33 }
-        { jit-return 37 }
+        { 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 ( -- )

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

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 ;
 
-: <uninterned> ( name -- word )
-    f <word> dup undefine ;
-
 : gensym ( -- word )
-    "G:" \ gensym counter number>string append <uninterned> ;
+    "G:" \ gensym counter number>string append f <word> ;
 
 : 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 <word> dup reveal dup undefine ] if ;
+    dup [ 2nip ] [ drop <word> dup reveal ] if ;
 
 : constructor-word ( name vocab -- word )
     >r "<" swap ">" 3append r> create ;

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;

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

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;
 }