1\ ** ficl/softwords/softcore.fr 2\ ** FICL soft extensions 3\ ** John Sadler (john_sadler@alum.mit.edu) 4\ ** September, 1998 |
5\ 6\ $FreeBSD: head/sys/boot/ficl/softwords/softcore.fr 94290 2002-04-09 17:45:28Z dcs $ |
7 |
8\ ** Ficl USER variables 9\ ** See words.c for primitive def'n of USER |
10\ #if FICL_WANT_USER 11variable nUser 0 nUser ! 12: user \ name ( -- ) 13 nUser dup @ user 1 swap +! ; 14 15\ #endif 16 17\ ** ficl extras --- 11 unchanged lines hidden (view full) --- 29: space ( -- ) bl emit ; 30 31: spaces ( n -- ) 0 ?do space loop ; 32 33: abort" 34 state @ if 35 postpone if 36 postpone ." |
37 postpone cr 38 -2 39 postpone literal 40 postpone throw 41 postpone endif 42 else 43 [char] " parse 44 rot if --- 8 unchanged lines hidden (view full) --- 53 54 55\ ** CORE EXT 560 constant false 57false invert constant true 58: <> = 0= ; 59: 0<> 0= 0= ; 60: compile, , ; |
61: convert char+ 65535 >number drop ; \ cribbed from DPANS A.6.2.0970 |
62: erase ( addr u -- ) 0 fill ; |
63variable span 64: expect ( c-addr u1 -- ) accept span ! ; 65\ see marker.fr for MARKER implementation |
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< ; 69 70 71\ ** LOCAL EXT word set 72\ #if FICL_WANT_LOCALS 73: locals| ( name...name | -- ) --- 91 unchanged lines hidden (view full) --- 165set-current \ stop hiding words 166 167: order ( -- ) 168 ." Search:" cr 169 get-order 0 ?do 3 spaces list-wid loop cr 170 ." Compile: " get-current list-wid cr 171; 172 |
173: debug ' debug-xt ; immediate 174: on-step ." S: " .s cr ; |
175 |
176 177\ Submitted by lch. 178: strdup ( c-addr length -- c-addr2 length2 ior ) 179 0 locals| addr2 length c-addr | end-locals 180 length 1 + allocate 181 0= if 182 to addr2 183 c-addr addr2 length move 184 addr2 length 0 185 else 186 0 -1 187 endif 188 ; 189 190: strcat ( 2:a 2:b -- 2:new-a ) 191 0 locals| b-length b-u b-addr a-u a-addr | end-locals 192 b-u to b-length 193 b-addr a-addr a-u + b-length move 194 a-addr a-u b-length + 195 ; 196 197: strcpy ( 2:a 2:b -- 2:new-a ) 198 locals| b-u b-addr a-u a-addr | end-locals 199 a-addr 0 b-addr b-u strcat 200 ; 201 202 |
203previous \ lose hidden words from search order 204 205\ ** E N D S O F T C O R E . F R 206 |