1 \ ** ficl/softwords/softcore.fr
2 \ ** FICL soft extensions
3 \ ** John Sadler (john_sadler@alum.mit.edu)
6 \ $FreeBSD: src/sys/boot/ficl/softwords/softcore.fr,v 1.8.2.1 2000/07/06 23:51:46 obrien Exp $
7 \ $DragonFly: src/sys/boot/ficl/softwords/softcore.fr,v 1.2 2003/06/17 04:28:18 dillon Exp $
9 \ ** Ficl USER variables
10 \ ** See words.c for primitive def'n of USER
13 variable nUser 0 nUser !
15 nUser dup @ user 1 swap +! ;
20 \ EMPTY cleans the parameter stack
21 : empty ( xn..x1 -- ) depth 0 ?do drop loop ;
23 : cell- ( addr -- addr ) [ 1 cells ] literal - ;
24 : -rot ( a b c -- c a b ) 2 -roll ;
28 dup 0< if negate endif ;
29 decimal 32 constant bl
31 : space ( -- ) bl emit ;
33 : spaces ( n -- ) 0 ?do space loop ;
61 false invert constant true
65 : erase ( addr u -- ) 0 fill ;
66 : nip ( y x -- x ) swap drop ;
67 : tuck ( y x -- x y x) swap over ;
68 : within ( test low high -- flag ) over - >r - r> u< ;
71 \ ** LOCAL EXT word set
72 \ #if FICL_WANT_LOCALS
73 : locals| ( name...name | -- )
76 dup 0= abort" where's the delimiter??"
81 repeat 2drop 0 0 (local)
84 : local ( name -- ) bl word count (local) ; immediate
86 : 2local ( name -- ) bl word count (2local) ; immediate
88 : end-locals ( -- ) 0 0 (local) ; immediate
92 \ ** TOOLS word set...
97 i 7 and 7 = if cr endif
101 \ ** SEARCH+EXT words and ficl helpers
106 \ DO_VOCABULARY handles the DOES> part of a VOCABULARY
107 \ When executed, new voc replaces top of search stack
108 : do-vocabulary ( -- )
109 does> @ search> drop >search ;
111 : vocabulary ( name -- )
112 wordlist create , do-vocabulary ;
114 : ficl-vocabulary ( nBuckets name -- )
115 ficl-wordlist create , do-vocabulary ;
117 \ ALSO dups the search stack...
119 search> dup >search >search ;
121 \ FORTH drops the top of the search stack and pushes FORTH-WORDLIST
124 forth-wordlist >search ;
126 \ ONLY sets the search order to a default state
130 \ ORDER displays the compile wid and the search order list
133 get-order 0 ?do x. loop cr
134 ." Compile: " get-current x. cr ;
136 \ PREVIOUS drops the search order stack
137 : previous ( -- ) search> drop ;
139 \ FICL-SET-CURRENT sets the compile wordlist and pushes the previous value
140 : ficl-set-current ( wid -- old-wid )
141 get-current swap set-current ;
143 wordlist constant hidden
144 : hide hidden dup >search ficl-set-current ;
146 \ ** E N D S O F T C O R E . F R