summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/search.fs
diff options
context:
space:
mode:
authorYang Zhang <yang.z.zhang@intel.com>2015-08-28 09:58:54 +0800
committerYang Zhang <yang.z.zhang@intel.com>2015-09-01 12:44:00 +0800
commite44e3482bdb4d0ebde2d8b41830ac2cdb07948fb (patch)
tree66b09f592c55df2878107a468a91d21506104d3f /qemu/roms/SLOF/slof/fs/search.fs
parent9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00 (diff)
Add qemu 2.4.0
Change-Id: Ic99cbad4b61f8b127b7dc74d04576c0bcbaaf4f5 Signed-off-by: Yang Zhang <yang.z.zhang@intel.com>
Diffstat (limited to 'qemu/roms/SLOF/slof/fs/search.fs')
-rw-r--r--qemu/roms/SLOF/slof/fs/search.fs89
1 files changed, 89 insertions, 0 deletions
diff --git a/qemu/roms/SLOF/slof/fs/search.fs b/qemu/roms/SLOF/slof/fs/search.fs
new file mode 100644
index 000000000..3acca2f11
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/search.fs
@@ -0,0 +1,89 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ * IBM Corporation - initial implementation
+\ ****************************************************************************/
+\
+\ Copyright 2002,2003,2004 Segher Boessenkool <segher@kernel.crashing.org>
+\
+
+
+\ stuff we should already have:
+
+: linked ( var -- ) here over @ , swap ! ;
+
+HEX
+
+\ \ \
+\ \ \ Wordlists
+\ \ \
+
+VARIABLE wordlists forth-wordlist wordlists !
+
+\ create a new wordlist
+: wordlist ( -- wid ) here wordlists linked 0 , ;
+
+
+\ \ \
+\ \ \ Search order
+\ \ \
+
+10 CONSTANT max-in-search-order \ should define elsewhere
+\ CREATE search-order max-in-search-order cells allot \ stack of wids \ is in engine now
+\ search-order VALUE context \ top of stack \ is in engine now
+
+: also ( -- ) clean-hash context dup cell+ dup to context >r @ r> ! ;
+: previous ( -- ) clean-hash context cell- to context ;
+: only ( -- ) clean-hash search-order to context ( minimal-wordlist search-order ! ) ;
+: seal ( -- ) clean-hash context @ search-order dup to context ! ;
+
+: get-order ( -- wid_n .. wid_1 n )
+ context >r search-order BEGIN dup r@ u<= WHILE
+ dup @ swap cell+ REPEAT r> drop
+ search-order - cell / ;
+: set-order ( wid_n .. wid_1 n -- ) \ XXX: special cases for 0, -1
+ clean-hash 1- cells search-order + dup to context
+ BEGIN dup search-order u>= WHILE
+ dup >r ! r> cell- REPEAT drop ;
+
+
+\ \ \
+\ \ \ Compilation wordlist
+\ \ \
+
+: get-current ( -- wid ) current ;
+: set-current ( wid -- ) to current ;
+
+: definitions ( -- ) context @ set-current ;
+
+
+\ \ \
+\ \ \ Vocabularies
+\ \ \
+
+: VOCABULARY ( C: "name" -- ) ( -- ) CREATE wordlist drop DOES> clean-hash context ! ;
+\ : VOCABULARY ( C: "name" -- ) ( -- ) wordlist CREATE , DOES> @ context ! ;
+\ XXX we'd like to swap forth and forth-wordlist around (for .voc 's sake)
+: FORTH ( -- ) clean-hash forth-wordlist context ! ;
+
+: .voc ( wid -- ) \ display name for wid \ needs work ( body> or something like that )
+ dup cell- @ ['] vocabulary ['] forth within IF
+ 2 cells - >name name>string type ELSE u. THEN space ;
+: vocs ( -- ) \ display all wordlist names
+ cr wordlists BEGIN @ dup WHILE dup .voc REPEAT drop ;
+: order ( -- )
+ cr ." context: " get-order 0 ?DO .voc LOOP
+ cr ." current: " get-current .voc ;
+
+
+
+
+\ some handy helper
+: voc-find ( wid -- 0 | link )
+ clean-hash cell+ @ (find) clean-hash ;