From 475caf35f4db7ee34387491b91f20ef597a554ce Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Fri, 1 Jan 2021 08:05:29 -0500 Subject: [PATCH] Make KEY non-blocking ... and rename it to KEY?. Then, add KEY from KEY? for its blocking version. I need this for an upcoming Remote Shell feature. If a Collapse OS system remotely controls another shell, it needs to be able to poll both the remote system and the local keyboard at the same time. A blocking KEY is incompatible with this. In some places, the polling mechanism doesn't make sense, so this new KEY? always returns a character. In some places, I just haven't implemented the mechanism yet, so I kept the old blocking code and added a "always 1" flag as a temporary shim. I have probably broken something, but in emulators, Collapse OS runs fine. It's an important reminder of what will be lost with the new "dogfooding" approach (see recent mailing list message): without emulators, it's much harder to to sweeping changes like this without breaking stuff. It's fine, I don't expect many more of these core changes to the system. It's nearly feature-complete. --- arch/8086/pcat/blk.fs | 6 ++--- arch/z80/rc2014/blk.fs | 53 +++++++++++++++++--------------------- arch/z80/sms/blk.fs | 16 ++++++------ arch/z80/ti84/blk.fs | 45 ++++++++++++++------------------ arch/z80/ti84/xcomp.fs | 2 +- arch/z80/trs80/blk.fs | 4 +-- arch/z80/z80mbc2/xcomp.fs | 4 +-- blk.fs | 30 +++++++++++---------- cvm/common.fs | 2 +- cvm/stage.bin | Bin 4959 -> 4977 bytes doc/dict.txt | 41 ++++++++++++++++++----------- doc/impl.txt | 2 +- doc/protocol.txt | 11 ++++---- emul/8086/xcomp.fs | 2 +- emul/z80/acia.c | 5 ++-- emul/z80/acia.h | 2 +- emul/z80/rc2014.c | 6 ++--- emul/z80/xcomp.fs | 2 +- 18 files changed, 118 insertions(+), 115 deletions(-) diff --git a/arch/8086/pcat/blk.fs b/arch/8086/pcat/blk.fs index 6fdb4c6..97d86ee 100644 --- a/arch/8086/pcat/blk.fs +++ b/arch/8086/pcat/blk.fs @@ -16,13 +16,13 @@ BX 0 MOVxI, 0x13 INT, ( read sectors 2-15 of boot floppy ) ( TODO: reading 12 sectors like this probably doesn't work on real vintage PC/AT with floppy. Make this more robust. ) 0x800 0 JMPf, -ORG @ 0x1fe + HERE ! 0x55 C,* 0xaa C,* +ORG @ 0x1fe + HERE ! 0x55 C, 0xaa C, ( ----- 604 ) CODE (emit) 1 chkPS, AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT, ;CODE -CODE (key) - AH AH XORrr, 0x16 INT, AH AH XORrr, AX PUSHx, +CODE (key?) + AH AH XORrr, 0x16 INT, AH AH XORrr, AX PUSHx, AX PUSHx, ;CODE ( ----- 606 ) CODE 13H08H ( driveno -- cx dx ) diff --git a/arch/z80/rc2014/blk.fs b/arch/z80/rc2014/blk.fs index c478ee9..8eb4d84 100644 --- a/arch/z80/rc2014/blk.fs +++ b/arch/z80/rc2014/blk.fs @@ -7,15 +7,15 @@ 6850_IO for data register. CTL numbers used: 0x16 = no interrupt, 8bit words, 1 stop bit 64x divide. 0x56 = RTS high ) -CODE 6850< - A 0x16 ( RTS low ) LDri, 6850_CTL OUTiA, - BEGIN, - 6850_CTL INAi, 0x01 ANDi, ( is ACIA rcv buf full? ) - JRZ, ( no, loop ) AGAIN, - A 0x56 ( RTS high ) LDri, 6850_CTL OUTiA, - ( we have data, fetch and push ) - 6850_IO INAi, PUSHA, -;CODE +: _rts 0x16 ( RTS low ) [ 6850_CTL LITN ] PC! ; +: _rts^ 0x56 ( RTS high ) [ 6850_CTL LITN ] PC! ; +: 6850 HL POP, chkPS, @@ -25,7 +25,7 @@ CODE 6850> A L LDrr, 6850_IO OUTiA, ;CODE ( ----- 603 ) -: (key) 6850< ; +: (key?) 6850 ; : 6850$ 0x56 ( RTS high ) [ 6850_CTL LITN ] PC! ; ( ----- 605 ) @@ -34,17 +34,16 @@ CODE 6850> SIOA_DATA for ch A data register SIOB_CTL for ch B control register SIOB_DATA for ch B data register ) -CODE SIOA< - A 0x05 ( PTR5 ) LDri, SIOA_CTL OUTiA, - A 0b01101000 ( De-assert RTS ) LDri, SIOA_CTL OUTiA, - BEGIN, - SIOA_CTL ( RR0 ) INAi, 0x01 ANDi, ( is rcv buf full? ) - JRZ, ( no, loop ) AGAIN, - A 0x05 ( PTR5 ) LDri, SIOA_CTL OUTiA, - A 0b01101010 ( Assert RTS ) LDri, SIOA_CTL OUTiA, - ( we have data, fetch and push ) - SIOA_DATA INAi, PUSHA, -;CODE +: _ HL POP, chkPS, @@ -60,13 +59,7 @@ CREATE _ ( init data ) 0x18 C, ( CMD3 ) 0x21 C, ( CMD2/PTR1 ) 0 C, ( WR1/Rx no INT ) : SIOA$ 9 0 DO _ I + C@ [ SIOA_CTL LITN ] PC! LOOP ; ( ----- 607 ) -CODE SIOB< - BEGIN, - SIOB_CTL ( RR0 ) INAi, 0x01 ANDi, ( is rcv buf full? ) - JRZ, ( no, loop ) AGAIN, - ( we have data, fetch and push ) - SIOB_DATA INAi, PUSHA, -;CODE +: SIOB HL POP, chkPS, BEGIN, @@ -105,7 +98,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS 270 LOAD ( xcomp overrides ) 283 335 LOADR ( boot.z80 ) 353 LOAD ( xcomp core low ) 605 607 LOADR ( SIO ) 419 LOAD ( SPI relay ) 423 436 LOADR ( SD Card ) -400 LOAD ( AT28 ) : (key) SIOB< ; : (emit) SIOB> ; +400 LOAD ( AT28 ) : (key?) SIOA ; 390 LOAD ( xcomp core high ) (entry) _ PC ORG @ 8 + ! ( Update LATEST ) -," SIOB$ BLK$ " EOT, +," SIOA$ BLK$ " EOT, diff --git a/arch/z80/sms/blk.fs b/arch/z80/sms/blk.fs index 0805c5c..17c18ee 100644 --- a/arch/z80/sms/blk.fs +++ b/arch/z80/sms/blk.fs @@ -64,7 +64,7 @@ from it. It goes as follow: (cont.) ( ----- 611 ) This module is currently hard-wired to VDP driver, that is, it -calls vdp's routines during (key) to update character +calls vdp's routines during (key?) to update character selection. Load range: 632-637 @@ -113,15 +113,15 @@ CREATE _ '0' C, ':' C, 'A' C, '[' C, 'a' C, 0xff C, 0xe0 AND 0xe0 < ; ( ----- 616 ) -: (key) - _next C@ IF _next C@ 0 _next C! EXIT THEN - BEGIN _updsel UNTIL +: (key?) ( -- c? f ) + _next C@ IF _next C@ 0 _next C! 1 EXIT THEN + _updsel IF _prevstat C@ - 0x20 ( BUTC ) OVER AND NOT IF DROP _sel C@ EXIT THEN - 0x40 ( BUTA ) AND NOT IF 0x8 ( BS ) EXIT THEN + 0x20 ( BUTC ) OVER AND NOT IF DROP _sel C@ 1 EXIT THEN + 0x40 ( BUTA ) AND NOT IF 0x8 ( BS ) 1 EXIT THEN ( If not BUTC or BUTA, it has to be START ) - 0xd _next C! _sel C@ -; + 0xd _next C! _sel C@ 1 + ELSE 0 ( f ) THEN ; ( ----- 617 ) : PAD$ 0xff _prevstat C! 'a' _sel C! 0 _next C! ; diff --git a/arch/z80/ti84/blk.fs b/arch/z80/ti84/blk.fs index 9fd1d78..326ef6c 100644 --- a/arch/z80/ti84/blk.fs +++ b/arch/z80/ti84/blk.fs @@ -129,7 +129,7 @@ Keyboard driver Load range: 566-570 -Implement a (key) word that interpret keystrokes from the +Implement a (key?) word that interpret keystrokes from the builtin keyboard. The word waits for a digit to be pressed and returns the corresponding ASCII value. @@ -189,35 +189,30 @@ CREATE _atbl 0x20 C, 'Y' C, 'T' C, 'O' C, 'J' C, 'E' C, 'B' C, 0 C, 0 C, 'X' C, 'S' C, 'N' C, 'I' C, 'D' C, 'A' C, 0x80 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0x81 ( 2nd ) C, 0 C, 0x7f C, -: _2nd@ [ KBD_MEM LITN ] C@ 1 AND ; -: _2nd! [ KBD_MEM LITN ] C@ 0xfe AND + [ KBD_MEM LITN ] C! ; -: _alock@ [ KBD_MEM LITN ] C@ 2 AND ; -: _alock^ [ KBD_MEM LITN ] C@ 2 XOR [ KBD_MEM LITN ] C! ; +: _@ [ KBD_MEM LITN ] C@ ; : _! [ KBD_MEM LITN ] C! ; +: _2nd@ _@ 1 AND ; : _2nd! _@ 0xfe AND + _! ; +: _alpha@ _@ 2 AND ; : _alpha! 2 * _@ 0xfd AND + _! ; +: _alock@ _@ 4 AND ; : _alock^ _@ 4 XOR _! ; ( ----- 619 ) : _gti ( -- tindex, that it, index in _dtbl or _atbl ) - 0 ( gid ) 0 ( dummy ) - BEGIN ( loop until a digit is pressed ) - DROP - 1+ DUP 7 = IF DROP 0 THEN ( inc gid ) - 1 OVER LSHIFT 0xff -^ ( group dmask ) _get - DUP 0xff = NOT UNTIL _wait - ( gid dmask ) + 7 0 DO + 1 I LSHIFT 0xff -^ ( group dmask ) _get + DUP 0xff = IF DROP ELSE I ( dmask gid ) LEAVE THEN + LOOP _wait + SWAP ( gid dmask ) 0xff XOR ( dpos ) 0 ( dindex ) BEGIN 1+ 2DUP RSHIFT NOT UNTIL 1- ( gid dpos dindex ) NIP ( gid dindex ) SWAP 8 * + ; ( ----- 620 ) -: _tbl^ ( swap input tbl ) - _atbl = IF _dtbl ELSE _atbl THEN ; -: (key) - 0 _2nd! 0 ( lastchr ) BEGIN - _alock@ IF _atbl ELSE _dtbl THEN - OVER 0x80 ( alpha ) = - IF _tbl^ _2nd@ IF _alock^ THEN THEN - SWAP 0x81 = _2nd! - _gti + C@ - DUP 0 0x80 >< UNTIL ( loop if not in range ) - ( lowercase? ) - _2nd@ IF DUP 'A' 'Z' =><= IF 0x20 OR THEN THEN -; +: (key?) ( -- c? f ) + 0 _get 0xff = IF ( no key pressed ) 0 EXIT THEN + _alpha@ _alock@ IF NOT THEN IF _atbl ELSE _dtbl THEN + _gti + C@ ( c ) + DUP 0x80 = IF _2nd@ IF _alock^ ELSE 1 _alpha! THEN THEN + DUP 0x81 = _2nd! + DUP 0 0x80 >< IF ( we have something ) + ( lower? ) _2nd@ IF DUP 'A' 'Z' =><= IF 0x20 OR THEN THEN + 0 _2nd! 0 _alpha! 1 ( c f ) + ELSE ( nothing ) DROP 0 THEN ; : KBD$ 0 [ KBD_MEM LITN ] C! ; diff --git a/arch/z80/ti84/xcomp.fs b/arch/z80/ti84/xcomp.fs index 1bd2c82..e13e783 100644 --- a/arch/z80/ti84/xcomp.fs +++ b/arch/z80/ti84/xcomp.fs @@ -39,7 +39,7 @@ EI, RETI, 0x03 ALLOT0 ( 0x53 ) -0x5a JP, ( 0x56 ) 0xff A, 0xa5 A, 0xff A, ( 0x5a ) +0x5a JP, ( 0x56 ) 0xff C, 0xa5 C, 0xff C, ( 0x5a ) ( boot ) DI, IM1, diff --git a/arch/z80/trs80/blk.fs b/arch/z80/trs80/blk.fs index 12b8622..a5eda0b 100644 --- a/arch/z80/trs80/blk.fs +++ b/arch/z80/trs80/blk.fs @@ -11,10 +11,10 @@ There is also the RECV program at B612. ( ----- 602 ) 1 8 LOADR+ ( ----- 603 ) -CODE (key) +CODE (key?) ( -- c? f ) ( TODO: make non-blocking ) A 0x01 LDri, ( @KEY ) 0x28 RST, - PUSHA, + PUSHA, PUSH1, ;CODE CODE (emit) EXX, ( protect BC ) BC POP, ( c == @DSP arg ) chkPS, diff --git a/arch/z80/z80mbc2/xcomp.fs b/arch/z80/z80mbc2/xcomp.fs index 762dddc..b90cdd8 100644 --- a/arch/z80/z80mbc2/xcomp.fs +++ b/arch/z80/z80mbc2/xcomp.fs @@ -10,9 +10,9 @@ RS_ADDR 0x80 - CONSTANT SYSVARS CODE (emit) A 1 LDri, 1 OUTiA, HL POP, A L LDrr, 0 OUTiA, ;CODE -CODE (key) +CODE (key?) ( TODO: make non-blocking ) BEGIN, 1 INAi, A INCr, JRZ, AGAIN, - A DECr, PUSHA, + A DECr, PUSHA, PUSH1, ;CODE : _sel ( sec ) ( 32 sectors per track, 512 tracks per disk ) diff --git a/blk.fs b/blk.fs index 5d9c8eb..135a21e 100644 --- a/blk.fs +++ b/blk.fs @@ -807,7 +807,7 @@ CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 , BLKDTY @ IF '*' EMIT THEN 4 nspcs ; : nums 17 1 DO 2 I + aty I . SPC SPC LOOP ; ( ----- 127 ) -: mode! ( c -- ) 4 col- CELL! ; +: mode! ( c -- ) 4 col- CELL! ; : @emit C@ 0x20 MAX 0x7f MIN EMIT ; : contents 16 0 DO @@ -2002,7 +2002,8 @@ SYSVARS 0x0c + :** C<* ; ( del is same as backspace ) : BS? DUP 0x7f = SWAP 0x8 = OR ; -SYSVARS 0x55 + :** KEY +SYSVARS 0x55 + :** KEY? +: KEY BEGIN KEY? UNTIL ; ( cont.: read one char into input buffer and returns whether we should continue, that is, whether CR was not met. ) ( ----- 379 ) @@ -2104,7 +2105,7 @@ SYSVARS 0x55 + :** KEY 0x02 RAM+ CURRENT* ! CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR ) 0 0x08 RAM+ ! ( 08 == C<* override ) - ['] (emit) ['] EMIT **! ['] (key) ['] KEY **! + ['] (emit) ['] EMIT **! ['] (key?) ['] KEY? **! ['] CRLF ['] NL **! ['] (boot<) ['] C<* **! ( boot< always has a char waiting. 06 == C IF DROP (key) EXIT THEN - DUP _shift? IF DROP 1 PS2_SHIFT C! (key) EXIT THEN + 0 EXIT THEN + DUP 0x7f > IF DROP 0 EXIT THEN + DUP _shift? IF DROP 1 PS2_SHIFT C! 0 EXIT THEN ( ah, finally, we have a gentle run-of-the-mill KC ) - PS2_CODES PS2_SHIFT C@ IF 0x80 + THEN + C@ - ?DUP NOT IF (key) THEN ; + PS2_CODES PS2_SHIFT C@ IF 0x80 + THEN + C@ ( c, maybe 0 ) + ?DUP ( c? f ) ; ( ----- 418 ) SPI relay driver diff --git a/cvm/common.fs b/cvm/common.fs index ee362d6..e50bfc9 100644 --- a/cvm/common.fs +++ b/cvm/common.fs @@ -75,7 +75,7 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) 0x39 CODE |L 0x3a CODE |M 353 LOAD ( xcomp core ) -: (key) 0 PC@ ; +: (key?) 0 PC@ 1 ; : EFS@ 1 3 PC! ( read ) |M 3 PC! 3 PC! ( blkid ) diff --git a/cvm/stage.bin b/cvm/stage.bin index b5e40969ad0e6f4f83e38f8c8502394ab13756f7..af86de0904aa5c781fa32546689986f8a4b3794e 100644 GIT binary patch delta 415 zcmYjN-zx-R6up<3*&WQxH?t9TRwCOjMO&UIYlk6r*2pR(zrvG^VU>7LYT^(0TD4C+ zXg6N`dXPtvM=#n}@+TM`RcHP}Isy<=1x8-MloA{Ck76NKa8@BGZ~#2*ubn`e3N(b`-UX)%P{!(JGul3Ft9Q% zXPnQFz~Ii@nUM*o1V%Fp$S`PRr&el80rgI1bYzra zaCHlI;GP^SP|gH2|C)eaz(xTlhUF~QEKUseK-N-T5bG-t3$TJ%AcqyOTeBcLD~ZpG zfhE4UvUn$_7X!C*eojteL2;^rfAA(20oH?)Lj+40izc5GOlCYhSyxCyx=3(7gBHkU zpI}#Eh8CdzR2inS&tyztv6);TWGI>=7NsLmOk?Ep`B(9U>| ffff -," xxx" -- Write xxx to HERE -." xxx" -- *I* Compiles string literal xxx followed by a - call to STYPE. -C -- a Address of variable containing current pos in - input buffer. -KEY -- c Get char c from direct input -PC! c a -- Spit c to port a -PC@ a -- c Fetch c from port a -WORD -- a Read one word from buffered input and push its - addr. Always null terminated. If ASCII EOT is - encountered, a will point to it (it is cons- - idered a word). +," xxx" -- Write xxx to HERE +." xxx" -- *I* Compiles string literal xxx followed by a + call to STYPE. +C -- a Address of variable containing current pos in + input buffer. +KEY? -- c? f Polls the keyboard for a key. If a key is + pressed, f is true and c is the char. Other- + wise, f is false and c is *not* on the stack. +KEY -- c Get char c from direct input +PC! c a -- Spit c to port a +PC@ a -- c Fetch c from port a +WORD -- a Read one word from buffered input and push its + addr. Always null terminated. If ASCII EOT is + encountered, a will point to it (it is cons- + idered a word). There are also ascii const emitters: BS CR LF SPC CRLF +KEY? and EMIT are ialiases to (key?) and (emit) (see TTY proto- +col in protocol.txt). KEY is a loop over KEY?. + NL is an ialias that points to CRLF by default and that should generally be used when we want to emit a newline. diff --git a/doc/impl.txt b/doc/impl.txt index eaeb521..f242843 100644 --- a/doc/impl.txt +++ b/doc/impl.txt @@ -165,7 +165,7 @@ SYSVARS FUTURE USES +3c BLK(* +08 C<* override +43 FUTURE USES +0a NL ialias +51 CURRENTPTR +0c C<* +53 EMIT ialias -+0e WORDBUF +55 KEY ialias ++0e WORDBUF +55 KEY? ialias +2e BOOT C< PTR +57 FUTURE USES +30 IN> +32 IN(* +70 DRIVERS diff --git a/doc/protocol.txt b/doc/protocol.txt index 0aaa9a5..426671d 100644 --- a/doc/protocol.txt +++ b/doc/protocol.txt @@ -2,15 +2,16 @@ Some subsystems (and in the case of KEY and EMIT, the core) re- quire drivers to implement certain words in a certain way. For -example, the core requires drivers to implement (key) and (emit) -or else it won't know how to provide a console. +example, the core requires drivers to implement (key?) and +(emit) or else it won't know how to provide a console. These protocols are described here. # TTY protocol -(key) -- c Returns the next typed key on the console. - If none, block until there is one. +(key?) -- c? f Returns whether a key has been pressed and, + if it has, returns which key. When f is + false, c is *not* placed in the stack. (emit) c -- Spit a character on the console. # PS/2 protocol @@ -19,7 +20,7 @@ This protocol enables communication with a device that spits PS/2 keycodes. (ps2kc) -- kc Returns the next typed PS/2 keycode from the - console. Blocking. + console. 0 if nothing was typed. # SPI Relay protocol diff --git a/emul/8086/xcomp.fs b/emul/8086/xcomp.fs index 5b80ede..f6e294b 100644 --- a/emul/8086/xcomp.fs +++ b/emul/8086/xcomp.fs @@ -6,7 +6,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS 445 461 LOADR ( 8086 boot code ) 353 LOAD ( xcomp core low ) CODE (emit) AX POPx, 1 INT, ;CODE -CODE (key) 2 INT, AH 0 MOVri, AX PUSHx, ;CODE +CODE (key?) 2 INT, AH 0 MOVri, AX PUSHx, AX PUSHx, ;CODE : COLS 80 ; : LINES 25 ; CODE AT-XY ( x y ) BX POPx, AX POPx, 3 INT, ;CODE CODE _ BX POPx, AX POPx, 4 INT, ;CODE diff --git a/emul/z80/acia.c b/emul/z80/acia.c index 05d0832..b9c0f20 100644 --- a/emul/z80/acia.c +++ b/emul/z80/acia.c @@ -31,9 +31,10 @@ bool acia_has_irq(ACIA *acia) return acia->in_int; } -bool acia_hasrx(ACIA *acia) +bool acia_cantransmit(ACIA *acia) { - return acia->status & 0x01; // RDRF + return !(acia->status & 0x01 // RDRF + || acia->control & 0x40); // RTS } bool acia_hastx(ACIA *acia) diff --git a/emul/z80/acia.h b/emul/z80/acia.h index 1125598..61e248e 100644 --- a/emul/z80/acia.h +++ b/emul/z80/acia.h @@ -29,7 +29,7 @@ typedef struct { void acia_init(ACIA *acia); bool acia_has_irq(ACIA *acia); -bool acia_hasrx(ACIA *acia); +bool acia_cantransmit(ACIA *acia); bool acia_hastx(ACIA *acia); uint8_t acia_read(ACIA *acia); void acia_write(ACIA *acia, uint8_t val); diff --git a/emul/z80/rc2014.c b/emul/z80/rc2014.c index cffe545..7bd5660 100644 --- a/emul/z80/rc2014.c +++ b/emul/z80/rc2014.c @@ -108,9 +108,9 @@ static bool hastx() return use_sio ? sio_hastx(&sio) : acia_hastx(&acia); } -static bool hasrx() +static bool cantransmit() { - return use_sio ? sio_hasrx(&sio) : acia_hasrx(&acia); + return use_sio ? !sio_hasrx(&sio) : acia_cantransmit(&acia); } static uint8_t _read() @@ -241,7 +241,7 @@ int main(int argc, char *argv[]) break; } } - if (tosend && !hasrx()) { + if (tosend && cantransmit()) { _write(tosend); tosend = 0; } diff --git a/emul/z80/xcomp.fs b/emul/z80/xcomp.fs index 3d43dae..571fa4f 100644 --- a/emul/z80/xcomp.fs +++ b/emul/z80/xcomp.fs @@ -9,7 +9,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS 283 335 LOADR ( boot.z80 ) 353 LOAD ( xcomp core low ) : (emit) 0 PC! ; -: (key) 0 PC@ ; +: (key?) 0 PC@ 1 ; : EFS@ 1 3 PC! ( read ) 256 /MOD 3 PC! 3 PC! ( blkid )