steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

some compiler work, compiled? primitive

cvs
Slava Pestov 2004-10-05 03:58:53 +00:00
parent 35261e5232
commit f6429f7dab
7 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
library/compiler/compiler.factor
View File

@ -85,14 +85,6 @@ SYMBOL: compile-words
#! After word is compiled, put its XT at where, relative. #! After word is compiled, put its XT at where, relative.
3list deferred-xts cons@ ; 3list deferred-xts cons@ ;
: compiled? ( word -- ? )
#! This is a hack.
dup "compiled" word-property [
drop t
] [
primitive?
] ifte ;
: compiling? ( word -- ? ) : compiling? ( word -- ? )
#! A word that is compiling or already compiled will not be #! A word that is compiling or already compiled will not be
#! added to the list of words to be compiled. #! added to the list of words to be compiled.
@ -120,10 +112,7 @@ SYMBOL: compile-words
deferred-xts off ; deferred-xts off ;
: postpone-word ( word -- ) : postpone-word ( word -- )
dup compiled? [ drop ] [ dup compiled? [ drop ] [ compile-words unique@ ] ifte ;
t over "compiled" set-word-property
compile-words unique@
] ifte ;
! During compilation, these two variables store pending ! During compilation, these two variables store pending
! literals. Literals are either consumed at compile-time by ! literals. Literals are either consumed at compile-time by

13
library/cross-compiler.factor
View File

@ -305,6 +305,13 @@ IN: image
set-word-parameter set-word-parameter
word-plist word-plist
set-word-plist set-word-plist
call-profiling
call-count
set-call-count
allot-profiling
allot-count
set-allot-count
compiled?
drop drop
dup dup
swap swap
@ -352,12 +359,6 @@ IN: image
(random-int) (random-int)
type type
size size
call-profiling
call-count
set-call-count
allot-profiling
allot-count
set-allot-count
dump dump
cwd cwd
cd cd

2
library/test/httpd/html.factor
View File

@ -11,7 +11,7 @@ USE: stack
"<html>&'sgml'" "<html>&'sgml'"
] [ "<html>&'sgml'" chars>entities ] unit-test ] [ "<html>&'sgml'" chars>entities ] unit-test
[ "/file/foo/bar" ] [ "/foo/bar" ]
[ [
[ [
"/home/slava/doc/" "doc-root" set "/home/slava/doc/" "doc-root" set

13
native/primitives.c
View File

@ -117,6 +117,13 @@ XT primitives[] = {
primitive_set_word_parameter, primitive_set_word_parameter,
primitive_word_plist, primitive_word_plist,
primitive_set_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_drop,
primitive_dup, primitive_dup,
primitive_swap, primitive_swap,
@ -164,12 +171,6 @@ XT primitives[] = {
primitive_random_int, primitive_random_int,
primitive_type, primitive_type,
primitive_size, 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_dump,
primitive_cwd, primitive_cwd,
primitive_cd, primitive_cd,

2
native/primitives.h
View File

@ -1,4 +1,4 @@
extern XT primitives[]; extern XT primitives[];
#define PRIMITIVE_COUNT 195 #define PRIMITIVE_COUNT 196
CELL primitive_to_xt(CELL primitive); CELL primitive_to_xt(CELL primitive);

8
native/word.c
View File

@ -104,6 +104,14 @@ void primitive_set_word_allot_count(void)
word->allot_count = to_fixnum(dpop()); 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) void fixup_word(WORD* word)
{ {
update_xt(word); update_xt(word);

1
native/word.h
View File

@ -46,5 +46,6 @@ void primitive_word_call_count(void);
void primitive_set_word_call_count(void); void primitive_set_word_call_count(void);
void primitive_word_allot_count(void); void primitive_word_allot_count(void);
void primitive_set_word_allot_count(void); void primitive_set_word_allot_count(void);
void primitive_word_compiledp(void);
void fixup_word(WORD* word); void fixup_word(WORD* word);
void collect_word(WORD* word); void collect_word(WORD* word);