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

13
library/cross-compiler.factor
View File

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

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

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

13
native/primitives.c
View File

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

2
native/primitives.h
View File

@ -1,4 +1,4 @@
extern XT primitives[];
#define PRIMITIVE_COUNT 195
#define PRIMITIVE_COUNT 196
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());
}
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);

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_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);