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

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.