diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 673606eb13..bbd9d6c132 100644 --- a/TODO.FACTOR.txt +++ b/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: diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor index 9f2d8dac11..9701b319b2 100644 --- a/library/cross-compiler.factor +++ b/library/cross-compiler.factor @@ -98,6 +98,7 @@ DEFER: (random-int) IN: words DEFER: +DEFER: word-hashcode DEFER: word-primitive DEFER: set-word-primitive DEFER: word-parameter @@ -196,6 +197,7 @@ IN: cross-compiler fsqrt word? + word-hashcode word-primitive set-word-primitive word-parameter diff --git a/library/image.factor b/library/image.factor index 5465e42678..bb830ea1b6 100644 --- a/library/image.factor +++ b/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,) ; diff --git a/library/platform/native/kernel.factor b/library/platform/native/kernel.factor index f2ac860605..e6563ad71e 100644 --- a/library/platform/native/kernel.factor +++ b/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 ] diff --git a/native/primitives.c b/native/primitives.c index 6fc8020b0b..b71913d848 100644 --- a/native/primitives.c +++ b/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, diff --git a/native/primitives.h b/native/primitives.h index 7304689766..8f29a1d387 100644 --- a/native/primitives.h +++ b/native/primitives.h @@ -1,4 +1,4 @@ extern XT primitives[]; -#define PRIMITIVE_COUNT 144 +#define PRIMITIVE_COUNT 145 CELL primitive_to_xt(CELL primitive); diff --git a/native/word.c b/native/word.c index 90a05a85b6..f304ffe688 100644 --- a/native/word.c +++ b/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)); diff --git a/native/word.h b/native/word.h index eece411c32..d4623c94dd 100644 --- a/native/word.h +++ b/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);