diff --git a/projects/library/binary-tree.tal b/projects/library/binary-tree.tal new file mode 100644 index 0000000..e76a2f6 --- /dev/null +++ b/projects/library/binary-tree.tal @@ -0,0 +1,73 @@ +( + +binary tree node layout: + ++--+--+ +| ' | incoming-ptr* ++--+--+ key: null optional + v left right terminated binary + | ptr ptr string data + \ +--+--+--+--+---------+--+----- - - + ---> | ' | ' | U x n .00| + +--+--+--+--+---------+--+----- - - + +All of the pointers (ptr) are shorts that have the value of the memory +location of the next node, or 0000 to mean that pointer is empty. The very +simplest tree is one where the incoming-ptr* is empty: + ++--+--+ +|00'00| incoming-ptr* ++--+--+ + +traverse-tree does two jobs at once, depending on whether the search-key is +found: + +* if the search-key exists in the tree, return a pointer to the binary data + that follows that node's key string; + +* if the search-key is not present in the key, return the incoming-ptr* that + should be written when adding this node yourself. + +) + +@traverse-tree ( incoming-ptr* search-key* -- binary-ptr* 00 if key found + OR node-incoming-ptr* 01 if key not found ) + STH2 + &loop ( incoming-ptr* / search-key* ) + LDA2k ORA ,&valid-node JCN + POP2r #01 JMP2r + + &valid-node ( incoming-ptr* / search-key* ) + LDA2 ( node* / search-key* ) + DUP2 #0004 ADD2 ( node* node-key* / search-key* ) + STH2kr ( node* node-key* search-key* / search-key* ) + ,strcmp JSR ( node* node-end* search-end* order nomatch / search-key* ) + ,&nomatch JCN ( node* node-end* search-end* order / search-key* ) + POP POP2 ( node* node-end* / search-key* ) + INC2 NIP2 ( binary-ptr* / search-key* ) + POP2r #00 ( binary-ptr* 00 ) + JMP2r + + &nomatch ( node* node-end* search-end* order / search-key* ) + #80 AND #06 SFT #00 SWP STH2 ( node* node-end* search-end* / search-key* node-offset^ ) + POP2 POP2 ( node* / search-key* node-offset^ ) + STH2r ADD2 ( incoming-ptr* / search-key* ) + ,&loop JMP + +@strcmp ( a* b* -- a-end* b-end* order nonzero if strings differ + OR a-end* b-end* 00 00 if strings match ) + STH2 + ,&entry JMP + + &loop ( a* a b / b* ) + SUB ,&nomatch JCNk ( a* a-b nonzero / b* ) + POP2 ( a* / b* ) + INC2 INC2r + &entry ( a* / b* ) + LDAk LDAkr STHr ( a* a b / b* ) + ORAk ,&loop JCN + + &nomatch ( a* a-b flag / b* ) + STH2r SWP2 ( a* b* a-b flag ) + JMP2r + diff --git a/projects/software/asma.tal b/projects/software/asma.tal index 80a533d..735da2d 100644 --- a/projects/software/asma.tal +++ b/projects/software/asma.tal @@ -583,45 +583,10 @@ include projects/library/file-read-chunks.tal @asma-traverse-tree ( incoming-ptr* -- binary-ptr* 00 if key found OR node-incoming-ptr* 01 if key not found ) - &loop ( incoming-ptr* ) - LDA2k ORA ,&valid-node JCN - #01 JMP2r + ;asma/token LDA2 + ( fall through to traverse-tree ) - &valid-node - LDA2 STH2k - #0004 ADD2 ,asma-strcmp-tree JSR - DUP ,&nomatch JCN - POP2r JMP2r - - &nomatch - #06 SFT #02 AND #00 SWP - STH2r ADD2 - ,&loop JMP - - ( &help-str "Looking 20 "up 20 00 ) - -@asma-strcmp-tree ( node-key* -- order if strings differ - OR after-node-key* 00 if strings match ) - ;asma/token LDA2 STH2 - - &loop ( node-key* / token* ) - DUP2 INC2 SWP2 LDA LDAkr STHr - ORAk ,¬-end JCN - - ( end of C strings, match found ) - POP2r POP - JMP2r - - ¬-end - SUB - DUP ,&nomatch JCN - POP - LIT2r 0001 ADD2r - ,&loop JMP - - &nomatch - POP2r ROT ROT POP2 - JMP2r +include projects/library/binary-tree.tal ( First character routines. @@ -878,8 +843,8 @@ include projects/library/file-read-chunks.tal ¬-macro POP2 - ;&include-string ;asma-strcmp-tree JSR2 ,¬-include JCN - POP2 ( discard dummy after-node-key* ) + ;&include-string ;asma/token LDA2 + ;strcmp JSR2 NIP2 NIP2 NIP ,¬-include JCN #08 asma-STATE-SET JMP2r