duskos

commit 1c9ed4819db61aee583649ac21bc206ce8a9122c
parent a6c46ca861ad644a3ca48db0860433e72209e225
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Fri, 23 Dec 2022 14:14:50 -0500

sys/kbd: new subsystem

This wraps up the whole key/key? thing more cleanly. "key" didn't belong in core
because we can have a system without an interactive keyboard, but it didn't
belong in sys/rdln either.

Diffstat:
M
fs/doc/dict.txt
 | 
9
++++++---
M
fs/doc/io.txt
 | 
2
++
A
fs/sys/kbd.fs
 | 
10
++++++++++
M
fs/sys/rdln.fs
 | 
3
++-
M
fs/xcomp/i386/pc/init.fs
 | 
3
++-
M
posix/init.fs
 | 
3
+++
M
posix/vm.c
 | 
2
+-

7 files changed, 26 insertions(+), 6 deletions(-)
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -293,9 +293,6 @@ rebind     'data 'bind --
 
 ## I/O
 
-key?       -- c? f     Poll system interactive input source for keypress. If
-                       there is one, f=1 and c is set. Otherwise, f=0.
-key        -- c        Read next character from system interactive input source.
 in<        -- c        Read next character from system input source.
 "<         -- c        Read from in< and apply literal escapes. c=-1 when " is
                        read (end of string).
@@ -375,3 +372,9 @@ to@   --> @
 to@!  --> @!
 to@+  --> @@+
 to!+  --> @!+
+
+## sys/kbd
+
+key?       -- c? f     Poll system interactive input source for keypress. If
+                       there is one, f=1 and c is set. Otherwise, f=0.
+key        -- c        Read next character from system interactive input source.
diff --git a/fs/doc/io.txt b/fs/doc/io.txt
@@ -63,6 +63,8 @@ convenience words:
 :getc ( hdl -- c )
   Read 1 byte from hdl an return it. Advance position by 1 byte. Return -1 on
   EOF. If putback is nonzero, return this value instead, and reset putback to 0.
+  This can be used to poll an interactive (keyboard, serial link, etc) I/O
+  device: -1 is returned as long as there's nothing to return.
 
 :putc ( c hdl -- )
   Write 1 byte to hdl. Advance position by 1 byte. Aborts if unable to write.
diff --git a/fs/sys/kbd.fs b/fs/sys/kbd.fs
@@ -0,0 +1,10 @@
+\ Keyboard subsystem
+\ Provides a I/O wrapper around a keyboard driver
+
+alias abort key?
+: key begin key? until ;
+
+create _buf 1 allot
+: _readbuf ( n hdl -- a? read-n )
+  2drop key? if _buf c! _buf 1 else 0 then ;
+create KeyboardIn 0 , ' _readbuf , ' _ioerr , ' _ioerr ,
diff --git a/fs/sys/rdln.fs b/fs/sys/rdln.fs
@@ -1,4 +1,6 @@
 \ Readline interface
+require /sys/kbd.fs
+
 64 const LNSZ
 create in( LNSZ allot
 here value in)
@@ -12,7 +14,6 @@ in) value in>
   else ( ptr c ) \ non-BS
     dup emitv dup rot c!+ ( c ptr+1 ) dup in) = rot SPC < or ( ptr+1 f )
   then ;
-: key begin key? until ;
 : rdln
   in( LNSZ SPC fill S"  ok\n" stype
   in( begin key lntype until drop nl> ;
diff --git a/fs/xcomp/i386/pc/init.fs b/fs/xcomp/i386/pc/init.fs
@@ -36,12 +36,13 @@ pic$ idt$
 
 f<< /fs/fat.fs
 
+f<< /sys/kbd.fs
 f<< /drv/pc/ps28042.fs
 f<< /sys/ps2.fs
 
 8042ps2$
 ' 8042kbd@? to (ps2@?)
-: key? ps2keyset1? ;
+' ps2keyset1? to key?
 
 f<< /drv/pc/a20.fs
 a20$
diff --git a/posix/init.fs b/posix/init.fs
@@ -1,2 +1,5 @@
 \ Initialization for POSIX Dusk
 : ARCH S" forth" ;
+
+f<< /sys/kbd.fs
+' (key?) to key?
diff --git a/posix/vm.c b/posix/vm.c
@@ -1056,7 +1056,7 @@ static void (*ops[OPCNT])() = {
 static char *opnames[OPCNT] = {
 	NULL, NULL, NULL, NULL, "bye", "byefail", "quit", "(abort)",
 	"execute", "(cell)", "(does)", "(s)", "(br)", "(?br)", "(next)", NULL,
-	NULL, "p+,", NULL, "p',", "boot<", "(emit)", "key?", "drop",
+	NULL, "p+,", NULL, "p',", "boot<", "(emit)", "(key?)", "drop",
 	"dup", "?dup", "swap", "over", "rot", "rot>", "nip", "tuck",
 	NULL, "r+,", NULL, "r',", "scnt", "rcnt", NULL, NULL,
 	"@", "!", "+!", "@!", "@+", "!+", "@@+", "@!+",