Return to search-order.fs CVS log

Up to [gforth] / gforth

added code.fs (code, ;code, end-code, assembler)
renamed dostruc to dofield
made index and doc-entries nicer
Only words containing 'e' or 'E' are converted to FP numbers.
added many wordset comments
added flush-icache primitive and FLUSH_ICACHE macro
added +DO, U+DO, -DO, U-DO and -LOOP
added code address labels (`docol:' etc.)
fixed sparc cache_flush

    1: \ search order wordset                                 14may93py
    2: 
    3: $10 constant maxvp
    4: Variable vp
    5:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
    6:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
    7: 
    8: : get-current  ( -- wid )  current @ ;
    9: : set-current  ( wid -- )  current ! ;
   10: 
   11: : context ( -- addr )  vp dup @ cells + ;
   12: : definitions  ( -- )  context @ current ! ;
   13: 
   14: \ wordlist Vocabulary also previous                    14may93py
   15: 
   16: AVariable voclink
   17: 
   18: Defer 'initvoc
   19: ' drop IS 'initvoc
   20: 
   21: Variable slowvoc   slowvoc off
   22: 
   23: : wordlist  ( -- wid )
   24:   here  0 A, Forth-wordlist wordlist-map @ A, voclink @ A, slowvoc @ A,
   25:   dup wordlist-link dup voclink ! 'initvoc ;
   26: 
   27: : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
   28: 
   29: : also  ( -- )
   30:   context @ vp @ 1+ dup maxvp > abort" Vocstack full"
   31:   vp ! context ! ;
   32: 
   33: : previous ( -- )  vp @ 1- dup 0= abort" Vocstack empty" vp ! ;
   34: 
   35: \ vocabulary find                                      14may93py
   36: 
   37: : (vocfind)  ( addr count nfa1 -- nfa2|false )
   38:     \ !! generalize this to be independent of vp
   39:     drop vp dup @ 1- cells over +
   40:     DO  2dup I 2@ over <>
   41:         IF  (search-wordlist) dup
   42: 	    IF  nip nip  UNLOOP EXIT
   43: 	    THEN  drop
   44:         ELSE  drop 2drop  THEN
   45:     [ -1 cells ] Literal +LOOP
   46:     2drop false ;
   47: 
   48: 0 value locals-wordlist
   49: 
   50: : (localsvocfind)  ( addr count nfa1 -- nfa2|false )
   51:     \ !! use generalized (vocfind)
   52:     drop locals-wordlist
   53:     IF 2dup locals-wordlist (search-wordlist) dup
   54: 	IF nip nip
   55: 	    EXIT
   56: 	THEN drop
   57:     THEN
   58:     0 (vocfind) ;
   59: 
   60: \ In the kernal the dictionary search works on only one wordlist.
   61: \ The following stuff builds a thing that looks to the kernal like one
   62: \ wordlist, but when searched it searches the whole search order
   63: \  (including locals)
   64: 
   65: \ this is the wordlist-map of the dictionary
   66: Create vocsearch       ' (localsvocfind) A, ' (reveal) A,  ' drop A,
   67: 
   68: \ Only root                                            14may93py
   69: 
   70: wordlist \ the wordlist structure
   71: vocsearch over wordlist-map A! \ patch the map into it
   72: 
   73: Vocabulary Forth
   74: Vocabulary Root
   75: 
   76: : Only  vp off  also Root also definitions ;
   77: 
   78: \ set initial search order                             14may93py
   79: 
   80: Forth-wordlist @ ' Forth >body A!
   81: 
   82: vp off  also Root also definitions
   83: Only Forth also definitions
   84: 
   85: lookup A! \ our dictionary search order becomes the law
   86: 
   87: ' Forth >body constant forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid
   88: 
   89: 
   90: \ get-order set-order                                  14may93py
   91: 
   92: : get-order  ( -- wid1 .. widn n )
   93:   vp @ 0 ?DO  vp cell+ I cells + @  LOOP  vp @ ;
   94: 
   95: : set-order  ( wid1 .. widn n / -1 -- )
   96:   dup -1 = IF  drop Only exit  THEN  dup vp !
   97:   ?dup IF  1- FOR  vp cell+ I cells + !  NEXT  THEN ;
   98: 
   99: : seal ( -- )  context @ 1 set-order ;
  100: 
  101: \ words visible in roots                               14may93py
  102: 
  103: : .name ( name -- ) name>string type space ;
  104: : words  cr 0 context @
  105:   BEGIN  @ dup  WHILE  2dup cell+ c@ $1F and 2 + dup >r +
  106:          &79 >  IF  cr nip 0 swap  THEN
  107:          dup .name space r> rot + swap  REPEAT 2drop ;
  108: 
  109: : body> ( data -- cfa )  0 >body - ;
  110: 
  111: : .voc  body> >name .name ;
  112: : order ( -- )  \  search-ext
  113:     \g prints the search order and the @code{current} wordlist.  The
  114:     \g standard requires that the wordlists are printed in the order
  115:     \g in which they are searched. Therefore, the output is reversed
  116:     \g with respect to the conventional way of displaying stacks. The
  117:     \g @code{current} wordlist is displayed last.
  118:     get-order 0
  119:     ?DO
  120: 	.voc
  121:     LOOP
  122:     4 spaces get-current .voc ;
  123: : vocs ( -- ) \ gforth
  124:     \g prints vocabularies and wordlists defined in the system.
  125:     voclink
  126:     BEGIN
  127: 	@ dup @
  128:     WHILE
  129: 	dup 0 wordlist-link - .voc
  130:     REPEAT
  131:     drop ;
  132: 
  133: Root definitions
  134: 
  135: ' words Alias words
  136: ' Forth Alias Forth
  137: ' forth-wordlist alias forth-wordlist
  138: ' set-order alias set-order
  139: ' order alias order
  140: 
  141: Forth definitions
  142: 
  143: include hash.fs
  144: 
  145: \ marker                                               18dec94py
  146: 
  147: \ Marker creates a mark that is removed (including everything 
  148: \ defined afterwards) when executing the mark.
  149: 
  150: : marker, ( -- mark )  here dup A,
  151:   voclink @ A, voclink
  152:   BEGIN  @ dup @  WHILE  dup 0 wordlist-link - @ A,  REPEAT  drop
  153:   udp @ , ;
  154: 
  155: : marker! ( mark -- )  dup @ swap cell+
  156:   dup @ voclink ! cell+
  157:   voclink
  158:   BEGIN  @ dup @  WHILE  over @ over 0 wordlist-link - !
  159: 	 swap cell+ swap
  160:   REPEAT  drop  voclink
  161:   BEGIN  @ dup @  WHILE  dup 0 wordlist-link - rehash  REPEAT  drop
  162:   @ udp !  dp ! ;
  163: 
  164: : marker ( "mark" -- )
  165:   marker, Create A,  DOES>  @ marker! ;