Annotation of gforth/search.fs, revision 1.1
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:
! 29: : context ( -- addr ) vp dup @ cells + ;
! 30: : definitions ( -- ) context @ current ! ;
! 31:
! 32: \ wordlist Vocabulary also previous 14may93py
! 33:
! 34: AVariable voclink
! 35:
! 36: Defer 'initvoc
! 37: ' drop ' 'initvoc >body !
! 38:
! 39: Variable slowvoc slowvoc off
! 40:
! 41: Forth-wordlist AConstant Forth-wordlist
! 42:
! 43: : wordlist ( -- wid )
! 44: here 0 A,
! 45: slowvoc @
! 46: IF [ Forth-wordlist wordlist-map @ ] ALiteral
! 47: ELSE Forth-wordlist wordlist-map @ THEN
! 48: A, voclink @ A, slowvoc @ A,
! 49: dup wordlist-link dup voclink ! 'initvoc ;
! 50:
! 51: : Vocabulary ( -- ) Create wordlist drop DOES> context ! ;
! 52:
! 53: : also ( -- )
! 54: context @ vp @ 1+ dup maxvp > abort" Vocstack full"
! 55: vp ! context ! ;
! 56:
! 57: : previous ( -- ) vp @ 1- dup 0= abort" Vocstack empty" vp ! ;
! 58:
! 59: \ vocabulary find 14may93py
! 60:
! 61: : (vocfind) ( addr count wid -- nfa|false )
! 62: \ !! generalize this to be independent of vp
! 63: drop vp dup @ 1- cells over +
! 64: DO 2dup I 2@ over <>
! 65: IF (search-wordlist) dup
! 66: IF nip nip UNLOOP EXIT
! 67: THEN drop
! 68: ELSE drop 2drop THEN
! 69: [ -1 cells ] Literal +LOOP
! 70: 2drop false ;
! 71:
! 72: 0 value locals-wordlist
! 73:
! 74: : (localsvocfind) ( addr count wid -- nfa|false )
! 75: \ !! use generalized (vocfind)
! 76: drop locals-wordlist
! 77: IF 2dup locals-wordlist (search-wordlist) dup
! 78: IF nip nip
! 79: EXIT
! 80: THEN drop
! 81: THEN
! 82: 0 (vocfind) ;
! 83:
! 84: \ In the kernel the dictionary search works on only one wordlist.
! 85: \ The following stuff builds a thing that looks to the kernel like one
! 86: \ wordlist, but when searched it searches the whole search order
! 87: \ (including locals)
! 88:
! 89: \ this is the wordlist-map of the dictionary
! 90: Create vocsearch ( -- wordlist-map )
! 91: ' (localsvocfind) A, ' (reveal) A, ' drop A,
! 92:
! 93: \ Only root 14may93py
! 94:
! 95: wordlist \ the wordlist structure
! 96: vocsearch over wordlist-map ! \ patch the map into it
! 97:
! 98: Vocabulary Forth
! 99: Vocabulary Root
! 100:
! 101: : Only vp off also Root also definitions ;
! 102:
! 103: \ set initial search order 14may93py
! 104:
! 105: Forth-wordlist @ ' Forth >body !
! 106:
! 107: vp off also Root also definitions
! 108: Only Forth also definitions
! 109:
! 110: lookup ! \ our dictionary search order becomes the law
! 111:
! 112: ' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid
! 113:
! 114:
! 115: \ get-order set-order 14may93py
! 116:
! 117: : get-order ( -- wid1 .. widn n )
! 118: vp @ 0 ?DO vp cell+ I cells + @ LOOP vp @ ;
! 119:
! 120: : set-order ( wid1 .. widn n / -1 -- )
! 121: dup -1 = IF drop Only exit THEN dup vp !
! 122: ?dup IF 1- FOR vp cell+ I cells + ! NEXT THEN ;
! 123:
! 124: : seal ( -- ) context @ 1 set-order ;
! 125:
! 126: \ words visible in roots 14may93py
! 127:
! 128: : .name ( name -- ) \ gforth dot-name
! 129: name>string type space ;
! 130:
! 131: require termsize.fs
! 132:
! 133: : words ( -- ) \ tools
! 134: cr 0 context @
! 135: BEGIN
! 136: @ dup
! 137: WHILE
! 138: 2dup name>string nip 2 + dup >r +
! 139: cols >=
! 140: IF
! 141: cr nip 0 swap
! 142: THEN
! 143: dup .name space r> rot + swap
! 144: REPEAT
! 145: 2drop ;
! 146:
! 147: ' words alias vlist ( -- ) \ gforth
! 148: \g Old (pre-Forth-83) name for @code{WORDS}.
! 149:
! 150: : body> ( data -- cfa ) 0 >body - ;
! 151:
! 152: : .voc
! 153: body> >name .name ;
! 154: : order ( -- ) \ search-ext
! 155: \g prints the search order and the @code{current} wordlist. The
! 156: \g standard requires that the wordlists are printed in the order
! 157: \g in which they are searched. Therefore, the output is reversed
! 158: \g with respect to the conventional way of displaying stacks. The
! 159: \g @code{current} wordlist is displayed last.
! 160: get-order 0
! 161: ?DO
! 162: .voc
! 163: LOOP
! 164: 4 spaces get-current .voc ;
! 165: : vocs ( -- ) \ gforth
! 166: \g prints vocabularies and wordlists defined in the system.
! 167: voclink
! 168: BEGIN
! 169: @ dup @
! 170: WHILE
! 171: dup 0 wordlist-link - .voc
! 172: REPEAT
! 173: drop ;
! 174:
! 175: Root definitions
! 176:
! 177: ' words Alias words
! 178: ' Forth Alias Forth
! 179: ' forth-wordlist alias forth-wordlist
! 180: ' set-order alias set-order
! 181: ' order alias order
! 182:
! 183: Forth definitions
! 184:
! 185: include hash.fs
! 186:
! 187: \ table (case-sensitive wordlist)
! 188:
! 189: : table-find ( addr len wordlist -- nfa / false )
! 190: >r 2dup r> bucket @ (tablefind) ;
! 191:
! 192: Create tablesearch-map ( -- wordlist-map )
! 193: ' table-find A, ' hash-reveal A, ' (rehash) A,
! 194:
! 195: : table ( -- wid )
! 196: \g create a case-sensitive wordlist
! 197: wordlist
! 198: tablesearch-map over wordlist-map ! ;
! 199:
! 200: \ marker 18dec94py
! 201:
! 202: \ Marker creates a mark that is removed (including everything
! 203: \ defined afterwards) when executing the mark.
! 204:
! 205: : marker, ( -- mark ) here dup A,
! 206: voclink @ A, voclink
! 207: BEGIN @ dup @ WHILE dup 0 wordlist-link - @ A, REPEAT drop
! 208: udp @ , ;
! 209:
! 210: : marker! ( mark -- )
! 211: dup @ swap cell+
! 212: dup @ voclink ! cell+
! 213: voclink
! 214: BEGIN
! 215: @ dup @
! 216: WHILE
! 217: over @ over 0 wordlist-link - !
! 218: swap cell+ swap
! 219: REPEAT
! 220: drop voclink
! 221: BEGIN
! 222: @ dup @
! 223: WHILE
! 224: dup 0 wordlist-link - rehash
! 225: REPEAT
! 226: drop
! 227: @ udp ! dp ! ;
! 228:
! 229: : marker ( "mark" -- )
! 230: marker, Create A,
! 231: DOES> ( -- )
! 232: @ marker! ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to search.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth