Annotation of gforth/search.fs, revision 1.29

1.1       anton       1: \ search order wordset                                 14may93py
                      2: 
1.27      anton       3: \ Copyright (C) 1995,1996,1997,1998,2000,2003,2005 Free Software Foundation, Inc.
1.1       anton       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
1.18      anton      19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.1       anton      20: 
1.24      anton      21: require struct.fs
                     22: 
1.20      pazsan     23: $10 Value maxvp                \ current size of search order stack
                     24: $400 Value maxvp-limit \ upper limit for resizing search order stack
                     25: 0 AValue vp            \ will be initialized later (dynamic)
1.1       anton      26: 
1.7       crook      27: : get-current  ( -- wid ) \ search
1.12      crook      28:   \G @i{wid} is the identifier of the current compilation word list.
1.7       crook      29:   current @ ;
                     30: 
                     31: : set-current  ( wid -- )  \ search
1.12      crook      32:   \G Set the compilation word list to the word list identified by @i{wid}.
1.7       crook      33:   current ! ;
1.1       anton      34: 
1.11      anton      35: :noname ( -- addr )
                     36:     vp dup @ cells + ;
                     37: is context
                     38: 
                     39: : vp! ( u -- )
                     40:     vp ! ;
1.7       crook      41: : definitions  ( -- ) \ search
1.13      crook      42:   \G Set the compilation word list to be the same as the word list
                     43:   \G that is currently at the top of the search order.
1.7       crook      44:   context @ current ! ;
1.1       anton      45: 
                     46: \ wordlist Vocabulary also previous                    14may93py
                     47: 
1.2       jwilke     48: Variable slowvoc   0 slowvoc !
1.1       anton      49: 
1.2       jwilke     50: \ Forth-wordlist AConstant Forth-wordlist
1.1       anton      51: 
1.2       jwilke     52: : mappedwordlist ( map-struct -- wid ) \ gforth
1.7       crook      53: \G Create a wordlist with a special map-structure.
1.28      anton      54:   align here swap A, 0 A, voclink @ A, 0 A,
1.2       jwilke     55:   dup wordlist-link voclink !
                     56:   dup initvoc ;
1.1       anton      57: 
1.7       crook      58: : wordlist  ( -- wid ) \ search
1.12      crook      59:   \G Create a new, empty word list represented by @i{wid}.
1.1       anton      60:   slowvoc @
1.2       jwilke     61:   IF    \ this is now f83search because hashing may be loaded already
                     62:        \ jaw
                     63:        f83search 
1.1       anton      64:   ELSE  Forth-wordlist wordlist-map @   THEN
1.2       jwilke     65:   mappedwordlist ;
1.1       anton      66: 
1.7       crook      67: : Vocabulary ( "name" -- ) \ gforth
                     68:   \G Create a definition "name" and associate a new word list with it.
1.13      crook      69:   \G The run-time effect of "name" is to replace the @i{wid} at the
                     70:   \G top of the search order with the @i{wid} associated with the new
                     71:   \G word list.
1.7       crook      72:   Create wordlist drop  DOES> context ! ;
                     73: 
1.10      anton      74: : check-maxvp ( n -- )
1.19      dvdkhlng   75:    dup maxvp-limit > -49 and throw
                     76:    dup maxvp > IF
1.20      pazsan     77:       BEGIN  dup  maxvp 2* dup TO maxvp  <= UNTIL
1.19      dvdkhlng   78:       vp  maxvp 1+ cells resize throw TO vp
                     79:    THEN drop ;
                     80: 
1.16      anton      81: : >order ( wid -- ) \ gforth to-order
1.10      anton      82:     \g Push @var{wid} on the search order.
                     83:     vp @ 1+ dup check-maxvp vp! context ! ;
                     84: 
1.13      crook      85: : also  ( -- ) \ search-ext
1.15      anton      86:   \G Like @code{DUP} for the search order. Usually used before a
                     87:   \G vocabulary (e.g., @code{also Forth}); the combined effect is to push
                     88:   \G the wordlist represented by the vocabulary on the search order.
