diff options
author | Yang Zhang <yang.z.zhang@intel.com> | 2015-08-28 09:58:54 +0800 |
---|---|---|
committer | Yang Zhang <yang.z.zhang@intel.com> | 2015-09-01 12:44:00 +0800 |
commit | e44e3482bdb4d0ebde2d8b41830ac2cdb07948fb (patch) | |
tree | 66b09f592c55df2878107a468a91d21506104d3f /qemu/roms/SLOF/slof/fs/search.fs | |
parent | 9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00 (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.fs | 89 |
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 ; |