]> gitweb.factorcode.org Git - factor.git/commitdiff
projects / factor.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 35261e5)
some compiler work, compiled? primitive
authorSlava Pestov <slava@factorcode.org>
Tue, 5 Oct 2004 03:58:53 +0000 (03:58 +0000)
committerSlava Pestov <slava@factorcode.org>
Tue, 5 Oct 2004 03:58:53 +0000 (03:58 +0000)
library/compiler/compiler.factor patch | blob | history
library/cross-compiler.factor patch | blob | history
library/test/httpd/html.factor patch | blob | history
native/primitives.c patch | blob | history
native/primitives.h patch | blob | history
native/word.c patch | blob | history
native/word.h patch | blob | history

diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor
index ca3b8c4a61faa967077a4d621e18329cedec722b..d5aa74a57a10b006c039b492b8ef7230b384f470 100644 (file)
--- 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 9fedfa7f9eb8a80cc89a717a2a9a7316d4a9b070..02985a45213f1f610e9a7bde183d955148983ad3 100644 (file)
--- 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 2ab1a8cf6d12673f5c0086650a7592b69e2b8a14..fdff7b246b9664cef1c7b55647ff6a3fe95a6695 100644 (file)
--- a/library/test/httpd/html.factor
+++ b/library/test/httpd/html.factor
@@ -11,7 +11,7 @@ USE: stack
     "&lt;html&gt;&amp;&apos;sgml&apos;"
 ] [ "<html>&'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 eb78b59241a7fcc59dd2077606d759842d6d398a..554d145044a75fd60369654424667adeebfd318a 100644 (file)
--- 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 ea9414b4d834b39076a8fcf72cca1bf3d0672f31..430e5f8ec75aebffd97c2e771775dd1174c564aa 100644 (file)
--- 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 f5ce3a2e8a638eb3e4479a228aa14541bc0592ed..0b9f70a2a37137ae1789986fd724016d84b07c08 100644 (file)
--- 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 c93e2bdaa5b5a87ebaa724eb840950103cf5017b..a76c0b96f6321e076d17e03c39400ba143c9c530 100644 (file)
--- 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);
Factor programming language