move the full listener from interface/retro-unix to the basic image

FossilOrigin-Name: e6fd949a0911730c0db46faf3c20fdb7b265b38bc2b3b3456980d26a4bb1bdbc
This commit is contained in:
crc 2023-12-15 14:10:08 +00:00
parent b54beb2091
commit c84b9a7e5d
5 changed files with 830 additions and 859 deletions

View file

@ -46,6 +46,9 @@
the device handlers
- support loading extensions at runtime via `library:load`
(searches ./library/ and ~/.config/retroforth/library/)
- more use of assembly language
- move full listener from interface/retro-unix to the base
image
- library
- block-editor (from konilo)

View file

@ -1872,33 +1872,52 @@ provide much more than I can do here.
## Listener
The basic image has a space allocated for input at the end of
the kernel. A pointer to this is stored at address 7.
~~~
:TIB #7 fetch ;
~~~
~~~
[ 'ERROR:_Word_Not_Found:_ s:put TIB s:put nl ]
&err:notfound set-hook
~~~
If a VM implementation provides both the character output and a
generic "keyboard" input, the basic listener here can be used.
~~~
{{
:eol? (c-f)
[ ASCII:CR eq? ] [ ASCII:LF eq? ] [ ASCII:SPACE eq? ] tri or or ;
:valid? (s-sf)
dup s:length n:-zero? ;
:bs? (c-cf)
dup [ #8 eq? ] [ #127 eq? ] bi or ;
:check-bs (c-c)
bs? [ buffer:size #2 gteq? [ buffer:get drop ] if buffer:get drop ] if ;
---reveal---
:c:get (-c) hook #1 io:scan-for io:invoke ;
:bye (-) \ha...... ;
FALSE 'Ignoring var-n
{{
'EOT var
(-nn) :version @Version #100 /mod ;
(c-f) :done? dup !EOT
[ ASCII:CR eq? ]
[ ASCII:LF eq? ]
[ ASCII:SPACE eq? ] tri or or ;
(c-f) :eol? @EOT [ ASCII:CR eq? ] [ ASCII:LF eq? ] bi or ;
(s-sf) :valid? dup s:length n:strictly-positive? ;
(c-c) :check-eof dup [ #-1 eq? ] [ ASCII:EOT eq? ] bi or &bye if ;
:bs buffer:size #2 gteq?
[ buffer:get drop ] if buffer:get drop ;
(c-c) :check-bs dup [ ASCII:BS eq? ] [ ASCII:DEL eq? ] bi or &bs if ;
(c-c) :check check-eof check-bs ;
(-c) :character c:get dup buffer:add ;
(q-) :buffer [ TIB buffer:set call buffer:start ] buffer:preserve ;
(-s) :read-token [ [ character check done? ] until ] buffer s:chop ;
(-sf) :input read-token valid? ;
(sf-) :process @Ignoring [ drop-pair eol? [ &Ignoring v:off ] if ] if;
&interpret &drop choose ;
---reveal---
:s:get-word (-s) [ #7 fetch buffer:set
[ c:get dup buffer:add check-bs eol? ] until
buffer:start s:chop ] buffer:preserve ;
:bye (-) \ha...... ;
:listen (-)
repeat s:get-word valid? &interpret &drop choose again ;
:banner version 'RETRO_12_(%n.%n)\n s:format s:put
FREE EOM FREE - EOM '%n_Max,_%n_Used,_%n_Free\n s:format s:put ;
:listen banner repeat input process again ;
}}
&listen #1 store

View file

@ -3,13 +3,6 @@
In this file I am implementing the interactive listener that
RETRO 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. A pointer to this is stored at address 7.
~~~
:TIB #7 fetch ;
~~~
~~~
:image:save (s-) #1000 io:scan-for io:invoke ;
~~~
@ -55,53 +48,17 @@ RRE's C part will access a couple parts of this, based on the
startup flags passed.
~~~
{{
'EOT var
FALSE 'Ignoring var-n
(-nn) :version @Version #100 /mod ;
(c-f) :done? dup !EOT
[ ASCII:CR eq? ]
[ ASCII:LF eq? ]
[ ASCII:SPACE eq? ] tri or or ;
(c-f) :eol? @EOT [ ASCII:CR eq? ] [ ASCII:LF eq? ] bi or ;
(s-sf) :valid? dup s:length n:strictly-positive? ;
(c-c) :check-eof dup [ #-1 eq? ] [ ASCII:EOT eq? ] bi or &bye if ;
:bs buffer:size #2 gteq?
[ buffer:get drop ] if buffer:get drop ;
(c-c) :check-bs dup [ ASCII:BS eq? ] [ ASCII:DEL eq? ] bi or &bs if ;
(c-c) :check check-eof check-bs ;
(-c) :character c:get dup buffer:add ;
(q-) :buffer [ TIB buffer:set call buffer:start ] buffer:preserve ;
(-s) :read-token [ [ character check done? ] until ] buffer s:chop ;
(-sf) :input read-token valid? ;
(sf-) :process @Ignoring [ drop-pair eol? [ &Ignoring v:off ] if ] if;
&interpret &drop choose ;
---reveal---
:// script:ignore-to-eol &Ignoring v:on ; immediate
:banner version 'RETRO_12_(%n.%n)\n s:format s:put
FREE EOM FREE - EOM '%n_Max,_%n_Used,_%n_Free\n s:format s:put ;
:listen banner repeat input process again ;
}}
&listen #1 store
~~~
~~~
[ 'ERROR:_Word_Not_Found:_ s:put TIB s:put nl ]
&err:notfound set-hook
~~~
## d:source
~~~
'interface/retro-unix.retro s:keep
dup 'listen d:lookup d:source store
dup 'banner d:lookup d:source store
dup '// d:lookup d:source store
dup 'clear d:lookup d:source store
dup 's:get d:lookup d:source store
dup 'parse-until d:lookup d:source store
dup 'image:save d:lookup d:source store
dup 'TIB d:lookup d:source store
drop
~~~

BIN
ngaImage

Binary file not shown.

File diff suppressed because it is too large Load diff