Extracted binary tree library from asma

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
+

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 ,&not-end JCN
-
-	( end of C strings, match found )
-	POP2r POP
-	JMP2r
-
-	&not-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
 
 	&not-macro
 	POP2
-	;&include-string ;asma-strcmp-tree JSR2 ,&not-include JCN
-	POP2 ( discard dummy after-node-key* )
+	;&include-string ;asma/token LDA2
+		;strcmp JSR2 NIP2 NIP2 NIP ,&not-include JCN
 	#08 asma-STATE-SET
 	JMP2r