search.f

Tixys source code, include G.711, G.726, IMA-ADPCM etc.

\ Definitions for ANS Search Order and Search Order Extension words.
\
\ This program has been placed in the Public Domain by J.D.Medhurst (a.k.a. Tixy)

\ -------------------------------------------------------------------------
\ WORDS implementation

: LFA>NFA ( lfa -- nfa )
	CELL+ ;

: NAME ( nfa -- c-addr u )
	COUNT 31 AND ;

: .NAME ( lfa -- )
	LFA>NFA NAME TYPE SPACE ;

: WORDLIST-WORDS ( wid -- )
	@ BEGIN DUP @ WHILE DUP .NAME DUP @ + REPEAT DROP ;

: WORDS ( -- )
	CONTEXT @ 1+ 1 ?DO CONTEXT I CELLS + @ WORDLIST-WORDS LOOP ;

\ -------------------------------------------------------------------------
\ Search order manipulation

: GET-CURRENT ( -- wid )
	CURRENT @ ;

: SET-CURRENT ( wid -- )
	CURRENT ! ;

: GET-ORDER ( -- widn ... wid1 n )
	0 CONTEXT @ ?DO CONTEXT I CELLS + @ -1 +LOOP ;

: SET-ORDER ( widn ... wid1 n -- )
	DUP 0< IF DROP FORTH-WORDLIST 1 THEN
	DUP 1+ 0 DO CONTEXT I CELLS + ! LOOP ;

: ALSO ( -- )
	GET-ORDER >R DUP R> 1+ SET-ORDER ;

: ONLY ( -- )
	-1 SET-ORDER ;

: PREVIOUS ( -- )
	GET-ORDER NIP 1- SET-ORDER ;

: DEFINITIONS ( -- )
	CONTEXT CELL+ @ SET-CURRENT ;

\ -------------------------------------------------------------------------
\ Wordlist creation

CREATE WORDLIST-END 0 ,

: WORDLIST ( -- wid )
	ALIGN HERE WORDLIST-END , WORDLISTS @ , 0 , DUP WORDLISTS ! ;

: WID>LFA-PTR ( wid -- nfa )
	CELL+ CELL+ ;

: NAME-WORDLIST ( wid -- )
	LATEST @ SWAP WID>LFA-PTR ! ;

: (vocabulary) ( wid -- )
	CONTEXT CELL+ ! ;

\ -------------------------------------------------------------------------
\ ORDER Implementation

: .H ( x -- )
	BASE @ SWAP HEX . BASE ! ;

: .WID ( wid -- )
	DUP WID>LFA-PTR @ ?DUP IF .NAME DROP EXIT THEN .H ;

: ORDER ( -- )
	GET-CURRENT .WID SPACE
	GET-ORDER BEGIN ?DUP WHILE 1- SWAP .WID REPEAT ;

\ -------------------------------------------------------------------------
\ Definitions for FORTH and ENVIRONMENT vocabularies

: VOCABULARY ( "<spaces>name" -- )
	CREATE WORDLIST NAME-WORDLIST DOES> (vocabulary) ;

: FORTH ( -- )
	FORTH-WORDLIST (vocabulary) ;

FORTH-WORDLIST NAME-WORDLIST

FORTH-WORDLIST CELL+ @
CONSTANT ENVIRONMENT-WORDLIST

: ENVIRONMENT ( -- )
	ENVIRONMENT-WORDLIST (vocabulary) ;

ENVIRONMENT-WORDLIST NAME-WORDLIST