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.
This commit is contained in:
parent
e3d4afa0c2
commit
475caf35f4
@ -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)
|
CODE (key?)
|
||||||
AH AH XORrr, 0x16 INT, AH AH XORrr, AX PUSHx,
|
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<
|
: _rts 0x16 ( RTS low ) [ 6850_CTL LITN ] PC! ;
|
||||||
A 0x16 ( RTS low ) LDri, 6850_CTL OUTiA,
|
: _rts^ 0x56 ( RTS high ) [ 6850_CTL LITN ] PC! ;
|
||||||
BEGIN,
|
: 6850<? ( -- c? f )
|
||||||
6850_CTL INAi, 0x01 ANDi, ( is ACIA rcv buf full? )
|
[ 6850_CTL LITN ] PC@ 1 AND ( is rcv buff full ? )
|
||||||
JRZ, ( no, loop ) AGAIN,
|
NOT IF ( RTS low, then wait 1ms and try again )
|
||||||
A 0x56 ( RTS high ) LDri, 6850_CTL OUTiA,
|
_rts 10 TICKS ( 1ms ) _rts^
|
||||||
( we have data, fetch and push )
|
[ 6850_CTL LITN ] PC@ 1 AND ( is rcv buff full ? )
|
||||||
6850_IO INAi, PUSHA,
|
NOT IF 0 EXIT THEN
|
||||||
;CODE
|
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<
|
: _<? ( io ctl -- c? f )
|
||||||
A 0x05 ( PTR5 ) LDri, SIOA_CTL OUTiA,
|
DUP ( io ctl ctl ) PC@ 1 AND ( is rcv buff full ? )
|
||||||
A 0b01101000 ( De-assert RTS ) LDri, SIOA_CTL OUTiA,
|
NOT IF ( io ctl )
|
||||||
BEGIN,
|
0x05 ( PTR5 ) OVER PC! 0b01101000 OVER PC! ( RTS low )
|
||||||
SIOA_CTL ( RR0 ) INAi, 0x01 ANDi, ( is rcv buf full? )
|
10 TICKS ( 1ms )
|
||||||
JRZ, ( no, loop ) AGAIN,
|
0x05 ( PTR5 ) OVER PC! 0b01101010 OVER PC! ( RTS high )
|
||||||
A 0x05 ( PTR5 ) LDri, SIOA_CTL OUTiA,
|
PC@ 1 AND ( is rcv buff full ? )
|
||||||
A 0b01101010 ( Assert RTS ) LDri, SIOA_CTL OUTiA,
|
NOT IF DROP 0 ( f ) EXIT THEN
|
||||||
( we have data, fetch and push )
|
ELSE DROP THEN ( io ) PC@ ( c ) 1 ( f ) ;
|
||||||
SIOA_DATA INAi, PUSHA,
|
: SIOA<? [ SIOA_DATA LITN SIOA_CTL LITN ] _<? ;
|
||||||
;CODE
|
|
||||||
( ----- 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<
|
: SIOB<? [ SIOB_DATA LITN SIOB_CTL LITN ] _<? ;
|
||||||
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
|
|
||||||
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)
|
: (key?) ( -- c? f )
|
||||||
_next C@ IF _next C@ 0 _next C! EXIT THEN
|
_next C@ IF _next C@ 0 _next C! 1 EXIT THEN
|
||||||
BEGIN _updsel UNTIL
|
_updsel IF
|
||||||
_prevstat C@
|
_prevstat C@
|
||||||
0x20 ( BUTC ) OVER AND NOT IF DROP _sel C@ EXIT THEN
|
0x20 ( BUTC ) OVER AND NOT IF DROP _sel C@ 1 EXIT THEN
|
||||||
0x40 ( BUTA ) AND NOT IF 0x8 ( BS ) 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 ;
|
: _@ [ KBD_MEM LITN ] C@ ; : _! [ KBD_MEM LITN ] C! ;
|
||||||
: _2nd! [ KBD_MEM LITN ] C@ 0xfe AND + [ KBD_MEM LITN ] C! ;
|
: _2nd@ _@ 1 AND ; : _2nd! _@ 0xfe AND + _! ;
|
||||||
: _alock@ [ KBD_MEM LITN ] C@ 2 AND ;
|
: _alpha@ _@ 2 AND ; : _alpha! 2 * _@ 0xfd AND + _! ;
|
||||||
: _alock^ [ KBD_MEM LITN ] C@ 2 XOR [ KBD_MEM LITN ] C! ;
|
: _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 )
|
7 0 DO
|
||||||
BEGIN ( loop until a digit is pressed )
|
1 I LSHIFT 0xff -^ ( group dmask ) _get
|
||||||
DROP
|
DUP 0xff = IF DROP ELSE I ( dmask gid ) LEAVE THEN
|
||||||
1+ DUP 7 = IF DROP 0 THEN ( inc gid )
|
LOOP _wait
|
||||||
1 OVER LSHIFT 0xff -^ ( group dmask ) _get
|
SWAP ( gid dmask )
|
||||||
DUP 0xff = NOT UNTIL _wait
|
|
||||||
( 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 )
|
: (key?) ( -- c? f )
|
||||||
_atbl = IF _dtbl ELSE _atbl THEN ;
|
0 _get 0xff = IF ( no key pressed ) 0 EXIT THEN
|
||||||
: (key)
|
_alpha@ _alock@ IF NOT THEN IF _atbl ELSE _dtbl THEN
|
||||||
0 _2nd! 0 ( lastchr ) BEGIN
|
_gti + C@ ( c )
|
||||||
_alock@ IF _atbl ELSE _dtbl THEN
|
DUP 0x80 = IF _2nd@ IF _alock^ ELSE 1 _alpha! THEN THEN
|
||||||
OVER 0x80 ( alpha ) =
|
DUP 0x81 = _2nd!
|
||||||
IF _tbl^ _2nd@ IF _alock^ THEN THEN
|
DUP 0 0x80 >< IF ( we have something )
|
||||||
SWAP 0x81 = _2nd!
|
( lower? ) _2nd@ IF DUP 'A' 'Z' =><= IF 0x20 OR THEN THEN
|
||||||
_gti + C@
|
0 _2nd! 0 _alpha! 1 ( c f )
|
||||||
DUP 0 0x80 >< UNTIL ( loop if not in range )
|
ELSE ( nothing ) DROP 0 THEN ;
|
||||||
( lowercase? )
|
|
||||||
_2nd@ IF DUP 'A' 'Z' =><= IF 0x20 OR THEN 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 )
|
||||||
|
30
blk.fs
30
blk.fs
@ -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?) ( -- c? f )
|
||||||
: (key) _get
|
(ps2kc) DUP NOT IF EXIT THEN ( kc )
|
||||||
DUP 0xe0 ( extended ) = IF ( ignore ) DROP (key) EXIT THEN
|
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
|
0 EXIT THEN
|
||||||
DUP 0x7f > IF DROP (key) EXIT THEN
|
DUP 0x7f > IF DROP 0 EXIT THEN
|
||||||
DUP _shift? IF DROP 1 PS2_SHIFT C! (key) 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@
|
PS2_CODES PS2_SHIFT C@ IF 0x80 + THEN + C@ ( c, maybe 0 )
|
||||||
?DUP NOT IF (key) THEN ;
|
?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 )
|
||||||
|
BIN
cvm/stage.bin
BIN
cvm/stage.bin
Binary file not shown.
41
doc/dict.txt
41
doc/dict.txt
@ -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" -- Write xxx to HERE
|
||||||
." xxx" -- *I* Compiles string literal xxx followed by a
|
." xxx" -- *I* Compiles string literal xxx followed by a
|
||||||
call to STYPE.
|
call to STYPE.
|
||||||
C<? -- f Returns whether there's a char waiting in buf.
|
C<? -- f Returns whether there's a char waiting in buf.
|
||||||
C< -- c Read one char from buffered input.
|
C< -- c Read one char from buffered input.
|
||||||
EMIT c -- Spit char c to output stream
|
EMIT c -- Spit char c to output stream
|
||||||
IN> -- a Address of variable containing current pos in
|
IN> -- a Address of variable containing current pos in
|
||||||
input buffer.
|
input buffer.
|
||||||
KEY -- c Get char c from direct input
|
KEY? -- c? f Polls the keyboard for a key. If a key is
|
||||||
PC! c a -- Spit c to port a
|
pressed, f is true and c is the char. Other-
|
||||||
PC@ a -- c Fetch c from port a
|
wise, f is false and c is *not* on the stack.
|
||||||
WORD -- a Read one word from buffered input and push its
|
KEY -- c Get char c from direct input
|
||||||
addr. Always null terminated. If ASCII EOT is
|
PC! c a -- Spit c to port a
|
||||||
encountered, a will point to it (it is cons-
|
PC@ a -- c Fetch c from port a
|
||||||
idered a word).
|
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)
|
example, the core requires drivers to implement (key?) and
|
||||||
or else it won't know how to provide a console.
|
(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.
|
(key?) -- c? f Returns whether a key has been pressed and,
|
||||||
If none, block until there is one.
|
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 )
|
||||||
|
Loading…
Reference in New Issue
Block a user