Remove integer-slot and set-integer-slot primitives, add word-xt primitive

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 822fc60ed1e5982a542a43066bcdbd5fa75bd401..69924e954eb1509f1fb9bc53135620bee34b879c 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,8 +1,8 @@
 - auto-invoke code gc
-- fix alien-callback/SEH bug on win32
 - live search: timer delay would be nice
 - help responder has no way to access { "foo" "bar" }
 - httpd search tools
+- code-gc instability with callbacks
 
 + ui:
 

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index 949b349fdb485f618331d98cb283573c0629ab6a..6f86a528b0275cb6500a259d333c608026b49ef1 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -101,6 +101,7 @@ call
     { "float>=" "math-internals"            }
     { "(word)" "kernel-internals"           }
     { "update-xt" "words"                   }
+    { "word-xt" "words"                     }
     { "drop" "kernel"                       }
     { "2drop" "kernel"                      }
     { "3drop" "kernel"                      }
@@ -183,8 +184,6 @@ call
     { "alien-address" "alien"               }
     { "slot" "kernel-internals"             }
     { "set-slot" "kernel-internals"         }
-    { "integer-slot" "kernel-internals"     }
-    { "set-integer-slot" "kernel-internals" }
     { "char-slot" "kernel-internals"        }
     { "set-char-slot" "kernel-internals"    }
     { "resize-array" "arrays"               }

diff --git a/library/compiler/inference/known-words.factor b/library/compiler/inference/known-words.factor
index 1814a80de40fa95233edf3517ca2b218877217e3..2bfba437a2a6db41383397904f87c129e0f656c0 100644 (file)
--- a/library/compiler/inference/known-words.factor
+++ b/library/compiler/inference/known-words.factor
@@ -229,7 +229,8 @@ t over set-effect-terminated?
 \ (word) { object object } { word } <effect> "infer-effect" set-word-prop
 
 \ update-xt { word } { } <effect> "infer-effect" set-word-prop
-\ compiled? { word } { object } <effect> "infer-effect" set-word-prop
+
+\ word-xt { word } { integer } <effect> "infer-effect" set-word-prop
 
 \ getenv { fixnum } { object } <effect> "infer-effect" set-word-prop
 \ setenv { object fixnum } { } <effect> "infer-effect" set-word-prop
@@ -323,10 +324,6 @@ t over set-effect-terminated?
 
 \ set-slot { object object fixnum } { } <effect> "infer-effect" set-word-prop
 
-\ integer-slot { object fixnum } { integer } <effect> "infer-effect" set-word-prop
-
-\ set-integer-slot { integer object fixnum } { } <effect> "infer-effect" set-word-prop
-
 \ char-slot { fixnum object } { fixnum } <effect> "infer-effect" set-word-prop
 
 \ set-char-slot { fixnum fixnum object } { } <effect> "infer-effect" set-word-prop

diff --git a/library/kernel.facts b/library/kernel.facts
index 14c0336d672f3aee4d172f692fdb41cd6c1abc2a..3d32e2bc9c3778f4103edfb457d3e6a17fa92105 100644 (file)
--- a/library/kernel.facts
+++ b/library/kernel.facts
@@ -356,16 +356,6 @@ HELP: setenv ( obj n -- )
 { $values { "n" "a non-negative integer" } { "obj" "an object" } }
 { $description "Writes an object to the Factor runtime's environment table. User code never has to write to the environment table directly; instead, use one of the callers of this word." } ;
 
