File:  [gforth] / gforth / search.fs
Revision 1.30: download - view: text, annotated - select for diffs
Mon Oct 22 20:11:43 2007 UTC (13 years, 10 months ago) by anton
Branches: MAIN
CVS tags: HEAD
bugfix <2007Oct22.192528@mips.complang.tuwien.ac.at> and cleanup

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

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