Diff for /gforth/Attic/search-order.fs between versions 1.9 and 1.10

version 1.9, 1994/12/21 14:26:25 version 1.10, 1995/02/23 20:17:24
Line 21  Defer 'initvoc Line 21  Defer 'initvoc
 Variable slowvoc   slowvoc off  Variable slowvoc   slowvoc off
   
 : wordlist  ( -- wid )  : wordlist  ( -- wid )
   here  0 A, Forth-wordlist cell+ @ A, voclink @ A, slowvoc @ A,    here  0 A, Forth-wordlist wordlist-map @ A, voclink @ A, slowvoc @ A,
   dup 2 cells + dup voclink ! 'initvoc ;    dup wordlist-link dup voclink ! 'initvoc ;
   
 : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;  : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
   
Line 36  Variable slowvoc   slowvoc off Line 36  Variable slowvoc   slowvoc off
   
 : (vocfind)  ( addr count nfa1 -- nfa2|false )  : (vocfind)  ( addr count nfa1 -- nfa2|false )
     \ !! generalize this to be independent of vp      \ !! generalize this to be independent of vp
     drop 1 vp @      drop vp dup @ 1- cells over +
     DO  2dup vp I cells + @ (search-wordlist) dup      DO  2dup I 2@ over <>
         IF  nip nip          IF  (search-wordlist) dup
             UNLOOP EXIT              IF  nip nip  UNLOOP EXIT
         THEN  drop              THEN  drop
     -1 +LOOP          ELSE  drop 2drop  THEN
       [ -1 cells ] Literal +LOOP
     2drop false ;      2drop false ;
   
 0 value locals-wordlist  0 value locals-wordlist
Line 67  Create vocsearch       ' (localsvocfind) Line 68  Create vocsearch       ' (localsvocfind)
 \ Only root                                            14may93py  \ Only root                                            14may93py
   
 wordlist \ the wordlist structure  wordlist \ the wordlist structure
 vocsearch over cell+ A! \ patch the map into it  vocsearch over wordlist-map A! \ patch the map into it
   
 Vocabulary Forth  Vocabulary Forth
 Vocabulary Root  Vocabulary Root
Line 107  lookup A! \ our dictionary search order Line 108  lookup A! \ our dictionary search order
 : .voc  body> >name .name ;  : .voc  body> >name .name ;
 : order  1 vp @  DO  vp I cells + @ .voc  -1 +LOOP  2 spaces  : order  1 vp @  DO  vp I cells + @ .voc  -1 +LOOP  2 spaces
   current @ .voc ;    current @ .voc ;
 : vocs   voclink  BEGIN  @ dup @  WHILE  dup 2 cells - .voc  REPEAT  drop ;  : vocs   voclink  BEGIN  @ dup @  WHILE  dup 0 wordlist-link - .voc  REPEAT
     drop ;
   
 Root definitions  Root definitions
   
Line 125  include hash.fs Line 127  include hash.fs
   
 : marker, ( -- mark )  here dup A,  : marker, ( -- mark )  here dup A,
   voclink @ A, voclink    voclink @ A, voclink
   BEGIN  @ dup @  WHILE  dup 2 cells - @ A,  REPEAT  drop    BEGIN  @ dup @  WHILE  dup 0 wordlist-link - @ A,  REPEAT  drop
   udp @ , ;    udp @ , ;
   
 : marker! ( mark -- )  dup @ swap cell+  : marker! ( mark -- )  dup @ swap cell+
   dup @ voclink ! cell+    dup @ voclink ! cell+
   voclink    voclink
   BEGIN  @ dup @  WHILE  over @ over 2 cells - !    BEGIN  @ dup @  WHILE  over @ over 0 wordlist-link - !
          swap cell+ swap           swap cell+ swap
   REPEAT  drop  voclink    REPEAT  drop  voclink
   BEGIN  @ dup @  WHILE  dup 2 cells - rehash  REPEAT  drop    BEGIN  @ dup @  WHILE  dup 0 wordlist-link - rehash  REPEAT  drop
   @ udp !  dp ! ;    @ udp !  dp ! ;
   
 : marker ( "mark" -- )  : marker ( "mark" -- )

Removed from v.1.9  
changed lines
  Added in v.1.10


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