: .HEAD ( nfa--)
name_count ~TYPE
;
\ Print the words in alpha order.
\ First we have to work out how many will match.
\ Then allocate a buffer big enough to store three pointers per word
\ datapointer lesspointer greaterpointer.
\ We could be stingy and use 2bytes for less and greater pointers but why bother.
\ we return the buffer anyway.
\ Then we add the words to the structure and print it out.
\ In other words we create a binary tree and use it.
\ describe the binary tree structure
zero
| DUP CONSTANT _#pointer_data CELL+ \ name address
| DUP CONSTANT _#pointer_less CELL+ \ a offset
| DUP CONSTANT _#pointer_greater CELL+ \ a offset
| CONSTANT _#pointer_length
10 CONSTANT _#print_column
: .HEAD ( nfa--)
name_count _#name_count_bits AND ~TYPE
;
\ tab to a mutlipel of n
: tabs ( n--)
character# OVER / 1 + * character# - zero MAX SPACES ;
\ if character# is greater than character_max afer adding n a CR
: ?cr ( n --)
character# + character_max @ < not IF CR THEN ;
: _print_tree ( offset -- )
buffer OVER + _#pointer_less + @ ?DUP IF ( sorry more to go )
\ offset offset_new (--
RECURSE \ when we get back all less than is done
THEN
\ print ourselves
^C
buffer OVER +
_#pointer_data + @ .HEAD
_#print_column tabs SPACE
_#print_column
?cr
\ now the greater than connected to this node
buffer OVER + _#pointer_greater + @ ?DUP IF ( there is greater stuff)
RECURSE \ when we get back all is done
\ to the word we where less than
THEN
DROP \ (--
;
: (words) { variable _%wid variable _$match1 -- }{
variable _%word_cnt \ number of words that will be printed.
variable _%buffer_pointer \ where we put the next lot of data
\ when loading the buffer.
variable _%current_packet \ packet we are dealing with when linking
\ new packet in tree.
variable _%#threads \ number of threads to deal with
}
zero _%word_cnt ! \ (-- number of words found
_%wid @
[ _#voc_head> _#voc_wid - ]T LITERAL + @ DUP \ heads heads(--
[ _#voc_heads_count _#voc_heads_base - ]T LITERAL + @
_%#threads ! \ heads (--
[ _#voc_heads_data _#voc_heads_base - ]T LITERAL + \ threads(--
_%#threads @ zero DO
DUP I CELLS + BEGIN \ threads link (--
@ ?DUP
WHILE
DUP lfa>nfa name_count _#name_count_bits AND
_$match1 @ COUNT SEARCH IF
one _%word_cnt +! \ threads link (--
THEN
2DROP
^C
REPEAT
LOOP \ threads (--
\ threads(-- We now know how many words we will have to deal with
_%word_cnt @ IF
\ Get and initialize our data area.
_%word_cnt @ _#pointer_length * get_buffer \ get_buffer puts in 'buffer the
\ address of an area
\ large enough
\ to store the data
\ This is the fastest method to initialise
buffer _%word_cnt @ _#pointer_length * ERASE
zero _%buffer_pointer !
\ threads(--
_%#threads @ zero DO
DUP I CELLS +
BEGIN
@ ?DUP
WHILE
\ threads link(--
DUP lfa>nfa name_count _#name_count_bits AND _$match1 @ COUNT SEARCH IF \ word has to be added
2DROP
DUP lfa>nfa \ threads link nfa(--
\ remember the less and greater pointers are zero
\ because of the erase above.
\ we can use the code below for the first time through
\ because the _buffer_pointers are zero.
DUP buffer _%buffer_pointer @ + _#pointer_data + ! \ threads link nfa(--
zero _%current_packet !
name_count _#name_count_bits AND
BEGIN
2DUP
_%current_packet @ buffer + _#pointer_data + @
name_count _#name_count_bits AND COMPARE \ threads link addr n flag(--
0< IF ( new data is less than current node)
_%current_packet @ buffer + _#pointer_less + @ DUP 0= IF
\ we can place a pointer here
\ threads link nfa zero (--
_%buffer_pointer @
_%current_packet @ buffer + _#pointer_less + !
ELSE
\ threads link nfa next_pointer (--
DUP _%current_packet !
THEN
ELSE ( new data is higher than current node)
_%current_packet @ buffer + _#pointer_greater + @ DUP 0= IF
\ we can place a pointer here
\ threads link nfa zero (--
_%buffer_pointer @
_%current_packet @ buffer + _#pointer_greater + !
ELSE
\ threads link nfa next_pointer (--
DUP _%current_packet !
THEN
THEN
^C
0= UNTIL \ threads link nfa (--
2DROP
( used a buffer position)
_#pointer_length _%buffer_pointer +!
\ threads link (--
ELSE 2DROP THEN
REPEAT \ threads list(--
LOOP
\ (--
\ we now have a structure that can be used to print out the names in
\ sorted order.
\ You trace down less link until zero, print it go back trace down less link
\ until zero print it etc.
\ as this is best done with recursize code there is a word _print_tree
CR
zero _print_tree
send
kill_buffer
THEN \ threads(--
DROP
;
( -- )
List the definition names in the first word list of the search order. The format of the display is implementation-dependent.
WORDS does not corrupt the transient region identified by #>.
: WORDS { ( "name" ) }{
variable _$match1 }
$buffer buffer _$match1 !
\ set count of strings to zero
BL (word) _$match1 @ $make
context @ _$match1 @ (words)
kill_buffer
;