Return to search-order.fs CVS log

Up to [gforth] / gforth

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

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.10    ! pazsan     24:   here  0 A, Forth-wordlist wordlist-map @ A, voclink @ A, slowvoc @ A,
        !            25:   dup wordlist-link 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
1.10    ! pazsan     39:     drop vp dup @ 1- cells over +
        !            40:     DO  2dup I 2@ over <>
        !            41:         IF  (search-wordlist) dup
        !            42:            IF  nip nip  UNLOOP EXIT
        !            43:            THEN  drop
        !            44:         ELSE  drop 2drop  THEN
        !            45:     [ -1 cells ] Literal +LOOP
1.2       anton      46:     2drop false ;
                     47: 
                     48: 0 value locals-wordlist
                     49: 
1.5       pazsan     50: : (localsvocfind)  ( addr count nfa1 -- nfa2|false )
1.2       anton      51:     \ !! use generalized (vocfind)
                     52:     drop locals-wordlist
                     53:     IF 2dup locals-wordlist (search-wordlist) dup
                     54:        IF nip nip
                     55:            EXIT
                     56:        THEN drop
                     57:     THEN
                     58:     0 (vocfind) ;
                     59: 
                     60: \ In the kernal the dictionary search works on only one wordlist.
                     61: \ The following stuff builds a thing that looks to the kernal like one
                     62: \ wordlist, but when searched it searches the whole search order
                     63: \  (including locals)
1.1       anton      64: 
1.2       anton      65: \ this is the wordlist-map of the dictionary
1.5       pazsan     66: Create vocsearch       ' (localsvocfind) A, ' (reveal) A,  ' drop A,
1.1       anton      67: 
                     68: \ Only root                                            14may93py
                     69: 
1.2       anton      70: wordlist \ the wordlist structure
1.10    ! pazsan     71: vocsearch over wordlist-map A! \ patch the map into it
1.1       anton      72: 
                     73: Vocabulary Forth
                     74: Vocabulary Root
                     75: 
                     76: : Only  vp off  also Root also definitions ;
                     77: 
                     78: \ set initial search order                             14may93py
                     79: 
                     80: Forth-wordlist @ ' Forth >body A!
                     81: 
1.8       pazsan     82: vp off  also Root also definitions
1.1       anton      83: Only Forth also definitions
                     84: 
1.7       pazsan     85: lookup A! \ our dictionary search order becomes the law
1.3       pazsan     86: 
1.1       anton      87: \ get-order set-order                                  14may93py
                     88: 
                     89: : get-order  ( -- wid1 .. widn n )
                     90:   vp @ 0 ?DO  vp cell+ I cells + @  LOOP  vp @ ;
                     91: 
                     92: : set-order  ( wid1 .. widn n / -1 -- )
                     93:   dup -1 = IF  drop Only exit  THEN  dup vp !
                     94:   ?dup IF  1- FOR  vp cell+ I cells + !  NEXT  THEN ;
                     95: 
                     96: : seal ( -- )  context @ 1 set-order ;
                     97: 
                     98: \ words visible in roots                               14may93py
                     99: 
                    100: : .name ( name -- ) name>string type space ;
                    101: : words  cr 0 context @
                    102:   BEGIN  @ dup  WHILE  2dup cell+ c@ $1F and 2 + dup >r +
                    103:          &79 >  IF  cr nip 0 swap  THEN
                    104:          dup .name space r> rot + swap  REPEAT 2drop ;
                    105: 
                    106: : body> ( data -- cfa )  0 >body - ;
                    107: 
                    108: : .voc  body> >name .name ;
                    109: : order  1 vp @  DO  vp I cells + @ .voc  -1 +LOOP  2 spaces
                    110:   current @ .voc ;
1.10    ! pazsan    111: : vocs   voclink  BEGIN  @ dup @  WHILE  dup 0 wordlist-link - .voc  REPEAT
        !           112:   drop ;
1.1       anton     113: 
                    114: Root definitions
                    115: 
                    116: ' words Alias words
                    117: ' Forth Alias Forth
                    118: 
                    119: Forth definitions
1.5       pazsan    120: 
1.6       anton     121: include hash.fs
1.9       pazsan    122: 
                    123: \ marker                                               18dec94py
                    124: 
                    125: \ Marker creates a mark that is removed (including everything 
                    126: \ defined afterwards) when executing the mark.
                    127: 
                    128: : marker, ( -- mark )  here dup A,
                    129:   voclink @ A, voclink
1.10    ! pazsan    130:   BEGIN  @ dup @  WHILE  dup 0 wordlist-link - @ A,  REPEAT  drop
1.9       pazsan    131:   udp @ , ;
                    132: 
                    133: : marker! ( mark -- )  dup @ swap cell+
                    134:   dup @ voclink ! cell+
                    135:   voclink
1.10    ! pazsan    136:   BEGIN  @ dup @  WHILE  over @ over 0 wordlist-link - !
1.9       pazsan    137:         swap cell+ swap
                    138:   REPEAT  drop  voclink
1.10    ! pazsan    139:   BEGIN  @ dup @  WHILE  dup 0 wordlist-link - rehash  REPEAT  drop
1.9       pazsan    140:   @ udp !  dp ! ;
                    141: 
                    142: : marker ( "mark" -- )
                    143:   marker, Create A,  DOES>  @ marker! ;