... 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.master
@@ -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 | ( TODO: reading 12 sectors like this probably doesn't work | ||||
on real vintage PC/AT with floppy. Make this more robust. ) | on real vintage PC/AT with floppy. Make this more robust. ) | ||||
0x800 0 JMPf, | 0x800 0 JMPf, | ||||
ORG @ 0x1fe + HERE ! 0x55 C,* 0xaa C,* | |||||
ORG @ 0x1fe + HERE ! 0x55 C, 0xaa C, | |||||
( ----- 604 ) | ( ----- 604 ) | ||||
CODE (emit) 1 chkPS, | CODE (emit) 1 chkPS, | ||||
AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT, | AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT, | ||||
;CODE | ;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 | ;CODE | ||||
( ----- 606 ) | ( ----- 606 ) | ||||
CODE 13H08H ( driveno -- cx dx ) | CODE 13H08H ( driveno -- cx dx ) | ||||
@@ -7,15 +7,15 @@ | |||||
6850_IO for data register. | 6850_IO for data register. | ||||
CTL numbers used: 0x16 = no interrupt, 8bit words, 1 stop bit | CTL numbers used: 0x16 = no interrupt, 8bit words, 1 stop bit | ||||
64x divide. 0x56 = RTS high ) | 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<? ( -- c? f ) | |||||
[ 6850_CTL LITN ] PC@ 1 AND ( is rcv buff full ? ) | |||||
NOT IF ( RTS low, then wait 1ms and try again ) | |||||
_rts 10 TICKS ( 1ms ) _rts^ | |||||
[ 6850_CTL LITN ] PC@ 1 AND ( is rcv buff full ? ) | |||||
NOT IF 0 EXIT THEN | |||||
THEN [ 6850_IO LITN ] PC@ ( c ) 1 ( f ) ; | |||||
( ----- 602 ) | ( ----- 602 ) | ||||
CODE 6850> | CODE 6850> | ||||
HL POP, chkPS, | HL POP, chkPS, | ||||
@@ -25,7 +25,7 @@ CODE 6850> | |||||
A L LDrr, 6850_IO OUTiA, | A L LDrr, 6850_IO OUTiA, | ||||
;CODE | ;CODE | ||||
( ----- 603 ) | ( ----- 603 ) | ||||
: (key) 6850< ; | |||||
: (key?) 6850<? ; | |||||
: (emit) 6850> ; | : (emit) 6850> ; | ||||
: 6850$ 0x56 ( RTS high ) [ 6850_CTL LITN ] PC! ; | : 6850$ 0x56 ( RTS high ) [ 6850_CTL LITN ] PC! ; | ||||
( ----- 605 ) | ( ----- 605 ) | ||||
@@ -34,17 +34,16 @@ CODE 6850> | |||||
SIOA_DATA for ch A data register | SIOA_DATA for ch A data register | ||||
SIOB_CTL for ch B control register | SIOB_CTL for ch B control register | ||||
SIOB_DATA for ch B data 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 | |||||
: _<? ( io ctl -- c? f ) | |||||
DUP ( io ctl ctl ) PC@ 1 AND ( is rcv buff full ? ) | |||||
NOT IF ( io ctl ) | |||||
0x05 ( PTR5 ) OVER PC! 0b01101000 OVER PC! ( RTS low ) | |||||
10 TICKS ( 1ms ) | |||||
0x05 ( PTR5 ) OVER PC! 0b01101010 OVER PC! ( RTS high ) | |||||
PC@ 1 AND ( is rcv buff full ? ) | |||||
NOT IF DROP 0 ( f ) EXIT THEN | |||||
ELSE DROP THEN ( io ) PC@ ( c ) 1 ( f ) ; | |||||
: SIOA<? [ SIOA_DATA LITN SIOA_CTL LITN ] _<? ; | |||||
( ----- 606 ) | ( ----- 606 ) | ||||
CODE SIOA> | CODE SIOA> | ||||
HL POP, chkPS, | HL POP, chkPS, | ||||
@@ -60,13 +59,7 @@ CREATE _ ( init data ) 0x18 C, ( CMD3 ) | |||||
0x21 C, ( CMD2/PTR1 ) 0 C, ( WR1/Rx no INT ) | 0x21 C, ( CMD2/PTR1 ) 0 C, ( WR1/Rx no INT ) | ||||
: SIOA$ 9 0 DO _ I + C@ [ SIOA_CTL LITN ] PC! LOOP ; | : SIOA$ 9 0 DO _ I + C@ [ SIOA_CTL LITN ] PC! LOOP ; | ||||
( ----- 607 ) | ( ----- 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<? [ SIOB_DATA LITN SIOB_CTL LITN ] _<? ; | |||||
CODE SIOB> | CODE SIOB> | ||||
HL POP, chkPS, | HL POP, chkPS, | ||||
BEGIN, | BEGIN, | ||||
@@ -105,7 +98,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS | |||||
270 LOAD ( xcomp overrides ) 283 335 LOADR ( boot.z80 ) | 270 LOAD ( xcomp overrides ) 283 335 LOADR ( boot.z80 ) | ||||
353 LOAD ( xcomp core low ) 605 607 LOADR ( SIO ) | 353 LOAD ( xcomp core low ) 605 607 LOADR ( SIO ) | ||||
419 LOAD ( SPI relay ) 423 436 LOADR ( SD Card ) | 419 LOAD ( SPI relay ) 423 436 LOADR ( SD Card ) | ||||
400 LOAD ( AT28 ) : (key) SIOB< ; : (emit) SIOB> ; | |||||
400 LOAD ( AT28 ) : (key?) SIOA<? ; : (emit) SIOA> ; | |||||
390 LOAD ( xcomp core high ) | 390 LOAD ( xcomp core high ) | ||||
(entry) _ PC ORG @ 8 + ! ( Update LATEST ) | (entry) _ PC ORG @ 8 + ! ( Update LATEST ) | ||||
," SIOB$ BLK$ " EOT, | |||||
," SIOA$ BLK$ " EOT, |
@@ -64,7 +64,7 @@ from it. It goes as follow: | |||||
(cont.) | (cont.) | ||||
( ----- 611 ) | ( ----- 611 ) | ||||
This module is currently hard-wired to VDP driver, that is, it | 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. | selection. | ||||
Load range: 632-637 | Load range: 632-637 | ||||
@@ -113,15 +113,15 @@ CREATE _ '0' C, ':' C, 'A' C, '[' C, 'a' C, 0xff C, | |||||
0xe0 AND 0xe0 < | 0xe0 AND 0xe0 < | ||||
; | ; | ||||
( ----- 616 ) | ( ----- 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@ | _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 ) | ( 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 ) | ( ----- 617 ) | ||||
: PAD$ | : PAD$ | ||||
0xff _prevstat C! 'a' _sel C! 0 _next C! ; | 0xff _prevstat C! 'a' _sel C! 0 _next C! ; | ||||
@@ -129,7 +129,7 @@ Keyboard driver | |||||
Load range: 566-570 | 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 | builtin keyboard. The word waits for a digit to be pressed and | ||||
returns the corresponding ASCII value. | 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, | 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, '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, | 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 ) | ( ----- 619 ) | ||||
: _gti ( -- tindex, that it, index in _dtbl or _atbl ) | : _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 ) | 0xff XOR ( dpos ) 0 ( dindex ) | ||||
BEGIN 1+ 2DUP RSHIFT NOT UNTIL 1- | BEGIN 1+ 2DUP RSHIFT NOT UNTIL 1- | ||||
( gid dpos dindex ) NIP | ( gid dpos dindex ) NIP | ||||
( gid dindex ) SWAP 8 * + ; | ( gid dindex ) SWAP 8 * + ; | ||||
( ----- 620 ) | ( ----- 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! ; | : KBD$ 0 [ KBD_MEM LITN ] C! ; |
@@ -39,7 +39,7 @@ EI, | |||||
RETI, | RETI, | ||||
0x03 ALLOT0 ( 0x53 ) | 0x03 ALLOT0 ( 0x53 ) | ||||
0x5a JP, ( 0x56 ) 0xff A, 0xa5 A, 0xff A, ( 0x5a ) | |||||
0x5a JP, ( 0x56 ) 0xff C, 0xa5 C, 0xff C, ( 0x5a ) | |||||
( boot ) | ( boot ) | ||||
DI, | DI, | ||||
IM1, | IM1, | ||||
@@ -11,10 +11,10 @@ There is also the RECV program at B612. | |||||
( ----- 602 ) | ( ----- 602 ) | ||||
1 8 LOADR+ | 1 8 LOADR+ | ||||
( ----- 603 ) | ( ----- 603 ) | ||||
CODE (key) | |||||
CODE (key?) ( -- c? f ) ( TODO: make non-blocking ) | |||||
A 0x01 LDri, ( @KEY ) | A 0x01 LDri, ( @KEY ) | ||||
0x28 RST, | 0x28 RST, | ||||
PUSHA, | |||||
PUSHA, PUSH1, | |||||
;CODE | ;CODE | ||||
CODE (emit) EXX, ( protect BC ) | CODE (emit) EXX, ( protect BC ) | ||||
BC POP, ( c == @DSP arg ) chkPS, | BC POP, ( c == @DSP arg ) chkPS, | ||||
@@ -10,9 +10,9 @@ RS_ADDR 0x80 - CONSTANT SYSVARS | |||||
CODE (emit) | CODE (emit) | ||||
A 1 LDri, 1 OUTiA, HL POP, A L LDrr, 0 OUTiA, | A 1 LDri, 1 OUTiA, HL POP, A L LDrr, 0 OUTiA, | ||||
;CODE | ;CODE | ||||
CODE (key) | |||||
CODE (key?) ( TODO: make non-blocking ) | |||||
BEGIN, 1 INAi, A INCr, JRZ, AGAIN, | BEGIN, 1 INAi, A INCr, JRZ, AGAIN, | ||||
A DECr, PUSHA, | |||||
A DECr, PUSHA, PUSH1, | |||||
;CODE | ;CODE | ||||
: _sel ( sec ) | : _sel ( sec ) | ||||
( 32 sectors per track, 512 tracks per disk ) | ( 32 sectors per track, 512 tracks per disk ) | ||||
@@ -807,7 +807,7 @@ CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 , | |||||
BLKDTY @ IF '*' EMIT THEN 4 nspcs ; | BLKDTY @ IF '*' EMIT THEN 4 nspcs ; | ||||
: nums 17 1 DO 2 I + aty I . SPC SPC LOOP ; | : nums 17 1 DO 2 I + aty I . SPC SPC LOOP ; | ||||
( ----- 127 ) | ( ----- 127 ) | ||||
: mode! ( c -- ) 4 col- CELL! ; | |||||
: mode! ( c -- ) 4 col- CELL! ; | |||||
: @emit C@ 0x20 MAX 0x7f MIN EMIT ; | : @emit C@ 0x20 MAX 0x7f MIN EMIT ; | ||||
: contents | : contents | ||||
16 0 DO | 16 0 DO | ||||
@@ -2002,7 +2002,8 @@ SYSVARS 0x0c + :** C<* | |||||
; | ; | ||||
( del is same as backspace ) | ( del is same as backspace ) | ||||
: BS? DUP 0x7f = SWAP 0x8 = OR ; | : 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 | ( cont.: read one char into input buffer and returns whether we | ||||
should continue, that is, whether CR was not met. ) | should continue, that is, whether CR was not met. ) | ||||
( ----- 379 ) | ( ----- 379 ) | ||||
@@ -2104,7 +2105,7 @@ SYSVARS 0x55 + :** KEY | |||||
0x02 RAM+ CURRENT* ! | 0x02 RAM+ CURRENT* ! | ||||
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR ) | CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR ) | ||||
0 0x08 RAM+ ! ( 08 == C<* override ) | 0 0x08 RAM+ ! ( 08 == C<* override ) | ||||
['] (emit) ['] EMIT **! ['] (key) ['] KEY **! | |||||
['] (emit) ['] EMIT **! ['] (key?) ['] KEY? **! | |||||
['] CRLF ['] NL **! | ['] CRLF ['] NL **! | ||||
['] (boot<) ['] C<* **! | ['] (boot<) ['] C<* **! | ||||
( boot< always has a char waiting. 06 == C<?* ) | ( boot< always has a char waiting. 06 == C<?* ) | ||||
@@ -2205,7 +2206,7 @@ Load range: B402-B403 | |||||
( ----- 410 ) | ( ----- 410 ) | ||||
PS/2 keyboard subsystem | PS/2 keyboard subsystem | ||||
Provides (key) from a driver providing the PS/2 protocol. That | |||||
Provides (key?) from a driver providing the PS/2 protocol. That | |||||
is, for a driver taking care of providing all key codes emanat- | is, for a driver taking care of providing all key codes emanat- | ||||
ing from a PS/2 keyboard, this subsystem takes care of mapping | ing from a PS/2 keyboard, this subsystem takes care of mapping | ||||
those keystrokes to ASCII characters. This code is designed to | those keystrokes to ASCII characters. This code is designed to | ||||
@@ -2220,7 +2221,7 @@ Load range: 411-414 | |||||
( A list of the values associated with the 0x80 possible scan | ( A list of the values associated with the 0x80 possible scan | ||||
codes of the set 2 of the PS/2 keyboard specs. 0 means no | codes of the set 2 of the PS/2 keyboard specs. 0 means no | ||||
value. That value is a character that can be read in (key) | |||||
value. That value is a character that can be read in (key?) | |||||
No make code in the PS/2 set 2 reaches 0x80. ) | No make code in the PS/2 set 2 reaches 0x80. ) | ||||
CREATE PS2_CODES | CREATE PS2_CODES | ||||
( 00 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, | ( 00 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, | ||||
@@ -2262,19 +2263,20 @@ CREATE PS2_CODES | |||||
( 78 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, | ( 78 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, | ||||
( ----- 414 ) | ( ----- 414 ) | ||||
: _shift? ( kc -- f ) DUP 0x12 = SWAP 0x59 = OR ; | : _shift? ( kc -- f ) DUP 0x12 = SWAP 0x59 = OR ; | ||||
: _get ( -- kc ) 0 ( dummy ) BEGIN DROP (ps2kc) DUP UNTIL ; | |||||
: (key) _get | |||||
DUP 0xe0 ( extended ) = IF ( ignore ) DROP (key) EXIT THEN | |||||
: (key?) ( -- c? f ) | |||||
(ps2kc) DUP NOT IF EXIT THEN ( kc ) | |||||
DUP 0xe0 ( extended ) = IF ( ignore ) DROP 0 EXIT THEN | |||||
DUP 0xf0 ( break ) = IF DROP ( ) | DUP 0xf0 ( break ) = IF DROP ( ) | ||||
( get next kc and see if it's a shift ) | ( get next kc and see if it's a shift ) | ||||
_get _shift? IF ( drop shift ) 0 PS2_SHIFT C! THEN | |||||
BEGIN (ps2kc) ?DUP UNTIL ( kc ) | |||||
_shift? IF ( drop shift ) 0 PS2_SHIFT C! THEN | |||||
( whether we had a shift or not, we return the next ) | ( whether we had a shift or not, we return the next ) | ||||
(key) EXIT THEN | |||||
DUP 0x7f > 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 ) | ( 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 ) | ( ----- 418 ) | ||||
SPI relay driver | SPI relay driver | ||||
@@ -75,7 +75,7 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) | |||||
0x39 CODE |L | 0x39 CODE |L | ||||
0x3a CODE |M | 0x3a CODE |M | ||||
353 LOAD ( xcomp core ) | 353 LOAD ( xcomp core ) | ||||
: (key) 0 PC@ ; | |||||
: (key?) 0 PC@ 1 ; | |||||
: EFS@ | : EFS@ | ||||
1 3 PC! ( read ) | 1 3 PC! ( read ) | ||||
|M 3 PC! 3 PC! ( blkid ) | |M 3 PC! 3 PC! ( blkid ) | ||||
@@ -10,6 +10,11 @@ top of stack (TOS). For example, in "a b -- c d", b is TOS | |||||
before, d is TOS after. "R:" means that the Return Stack is | before, d is TOS after. "R:" means that the Return Stack is | ||||
modified. | modified. | ||||
Some words have a variable stack signature, most often in pair | |||||
with a flag. These are indicated with "?" to tell that the argu- | |||||
ment might not be there. For example, "-- n? f" means that "n" | |||||
might or might not be there. | |||||
Word references (wordref): When we say we have a "word | Word references (wordref): When we say we have a "word | ||||
reference", it's a pointer to a word's *entry type field*. For | reference", it's a pointer to a word's *entry type field*. For | ||||
example, the address that "' DUP" puts on the stack is a | example, the address that "' DUP" puts on the stack is a | ||||
@@ -236,25 +241,31 @@ STYPE a -- EMIT all chars of string at at addr a. | |||||
.X n -- Print n in hex form. Always 4 characters. | .X n -- Print n in hex form. Always 4 characters. | ||||
Numbers are never considered negative. | Numbers are never considered negative. | ||||
"-1 .X" --> ffff | "-1 .X" --> ffff | ||||
," xxx" -- Write xxx to HERE | |||||
." xxx" -- *I* Compiles string literal xxx followed by a | |||||
call to STYPE. | |||||
C<? -- f Returns whether there's a char waiting in buf. | |||||
C< -- c Read one char from buffered input. | |||||
EMIT c -- Spit char c to output stream | |||||
IN> -- 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<? -- f Returns whether there's a char waiting in buf. | |||||
C< -- c Read one char from buffered input. | |||||
EMIT c -- Spit char c to output stream | |||||
IN> -- 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: | There are also ascii const emitters: | ||||
BS CR LF SPC CRLF | 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 | NL is an ialias that points to CRLF by default and that should | ||||
generally be used when we want to emit a newline. | generally be used when we want to emit a newline. | ||||
@@ -165,7 +165,7 @@ SYSVARS FUTURE USES +3c BLK(* | |||||
+08 C<* override +43 FUTURE USES | +08 C<* override +43 FUTURE USES | ||||
+0a NL ialias +51 CURRENTPTR | +0a NL ialias +51 CURRENTPTR | ||||
+0c C<* +53 EMIT ialias | +0c C<* +53 EMIT ialias | ||||
+0e WORDBUF +55 KEY ialias | |||||
+0e WORDBUF +55 KEY? ialias | |||||
+2e BOOT C< PTR +57 FUTURE USES | +2e BOOT C< PTR +57 FUTURE USES | ||||
+30 IN> | +30 IN> | ||||
+32 IN(* +70 DRIVERS | +32 IN(* +70 DRIVERS | ||||
@@ -2,15 +2,16 @@ | |||||
Some subsystems (and in the case of KEY and EMIT, the core) re- | Some subsystems (and in the case of KEY and EMIT, the core) re- | ||||
quire drivers to implement certain words in a certain way. For | 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. | These protocols are described here. | ||||
# TTY protocol | # 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. | (emit) c -- Spit a character on the console. | ||||
# PS/2 protocol | # PS/2 protocol | ||||
@@ -19,7 +20,7 @@ This protocol enables communication with a device that spits | |||||
PS/2 keycodes. | PS/2 keycodes. | ||||
(ps2kc) -- kc Returns the next typed PS/2 keycode from the | (ps2kc) -- kc Returns the next typed PS/2 keycode from the | ||||
console. Blocking. | |||||
console. 0 if nothing was typed. | |||||
# SPI Relay protocol | # SPI Relay protocol | ||||
@@ -6,7 +6,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS | |||||
445 461 LOADR ( 8086 boot code ) | 445 461 LOADR ( 8086 boot code ) | ||||
353 LOAD ( xcomp core low ) | 353 LOAD ( xcomp core low ) | ||||
CODE (emit) AX POPx, 1 INT, ;CODE | 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 ; | : COLS 80 ; : LINES 25 ; | ||||
CODE AT-XY ( x y ) BX POPx, AX POPx, 3 INT, ;CODE | CODE AT-XY ( x y ) BX POPx, AX POPx, 3 INT, ;CODE | ||||
CODE _ BX POPx, AX POPx, 4 INT, ;CODE | CODE _ BX POPx, AX POPx, 4 INT, ;CODE | ||||
@@ -31,9 +31,10 @@ bool acia_has_irq(ACIA *acia) | |||||
return acia->in_int; | 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) | bool acia_hastx(ACIA *acia) | ||||
@@ -29,7 +29,7 @@ typedef struct { | |||||
void acia_init(ACIA *acia); | void acia_init(ACIA *acia); | ||||
bool acia_has_irq(ACIA *acia); | bool acia_has_irq(ACIA *acia); | ||||
bool acia_hasrx(ACIA *acia); | |||||
bool acia_cantransmit(ACIA *acia); | |||||
bool acia_hastx(ACIA *acia); | bool acia_hastx(ACIA *acia); | ||||
uint8_t acia_read(ACIA *acia); | uint8_t acia_read(ACIA *acia); | ||||
void acia_write(ACIA *acia, uint8_t val); | void acia_write(ACIA *acia, uint8_t val); | ||||
@@ -108,9 +108,9 @@ static bool hastx() | |||||
return use_sio ? sio_hastx(&sio) : acia_hastx(&acia); | 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() | static uint8_t _read() | ||||
@@ -241,7 +241,7 @@ int main(int argc, char *argv[]) | |||||
break; | break; | ||||
} | } | ||||
} | } | ||||
if (tosend && !hasrx()) { | |||||
if (tosend && cantransmit()) { | |||||
_write(tosend); | _write(tosend); | ||||
tosend = 0; | tosend = 0; | ||||
} | } | ||||
@@ -9,7 +9,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS | |||||
283 335 LOADR ( boot.z80 ) | 283 335 LOADR ( boot.z80 ) | ||||
353 LOAD ( xcomp core low ) | 353 LOAD ( xcomp core low ) | ||||
: (emit) 0 PC! ; | : (emit) 0 PC! ; | ||||
: (key) 0 PC@ ; | |||||
: (key?) 0 PC@ 1 ; | |||||
: EFS@ | : EFS@ | ||||
1 3 PC! ( read ) | 1 3 PC! ( read ) | ||||
256 /MOD 3 PC! 3 PC! ( blkid ) | 256 /MOD 3 PC! 3 PC! ( blkid ) | ||||