Fix implementation of deferred words

db4
Slava Pestov 2007-12-26 20:40:46 -05:00
parent 2a24567546
commit c5d91d12df
6 changed files with 38 additions and 37 deletions

View File

@ -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 ( -- )

View File

@ -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

View File

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

View File

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

View File

@ -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

View File

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