Return to search.fs CVS log

Up to [gforth] / gforth

Thrown out static vocabulary stack
Changed cross to make mixed threading workable

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