Annotation of gforth/search-order.fs, revision 1.8

1.1       anton       1: \ search order wordset                                 14may93py
                      2: 
                      3: $10 constant maxvp
                      4: Variable vp
1.5       pazsan      5:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
                      6:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
1.1       anton       7: 
                      8: : get-current  ( -- wid )  current @ ;
                      9: : set-current  ( wid -- )  current ! ;
                     10: 
                     11: : context ( -- addr )  vp dup @ cells + ;
                     12: : definitions  ( -- )  context @ current ! ;
                     13: 
1.5       pazsan     14: \ wordlist Vocabulary also previous                    14may93py
1.3       pazsan     15: 
1.5       pazsan     16: AVariable voclink
1.3       pazsan     17: 
1.5       pazsan     18: Defer 'initvoc
                     19: ' drop IS 'initvoc
1.1       anton      20: 
1.5       pazsan     21: Variable slowvoc   slowvoc off
1.1       anton      22: 
                     23: : wordlist  ( -- wid )
1.5       pazsan     24:   here  0 A, Forth-wordlist cell+ @ A, voclink @ A, slowvoc @ A,
                     25:   dup 2 cells + dup voclink ! 'initvoc ;
1.1       anton      26: 
                     27: : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
                     28: 
                     29: : also  ( -- )
                     30:   context @ vp @ 1+ dup maxvp > abort" Vocstack full"
                     31:   vp ! context ! ;
                     32: 
                     33: : previous ( -- )  vp @ 1- dup 0= abort" Vocstack empty" vp ! ;
                     34: 
                     35: \ vocabulary find                                      14may93py
                     36: 
1.5       pazsan     37: : (vocfind)  ( addr count nfa1 -- nfa2|false )
1.2       anton      38:     \ !! generalize this to be independent of vp
                     39:     drop 1 vp @
                     40:     DO  2dup vp I cells + @ (search-wordlist) dup
                     41:        IF  nip nip
                     42:            UNLOOP EXIT
                     43:        THEN  drop
                     44:     -1 +LOOP
                     45:     2drop false ;
                     46: 
                     47: 0 value locals-wordlist
                     48: 
1.5       pazsan     49: : (localsvocfind)  ( addr count nfa1 -- nfa2|false )
1.2       anton      50:     \ !! use generalized (vocfind)
                     51:     drop locals-wordlist
                     52:     IF 2dup locals-wordlist (search-wordlist) dup
                     53:        IF nip nip
                     54:            EXIT
                     55:        THEN drop
                     56:     THEN
                     57:     0 (vocfind) ;
                     58: 
                     59: \ In the kernal the dictionary search works on only one wordlist.
                     60: \ The following stuff builds a thing that looks to the kernal like one
                     61: \ wordlist, but when searched it searches the whole search order
                     62: \  (including locals)
1.1       anton      63: 
1.2       anton      64: \ this is the wordlist-map of the dictionary
1.5       pazsan     65: Create vocsearch       ' (localsvocfind) A, ' (reveal) A,  ' drop A,
1.1       anton      66: 
                     67: \ Only root                                            14may93py
                     68: 
1.2       anton      69: wordlist \ the wordlist structure
                     70: vocsearch over cell+ A! \ patch the map into it
1.1       anton      71: 
                     72: Vocabulary Forth
                     73: Vocabulary Root
                     74: 
                     75: : Only  vp off  also Root also definitions ;
                     76: 
                     77: \ set initial search order                             14may93py
                     78: 
                     79: Forth-wordlist @ ' Forth >body A!
                     80: 
1.8     ! pazsan     81: vp off  also Root also definitions
1.1       anton      82: Only Forth also definitions
                     83: 
1.7       pazsan     84: lookup A! \ our dictionary search order becomes the law
1.3       pazsan     85: 
1.1       anton      86: \ get-order set-order                                  14may93py
                     87: 
                     88: : get-order  ( -- wid1 .. widn n )
                     89:   vp @ 0 ?DO  vp cell+ I cells + @  LOOP  vp @ ;
                     90: 
                     91: : set-order  ( wid1 .. widn n / -1 -- )
                     92:   dup -1 = IF  drop Only exit  THEN  dup vp !
                     93:   ?dup IF  1- FOR  vp cell+ I cells + !  NEXT  THEN ;
                     94: 
                     95: : seal ( -- )  context @ 1 set-order ;
                     96: 
                     97: \ words visible in roots                               14may93py
                     98: 
                     99: : .name ( name -- ) name>string type space ;
                    100: : words  cr 0 context @
                    101:   BEGIN  @ dup  WHILE  2dup cell+ c@ $1F and 2 + dup >r +
                    102:          &79 >  IF  cr nip 0 swap  THEN
                    103:          dup .name space r> rot + swap  REPEAT 2drop ;
                    104: 
                    105: : body> ( data -- cfa )  0 >body - ;
                    106: 
                    107: : .voc  body> >name .name ;
                    108: : order  1 vp @  DO  vp I cells + @ .voc  -1 +LOOP  2 spaces
                    109:   current @ .voc ;
                    110: : vocs   voclink  BEGIN  @ dup @  WHILE  dup 2 cells - .voc  REPEAT  drop ;
                    111: 
                    112: Root definitions
                    113: 
                    114: ' words Alias words
                    115: ' Forth Alias Forth
                    116: 
                    117: Forth definitions
1.5       pazsan    118: 
1.6       anton     119: include hash.fs

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>