1.16      anton      89:   context @ >order ;
1.1       anton      90: 
1.13      crook      91: : previous ( -- ) \ search-ext
1.15      anton      92:   \G Drop the wordlist at the top of the search order.
1.10      anton      93:   vp @ 1- dup 0= -50 and throw vp! ;
1.1       anton      94: 
                     95: \ vocabulary find                                      14may93py
                     96: 
                     97: : (vocfind)  ( addr count wid -- nfa|false )
                     98:     \ !! generalize this to be independent of vp
                     99:     drop vp dup @ 1- cells over +
                    100:     DO  2dup I 2@ over <>
                    101:         IF  (search-wordlist) dup
                    102:            IF  nip nip  UNLOOP EXIT
                    103:            THEN  drop
                    104:         ELSE  drop 2drop  THEN
                    105:     [ -1 cells ] Literal +LOOP
                    106:     2drop false ;
                    107: 
                    108: 0 value locals-wordlist
                    109: 
                    110: : (localsvocfind)  ( addr count wid -- nfa|false )
                    111:     \ !! use generalized (vocfind)
                    112:     drop locals-wordlist
                    113:     IF 2dup locals-wordlist (search-wordlist) dup
                    114:        IF nip nip
                    115:            EXIT
                    116:        THEN drop
                    117:     THEN
                    118:     0 (vocfind) ;
                    119: 
                    120: \ In the kernel the dictionary search works on only one wordlist.
                    121: \ The following stuff builds a thing that looks to the kernel like one
                    122: \ wordlist, but when searched it searches the whole search order
                    123: \  (including locals)
                    124: 
                    125: \ this is the wordlist-map of the dictionary
                    126: Create vocsearch ( -- wordlist-map )
1.2       jwilke    127: ' (localsvocfind) A, ' (reveal) A,  ' drop A, ' drop A,
                    128: 
                    129: \ create dummy wordlist for kernel
                    130: slowvoc on
                    131: vocsearch mappedwordlist \ the wordlist structure ( -- wid )
                    132: 
                    133: \ we don't want the dummy wordlist in our linked list
                    134: 0 Voclink !
                    135: slowvoc off
1.1       anton     136: 
                    137: \ Only root                                            14may93py
                    138: 
1.29    ! anton     139: Vocabulary Forth ( -- ) \ search-ext
1.13      crook     140:   \G Replace the @i{wid} at the top of the search order with the
                    141:   \G @i{wid} associated with the word list @code{forth-wordlist}.
                    142: 
1.9       crook     143: 
1.7       crook     144: Vocabulary Root ( -- ) \ gforth
1.15      anton     145:   \G Add the root wordlist to the search order stack.  This vocabulary
                    146:   \G makes up the minimum search order and contains only a
                    147:   \G search-order words.
1.7       crook     148: 
1.9       crook     149: : Only ( -- ) \ search-ext
1.7       crook     150:   \G Set the search order to the implementation-defined minimum search
1.8       crook     151:   \G order (for Gforth, this is the word list @code{Root}).
1.7       crook     152:   1 vp! Root also ;
1.1       anton     153: 
1.23      anton     154: : update-image-order ( -- )
                    155:     \ save search order here, let vp point there
                    156:     here vp over vp @ 1+ cells
                    157:     dup allot move
                    158:     to vp ;
                    159: 
1.20      pazsan    160: : init-vp  ( -- )
1.23      anton     161:     vp @ $10 max to maxvp
                    162:     maxvp 1+ cells allocate throw
                    163:     vp over vp @ 1+ cells move
                    164:     TO vp ;
1.20      pazsan    165: 
                    166: :noname
                    167:    init-vp DEFERS 'cold ;
                    168: IS 'cold
                    169: 
1.23      anton     170: here 0 , to vp
                    171: 
                    172: init-vp Only Forth also definitions
1.20      pazsan    173: 
1.1       anton     174: \ set initial search order                             14may93py
                    175: 
1.5       pazsan    176: Forth-wordlist wordlist-id @ ' Forth >body wordlist-id !
1.1       anton     177: 
1.2       jwilke    178: lookup ! \ our dictionary search order becomes the law ( -- )
1.1       anton     179: 
                    180: ' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid
                    181: 
                    182: 
                    183: \ get-order set-order                                  14may93py
                    184: 
1.7       crook     185: : get-order  ( -- widn .. wid1 n ) \ search
1.13      crook     186:   \G Copy the search order to the data stack. The current search order
1.15      anton     187:   \G has @i{n} entries, of which @i{wid1} represents the wordlist
1.13      crook     188:   \G that is searched first (the word list at the top of the search
1.15      anton     189:   \G order) and @i{widn} represents the wordlist that is searched
1.13      crook     190:   \G last.
                    191:   vp @ 0 ?DO vp cell+ I cells + @ LOOP vp @ ;