-HELP: integer-slot ( obj m -- n )
-{ $values { "obj" "an object" } { "m" "a non-negative fixnum" } { "n" "an integer" } }
-{ $description "Reads the untagged integer stored at the " { $snippet "n" } "th slot of " { $snippet "obj" } "." }
-{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it does not perform type or bounds checks, and slot numbers are implementation detail." } ;
-
-HELP: set-integer-slot ( m obj n -- )
-{ $values { "n" "an integer" }  { "obj" "an object" } { "m" "a non-negative fixnum" } }
-{ $description "Writes an untagged integer to the " { $snippet "n" } "th slot of " { $snippet "obj" } "." }
-{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it does not perform type or bounds checks, and slot numbers are implementation detail." } ;
-
 HELP: slot ( obj m -- value )
 { $values { "obj" "an object" } { "m" "a non-negative fixnum" } { "value" "an object" } }
 { $description "Reads the object stored at the " { $snippet "n" } "th slot of " { $snippet "obj" } "." }

diff --git a/library/words.factor b/library/words.factor
index 943c861fb5dbbccef619dbf087f344ce748ccdc2..e9f823c39cc1ea154ca1b7a012ef91a249d71174 100644 (file)
--- a/library/words.factor
+++ b/library/words.factor
@@ -49,9 +49,6 @@ M: symbol definer drop \ SYMBOL: ;
     [ rot word-props set-hash ]
     [ nip remove-word-prop ] if ;
 
-GENERIC: word-xt ( word -- xt )
-M: word word-xt 8 integer-slot ;
-
 SYMBOL: vocabularies
 
 : vocab ( name -- vocab ) vocabularies get hash ;

diff --git a/vm/primitives.c b/vm/primitives.c
index 148e9592c04dd6e3cf486a5d272accd54eaf604d..b6a2f65907ab785f52d609641b2ddcd7219fff04 100644 (file)
--- a/vm/primitives.c
+++ b/vm/primitives.c
@@ -68,6 +68,7 @@ void* primitives[] = {
        primitive_float_greatereq,
        primitive_word,
        primitive_update_xt,
+       primitive_word_xt,
        primitive_drop,
        primitive_2drop,
        primitive_3drop,
@@ -150,8 +151,6 @@ void* primitives[] = {
        primitive_alien_address,
        primitive_slot,
        primitive_set_slot,
-       primitive_integer_slot,
-       primitive_set_integer_slot,
        primitive_char_slot,
        primitive_set_char_slot,
        primitive_resize_array,

diff --git a/vm/run.c b/vm/run.c
index b3ce9e19e72e9a772e945d697529fbf6394e6ad1..6c222046e77f5f843deefa4f8d3098b95b69417e 100644 (file)
--- a/vm/run.c
+++ b/vm/run.c
@@ -217,21 +217,6 @@ void primitive_set_slot(void)
        write_barrier(obj);
 }
 
-void primitive_integer_slot(void)
-{
-       F_FIXNUM slot = untag_fixnum_fast(dpop());
-       CELL obj = UNTAG(dpop());
-       dpush(tag_cell(get(SLOT(obj,slot))));
-}
-
-void primitive_set_integer_slot(void)
-{
-       F_FIXNUM slot = untag_fixnum_fast(dpop());
-       CELL obj = UNTAG(dpop());
-       F_FIXNUM value = to_cell(dpop());
-       put(SLOT(obj,slot),value);
-}
-
 CELL clone(CELL obj)
 {
        CELL size = object_size(obj);

diff --git a/vm/run.h b/vm/run.h
index 4f3093fa6c855ed06cdf572c5aa4b65f3e9218ac..191677eff83d57a359b64f0c846b79eec2ea8389 100644 (file)
--- a/vm/run.h
+++ b/vm/run.h
@@ -123,8 +123,6 @@ void primitive_type(void);
 void primitive_tag(void);
 void primitive_slot(void);
 void primitive_set_slot(void);
-void primitive_integer_slot(void);
-void primitive_set_integer_slot(void);
 CELL clone(CELL obj);
 void primitive_clone(void);
 

diff --git a/vm/types.c b/vm/types.c
index d644e4e798e2adf4d784bb290e5a6773206ad0a0..6fd7b2f0cd09367b7d1651bdd94d115dbf39b0f8 100644 (file)
--- a/vm/types.c
+++ b/vm/types.c
@@ -450,6 +450,12 @@ void primitive_update_xt(void)
        update_xt(untag_word(dpop()));
 }
 
+void primitive_word_xt(void)
+{
+       F_WORD *word = untag_word(dpeek());
+       drepl(tag_cell(word->xt));
+}
+
 void fixup_word(F_WORD* word)
 {
        /* If this is a compiled word, relocate the code pointer. Otherwise,

diff --git a/vm/types.h b/vm/types.h
index 035d01efbce0b763260df2536756326e25094b2a..2c555fab7a3f0f54a3746076466ba9c80f60e339 100644 (file)
--- a/vm/types.h
+++ b/vm/types.h
@@ -161,6 +161,7 @@ INLINE CELL tag_word(F_WORD *word)
 void update_xt(F_WORD* word);
 void primitive_word(void);
 void primitive_update_xt(void);
+void primitive_word_xt(void);
 void fixup_word(F_WORD* word);
 
 INLINE F_WRAPPER *untag_wrapper_fast(CELL tagged)