瀏覽代碼

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.
master
Virgil Dupras 3 年之前
父節點
當前提交
475caf35f4
共有 18 個檔案被更改,包括 118 行新增115 行删除
  1. +3
    -3
      arch/8086/pcat/blk.fs
  2. +23
    -30
      arch/z80/rc2014/blk.fs
  3. +8
    -8
      arch/z80/sms/blk.fs
  4. +20
    -25
      arch/z80/ti84/blk.fs
  5. +1
    -1
      arch/z80/ti84/xcomp.fs
  6. +2
    -2
      arch/z80/trs80/blk.fs
  7. +2
    -2
      arch/z80/z80mbc2/xcomp.fs
  8. +16
    -14
      blk.fs
  9. +1
    -1
      cvm/common.fs
  10. 二進制
      cvm/stage.bin
  11. +26
    -15
      doc/dict.txt
  12. +1
    -1
      doc/impl.txt
  13. +6
    -5
      doc/protocol.txt
  14. +1
    -1
      emul/8086/xcomp.fs
  15. +3
    -2
      emul/z80/acia.c
  16. +1
    -1
      emul/z80/acia.h
  17. +3
    -3
      emul/z80/rc2014.c
  18. +1
    -1
      emul/z80/xcomp.fs

+ 3
- 3
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 ( 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 )


+ 23
- 30
arch/z80/rc2014/blk.fs 查看文件

@@ -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,

+ 8
- 8
arch/z80/sms/blk.fs 查看文件

@@ -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! ;


+ 20
- 25
arch/z80/ti84/blk.fs 查看文件

@@ -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! ;

+ 1
- 1
arch/z80/ti84/xcomp.fs 查看文件

@@ -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,


+ 2
- 2
arch/z80/trs80/blk.fs 查看文件

@@ -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,


+ 2
- 2
arch/z80/z80mbc2/xcomp.fs 查看文件

@@ -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 )


+ 16
- 14
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) _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




+ 1
- 1
cvm/common.fs 查看文件

@@ -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 )


二進制
cvm/stage.bin 查看文件


+ 26
- 15
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" -- *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.




+ 1
- 1
doc/impl.txt 查看文件

@@ -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


+ 6
- 5
doc/protocol.txt 查看文件

@@ -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




+ 1
- 1
emul/8086/xcomp.fs 查看文件

@@ -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


+ 3
- 2
emul/z80/acia.c 查看文件

@@ -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)


+ 1
- 1
emul/z80/acia.h 查看文件

@@ -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);


+ 3
- 3
emul/z80/rc2014.c 查看文件

@@ -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;
} }


+ 1
- 1
emul/z80/xcomp.fs 查看文件

@@ -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…
取消
儲存