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

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:
 

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"               }

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

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

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 ;

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,

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

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

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,

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)