Return to search-order.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/search-order.fs, revision 1.1

1.1     ! anton       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: : wordlist  ( -- wid )
        !            19:   here  0 A, Forth-wordlist cell+ @ A, voclink @ A, 0 A,
        !            20:   dup 2 cells + voclink ! ;
        !            21: 
        !            22: : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
        !            23: 
        !            24: : also  ( -- )
        !            25:   context @ vp @ 1+ dup maxvp > abort" Vocstack full"
        !            26:   vp ! context ! ;
        !            27: 
        !            28: : previous ( -- )  vp @ 1- dup 0= abort" Vocstack empty" vp ! ;
        !            29: 
        !            30: \ vocabulary find                                      14may93py
        !            31: 
        !            32: : (vocfind)  ( addr count nfa1 -- nfa2 / false )  drop
        !            33:   1 vp @ DO  2dup vp I cells + @ (search-wordlist)
        !            34:              dup IF  nip nip UNLOOP exit  THEN  drop
        !            35:           -1 +LOOP  2drop false ;
        !            36: 
        !            37: Create vocsearch       ] (vocfind) (reveal) [
        !            38: 
        !            39: \ Only root                                            14may93py
        !            40: 
        !            41: wordlist vocsearch over cell+ A!
        !            42: 
        !            43: Vocabulary Forth
        !            44: Vocabulary Root
        !            45: 
        !            46: : Only  vp off  also Root also definitions ;
        !            47: 
        !            48: \ set initial search order                             14may93py
        !            49: 
        !            50: Forth-wordlist @ ' Forth >body A!
        !            51: 
        !            52: Only Forth also definitions
        !            53: 
        !            54: search A!
        !            55: 
        !            56: \ get-order set-order                                  14may93py
        !            57: 
        !            58: : get-order  ( -- wid1 .. widn n )
        !            59:   vp @ 0 ?DO  vp cell+ I cells + @  LOOP  vp @ ;
        !            60: 
        !            61: : set-order  ( wid1 .. widn n / -1 -- )
        !            62:   dup -1 = IF  drop Only exit  THEN  dup vp !
        !            63:   ?dup IF  1- FOR  vp cell+ I cells + !  NEXT  THEN ;
        !            64: 
        !            65: : seal ( -- )  context @ 1 set-order ;
        !            66: 
        !            67: \ words visible in roots                               14may93py
        !            68: 
        !            69: : .name ( name -- ) name>string type space ;
        !            70: : words  cr 0 context @
        !            71:   BEGIN  @ dup  WHILE  2dup cell+ c@ $1F and 2 + dup >r +
        !            72:          &79 >  IF  cr nip 0 swap  THEN
        !            73:          dup .name space r> rot + swap  REPEAT 2drop ;
        !            74: 
        !            75: : body> ( data -- cfa )  0 >body - ;
        !            76: 
        !            77: : .voc  body> >name .name ;
        !            78: : order  1 vp @  DO  vp I cells + @ .voc  -1 +LOOP  2 spaces
        !            79:   current @ .voc ;
        !            80: : vocs   voclink  BEGIN  @ dup @  WHILE  dup 2 cells - .voc  REPEAT  drop ;
        !            81: 
        !            82: Root definitions
        !            83: 
        !            84: ' words Alias words
        !            85: ' Forth Alias Forth
        !            86: 
        !            87: Forth definitions