267 lines
6.8 KiB
Forth
267 lines
6.8 KiB
Forth
# RRE Listener and Extensions
|
|
|
|
In this file I am implementing the interactive listener that
|
|
RRE will run when started with `-i`, `-i,c`, or `-i,fs`.
|
|
|
|
The basic image has a space allocated for input at the end of
|
|
the kernel. This is at address 1024 (the kernel space is fixed
|
|
at addresses 0 to 1023).
|
|
|
|
~~~
|
|
#1024 'TIB const
|
|
~~~
|
|
|
|
|
|
## Console Input
|
|
|
|
The RRE interface provides a keyboard device. This exposes it
|
|
via `c:get`.
|
|
|
|
~~~
|
|
{{
|
|
'io:Keyboard var
|
|
:identify
|
|
@io:Keyboard n:zero? [
|
|
#1 io:scan-for dup n:negative?
|
|
[ drop 'IO_DEVICE_TYPE_0001_NOT_FOUND s:put nl ]
|
|
[ !io:Keyboard ] choose ] if ;
|
|
---reveal---
|
|
:c:get (-c) identify @io:Keyboard io:invoke ;
|
|
}}
|
|
~~~
|
|
|
|
Now that I can read characters, it's time to support reading
|
|
strings. I do this via two words. The first is `parse-until`.
|
|
This will setup a temporary string as an input buffer, then
|
|
read input, passing each character ot a provided quote. When
|
|
the quote returns `TRUE`, it ends and returns the string. When
|
|
not `TRUE` it will add the character to the buffer.
|
|
|
|
~~~
|
|
{{
|
|
:gather (c-)
|
|
dup [ #8 eq? ] [ #127 eq? ] bi or [ drop ] [ buffer:add ] choose ;
|
|
:cycle (q-qc) repeat c:get dup-pair swap call not 0; drop gather again ;
|
|
---reveal---
|
|
:parse-until (q-s)
|
|
[ s:empty buffer:set cycle drop-pair buffer:start ] buffer:preserve ;
|
|
}}
|
|
~~~
|
|
|
|
Using this, a simple `s:get` can be implemented very easily as
|
|
a quote which looks for an end of line character.
|
|
|
|
~~~
|
|
:s:get (-s) [ [ ASCII:LF eq? ] [ ASCII:CR eq? ] bi or ] parse-until ;
|
|
~~~
|
|
|
|
|
|
## Scripting: Command Line Arguments
|
|
|
|
RRE also provides access to the command line arguments passed
|
|
to a script. The next few words map the scripting device to
|
|
words we can use.
|
|
|
|
~~~
|
|
{{
|
|
'io:Scripting var
|
|
:identify
|
|
@io:Scripting n:zero? [
|
|
#9 io:scan-for dup n:negative?
|
|
[ drop 'IO_DEVICE_TYPE_0009_NOT_FOUND s:put nl ]
|
|
[ !io:Scripting ] choose ] if ;
|
|
---reveal---
|
|
:sys:argc (-n) identify #0 @io:Scripting io:invoke ;
|
|
:sys:argv (n-s) s:empty swap identify #1 @io:Scripting io:invoke ;
|
|
:include (s-) identify #2 @io:Scripting io:invoke ;
|
|
:sys:name (-s) s:empty identify #3 @io:Scripting io:invoke ;
|
|
}}
|
|
~~~
|
|
|
|
# Fullscreen Interactive Listener
|
|
|
|
~~~
|
|
'FullScreenListener var
|
|
~~~
|
|
|
|
Nearly all of this will be hidden from the user.
|
|
|
|
~~~
|
|
{{
|
|
~~~
|
|
|
|
I'm using the buffer: words to deal with the TIB. To avoid any
|
|
conflict with user buffers, I'm duplicating the needed words
|
|
here, privately.
|
|
|
|
~~~
|
|
:Buffer `0 ; data
|
|
:Ptr `0 ; data
|
|
:terminate (-) #0 @Ptr store ;
|
|
:buffer:start (-a) @Buffer ;
|
|
:buffer:end (-a) @Ptr ;
|
|
:buffer:add (c-) buffer:end store &Ptr v:inc terminate ;
|
|
:buffer:get (-c) &Ptr v:dec buffer:end fetch terminate ;
|
|
:buffer:empty (-) buffer:start !Ptr terminate ;
|
|
:buffer:set (a-) !Buffer buffer:empty ;
|
|
~~~
|
|
|
|
Color choices are a personal thing. I define the ones I want
|
|
here.
|
|
|
|
~~~
|
|
:white,blue #27 c:put '[1;37;44m s:put ;
|
|
:white,black #27 c:put '[0;37;40m s:put ;
|
|
~~~
|
|
|
|
The top bar displays:
|
|
|
|
- stack depth
|
|
- memory stats
|
|
- top five stack values
|
|
|
|
~~~
|
|
:dump-stack
|
|
depth 0; #5 n:min
|
|
'|_ s:put
|
|
#1 [ 'a 'aa reorder n:put ] case
|
|
#2 [ 'ab 'abba reorder #2 [ n:put sp ] times ] case
|
|
#3 [ 'abc 'abccba reorder #3 [ n:put sp ] times ] case
|
|
#4 [ 'abcd 'abcddcba reorder #4 [ n:put sp ] times ] case
|
|
#5 [ 'abcde 'abcdeedcba reorder #5 [ n:put sp ] times ] case ;
|
|
|
|
:top-row #27 c:put '[1;0H s:put ;
|
|
:clear-row #80 [ sp ] times ;
|
|
|
|
:top top-row white,blue clear-row top-row
|
|
FREE depth n:dec 'SP:%n_FREE:%n_ s:format s:put
|
|
dump-stack ;
|
|
~~~
|
|
|
|
|
|
Next is the input bar. This is displayed at the bottom of the screen.
|
|
|
|
~~~
|
|
:bottom-row #27 c:put '[24;0H s:put ;
|
|
:input bottom-row white,blue clear-row bottom-row ;
|
|
~~~
|
|
|
|
The other bit is the output area in the middle. I have this as white
|
|
text on a black background.
|
|
|
|
~~~
|
|
:output bottom-row white,black clear-row bottom-row ;
|
|
~~~
|
|
|
|
Now on to input processing. I have a variable, `In`, which
|
|
tracks the number of characters read so far. This is used in
|
|
a few places, to ensure that backspace doesn't overwrite the
|
|
kernel, and to blank the line if too many characters are
|
|
input.
|
|
|
|
~~~
|
|
'In var
|
|
~~~
|
|
|
|
For handling backspaces, remove from the buffer and erase the
|
|
displayed character.
|
|
|
|
~~~
|
|
:discard buffer:get drop ;
|
|
:rub #8 c:put sp #8 c:put ;
|
|
~~~
|
|
|
|
I process input on CR, LF, and SPACE.
|
|
|
|
~~~
|
|
:evaluate TIB interpret ;
|
|
:reset #0 !In buffer:empty ;
|
|
~~~
|
|
|
|
Tie this together into a key handler.
|
|
|
|
~~~
|
|
:handle
|
|
ASCII:SPACE [ @In 0; drop output evaluate nl reset top input ] case
|
|
ASCII:CR [ @In 0; drop output evaluate nl reset top input ] case
|
|
ASCII:LF [ @In 0; drop output evaluate nl reset top input ] case
|
|
ASCII:DEL [ @In 0; drop discard rub &In v:dec ] case
|
|
ASCII:BS [ @In 0; drop discard rub &In v:dec ] case
|
|
dup c:put buffer:add &In v:inc ;
|
|
~~~
|
|
|
|
And use that a the `process` loop.
|
|
|
|
~~~
|
|
:process
|
|
TIB buffer:set
|
|
repeat c:get handle @In #80 eq? [ #0 !In input ] if again ;
|
|
~~~
|
|
|
|
The last few support words use the stty(1) program to setup and
|
|
reset the terminal.
|
|
|
|
~~~
|
|
:init 'stty_cbreak_-echo unix:system ;
|
|
:exit 'stty_-cbreak_echo unix:system #0 unix:exit ;
|
|
~~~
|
|
|
|
Switch to the public words.
|
|
|
|
~~~
|
|
---reveal---
|
|
~~~
|
|
|
|
And expose `bye`, `clear`, and the `listener`.
|
|
|
|
~~~
|
|
:clear #27 c:put '[2J s:put #27 c:put '[0;0H s:put ;
|
|
:listen:fullscreen:bye exit ;
|
|
:listen:fullscreen init clear top input process ;
|
|
~~~
|
|
|
|
Hide the support words.
|
|
|
|
~~~
|
|
}}
|
|
~~~
|
|
|
|
# Standard Interactive Listener
|
|
|
|
The main part of this file is the *listener*, an interactive
|
|
read-eval-print loop.
|
|
|
|
RRE's C part will access a couple parts of this, based on the
|
|
startup flags passed.
|
|
|
|
~~~
|
|
'NoEcho var
|
|
|
|
{{
|
|
:version (-) @Version #100 /mod n:put $. c:put n:put ;
|
|
:eol? (c-f) [ ASCII:CR eq? ] [ ASCII:LF eq? ] [ ASCII:SPACE eq? ] tri or or ;
|
|
:valid? (s-sf) dup s:length n:-zero? ;
|
|
:ok (-) @NoEcho not 0; drop compiling? [ nl 'Ok_ s:put ] -if ;
|
|
:check-eof (c-c) dup [ #-1 eq? ] [ #4 eq? ] bi or [ 'bye d:lookup d:xt fetch call ] if ;
|
|
:check-bs (c-c) dup [ #8 eq? ] [ #127 eq? ] bi or [ buffer:get buffer:get drop-pair ] if ;
|
|
:s:get (-s) [ TIB buffer:set
|
|
[ c:get dup buffer:add check-eof check-bs eol? ] until
|
|
buffer:start s:chop ] buffer:preserve ;
|
|
---reveal---
|
|
:banner (-) @NoEcho not 0; drop
|
|
'RETRO_12_(rx- s:put version $) c:put nl
|
|
EOM n:put '_MAX,_TIB_@_1025,_Heap_@_ s:put here n:put nl ;
|
|
:bye (-) @FullScreenListener [ listen:fullscreen:bye ] if
|
|
#0 unix:exit ;
|
|
:listen (-)
|
|
@FullScreenListener [ listen:fullscreen ] if;
|
|
ok repeat s:get valid? [ interpret ok ] [ drop ] choose again ;
|
|
}}
|
|
|
|
&listen #1 store
|
|
~~~
|
|
|
|
|
|
~~~
|
|
:image:save (s-) #1000 io:scan-for io:invoke ;
|
|
~~~
|