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

1.1       anton       1: \ search order wordset                                 14may93py
                      2: 
1.13      anton       3: \ Copyright (C) 1995 Free Software Foundation, Inc.
                      4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
                      9: \ as published by the Free Software Foundation; either version 2
                     10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
                     18: \ along with this program; if not, write to the Free Software
                     19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                     20: 
1.1       anton      21: $10 constant maxvp
                     22: Variable vp
1.5       pazsan     23:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
                     24:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
1.1       anton      25: 
                     26: : get-current  ( -- wid )  current @ ;
                     27: : set-current  ( wid -- )  current ! ;
                     28: 
                     29: : context ( -- addr )  vp dup @ cells + ;
                     30: : definitions  ( -- )  context @ current ! ;
                     31: 
1.5       pazsan     32: \ wordlist Vocabulary also previous                    14may93py
1.3       pazsan     33: 
1.5       pazsan     34: AVariable voclink
1.3       pazsan     35: 
1.5       pazsan     36: Defer 'initvoc
                     37: ' drop IS 'initvoc
1.1       anton      38: 
1.5       pazsan     39: Variable slowvoc   slowvoc off
1.1       anton      40: 
                     41: : wordlist  ( -- wid )
1.10      pazsan     42:   here  0 A, Forth-wordlist wordlist-map @ A, voclink @ A, slowvoc @ A,
                     43:   dup wordlist-link dup voclink ! 'initvoc ;
1.1       anton      44: 
                     45: : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
                     46: 
                     47: : also  ( -- )
                     48:   context @ vp @ 1+ dup maxvp > abort" Vocstack full"
                     49:   vp ! context ! ;
                     50: 
                     51: : previous ( -- )  vp @ 1- dup 0= abort" Vocstack empty" vp ! ;
                     52: 
                     53: \ vocabulary find                                      14may93py
                     54: 
1.15    ! anton      55: : (vocfind)  ( addr count wid -- nfa|false )
1.2       anton      56:     \ !! generalize this to be independent of vp
1.10      pazsan     57:     drop vp dup @ 1- cells over +
                     58:     DO  2dup I 2@ over <>
                     59:         IF  (search-wordlist) dup
                     60:            IF  nip nip  UNLOOP EXIT
                     61:            THEN  drop
                     62:         ELSE  drop 2drop  THEN
                     63:     [ -1 cells ] Literal +LOOP
1.2       anton      64:     2drop false ;
                     65: 
                     66: 0 value locals-wordlist
                     67: 
1.15    ! anton      68: : (localsvocfind)  ( addr count wid -- nfa|false )
1.2       anton      69:     \ !! use generalized (vocfind)
                     70:     drop locals-wordlist
                     71:     IF 2dup locals-wordlist (search-wordlist) dup
                     72:        IF nip nip
                     73:            EXIT
                     74:        THEN drop
                     75:     THEN
                     76:     0 (vocfind) ;
                     77: 
                     78: \ In the kernal the dictionary search works on only one wordlist.
                     79: \ The following stuff builds a thing that looks to the kernal like one
                     80: \ wordlist, but when searched it searches the whole search order
                     81: \  (including locals)
1.1       anton      82: 
1.2       anton      83: \ this is the wordlist-map of the dictionary
1.5       pazsan     84: Create vocsearch       ' (localsvocfind) A, ' (reveal) A,  ' drop A,
1.1       anton      85: 
                     86: \ Only root                                            14may93py
                     87: 
1.2       anton      88: wordlist \ the wordlist structure
1.10      pazsan     89: vocsearch over wordlist-map A! \ patch the map into it
1.1       anton      90: 
                     91: Vocabulary Forth
                     92: Vocabulary Root
                     93: 
                     94: : Only  vp off  also Root also definitions ;
                     95: 
                     96: \ set initial search order                             14may93py
                     97: 
                     98: Forth-wordlist @ ' Forth >body A!
                     99: 
1.8       pazsan    100: vp off  also Root also definitions
1.1       anton     101: Only Forth also definitions
                    102: 
