1\ ** ficl/softwords/softcore.fr 2\ ** FICL soft extensions 3\ ** John Sadler (john_sadler@alum.mit.edu) 4\ ** September, 1998 5 6S" FICL_WANT_USER" ENVIRONMENT? drop [if] 7\ ** Ficl USER variables 8\ ** See words.c for primitive def'n of USER 9variable nUser 0 nUser ! 10: user \ name ( -- ) 11 nUser dup @ user 1 swap +! ; 12 13[endif] 14 15 16 17S" FICL_WANT_LOCALS" ENVIRONMENT? drop [if] 18 19\ ** LOCAL EXT word set 20 21: locals| ( name...name | -- ) 22 begin 23 bl word count 24 dup 0= abort" where's the delimiter??" 25 over c@ 26 [char] | - over 1- or 27 while 28 (local) 29 repeat 2drop 0 0 (local) 30; immediate 31 32: local ( name -- ) bl word count (local) ; immediate 33 34: 2local ( name -- ) bl word count (2local) ; immediate 35 36: end-locals ( -- ) 0 0 (local) ; immediate 37 38 39\ Submitted by lch. 40: strdup ( c-addr length -- c-addr2 length2 ior ) 41 0 locals| addr2 length c-addr | end-locals 42 length 1 + allocate 43 0= if 44 to addr2 45 c-addr addr2 length move 46 addr2 length 0 47 else 48 0 -1 49 endif 50 ; 51 52: strcat ( 2:a 2:b -- 2:new-a ) 53 0 locals| b-length b-u b-addr a-u a-addr | end-locals 54 b-u to b-length 55 b-addr a-addr a-u + b-length move 56 a-addr a-u b-length + 57 ; 58 59: strcpy ( 2:a 2:b -- 2:new-a ) 60 locals| b-u b-addr a-u a-addr | end-locals 61 a-addr 0 b-addr b-u strcat 62 ; 63 64[endif] 65 66: xemit ( xchar -- ) 67 dup $80 u< if emit exit then \ special case ASCII 68 0 swap $3F 69 begin 2dup u> while 70 2/ >r dup $3F and $80 or swap 6 rshift r> 71 repeat $7F xor 2* or 72 begin dup $80 u< 0= while emit repeat drop 73; 74\ end-of-file 75