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