1.7       pazsan    103: lookup A! \ our dictionary search order becomes the law
1.3       pazsan    104: 
1.12      anton     105: ' Forth >body constant forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid
                    106: 
                    107: 
1.1       anton     108: \ get-order set-order                                  14may93py
                    109: 
                    110: : get-order  ( -- wid1 .. widn n )
                    111:   vp @ 0 ?DO  vp cell+ I cells + @  LOOP  vp @ ;
                    112: 
                    113: : set-order  ( wid1 .. widn n / -1 -- )
                    114:   dup -1 = IF  drop Only exit  THEN  dup vp !
                    115:   ?dup IF  1- FOR  vp cell+ I cells + !  NEXT  THEN ;
                    116: 
                    117: : seal ( -- )  context @ 1 set-order ;
                    118: 
                    119: \ words visible in roots                               14may93py
                    120: 
1.14      anton     121: : .name ( name -- ) \ gforth   dot-name
                    122:     name>string type space ;
                    123: 
                    124: require termsize.fs
                    125: 
                    126: : words ( -- ) \ tools
                    127:     cr 0 context @
                    128:     BEGIN
                    129:        @ dup
                    130:     WHILE
                    131:        2dup name>string nip 2 + dup >r +
                    132:        cols >=
                    133:        IF
                    134:            cr nip 0 swap
                    135:        THEN
                    136:        dup .name space r> rot + swap
                    137:     REPEAT
                    138:     2drop ;
1.1       anton     139: 
                    140: : body> ( data -- cfa )  0 >body - ;
                    141: 
1.14      anton     142: : .voc
                    143:     body> >name .name ;
1.12      anton     144: : order ( -- )  \  search-ext
                    145:     \g prints the search order and the @code{current} wordlist.  The
                    146:     \g standard requires that the wordlists are printed in the order
                    147:     \g in which they are searched. Therefore, the output is reversed
                    148:     \g with respect to the conventional way of displaying stacks. The
                    149:     \g @code{current} wordlist is displayed last.
                    150:     get-order 0
                    151:     ?DO
                    152:        .voc
                    153:     LOOP
                    154:     4 spaces get-current .voc ;
                    155: : vocs ( -- ) \ gforth
                    156:     \g prints vocabularies and wordlists defined in the system.
                    157:     voclink
                    158:     BEGIN
                    159:        @ dup @
                    160:     WHILE
                    161:        dup 0 wordlist-link - .voc
                    162:     REPEAT
                    163:     drop ;
1.1       anton     164: 
                    165: Root definitions
                    166: 
                    167: ' words Alias words
                    168: ' Forth Alias Forth
1.11      anton     169: ' forth-wordlist alias forth-wordlist
                    170: ' set-order alias set-order
                    171: ' order alias order
1.1       anton     172: 
                    173: Forth definitions
1.5       pazsan    174: 
1.6       anton     175: include hash.fs
1.9       pazsan    176: 
                    177: \ marker                                               18dec94py
                    178: 
                    179: \ Marker creates a mark that is removed (including everything 
                    180: \ defined afterwards) when executing the mark.
                    181: 
                    182: : marker, ( -- mark )  here dup A,
                    183:   voclink @ A, voclink
1.10      pazsan    184:   BEGIN  @ dup @  WHILE  dup 0 wordlist-link - @ A,  REPEAT  drop
1.9       pazsan    185:   udp @ , ;
                    186: 
                    187: : marker! ( mark -- )  dup @ swap cell+
                    188:   dup @ voclink ! cell+
                    189:   voclink
1.10      pazsan    190:   BEGIN  @ dup @  WHILE  over @ over 0 wordlist-link - !
1.9       pazsan    191:         swap cell+ swap
                    192:   REPEAT  drop  voclink
1.10      pazsan    193:   BEGIN  @ dup @  WHILE  dup 0 wordlist-link - rehash  REPEAT  drop
1.9       pazsan    194:   @ udp !  dp ! ;
                    195: 
                    196: : marker ( "mark" -- )
                    197:   marker, Create A,  DOES>  @ marker! ;

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