move the full listener from interface/retro-unix to the basic image
FossilOrigin-Name: e6fd949a0911730c0db46faf3c20fdb7b265b38bc2b3b3456980d26a4bb1bdbc
This commit is contained in:
parent
b54beb2091
commit
c84b9a7e5d
5 changed files with 830 additions and 859 deletions
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
BIN
ngaImage
Binary file not shown.
1586
vm/nga-c/image.c
1586
vm/nga-c/image.c
File diff suppressed because it is too large
Load diff
Loading…
Reference in a new issue