softcore.fr revision 40987 
1\ ** ficl/softwords/softcore.fr
2\ ** FICL soft extensions
3\ ** John Sadler (john_sadler@alum.mit.edu)
4\ ** September, 1998
5
6\ ** Ficl USER variables
7\ ** See words.c for primitive def'n of USER
8\ #if FICL_WANT_USER
9
10variable nUser  0 nUser ! 
11: user   \ name ( -- )  
12    nUser dup @ user 1 swap +! ; 
13
14\ #endif
15
16\ ** ficl extras
17\ EMPTY cleans the parameter stack
18: empty   ( xn..x1 -- ) depth 0 ?do drop loop ;
19\ CELL- undoes CELL+
20: cell-   ( addr -- addr )  [ 1 cells ] literal -  ;
21: -rot   ( a b c -- c a b )  2 -roll ;
22
23\ ** CORE 
24: abs   ( x -- x )
25    dup 0< if negate endif ;
26decimal 32 constant bl
27
28: space   ( -- )     bl emit ;
29
30: spaces  ( n -- )   0 ?do space loop ;
31
32: abort"  
33    postpone if 
34    postpone ." 
35    postpone cr 
36    postpone abort 
37    postpone endif 
38; immediate 
39
40
41\ ** CORE EXT
420  constant false 
43-1 constant true 
44: <>   = invert ; 
45: 0<>  0= invert ; 
46: compile,  , ; 
47: erase   ( addr u -- )    0 fill ; 
48: nip     ( y x -- x )     swap drop ; 
49: tuck    ( y x -- x y x)  swap over ; 
50
51\ ** LOCAL EXT word set
52\ #if FICL_WANT_LOCALS
53: locals|  ( name...name | -- )
54    begin
55        bl word   count
56        dup 0= abort" where's the delimiter??"
57        over c@
58        [char] | - over 1- or
59    while
60        (local)
61    repeat 2drop   0 0 (local)
62; immediate
63
64: local  ( name -- )  bl word count (local) ;  immediate
65
66: end-locals  ( -- )  0 0 (local) ;  immediate
67
68\ #endif
69
70\ ** TOOLS word set...
71: ?     ( addr -- )  @ . ;
72: dump  ( addr u -- )
73    0 ?do
74        dup c@ . 1+
75        i 7 and 7 = if cr endif
76    loop drop
77;
78
79\ ** SEARCH+EXT words and ficl helpers
80\ 
81: wordlist   ( -- )  
82    1 ficl-wordlist ;
83
84\ DO_VOCABULARY handles the DOES> part of a VOCABULARY
85\ When executed, new voc replaces top of search stack
86: do-vocabulary   ( -- ) 
87    does>  @ search> drop >search ;
88
89: vocabulary   ( name -- )  
90    wordlist create ,  do-vocabulary ; 
91
92: ficl-vocabulary   ( nBuckets name -- )  
93    ficl-wordlist create ,  do-vocabulary ; 
94
95\ ALSO dups the search stack...
96: also   ( -- )  
97    search> dup >search >search ; 
98
99\ FORTH drops the top of the search stack and pushes FORTH-WORDLIST
100: forth   ( -- )  
101    search> drop  
102    forth-wordlist >search ; 
103
104\ ONLY sets the search order to a default state
105: only   ( -- )  
106    -1 set-order ; 
107
108\ ORDER displays the compile wid and the search order list
109: order   ( -- )  
110    ." Search: " 
111    get-order  0 ?do x. loop cr 
112   ." Compile: " get-current x. cr  ; 
113
114\ PREVIOUS drops the search order stack
115: previous  ( --  )  search> drop ; 
116
117\ FICL-SET-CURRENT sets the compile wordlist and pushes the previous value
118: ficl-set-current   ( wid -- old-wid )  
119    get-current swap set-current ; 
120
121wordlist constant hidden
122: hide   hidden dup >search ficl-set-current ;
123
124\ ** E N D   S O F T C O R E . F R
125
126