words are now hashed

TODO.FACTOR.txt

@@ -6,6 +6,7 @@
   - index.html
   - if a directory is requested and URL does not end with /, redirect
 - minimize stage2 initialization code, just move it to source files
+_ push call/allot counts as ulong bignums
 
 + bignums:
 

library/cross-compiler.factor

@@ -98,6 +98,7 @@ DEFER: (random-int)
 
 IN: words
 DEFER: <word>
+DEFER: word-hashcode
 DEFER: word-primitive
 DEFER: set-word-primitive
 DEFER: word-parameter
@@ -196,6 +197,7 @@ IN: cross-compiler
         fsqrt
         word?
         <word>
+        word-hashcode
         word-primitive
         set-word-primitive
         word-parameter

library/image.factor

@@ -36,6 +36,7 @@ USE: logic
 USE: math
 USE: namespaces
 USE: prettyprint
+USE: random
 USE: stack
 USE: stdio
 USE: streams
@@ -168,7 +169,9 @@ USE: words
 ( Words )
 
 : word, ( -- pointer )
-    word-tag here-as word-tag >header emit 0 emit ;
+    word-tag here-as word-tag >header emit
+    0 HEX: fffffff random-int emit ( hashcode )
+    0 emit ;
 
 ! This is to handle mutually recursive words
 ! It is a hack. A recursive word in the cdr of a
@@ -295,7 +298,6 @@ IN: cross-compiler
     r> ( parameter -- ) emit
     ( plist -- ) emit
     0 emit ( padding )
-    0 emit
     0 emit ;
 
 : primitive, ( word primitive -- ) f (worddef,) ;

library/platform/native/kernel.factor

@@ -47,6 +47,7 @@ USE: vectors
 : hashcode ( obj -- hash )
     #! If two objects are =, they must have equal hashcodes.
     [
+        [ word? ] [ word-hashcode ]
         [ cons? ] [ 4 cons-hashcode ]
         [ string? ] [ str-hashcode ]
         [ number? ] [ >fixnum ]

native/primitives.c

@@ -87,6 +87,7 @@ XT primitives[] = {
         primitive_fsqrt,
 	primitive_wordp,
 	primitive_word,
+	primitive_word_hashcode,
 	primitive_word_primitive,
 	primitive_set_word_primitive,
 	primitive_word_parameter,

native/primitives.h

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

native/word.c

@@ -3,11 +3,13 @@
 WORD* word(CELL primitive, CELL parameter, CELL plist)
 {
 	WORD* word = allot_object(WORD_TYPE,sizeof(WORD));
+	word->hashcode = (CELL)word; /* initial address */
 	word->xt = primitive_to_xt(primitive);
 	word->primitive = primitive;
 	word->parameter = parameter;
 	word->plist = plist;
 	word->call_count = 0;
+	word->allot_count = 0;
 
 	return word;
 }
@@ -35,6 +37,11 @@ void primitive_word(void)
 	dpush(tag_word(word(primitive,parameter,plist)));
 }
 
+void primitive_word_hashcode(void)
+{
+	drepl(tag_fixnum(untag_word(dpeek())->hashcode));
+}
+
 void primitive_word_primitive(void)
 {
 	drepl(tag_fixnum(untag_word(dpeek())->primitive));

native/word.h

@@ -3,6 +3,8 @@ typedef void (*XT)(void);
 typedef struct {
 	/* TAGGED header */
 	CELL header;
+	/* untagged hashcode */
+	CELL hashcode;
 	/* untagged execution token: jump here to execute word */
 	CELL xt;
 	/* untagged on-disk primitive number */
@@ -15,7 +17,6 @@ typedef struct {
 	CELL call_count;
 	/* UNTAGGED amount of memory allocated in word */
 	CELL allot_count;
-	CELL padding;
 } WORD;
 
 INLINE WORD* untag_word(CELL tagged)
@@ -33,6 +34,7 @@ WORD* word(CELL primitive, CELL parameter, CELL plist);
 void update_xt(WORD* word);
 void primitive_wordp(void);
 void primitive_word(void);
+void primitive_word_hashcode(void);
 void primitive_word_primitive(void);
 void primitive_set_word_primitive(void);
 void primitive_word_parameter(void);