Add TRAVERSE-WORDLIST with some tests. Add P4_Nt type in case

of switch from xt == nt to xt != nt.

src/post4.c

@@ -760,7 +760,7 @@ p4WordAppend(P4_Ctx *ctx, P4_Cell data)
 	*(P4_Cell *)p4Allot(ctx, sizeof (data)) = data;
 }
 
-P4_Word *
+P4_Nt
 p4FindNameIn(P4_Ctx *ctx, const char *caddr, P4_Size length, unsigned wid)
 {
 	if (wid < 1 || P4_WORDLISTS < wid) {
@@ -777,13 +777,13 @@ p4FindNameIn(P4_Ctx *ctx, const char *caddr, P4_Size length, unsigned wid)
 	return NULL;
 }
 
-P4_Word *
+P4_Nt
 p4FindName(P4_Ctx *ctx, const char *caddr, P4_Size length)
 {
 	for (unsigned i = 0; i < ctx->norder; i++) {
-		P4_Word *word = p4FindNameIn(ctx, caddr, length, ctx->order[i]);
-		if (word != NULL) {
-			return word;
+		P4_Nt nt = p4FindNameIn(ctx, caddr, length, ctx->order[i]);
+		if (nt != NULL) {
+			return nt;
 		}
 	}
 	return NULL;
@@ -1419,7 +1419,7 @@ _inter_loop:	while (ctx->input->offset < ctx->input->length) {
 			} else if (ctx->state == P4_STATE_COMPILE && !P4_WORD_IS_IMM(word)) {
 				p4WordAppend(ctx, (P4_Cell) word);
 			} else {
-_forth:				exec[0].w = word;
+_forth:				exec[0].xt = word;
 				ip = exec;
 				NEXT;
 			}
@@ -1511,7 +1511,7 @@ _branchnz:	w = *ip;
 
 #ifdef HAVE_HOOKS
 		// ( i*x -- j*y )
-_hook_call:	x = w.w->data[0];
+_hook_call:	x = w.xt->data[0];
 		(*(void (*)(P4_Ctx *)) x.p)(ctx);
 		NEXT;
 #endif
@@ -1658,12 +1658,12 @@ _create:	str = p4ParseName(ctx->input);
 		word = p4WordCreate(ctx, str.string, str.length, &&_data_field);
 		// Reserve the 1st data cell for possible DOES>; wasted otherwise.
 		p4WordAppend(ctx, (P4_Cell)(P4_Int) 0),
-		P4_WORD_SET_CREATED(word);
+		P4_WORD_SET(word, P4_BIT_CREATED);
 		NEXT;
 
 		// DOES>
 _does:		word = *ctx->active;
-		if (!P4_WORD_WAS_CREATED(word)) {
+		if (!P4_WORD_IS(word, P4_BIT_CREATED)) {
 			THROW(P4_THROW_NOT_CREATED);
 		}
 		word->code = &&_do_does;
@@ -1693,7 +1693,7 @@ _do_does:	P4_PUSH(ctx->ds, w.xt->data + 1);
 
 		// ( xt -- addr )
 _body:		w = P4_POP(ctx->ds);
-		if (!P4_WORD_WAS_CREATED(w.w)) {
+		if (!P4_WORD_IS(w.nt, P4_BIT_CREATED)) {
 			THROW(P4_THROW_NOT_CREATED);
 		}
 		/*@fallthrough@*/
@@ -1713,10 +1713,9 @@ _allot:		P4_DROP(ctx->ds, 1);
 		// ( xt -- <spaces>name )
 _alias:		P4_DROP(ctx->ds, 1);
 		str = p4ParseName(ctx->input);
-		word = p4WordCreate(ctx, str.string, str.length, x.w->code);
-		word->bits = x.w->bits;
-		word->data = x.w->data;
-		word->ndata = x.w->ndata;
+		word = p4WordCreate(ctx, str.string, str.length, x.xt->code);
+		word->ndata = x.xt->ndata;
+		word->data = x.xt->data;
 		NEXT;
 
 		// ( key k -- value v )
@@ -2044,16 +2043,16 @@ _parse_name:	str = p4ParseName(ctx->input);
 		P4_PUSH(ctx->ds, str.length);
 		NEXT;
 
-		// ( caddr u -- xt | 0 )
+		// ( caddr u -- nt | 0 )
 _find_name:	w = P4_DROPTOP(ctx->ds);
-		P4_TOP(ctx->ds).w = p4FindName(ctx, w.s, x.z);
+		P4_TOP(ctx->ds).nt = p4FindName(ctx, w.s, x.z);
 		NEXT;
 
-		// ( caddr u wid -- xt | 0 )
+		// ( caddr u wid -- nt | 0 )
 _find_name_in:	y = P4_POP(ctx->ds);
 		w = P4_POP(ctx->ds);
 		x = P4_TOP(ctx->ds);
-		P4_TOP(ctx->ds).w = p4FindNameIn(ctx, x.s, w.z, y.u);
+		P4_TOP(ctx->ds).nt = p4FindNameIn(ctx, x.s, w.z, y.u);
 		NEXT;
 
 		// ( ms -- )

src/post4.h

@@ -301,7 +301,8 @@ typedef union p4_cell P4_Cell;
 typedef struct p4_word P4_Word;
 typedef struct p4_ctx P4_Ctx;
 
-typedef P4_Word *P4_Xt;
+typedef P4_Word *P4_Nt;
+typedef P4_Word *P4_Xt;			/* Currently same as an nt, but could change. */
 
 typedef struct {
 	P4_Size		length;		/* Length of string less NUL byte. */
@@ -344,7 +345,7 @@ union p4_cell {
 	P4_Cell	*	p;
 	char *		s;
 	void *		v;
-	P4_Word *	w;
+	P4_Nt		nt;
 	P4_Xt		xt;
 	const P4_Word *	cw;
 };
@@ -374,9 +375,6 @@ struct p4_word {
 #define P4_WORD_SET_IMM(w)		P4_WORD_SET(w, P4_BIT_IMM)
 #define P4_WORD_CLEAR_IMM(w)		P4_WORD_CLEAR(w, P4_BIT_IMM)
 
-#define P4_WORD_WAS_CREATED(w)		P4_WORD_IS(w, P4_BIT_CREATED)
-#define P4_WORD_SET_CREATED(w)		P4_WORD_SET(w, P4_BIT_CREATED)
-
 #define P4_WORD_IS_HIDDEN(w)		P4_WORD_IS(w, P4_BIT_HIDDEN)
 #define P4_WORD_SET_HIDDEN(w)		P4_WORD_SET(w, P4_BIT_HIDDEN)
 #define P4_WORD_CLEAR_HIDDEN(w)		P4_WORD_CLEAR(w,P4_BIT_HIDDEN)

src/post4.p4

@@ -2502,9 +2502,12 @@ MIN-N CONSTANT _sign_mask
 \ (S: x -- )
 : $#. DUP -65535 65536 WITHIN IF #. ELSE $. THEN ; $10 _pp!
 
+\ (S: addr u -- addr' addr )
+: bounds OVER + SWAP ;
+
 \ (S: addr u -- )
 : .cells
-	OVER + SWAP BEGIN 2DUP > WHILE
+	bounds BEGIN 2DUP > WHILE
 		DUP @ $#. CELL+
 	REPEAT 2DROP
 ; $20 _pp!
@@ -2544,7 +2547,7 @@ MIN-N CONSTANT _sign_mask
 
 \ (S: addr u -- )
 : DUMP
-	CHARS OVER + SWAP
+	CHARS bounds
 	BASE @ >R HEX
 	BEGIN 2DUP U> WHILE
 		2DUP _dump_row
@@ -2586,7 +2589,7 @@ MIN-N CONSTANT _sign_mask
 
 \ (S: caddr u -- )
 : \type
-	OVER + SWAP							\ S: b a
+	bounds								\ S: b a
 	BEGIN 2DUP > WHILE					\ S: b a
 		C@+ DUP _literal_backspace		\ S: b a' c e
 		?DUP IF							\ S: b a' c
@@ -2758,13 +2761,13 @@ CREATE _nada
 1 CONSTANT FORTH-WORDLIST
 
 \ (S: -- wid )
-: GET-CURRENT _ctx ctx.words _ctx ctx.lists - /CELL / 1+ ;
+: GET-CURRENT _ctx ctx.words _ctx ctx.lists - /CELL / 1+ ; $01 _pp!
 
 \ (S: wid -- )
 : SET-CURRENT
 	1- DUP 0 WORDLISTS WITHIN 0= -257 AND THROW
 	CELLS _ctx ctx.lists + _ctx ctx.active !
-;
+; $10 _pp!
 
 FORTH-WORDLIST SET-CURRENT
 
@@ -2779,7 +2782,7 @@ FORTH-WORDLIST SET-CURRENT
 		CELL+ 2DUP U>
 	WHILST
 	2DROP -257 THROW
-;
+; $01 _pp!
 
 \ (S: -- )
 : FORTH FORTH-WORDLIST _ctx ctx.order ! ;
@@ -2814,7 +2817,27 @@ FORTH-WORDLIST SET-CURRENT
 		R> DUP CELL+ >R !				\ S: wn.. 		R: p" p'
 	REPEAT
 	2R> 2DROP
-;
+; $10 _pp!
+
+\ (S: wid -- addr )
+: head_of_wordlist
+	1- DUP 0 WORDLISTS WITHIN 0= -257 AND THROW
+	CELLS _ctx ctx.lists +
+; $11 _pp!
+
+\ (S: i*x xt wid -- j*x )
+: TRAVERSE-WORDLIST
+	SWAP >R head_of_wordlist			\ S: w			R: xt
+	BEGIN @ DUP WHILE						\ S: w			R: xt
+		DUP w.length @ IF				\ S: w			R: xt
+			R@ OVER >R EXECUTE 0= IF	\ S: w xt		R: xt w
+				2R> 2DROP EXIT
+			THEN
+		THEN
+		R> w.prev						\ S: w'			R: xt
+	REPEAT
+	R> 2DROP
+; $20 _pp!
 
 \ (S: caddr u wid -- 0 | xt -1 | xt 1 )
 : SEARCH-WORDLIST
@@ -2825,15 +2848,15 @@ FORTH-WORDLIST SET-CURRENT
 			-1							\ S: xt -1
 		THEN
 	THEN
-;
+; $30 _pp!
 
 \ (S: -- )
 : ONLY -1 SET-ORDER ;
 : PREVIOUS GET-ORDER NIP 1- SET-ORDER ;
 : ALSO GET-ORDER OVER SWAP 1+ SET-ORDER ;
 : DEFINITIONS GET-ORDER OVER SET-CURRENT SET-ORDER ;
 
-: show_wid ( wid -- ) S\" \e[36m[ " TYPE #. S\" ]\e[0m\r\n" TYPE ;
+: show_wid ( wid -- ) S\" \e[36m[ " TYPE #. S\" ]\e[0m\r\n" TYPE ; $10 _pp!
 
 : ORDER ( -- )
 	GET-ORDER GET-ORDER

test/search.p4

@@ -171,7 +171,22 @@ t{ ' ' CATCH tw_y -> -13 }t
 
 \ Last word remains.
 t{ ' ' CATCH tw_x NIP -> 0 }t
+test_group_end
+
+.( TRAVERSE-WORDLIST ) test_group
+WORDLIST CONSTANT tv_traverse_wid
+: tw_count_words ( u nt -- u' bool ) DROP 1+ TRUE ;
+: tw_show_name ( nt -- bool ) NAME>STRING TYPE SPACE TRUE ;
 
+t{ tv_traverse_wid SET-CURRENT -> }t
+: tw_whoopee 1234 ;
+: tw_lots_of 5678 ;
+
+CR .( tw_show_name 2 words: )
+t{ ' tw_show_name GET-CURRENT TRAVERSE-WORDLIST -> }t
+CR
+t{ 0 ' tw_count_words tv_traverse_wid TRAVERSE-WORDLIST -> 2 }t
+ONLY FORTH DEFINITIONS
 test_group_end
 
 [THEN]