commit 7339d9c653ce9684eed306b335f529ed2405b43f
parent fa827b8616741e53952ccafe96c5a914c82ffe2b
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 24 Dec 2022 09:02:26 -0500
sys/grid: struct-ify and IO-ify
My initial Grid draft is quite inflexible. It plugs itself on global words on
load and once that's done, it can't be changed. Moreover, I'd like to make the
grid a bit more powerful (printing formatted strings at arbitrary positions) and
the simplest way to do that is to piggy-back on the IO subsystem.
So, here we are, having a Grid that is a nice little struct that extends IO and
that can plug cleanly into "emit".
To do this cleanly, I had to change the way "emit" and ConsoleOut plug into each
other. The hierarchy is now reversed and the "emit" alias is now not supposed to
change after its setting in sys/io. Changing ConsoleOut should be enough for all
your rug-pulling needs now.
Diffstat:
10 files changed, 108 insertions(+), 50 deletions(-)
diff --git a/fs/doc/io.txt b/fs/doc/io.txt
@@ -124,17 +124,31 @@ ptr -- where the MemIO is currently pointing
:new ( a -- hdl )
Allocate a new MemIO pointing to address a
-## SystemIn and SystemOut
+## ByteWriter
-SystemIn and SystemOut are structures that wrap around "key" and "emit",
-providing an I/O API around them.
+ByteWriter is a convenience structure that wraps a emit-like word with signature
+( c hdl -- ) with IO words.
+
+:writebyte ( c self -- )
+ The emit-like method to wrap.
+
+:new ( writebyte -- self )
+ Create a new ByteWriter that wraps the "writebyte" word.
## ConsoleIn and ConsoleOut
-ConsoleIn and ConsoleOut are values that, by default, point to SystemIn and
-SystemOut. When sys/rdln is used, ConsoleIn points to RdlnIn.
+ConsoleIn is the system IO that is connected to the interactive input of the
+system. ConsoleOut is the output of the system that is supposed to be visible to
+the operator.
+
+Those values can be changed, but generally only changes if the hardware changes.
+
+At boot, ConsoleIn's value is BootIn, an IO wrapping around the "boot source"
+contents in memory. That boot source is supposed to end up changing ConsoleIn to
+something else, usually an interactive input like RdlnIn from sys/rdln.
-Once loaded, the system interpret loop feeds itself from ConsoleIn.
+ConsoleOut starts as a black hole. Later during initialization, we're supposed
+to load a driver that can supply a proper ConsoleOut.
There is a "consoleecho" value, which is initialized to 0. When set to 1, all
characters being read through ConsoleIn are echoed through "emit". This can be
diff --git a/fs/doc/usage.txt b/fs/doc/usage.txt
@@ -341,12 +341,15 @@ to the associated data. This can be used to get a structbind's data reference:
There are several kinds of fields:
-* sfield: a 4 byte field
-* sfieldw: a 2 byte field
-* sfieldb: a 1 byte field
-* sconst: a 4 byte field that doesn't obey "to" semantics
-* sfield': a field that yields its address instead of a value. Useful for
+* sfield a 4 byte field
+* sfieldw a 2 byte field
+* sfieldb a 1 byte field
+* sconst a 4 byte field that doesn't obey "to" semantics
+* sfield' a field that yields its address instead of a value. Useful for
buffers. It must be called with a size argument.
+* smethod A 4 byte pointer to a word that behaves as described above.
+* ssmethod A "static" method. Like a method, but we don't copy the struct
+ address to PS.
You can also create gaps in the struct with "sallot":
diff --git a/fs/drv/pc/vga.fs b/fs/drv/pc/vga.fs
@@ -1,19 +1,24 @@
\ Video driver for PC's 80x25 mode
+require /sys/grid.fs
$b8000 const _mem(
-80 const COLS
-25 const LINES
-
-: cell! ( c pos -- ) << _mem( + swap $700 or swap w! ;
: vgareg@ ( idx -- c ) $3d4 pc! $3d5 pc@ ;
: vgareg! ( c idx -- ) $3d4 pc! $3d5 pc! ;
-: cursor! ( pos -- ) dup $0f vgareg! 8 rshift $0e vgareg! ;
-: scroll ( -- )
- _mem( COLS << + ( src ) _mem( ( src dst ) COLS LINES 1- * << ( src dst u )
- move ;
-: newln ( oldln -- newln )
- dup LINES 1- = if scroll else 1+ then ;
+
+extends Grid struct[ VgaGrid
+ 80 const _COLS
+ 25 const _LINES
+ : cell! ( c pos -- ) << _mem( + swap $700 or swap w! ;
+ : cursor! ( pos -- ) dup $0f vgareg! 8 rshift $0e vgareg! ;
+ : scroll ( -- )
+ _mem( _COLS << + ( src ) _mem( ( src dst )
+ _COLS _LINES 1- * << ( src dst u ) move ;
+ : newln ( oldln -- newln ) dup _LINES 1- = if scroll else 1+ then ;
+
+ : :new ( -- grid )
+ _COLS _LINES :newbase ['] cell! , ['] cursor! , ['] newln , ;
+]struct
\ Set video mode to text mode, 80x25
: vgatext! ( -- ) 0 0 3 int10h 2drop drop ;
diff --git a/fs/sys/grid.fs b/fs/sys/grid.fs
@@ -1,17 +1,33 @@
\ Grid subsystem
+extends ByteWriter struct[ Grid
+ sconst COLS
+ sconst LINES
+ sfield pos \ linear pos. if there's 80, pos 84 is 4th char of 2nd line.
+ ssmethod :cell! ( c pos -- )
+ ssmethod :cursor! ( pos -- )
+ ssmethod :newln ( oldln -- newln )
-0 value gridpos \ linear pos. if there's 80, pos 84 is 4th char of 2nd line.
+ : :pcell! ( c self -- ) dup pos swap :cell! ;
+ : :pos! ( pos self -- ) 2dup to pos :cursor! ;
-: pcell! ( c -- ) gridpos cell! ;
-: pos! ( pos -- ) dup to gridpos cursor! ;
+ : :clrline ( ln self -- ) >r \ V1=self
+ V1 COLS * V1 COLS >r begin ( pos ) SPC over V1 :cell! 1+ next drop rdrop ;
-: clrline ( ln -- ) COLS * COLS >r begin ( pos ) SPC over cell! 1+ next drop ;
-: linefeed ( -- )
- gridpos COLS / newln dup clrline COLS * pos! ;
+ : :linefeed ( self -- ) >r \ V1=self
+ r@ pos r@ COLS / r@ :newln dup r@ :clrline r@ COLS * r> :pos! ;
-: (emit) ( c -- ) case
- 8 ( BS ) of = SPC pcell! gridpos 1- pos! endof
- LF of = SPC pcell! linefeed endof
- SPC of > endof
- r@ pcell! gridpos 1+ dup COLS mod if pos! else drop linefeed then
- endcase ;
+ : _emit ( c self -- ) >r case \ V1=self V2=c
+ 8 ( BS ) of = SPC V1 :pcell! V1 pos 1- V1 :pos! endof
+ LF of = SPC V1 :pcell! V1 :linefeed endof
+ SPC of > endof
+ r@ V1 :pcell! V1 pos 1+ dup V1 COLS mod
+ if V1 :pos! else drop V1 :linefeed then
+ endcase rdrop ;
+
+ \ Creates the first part of the grid structure, but leaves the last 3 field
+ \ (methods) to the caller.
+ : :newbase ( cols lines -- partial-grid )
+ ['] _emit ByteWriter :new rot ( cols ) , swap ( lines ) , 0 , ;
+]struct
+
+0 structbind Grid grid
diff --git a/fs/sys/io.fs b/fs/sys/io.fs
@@ -34,6 +34,8 @@ struct+[ IO
-1 V1 :readbuf ?dup while ( a n ) V2 :write repeat rdrop rdrop ;
]struct
+: _consoleemit ConsoleOut IO :putc ;
+' _consoleemit to emit
: stdin StdIn IO :getc ;
: stdout StdOut IO :putc ;
: stdio$ ConsoleIn to StdIn ConsoleOut to StdOut ;
@@ -66,3 +68,14 @@ extends IO struct[ MemIO
here 0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] drop , ['] drop ,
swap ( a ) , ;
]struct
+
+extends IO struct[ ByteWriter
+ smethod :writebyte ( c self -- )
+
+ : _writebuf ( a n self -- written-n ) >r dup >r \ V1=self V2=n
+ ?dup if >r begin c@+ V1 :writebyte next then drop r> rdrop ;
+
+ : :new ( writebyte -- writer )
+ here 0 ( putback ) , ['] _ioerr , ['] _writebuf , ['] drop , ['] drop ,
+ swap ( writebyte ) , ;
+]struct
diff --git a/fs/tests/harness.fs b/fs/tests/harness.fs
@@ -3,18 +3,20 @@
: #eq ( n n -- ) 2dup = if 2drop else swap .x ." != " .x abort then ;
create _buf $100 allot
-0 value _sz
+_buf 1+ MemIO :new const _memio
-: _emit ( c -- )
- _buf _sz + 1+ c! 1 to+ _sz
- _sz $ff > if abort" capture overflow" then ;
\ capture is called with one word to call with capture on. It returns the
\ captured string. $ff bytes max.
: capture ( -- str )
- word ['] _emit to@! emit >r
- 0 to _sz runword
- r> to emit
- _sz _buf c! _buf ;
+ word
+ _buf 1+ to _memio MemIO ptr
+ _memio to@! ConsoleOut >r
+ _memio to@! StdOut >r
+ runword
+ r> to StdOut
+ r> to ConsoleOut
+ _memio MemIO ptr _buf - 1- ( sz )
+ _buf c! _buf ;
: #s= ( s1 s2 -- ) 2dup s= if 2drop else swap stype ." != " stype abort then ;
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -253,6 +253,7 @@ does> ( 'struct )
: sfield' ( sz -- ) doer _sfield does> CELLSZ + @ ( a off ) + ;
: sconst doer CELLSZ _sfield does> CELLSZ + @ ( a off ) + @ ;
: smethod doer _cur e>w structsz , CELLSZ sallot does> @ over + @ execute ;
+: ssmethod doer _cur e>w structsz , CELLSZ sallot does> @ swap + @ execute ;
struct[ Struct
sfield dict
@@ -295,23 +296,22 @@ struct[ IO
1 swap :readbuf if c@ else -1 ( EOF ) then then ;
]struct
-\ SystemIn and SystemOut
\ key and boot< never yield EOF
: _ioerr abort" Invalid I/O" ;
create _buf 1 allot
: _readbuf ( n hdl -- a? read-n ) 2drop boot< _buf c! _buf 1 ;
-create BootIn 0 , ' _readbuf , ' _ioerr , ' _ioerr ,
-: _writebuf ( a n hdl -- written-n ) 2drop c@ emit 1 ;
-create SystemOut 0 , ' _ioerr , ' _writebuf , ' drop ,
+create BootIn 0 , ' _readbuf , ' _ioerr , ' _ioerr , ' _ioerr ,
+: _writebuf 2drop drop 0 ;
+create IONullOut 0 , ' _ioerr , ' _writebuf , ' _ioerr , ' _ioerr ,
\ ConsoleIn and ConsoleOut
BootIn value ConsoleIn
-SystemOut value ConsoleOut
+IONullOut value ConsoleOut
0 value consoleecho
: _ ConsoleIn IO :getc consoleecho if dup emit then ;
current IN< !
ConsoleIn value StdIn
-ConsoleOut value StdOut
+IONullOut value StdOut
\ File API
\ Anticipating sys/file
diff --git a/fs/xcomp/i386/pc/init.fs b/fs/xcomp/i386/pc/init.fs
@@ -10,9 +10,10 @@
f<< /drv/pc/acpi.fs
\ Serial communication
\ f<< /drv/pc/com.fs
-f<< /drv/pc/vga.fs
f<< /sys/grid.fs
-' (emit) to emit
+f<< /drv/pc/vga.fs
+VgaGrid :new ' grid rebind
+grid :self dup to ConsoleOut to StdOut
\ Floppy boot drive
\ f<< /drv/pc/fdc.fs
diff --git a/fs/xcomp/i386/pc/inittest.fs b/fs/xcomp/i386/pc/inittest.fs
@@ -1,5 +1,7 @@
f<< /drv/pc/com.fs
-com$ ' >com to emit
+com$
+: _:emit ( c self -- ) drop >com ;
+' _:emit ByteWriter :new dup to ConsoleOut to StdOut
f<< sys/scratch.fs
f<< lib/fmt.fs
f<< lib/diag.fs
diff --git a/posix/init.fs b/posix/init.fs
@@ -1,5 +1,7 @@
\ Initialization for POSIX Dusk
: ARCH S" forth" ;
+: _:emit ( c self -- ) drop (emit) ;
+' _:emit ByteWriter :new dup to ConsoleOut to StdOut
f<< /sys/kbd.fs
' (key?) to key?