1.1       anton     192: 
1.29    ! anton     193: : set-order  ( widn .. wid1 n -- ) \ search
1.10      anton     194:     \G If @var{n}=0, empty the search order.  If @var{n}=-1, set the
                    195:     \G search order to the implementation-defined minimum search order
                    196:     \G (for Gforth, this is the word list @code{Root}). Otherwise,
                    197:     \G replace the existing search order with the @var{n} wid entries
                    198:     \G such that @var{wid1} represents the word list that will be
                    199:     \G searched first and @var{widn} represents the word list that will
                    200:     \G be searched last.
                    201:     dup -1 = IF
                    202:        drop only exit
                    203:     THEN
                    204:     dup check-maxvp
                    205:     dup vp!
                    206:     ?dup IF 1- FOR vp cell+ I cells + !  NEXT THEN ;
1.1       anton     207: 
1.7       crook     208: : seal ( -- ) \ gforth
                    209:   \G Remove all word lists from the search order stack other than the word
                    210:   \G list that is currently on the top of the search order stack.
                    211:   context @ 1 set-order ;
1.1       anton     212: 
1.24      anton     213: [IFUNDEF] .name
1.26      anton     214: : id. ( nt -- ) \ gforth  i-d-dot
1.24      anton     215:     \G Print the name of the word represented by @var{nt}.
                    216:     \ this name comes from fig-Forth
                    217:     name>string type space ;
                    218: 
1.26      anton     219: ' id. alias .id ( nt -- ) \ F83  dot-i-d
1.24      anton     220: \G F83 name for @code{id.}.
                    221: 
1.26      anton     222: ' id. alias .name ( nt -- ) \ gforth-obsolete  dot-name
1.24      anton     223: \G Gforth <=0.5.0 name for @code{id.}.
                    224: 
                    225: [THEN]
                    226: 
1.26      anton     227: : .voc ( wid -- ) \ gforth  dot-voc
1.24      anton     228: \G print the name of the wordlist represented by @var{wid}.  Can
                    229: \G only print names defined with @code{vocabulary} or
                    230: \G @code{wordlist constant}, otherwise prints @samp{???}.
                    231:     dup >r wordlist-struct %size + dup head? if ( wid nt )
                    232:        dup name>int dup >code-address docon: = swap >body @ r@ = and if
                    233:            id. rdrop exit
                    234:        endif
                    235:     endif
                    236:     drop r> body> >head-noprim id. ;
1.1       anton     237: 
1.29    ! anton     238: : order ( -- )  \  search-ext
1.9       crook     239:   \G Print the search order and the compilation word list.  The
                    240:   \G word lists are printed in the order in which they are searched
                    241:   \G (which is reversed with respect to the conventional way of
                    242:   \G displaying stacks). The compilation word list is displayed last.
                    243:   \ The standard requires that the word lists are printed in the order
                    244:   \ in which they are searched. Therefore, the output is reversed
                    245:   \ with respect to the conventional way of displaying stacks.
1.1       anton     246:     get-order 0
                    247:     ?DO
                    248:        .voc
                    249:     LOOP
                    250:     4 spaces get-current .voc ;
1.2       jwilke    251: 
1.1       anton     252: : vocs ( -- ) \ gforth
1.7       crook     253:     \G List vocabularies and wordlists defined in the system.
1.1       anton     254:     voclink
                    255:     BEGIN
1.2       jwilke    256:        @ dup
1.1       anton     257:     WHILE
                    258:        dup 0 wordlist-link - .voc
                    259:     REPEAT
                    260:     drop ;
                    261: 
                    262: Root definitions
                    263: 
1.9       crook     264: ' words Alias words  ( -- ) \ tools
                    265: \G Display a list of all of the definitions in the word list at the top
                    266: \G of the search order.
1.29    ! anton     267: ' Forth Alias Forth \ alias- search-ext
1.7       crook     268: ' forth-wordlist alias forth-wordlist ( -- wid ) \ search
1.12      crook     269:   \G @code{Constant} -- @i{wid} identifies the word list that includes all of the standard words
1.7       crook     270:   \G provided by Gforth. When Gforth is invoked, this word list is the compilation word
1.13      crook     271:   \G list and is at the top of the search order.
1.29    ! anton     272: ' set-order alias set-order ( wid1 ... widu u -- ) \ alias- search
        !           273: ' order alias order ( -- ) \ alias- search-ext
1.1       anton     274: 
                    275: Forth definitions
                    276: 

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