DROP
;
-( Compile-mode word which compiles everything until the next
- double quote as a litstring. )
-: S" IMMEDIATE ( -- addr len )
- ['] LITSTRING , ( compile LITSTRING )
- HERE ( save the address of the length word on the stack )
- 0 , ( dummy length - we don't know what it is yet )
+: COMPILING? STATE @ 0<> ;
+
+( In compile mode, word compiles everything until the next
+ double quote as a litstring. Otherwise, dynamically allocates
+ memory and stores string there, returning address and length. )
+: S" IMMEDIATE ( -- addr len )
+ COMPILING? IF
+ ['] LITSTRING , ( compile LITSTRING )
+ HERE ( save the address of the length word on the stack )
+ 0 , ( dummy length - we don't know what it is yet )
+ ELSE
+ HERE ( save the starting address on the stack )
+ THEN
BEGIN
- >IN @ #IB @ >= IF \ End of TIB?
+ >IN @ #IB @ >= IF \ End of IB?
QUERY-INPUT \ Get next line
THEN
- IB >IN @ + @ 1 >IN +! \ Get char from TIB
+ IB >IN @ + @ 1 >IN +! \ Get char from IB
DUP [CHAR] " <>
WHILE
- C, ( copy character )
+ , ( copy character )
REPEAT
DROP ( drop the double quote character at the end )
- DUP ( get the saved address of the length word )
- HERE SWAP - ( calculate the length )
- 1- ( subtract 1 (because we measured from the start of the length word) )
- SWAP ! ( and back-fill the length location )
+
+ COMPILING? IF
+ DUP ( get the saved address of the length word )
+ HERE SWAP - ( calculate the length )
+ 1- ( subtract 1 (because we measured from the start of the length word) )
+ SWAP ! ( and back-fill the length location )
+ ELSE
+ DUP HERE SWAP -
+ THEN
;
( Compile-mode word which compiles everything until the
right-paren to the terminal. )
: .(
BEGIN
- >IN @ #IB @ >= IF \ End of TIB?
+ >IN @ #IB @ >= IF \ End of IB?
QUERY-INPUT \ Get next line
THEN
- IB >IN @ + @ 1 >IN +! \ Get char from TIB
+ IB >IN @ + @ 1 >IN +! \ Get char from IB
DUP [CHAR] ) = IF
DROP ( drop the double quote character )
: COUNT ( addr1 -- addr2 n )
DUP 1+ SWAP @ ;
+( Compares two strings, returns 0 if identical. )
+: COMPARE ( addr1 n1 addr2 n2 -- res )
+ rot 2dup <> if
+ 2drop 2drop 1 exit
+ then
+
+ drop
+
+ 0 do
+ 2dup i + @ swap i + @ <> if
+ unloop 2drop 1 exit
+ then
+ loop
+
+ 2drop 0
+;
+
+( Converts a string to lower case. )
+: TOLOWER ( addr n -- )
+ 0 do
+ dup i + @ dup dup ( addr char char char )
+ [char] A >=
+ swap [char] Z <= and if
+ [char] A - [char] a +
+ over i + !
+ else
+ drop
+ then
+ loop
+
+ drop
+;
+
( Abort if flag is true. )
: ABORT" IMMEDIATE ( flag -- )
[COMPILE] S"