Return to search.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs

Annotation of qemu/roms/SLOF/slof/fs/search.fs, revision 1.1

1.1     ! root        1: \ *****************************************************************************
        !             2: \ * Copyright (c) 2004, 2008 IBM Corporation
        !             3: \ * All rights reserved.
        !             4: \ * This program and the accompanying materials
        !             5: \ * are made available under the terms of the BSD License
        !             6: \ * which accompanies this distribution, and is available at
        !             7: \ * http://www.opensource.org/licenses/bsd-license.php
        !             8: \ *
        !             9: \ * Contributors:
        !            10: \ *     IBM Corporation - initial implementation
        !            11: \ ****************************************************************************/
        !            12: \
        !            13: \ Copyright 2002,2003,2004  Segher Boessenkool  <[email protected]>
        !            14: \
        !            15: 
        !            16: 
        !            17: \ stuff we should already have:
        !            18: 
        !            19: : linked ( var -- )  here over @ , swap ! ;
        !            20: 
        !            21: HEX
        !            22: 
        !            23: \ \ \
        !            24: \ \ \  Wordlists
        !            25: \ \ \
        !            26: 
        !            27: VARIABLE wordlists  forth-wordlist wordlists !
        !            28: 
        !            29: \ create a new wordlist
        !            30: : wordlist ( -- wid )  here wordlists linked 0 , ;
        !            31: 
        !            32: 
        !            33: \ \ \
        !            34: \ \ \  Search order
        !            35: \ \ \
        !            36: 
        !            37: 10 CONSTANT max-in-search-order        \ should define elsewhere
        !            38: \ CREATE search-order max-in-search-order cells allot  \ stack of wids \ is in engine now
        !            39: \ search-order VALUE context   \ top of stack  \ is in engine now
        !            40: 
        !            41: : also ( -- )  clean-hash  context dup cell+ dup to context  >r @ r> ! ;
        !            42: : previous ( -- )  clean-hash  context cell- to context ;
        !            43: : only ( -- )  clean-hash  search-order to context  ( minimal-wordlist search-order ! ) ;
        !            44: : seal ( -- )  clean-hash  context @  search-order dup to context  ! ;
        !            45: 
        !            46: : get-order ( -- wid_n .. wid_1 n )
        !            47:        context >r search-order BEGIN dup r@ u<= WHILE
        !            48:        dup @ swap cell+ REPEAT r> drop
        !            49:        search-order - cell / ;
        !            50: : set-order ( wid_n .. wid_1 n -- )    \ XXX: special cases for 0, -1
        !            51:        clean-hash  1- cells search-order + dup to context
        !            52:        BEGIN dup search-order u>= WHILE
        !            53:        dup >r ! r> cell- REPEAT drop ;
        !            54: 
        !            55: 
        !            56: \ \ \
        !            57: \ \ \  Compilation wordlist
        !            58: \ \ \
        !            59: 
        !            60: : get-current ( -- wid )  current ;
        !            61: : set-current ( wid -- )  to current ;
        !            62: 
        !            63: : definitions ( -- )  context @ set-current ;
        !            64: 
        !            65: 
        !            66: \ \ \
        !            67: \ \ \  Vocabularies
        !            68: \ \ \
        !            69: 
        !            70: : VOCABULARY ( C: "name" -- ) ( -- )  CREATE wordlist drop  DOES> clean-hash  context ! ;
        !            71: \ : VOCABULARY ( C: "name" -- ) ( -- )  wordlist CREATE ,  DOES> @ context ! ;
        !            72: \ XXX we'd like to swap forth and forth-wordlist around (for .voc 's sake)
        !            73: : FORTH ( -- )  clean-hash  forth-wordlist context ! ;
        !            74: 
        !            75: : .voc ( wid -- ) \ display name for wid \ needs work ( body> or something like that )
        !            76:        dup cell- @ ['] vocabulary ['] forth within IF
        !            77:        2 cells - >name name>string type ELSE u. THEN  space ;
        !            78: : vocs ( -- ) \ display all wordlist names
        !            79:        cr wordlists BEGIN @ dup WHILE dup .voc REPEAT drop ;
        !            80: : order ( -- )
        !            81:        cr ." context:  " get-order 0 ?DO .voc LOOP
        !            82:        cr ." current:  " get-current .voc ;
        !            83: 
        !            84: 
        !            85: 
        !            86: 
        !            87: \ some handy helper
        !            88: : voc-find ( wid -- 0 | link )
        !            89:    clean-hash  cell+ @ (find)  clean-hash ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.