3 : CMOVE ( src dest length -- )
10 -ROT OVER - ( length src (dest-src) )
11 -ROT DUP ROT + SWAP ( (dest-src) (src+length) src )
15 OVER I + ( (dest-src) i@ (dest-src+i) )
22 : CMOVE> ( src dest length -- )
28 -ROT OVER - ( length src (dest-src) )
29 -ROT DUP ROT + 1- ( (dest-src) src (src+length-1) )
40 : COMPILING? STATE @ 0<> ;
42 ( In compile mode, word compiles everything until the next
43 double quote as a litstring. Otherwise, dynamically allocates
44 memory and stores string there, returning address and length. )
45 : S" IMMEDIATE ( -- addr len )
47 ['] LITSTRING , ( compile LITSTRING )
48 HERE ( save the address of the length word on the stack )
49 0 , ( dummy length - we don't know what it is yet )
51 HERE ( save the starting address on the stack )
55 >IN @ #IB @ >= IF \ End of IB?
56 QUERY-INPUT \ Get next line
59 IB >IN @ + @ 1 >IN +! \ Get char from IB
65 DROP ( drop the double quote character at the end )
68 DUP ( get the saved address of the length word )
69 HERE SWAP - ( calculate the length )
70 1- ( subtract 1 (because we measured from the start of the length word) )
71 SWAP ! ( and back-fill the length location )
77 ( Compile-mode word which compiles everything until the
78 next double quote as a litstring and appends a TYPE. )
84 ( Interpret-mode word which prints everything until the next
85 right-paren to the terminal. )
88 >IN @ #IB @ >= IF \ End of IB?
89 QUERY-INPUT \ Get next line
92 IB >IN @ + @ 1 >IN +! \ Get char from IB
95 DROP ( drop the double quote character )
96 EXIT ( return from this function )
102 ( Converts address of counted string into address of
103 start of string and length of string. )
104 : COUNT ( addr1 -- addr2 n )
107 ( Compares two strings, returns 0 if identical. )
108 : COMPARE ( addr1 n1 addr2 n2 -- res )
116 2dup i + @ swap i + @ <> if
124 ( Converts a string to lower case. )
125 : TOLOWER ( addr n -- )
127 dup i + @ dup dup ( addr char char char )
129 swap [char] Z <= and if
130 [char] A - [char] a +
140 ( Abort if flag is true. )
141 : ABORT" IMMEDIATE ( flag -- )
146 s" Aborted: " ['] lit , , ['] lit , , ['] swap ,