| CREATE (klabels) 0 t,
| CREATE no_labels -1 tw,
\ we will allow someone who has spent 10 years studying the code to change
\ the keyboard functions
dictionary_create keyboard_functions
0C dt,
0 dt,
0 dt,
0 dt,
0 dt,
0 dt,
0 dt,
0 dt,
0 dt,
0 dt,
0 dt,
0 dt,
0 dt,
( i*x c-addr u -- j*x )
Save the current input source specification. Store minus-one (-1) in SOURCE-ID if it is present. Make the string described by c-addr and u both the input source and input buffer, set >IN to zero, and interpret. When the parse area is empty, restore the prior input source specification. Other stack effects are due to the words EVALUATEd.
: string_set_stream ( addr n --)
zero >IN !
#TIB !
zero %line !
%tib !
-1 SOURCE-ID !
;
: EVALUATE ( ? addr n --? )
save_stream
string_set_stream
scan
restore_stream
;
: $evaluate ( addr --)
COUNT EVALUATE
;
CORE EXT
( -- )
Make the user input device the input source. Receive input into the terminal input buffer, replacing any previous contents. Make the result, whose address is returned by TIB, the input buffer. Set >IN to zero.
Note: This word is obsolescent and is included as a concession to existing implementations.
COLDFORTH Was never fixed up in the standard, it should have been. As defined here you can interpret QUERY from a file ( call it a script file) and get one line of user input. Hardly a useless function.
: QUERY ( --)
save_stream
0 SOURCE-ID !
#$buffer get_buffer
buffer %tib !
0 %line !
buffer #$buffer ACCEPT #TIB ! 0 >IN !
scan
kill_buffer
restore_stream
;
\ adds the functions keys
| : kquery ( --)
save_stream
0 SOURCE-ID !
#$buffer get_buffer
buffer %tib !
0 %line !
buffer #$buffer ACCEPT #TIB ! 0 >IN !
\ put a space between user input and output
SPACE
scan
SOURCE + char@
kill_buffer
restore_stream
\ temination_code(--
\ This adds functions keys
seal W@ not IF
DUP [ #end_function 1- ]T LITERAL > IF
#end_function -
keyboard_functions @ MIN
zero MAX
1+ 4* keyboard_functions + @execute
ELSE
DROP
THEN
ELSE
DROP
THEN
;
CORE
( -- ) ( R: i*x -- )
Empty the return stack, store zero in SOURCE-ID if it is present, make the user input device the input source, and enter interpretation state. Do not display a message. Repeat the following:
Accept a line from the input source into the input buffer, set >IN to zero, and interpret. Display the implementation-defined system prompt if in interpretation state, all processing has been completed, and no ambiguous condition exists.
COLDFORTH The code below is clearly non standard, but it is clearly the way it is going to stay. Emptying the return stack is aborts problem not QUITs. ABORT deals with the restart in all task, QUITs use is limited to those that are set up to use the forth interpretor. If QUIT is used in some other context other than after an abort then what advantage is there in not returning to the calling code.
To ask for data before the first prompt is really not a very sensible thing to do.
| CREATE 'message 0 t,
: QUIT ( --)
\ clear
\ CR
\ seal W@ IF
\ no_labels LABELS
\ no_labels SHIFT_LABELS
\ ELSE
\ (klabels) @ LABELS
\ no_labels SHIFT_LABELS
\ THEN
\ 'message @execute
BEGIN
CR
.prompt
send
\ QUERY
kquery
AGAIN
; RECOVER
paren CORE
Compilation: Perform the execution semantics given below.
Execution: ( "ccc<paren>" -- )
Parse ccc delimited by ) (right parenthesis). ( is an immediate word.
The number of characters in ccc may be zero to the number of characters in the parse area.
When parsing from a text file, if the end of the parse area is reached before a right parenthesis is found, refill the input buffer from the next line of the file, set >IN to zero, and resume parsing, repeating this process until either a right parenthesis is found or the end of the file is reached.
Typical use: ... ( ccc) ...
: ( ( -- )
BEGIN
[CHAR] ) (word) 2DROP
TIB >IN @ + 1- C@ [CHAR] ) = IF
EXIT
THEN
REFILL 0=
UNTIL
; IMMEDIATE