Annotation of gforth/search.fs, revision 1.4

1.1       anton       1: \ search order wordset                                 14may93py
                      2: 
                      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: 
                     21: $10 constant maxvp
                     22: Variable vp
                     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, 
                     25: 
                     26: : get-current  ( -- wid )  current @ ;
                     27: : set-current  ( wid -- )  current ! ;
                     28: 
1.2       jwilke     29: \ : context ( -- addr )  vp dup @ cells + ;
                     30: : vp! dup vp ! cells vp + to context ;
1.1       anton      31: : definitions  ( -- )  context @ current ! ;
                     32: 
                     33: \ wordlist Vocabulary also previous                    14may93py
                     34: 
1.2       jwilke     35: Variable slowvoc   0 slowvoc !
1.1       anton      36: 
1.2       jwilke     37: \ Forth-wordlist AConstant Forth-wordlist
1.1       anton      38: 
1.2       jwilke     39: : mappedwordlist ( map-struct -- wid ) \ gforth
                     40: \G creates a wordlist with a special map-structure
                     41:   here 0 A, swap A, voclink @ A, 0 A,
                     42:   dup wordlist-link voclink !
                     43:   dup initvoc ;
1.1       anton      44: 
                     45: : wordlist  ( -- wid )
                     46:   slowvoc @
1.2       jwilke     47:   IF    \ this is now f83search because hashing may be loaded already
                     48:        \ jaw
                     49:        f83search 
1.1       anton      50:   ELSE  Forth-wordlist wordlist-map @   THEN
1.2       jwilke     51:   mappedwordlist ;
1.1       anton      52: 
                     53: : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
                     54: 
                     55: : also  ( -- )
                     56:   context @ vp @ 1+ dup maxvp > abort" Vocstack full"
1.2       jwilke     57:   vp! context ! ;
1.1       anton      58: 
1.2       jwilke     59: : previous ( -- )  vp @ 1- dup 0= abort" Vocstack empty" vp! ;
1.1       anton      60: 
                     61: \ vocabulary find                                      14may93py
                     62: 
                     63: : (vocfind)  ( addr count wid -- nfa|false )
                     64:     \ !! generalize this to be independent of vp
                     65:     drop vp dup @ 1- cells over +
                     66:     DO  2dup I 2@ over <>
                     67:         IF  (search-wordlist) dup
                     68:            IF  nip nip  UNLOOP EXIT
                     69:            THEN  drop
                     70:         ELSE  drop 2drop  THEN
                     71:     [ -1 cells ] Literal +LOOP
                     72:     2drop false ;
                     73: 
                     74: 0 value locals-wordlist
                     75: 
                     76: : (localsvocfind)  ( addr count wid -- nfa|false )
                     77:     \ !! use generalized (vocfind)
                     78:     drop locals-wordlist
                     79:     IF 2dup locals-wordlist (search-wordlist) dup
                     80:        IF nip nip
                     81:            EXIT
                     82:        THEN drop
                     83:     THEN
                     84:     0 (vocfind) ;
                     85: 
                     86: \ In the kernel the dictionary search works on only one wordlist.
                     87: \ The following stuff builds a thing that looks to the kernel like one
                     88: \ wordlist, but when searched it searches the whole search order
                     89: \  (including locals)
                     90: 
                     91: \ this is the wordlist-map of the dictionary
                     92: Create vocsearch ( -- wordlist-map )
1.2       jwilke     93: ' (localsvocfind) A, ' (reveal) A,  ' drop A, ' drop A,
                     94: 
                     95: \ create dummy wordlist for kernel
                     96: slowvoc on
                     97: vocsearch mappedwordlist \ the wordlist structure ( -- wid )
                     98: 
                     99: \ we don't want the dummy wordlist in our linked list
                    100: 0 Voclink !
                    101: slowvoc off
1.1       anton     102: 
                    103: \ Only root                                            14may93py
                    104: 
                    105: Vocabulary Forth
                    106: Vocabulary Root
                    107: 
1.3       anton     108: : Only  1 vp! Root also ;
1.1       anton     109: 
                    110: \ set initial search order                             14may93py
                    111: 
                    112: Forth-wordlist @ ' Forth >body !
                    113: 
1.2       jwilke    114: 0 vp! also Root also definitions
1.1       anton     115: Only Forth also definitions
1.2       jwilke    116: lookup ! \ our dictionary search order becomes the law ( -- )
1.1       anton     117: 
                    118: ' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid
                    119: 
                    120: 
                    121: \ get-order set-order                                  14may93py
                    122: 
                    123: : get-order  ( -- wid1 .. widn n )
                    124:   vp @ 0 ?DO  vp cell+ I cells + @  LOOP  vp @ ;
                    125: 
                    126: : set-order  ( wid1 .. widn n / -1 -- )
1.2       jwilke    127:   dup -1 = IF  drop Only exit  THEN  dup vp!
1.1       anton     128:   ?dup IF  1- FOR  vp cell+ I cells + !  NEXT  THEN ;
                    129: 
                    130: : seal ( -- )  context @ 1 set-order ;
                    131: 
1.2       jwilke    132: : .voc
1.4     ! pazsan    133:     body> >head name>string type space ;
1.1       anton     134: 
                    135: : order ( -- )  \  search-ext
                    136:     \g prints the search order and the @code{current} wordlist.  The
                    137:     \g standard requires that the wordlists are printed in the order
                    138:     \g in which they are searched. Therefore, the output is reversed
                    139:     \g with respect to the conventional way of displaying stacks. The
                    140:     \g @code{current} wordlist is displayed last.
                    141:     get-order 0
                    142:     ?DO
                    143:        .voc
                    144:     LOOP
                    145:     4 spaces get-current .voc ;
1.2       jwilke    146: 
1.1       anton     147: : vocs ( -- ) \ gforth
                    148:     \g prints vocabularies and wordlists defined in the system.
                    149:     voclink
                    150:     BEGIN
1.2       jwilke    151:        @ dup
1.1       anton     152:     WHILE
                    153:        dup 0 wordlist-link - .voc
                    154:     REPEAT
                    155:     drop ;
                    156: 
                    157: Root definitions
                    158: 
                    159: ' words Alias words
                    160: ' Forth Alias Forth
                    161: ' forth-wordlist alias forth-wordlist
                    162: ' set-order alias set-order
                    163: ' order alias order
                    164: 
                    165: Forth definitions
                    166: 

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