diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor index ca3b8c4a61..d5aa74a57a 100644 --- a/library/compiler/compiler.factor +++ b/library/compiler/compiler.factor @@ -85,14 +85,6 @@ SYMBOL: compile-words #! After word is compiled, put its XT at where, relative. 3list deferred-xts cons@ ; -: compiled? ( word -- ? ) - #! This is a hack. - dup "compiled" word-property [ - drop t - ] [ - primitive? - ] ifte ; - : compiling? ( word -- ? ) #! A word that is compiling or already compiled will not be #! added to the list of words to be compiled. @@ -120,10 +112,7 @@ SYMBOL: compile-words deferred-xts off ; : postpone-word ( word -- ) - dup compiled? [ drop ] [ - t over "compiled" set-word-property - compile-words unique@ - ] ifte ; + dup compiled? [ drop ] [ compile-words unique@ ] ifte ; ! During compilation, these two variables store pending ! literals. Literals are either consumed at compile-time by diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor index 9fedfa7f9e..02985a4521 100644 --- a/library/cross-compiler.factor +++ b/library/cross-compiler.factor @@ -305,6 +305,13 @@ IN: image set-word-parameter word-plist set-word-plist + call-profiling + call-count + set-call-count + allot-profiling + allot-count + set-allot-count + compiled? drop dup swap @@ -352,12 +359,6 @@ IN: image (random-int) type size - call-profiling - call-count - set-call-count - allot-profiling - allot-count - set-allot-count dump cwd cd diff --git a/library/test/httpd/html.factor b/library/test/httpd/html.factor index 2ab1a8cf6d..fdff7b246b 100644 --- a/library/test/httpd/html.factor +++ b/library/test/httpd/html.factor @@ -11,7 +11,7 @@ USE: stack "<html>&'sgml'" ] [ "&'sgml'" chars>entities ] unit-test -[ "/file/foo/bar" ] +[ "/foo/bar" ] [ [ "/home/slava/doc/" "doc-root" set diff --git a/native/primitives.c b/native/primitives.c index eb78b59241..554d145044 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -117,6 +117,13 @@ XT primitives[] = { primitive_set_word_parameter, primitive_word_plist, primitive_set_word_plist, + primitive_call_profiling, + primitive_word_call_count, + primitive_set_word_call_count, + primitive_allot_profiling, + primitive_word_allot_count, + primitive_set_word_allot_count, + primitive_word_compiledp, primitive_drop, primitive_dup, primitive_swap, @@ -164,12 +171,6 @@ XT primitives[] = { primitive_random_int, primitive_type, primitive_size, - primitive_call_profiling, - primitive_word_call_count, - primitive_set_word_call_count, - primitive_allot_profiling, - primitive_word_allot_count, - primitive_set_word_allot_count, primitive_dump, primitive_cwd, primitive_cd, diff --git a/native/primitives.h b/native/primitives.h index ea9414b4d8..430e5f8ec7 100644 --- a/native/primitives.h +++ b/native/primitives.h @@ -1,4 +1,4 @@ extern XT primitives[]; -#define PRIMITIVE_COUNT 195 +#define PRIMITIVE_COUNT 196 CELL primitive_to_xt(CELL primitive); diff --git a/native/word.c b/native/word.c index f5ce3a2e8a..0b9f70a2a3 100644 --- a/native/word.c +++ b/native/word.c @@ -104,6 +104,14 @@ void primitive_set_word_allot_count(void) word->allot_count = to_fixnum(dpop()); } +void primitive_word_compiledp(void) +{ + WORD* word = untag_word(dpeek()); + /* is it bad to hardcode this? */ + drepl(tag_boolean(word->xt != (CELL)docol + && word->xt != (CELL)dosym)); +} + void fixup_word(WORD* word) { update_xt(word); diff --git a/native/word.h b/native/word.h index c93e2bdaa5..a76c0b96f6 100644 --- a/native/word.h +++ b/native/word.h @@ -46,5 +46,6 @@ void primitive_word_call_count(void); void primitive_set_word_call_count(void); void primitive_word_allot_count(void); void primitive_set_word_allot_count(void); +void primitive_word_compiledp(void); void fixup_word(WORD* word); void collect_word(WORD* word);