izaya/collapseos
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Transform "blk/" folders into "blk.fs" text files

Browse Source 
Working in "blk/" folder from a modern system is harder than it
should be. Moving blocks around is a bit awkward, grepping is a
bit less convenient than it could be, git blame has troubles
following, etc.

In this commit, we modify blkpack and blkunpack to work with single
text files with blocks being separated by a special markup.

I think this will make the code significantly more convenient to
work into.
This commit is contained in:
Virgil Dupras 2020-11-14 18:00:31 -05:00
parent 532bcc7e78
commit 95ab1ad588
317 changed files with 3965 additions and 3648 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
README.md
View File

@ -35,8 +35,7 @@ it's not a z80 emulator, but a *javascript port of Collapse OS*!
## Organisation of this repository
* `blk`: Collapse OS filesystem's content. That's actually where Collapse OS'
source code is located. Everything else is peripheral.
* `blk.fs`: Collapse OS filesystem's content. See below.
* `cvm`: A C implementation of Collapse OS, allowing it to run natively on any
POSIX platform.
* `doc`: Documentation.
@ -48,6 +47,24 @@ it's not a z80 emulator, but a *javascript port of Collapse OS*!
* `emul`: Tools for running Collapse OS in an emulated environment.
* `tests`: Automated test suite for the whole project.
## blk.fs
This file is a big text file containing the "real deal", that is, the contents
of Collapse OS' filesystem. That filesystem contains everything that a
post-collapse computer would manage, that is, all Forth and assembler source
code for the tools it needs to fulfill its goals.
The Collapse OS filesystem is a simple sequence of 1024 bytes blocks. That is
not very workable in the text editor of a modern system. `blk.fs` represents an
"unpacked" view of that block system. Each block (16 lines max per block, 64
chars max per line) begins with a marker indicating the block number of the
contents that follow.
Blocks must be in ascending order.
That file can be "packed" to a real blkfs with `/tools/blkpack`. A real blkfs
can be "unpacked" to its text file form with `/tools/blkunpack`.
## Status
The project unfinished but is progressing well! See [Collapse OS' website][web]

2
arch/8086/pcat/Makefile
View File

@ -15,7 +15,7 @@ $(BLKPACK):
$(MAKE) -C $(BASE)/tools
blkfs: $(BLKPACK)
$(BLKPACK) $(BASE)/blk blk > $@
cat $(BASE)/blk.fs blk.fs | $(BLKPACK) > $@
$(STAGE):
$(MAKE) -C $(CDIR) stage

88
arch/8086/pcat/blk.fs Normal file
View File

@ -0,0 +1,88 @@
( ----- 600 )
PC/AT recipe
602 MBR bootloader 604 KEY/EMIT drivers
606-608 BLK drivers 610 AT-XY drivers
612 xcomp unit
( ----- 602 )
H@ ORG ! 0x7c00 BIN( ! ( BIOS loads boot bin at 0x7c00 )
JMPs, L1 FWRs ( start )
ORG @ 0x25 + HERE ! ( bypass BPB )
L1 FSET ( start )
CLI, CLD, AX 0x800 MOVxI, DS AX MOVsx, ES AX MOVsx,
SS AX MOVsx, DX PUSHx, ( will be popped by OS ) STI,
AH 2 MOVri, DH 0 MOVri, CH 0 MOVri, CL 2 MOVri, AL 15 MOVri,
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 A, 0xaa A,
( ----- 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
( ----- 606 )
CODE 13H08H ( driveno -- cx dx )
DI POPx, DX PUSHx, ( protect ) DX DI MOVxx, AX 0x800 MOVxI,
ES PUSHs, DI DI XORxx, ES DI MOVsx,
0x13 INT, DI DX MOVxx, ES POPs, DX POPx, ( unprotect )
CX PUSHx, DI PUSHx,
;CODE
CODE 13H ( ax bx cx dx -- ax bx cx dx )
SI POPx, ( DX ) CX POPx, BX POPx, AX POPx,
DX PUSHx, ( protect ) DX SI MOVxx, DI DI XORxx,
0x13 INT, SI DX MOVxx, DX POPx, ( unprotect )
AX PUSHx, BX PUSHx, CX PUSHx, SI PUSHx,
;CODE
( ----- 607 )
: FDSPT 0x70 RAM+ ;
: FDHEADS 0x71 RAM+ ;
: _ ( AX BX sec )
( AH=read sectors, AL=1 sector, BX=dest,
CH=trackno CL=secno DH=head DL=drive )
FDSPT C@ /MOD ( AX BX sec trk )
FDHEADS C@ /MOD ( AX BX sec head trk )
8 LSHIFT ROT OR 1+ ( AX BX head CX )
SWAP 8 LSHIFT 0x03 C@ ( boot drive ) OR ( AX BX CX DX )
13H 2DROP 2DROP
;
( ----- 608 )
: FD@
2 * 16 + ( blkfs starts at sector 16 )
0x0201 BLK( 2 PICK _
0x0201 BLK( 0x200 + ROT 1+ _ ;
: FD!
2 * 16 + ( blkfs starts at sector 16 )
0x0301 BLK( 2 PICK _
0x0301 BLK( 0x200 + ROT 1+ _ ;
: FD$
( get number of sectors per track with command 08H. )
0x03 ( boot drive ) C@ 13H08H
8 RSHIFT 1+ FDHEADS C!
0x3f AND FDSPT C!
;
( ----- 610 )
: COLS 80 ; : LINES 25 ;
CODE AT-XY ( x y )
( DH=row DL=col BH=page )
AX POPx, BX POPx, DX PUSHx, ( protect )
DH AL MOVrr, DL BL MOVrr, BX BX XORxx, AH 2 MOVri,
0x10 INT, DX POPx, ( unprotect )
;CODE
( ----- 612 )
0xff00 CONSTANT RS_ADDR
0xfffa CONSTANT PS_ADDR
RS_ADDR 0x80 - CONSTANT SYSVARS
30 LOAD ( 8086 asm )
262 LOAD ( xcomp ) 270 LOAD ( xcomp overrides )
445 461 LOADR ( 8086 boot code )
353 LOAD ( xcomp core low )
604 LOAD ( KEY/EMIT drivers )
606 608 LOADR ( BLK drivers )
610 LOAD ( AT-XY drivers )
390 LOAD ( xcomp core high )
(entry) _ ( Update LATEST ) PC ORG @ 8 + !
," BLK$ FD$ ' FD@ BLK@* ! ' FD! BLK!* ! " EOT,

5
arch/8086/pcat/blk/600
View File

@ -1,5 +0,0 @@
PC/AT recipe
602 MBR bootloader 604 KEY/EMIT drivers
606-608 BLK drivers 610 AT-XY drivers
612 xcomp unit

12
arch/8086/pcat/blk/602
View File

@ -1,12 +0,0 @@
H@ ORG ! 0x7c00 BIN( ! ( BIOS loads boot bin at 0x7c00 )
JMPs, L1 FWRs ( start )
ORG @ 0x25 + HERE ! ( bypass BPB )
L1 FSET ( start )
CLI, CLD, AX 0x800 MOVxI, DS AX MOVsx, ES AX MOVsx,
SS AX MOVsx, DX PUSHx, ( will be popped by OS ) STI,
AH 2 MOVri, DH 0 MOVri, CH 0 MOVri, CL 2 MOVri, AL 15 MOVri,
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 A, 0xaa A,

6
arch/8086/pcat/blk/604
View File

@ -1,6 +0,0 @@
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

14
arch/8086/pcat/blk/606
View File

@ -1,14 +0,0 @@
CODE 13H08H ( driveno -- cx dx )
DI POPx, DX PUSHx, ( protect ) DX DI MOVxx, AX 0x800 MOVxI,
ES PUSHs, DI DI XORxx, ES DI MOVsx,
0x13 INT, DI DX MOVxx, ES POPs, DX POPx, ( unprotect )
CX PUSHx, DI PUSHx,
;CODE
CODE 13H ( ax bx cx dx -- ax bx cx dx )
SI POPx, ( DX ) CX POPx, BX POPx, AX POPx,
DX PUSHx, ( protect ) DX SI MOVxx, DI DI XORxx,
0x13 INT, SI DX MOVxx, DX POPx, ( unprotect )
AX PUSHx, BX PUSHx, CX PUSHx, SI PUSHx,
;CODE
: FDSPT 0x70 RAM+ ;
: FDHEADS 0x71 RAM+ ;

9
arch/8086/pcat/blk/607
View File

@ -1,9 +0,0 @@
: _ ( AX BX sec )
( AH=read sectors, AL=1 sector, BX=dest,
CH=trackno CL=secno DH=head DL=drive )
FDSPT C@ /MOD ( AX BX sec trk )
FDHEADS C@ /MOD ( AX BX sec head trk )
8 LSHIFT ROT OR 1+ ( AX BX head CX )
SWAP 8 LSHIFT 0x03 C@ ( boot drive ) OR ( AX BX CX DX )
13H 2DROP 2DROP
;

14
arch/8086/pcat/blk/608
View File

@ -1,14 +0,0 @@
: FD@
2 * 16 + ( blkfs starts at sector 16 )
0x0201 BLK( 2 PICK _
0x0201 BLK( 0x200 + ROT 1+ _ ;
: FD!
2 * 16 + ( blkfs starts at sector 16 )
0x0301 BLK( 2 PICK _
0x0301 BLK( 0x200 + ROT 1+ _ ;
: FD$
( get number of sectors per track with command 08H. )
0x03 ( boot drive ) C@ 13H08H
8 RSHIFT 1+ FDHEADS C!
0x3f AND FDSPT C!
;

7
arch/8086/pcat/blk/610
View File

@ -1,7 +0,0 @@
: COLS 80 ; : LINES 25 ;
CODE AT-XY ( x y )
( DH=row DL=col BH=page )
AX POPx, BX POPx, DX PUSHx, ( protect )
DH AL MOVrr, DL BL MOVrr, BX BX XORxx, AH 2 MOVri,
0x10 INT, DX POPx, ( unprotect )
;CODE

13
arch/8086/pcat/blk/612
View File

@ -1,13 +0,0 @@
0xff00 CONSTANT RS_ADDR
0xfffa CONSTANT PS_ADDR
RS_ADDR 0x80 - CONSTANT SYSVARS
30 LOAD ( 8086 asm )
262 LOAD ( xcomp ) 270 LOAD ( xcomp overrides )
445 461 LOADR ( 8086 boot code )
353 LOAD ( xcomp core low )
604 LOAD ( KEY/EMIT drivers )
606 608 LOADR ( BLK drivers )
610 LOAD ( AT-XY drivers )
390 LOAD ( xcomp core high )
(entry) _ ( Update LATEST ) PC ORG @ 8 + !
," BLK$ FD$ ' FD@ BLK@* ! ' FD! BLK!* ! " EOT,

2
arch/z80/rc2014/Makefile
View File

@ -16,7 +16,7 @@ $(BLKPACK):
$(MAKE) -C ../tools
blkfs: $(BLKPACK)
$(BLKPACK) $(BASE)/blk blk > $@
cat $(BASE)/blk.fs blk.fs | $(BLKPACK) > $@
$(STAGE):
$(MAKE) -C $(CDIR) stage

156
arch/z80/rc2014/blk.fs Normal file
View File

@ -0,0 +1,156 @@
( ----- 600 )
601 ACIA 606 Zilog SIO driver
615 SPI relay 619 Xcomp unit
( ----- 601 )
ACIA driver
Manage I/O from an asynchronous communication interface adapter
(ACIA). provides "(emit)" to put c char on the ACIA as well as
an input buffer from which a provided "(key)" reads. This driver
installs an interrupt handler at RST38 to handle RX.
To use, begin by loading declarations (B582) before xcomp is
loaded. These declarations provide default values for ports and
memory offsets that you can override. See B582.
Then, in the driver part, load range 583-588.
( ----- 602 )
0x80 CONSTANT ACIA_CTL ( IO port for ACIA's control register )
0x81 CONSTANT ACIA_IO ( IO port for ACIA's data registers )
0x20 CONSTANT ACIA_BUFSZ ( SZ-1 must be a mask )
( Address in memory that can be used variables shared
with ACIA's native words. 4 bytes used. )
CREATE ACIA_MEM SYSVARS 0x70 + ,
( Points to ACIA buf )
: ACIA( ACIA_MEM @ 2+ ;
( Read buf idx Pre-inc )
: ACIAR> ACIA_MEM @ ;
( Write buf idx Post-inc )
: ACIAW> ACIA_MEM @ 1+ ;
( This means that if W> == R>, buffer is full.
If R>+1 == W>, buffer is empty. )
( ----- 603 )
( ACIA INT handler, read into ACIAW> )
( Set RST 38 jump ) PC ORG @ 0x39 + !
AF PUSH,
ACIA_CTL INAi, 0x01 ANDi, ( is ACIA rcv buf full? )
IFZ, ( no, abort ) AF POP, EI, RETI, THEN,
HL PUSH,
HL ACIAW> LDdi, A (HL) LDrr,
HL DECd, (HL) CPr, ( W> == R> ? )
IFNZ, ( buffer not full )
( get wr ptr ) HL ACIA( LDd(i),
L ADDr, IFC, H INCr, THEN, L A LDrr,
( fetch/write ) ACIA_IO INAi, (HL) A LDrr,
( advance W> ) ACIAW> LDA(i), A INCr,
ACIA_BUFSZ 1- ANDi, ACIAW> LD(i)A,
THEN,
HL POP, AF POP, EI, RETI,
( ----- 604 )
: (key)
( inc then fetch )
[ ACIAR> LITN ] C@ 1+ [ ACIA_BUFSZ 1- LITN ] AND
( As long as R> == W>-1, it means that buffer is empty )
BEGIN DUP [ ACIAW> LITN ] C@ = NOT UNTIL
DUP [ ACIA( LITN ] @ + C@ ( ridx c )
SWAP [ ACIAR> LITN ] C! ( c )
;
: (emit)
( As long at CTL bit 1 is low, we are transmitting. wait )
BEGIN [ ACIA_CTL LITN ] PC@ 0x02 AND UNTIL
( The way is clear, go! )
[ ACIA_IO LITN ] PC!
;
( ----- 605 )
: ACIA$
H@ [ ACIA( LITN ] ! 0 [ ACIAR> LITN ] C!
1 [ ACIAW> LITN ] C! ( write index starts one pos later )
[ ACIA_BUFSZ LITN ] ALLOT
( setup ACIA
CR7 (1) - Receive Interrupt enabled
CR6:5 (00) - RTS low, transmit interrupt disabled.
CR4:2 (101) - 8 bits + 1 stop bit
CR1:0 (10) - Counter divide: 64 )
0b10010110 [ ACIA_CTL LITN ] PC!
(im1) ;
( ----- 606 )
Zilog SIO driver
Declarations at B607
Driver load range at B608-B610
( ----- 607 )
0x80 CONSTANT SIO_ACTL 0x81 CONSTANT SIO_ADATA
0x82 CONSTANT SIO_BCTL 0x83 CONSTANT SIO_BDATA
0x20 CONSTANT SIO_BUFSZ ( SZ-1 must be a mask )
( Address in memory that can be used variables shared
with SIO native words. 4 bytes used. )
CREATE SIO_MEM SYSVARS 0x70 + ,
( Points to SIO buf )
: SIO( SIO_MEM @ 2+ ;
( Read buf idx Pre-inc )
: SIOR> SIO_MEM @ ;
( Write buf idx Post-inc )
: SIOW> SIO_MEM @ 1+ ;
( This means that if W> == R>, buffer is full.
If R>+1 == W>, buffer is empty. )
( ----- 608 )
( INT handler. Set RST 38 jump ) PC ORG @ 0x39 + !
AF PUSH, BEGIN,
SIO_ACTL INAi, ( RR0 ) 0x01 ANDi, ( is recv buf full? )
IFZ, ( nope, exit ) A 0x20 ( CMD 4 ) LDri, SIO_ACTL OUTiA,
AF POP, EI, RETI, THEN,
HL PUSH,
HL SIOW> LDdi, A (HL) LDrr,
HL DECd, (HL) CPr, ( W> == R> ? )
IFNZ, ( buffer not full )
( get wr ptr ) HL SIO( LDd(i),
L ADDr, IFC, H INCr, THEN, L A LDrr,
( fetch/write ) SIO_ADATA INAi, (HL) A LDrr,
( advance W> ) SIOW> LDA(i), A INCr,
SIO_BUFSZ 1- ANDi, SIOW> LD(i)A,
THEN, HL POP, JR, AGAIN,
( ----- 609 )
: (key)
( inc then fetch )
[ SIOR> LITN ] C@ 1+ [ SIO_BUFSZ 1- LITN ] AND
( As long as R> == W>-1, it means that buffer is empty )
BEGIN DUP [ SIOW> LITN ] C@ = NOT UNTIL
DUP [ SIO( LITN ] @ + C@ ( ridx c )
SWAP [ SIOR> LITN ] C! ( c )
;
: (emit)
( As long at CTL bit 2 is low, we are transmitting. wait )
BEGIN [ SIO_ACTL LITN ] PC@ 0x04 AND UNTIL
( The way is clear, go! )
[ SIO_ADATA LITN ] PC!
;
( ----- 610 )
: _ [ SIO_ACTL LITN ] PC! ;
: SIO$
H@ [ SIO( LITN ] ! 0 [ SIOR> LITN ] C!
1 [ SIOW> LITN ] C! ( write index starts one pos later )
[ SIO_BUFSZ LITN ] ALLOT
0x18 _ ( CMD3 )
0x24 _ ( CMD2/PTR4 ) 0b11000100 _ ( WR4/64x/1stop/nopar )
0x03 _ ( PTR3 ) 0b11000001 _ ( WR3/RXen/8char )
0x05 _ ( PTR5 ) 0b01101000 _ ( WR5/TXen/8char )
0x21 _ ( CMD2/PTR1 ) 0b00011000 _ ( WR1/Rx INT all chars )
(im1)
;
( ----- 619 )
0xff00 CONSTANT RS_ADDR 0xfffa CONSTANT PS_ADDR
RS_ADDR 0x80 - CONSTANT SYSVARS
0x8000 CONSTANT HERESTART
4 CONSTANT SPI_DATA 5 CONSTANT SPI_CTL 1 CONSTANT SDC_DEVID
602 LOAD ( acia decl )
5 LOAD ( z80 assembler )
262 LOAD ( xcomp ) 282 LOAD ( boot.z80.decl )
270 LOAD ( xcomp overrides ) 283 335 LOADR ( boot.z80 )
353 LOAD ( xcomp core low ) 603 605 LOADR ( acia )
419 LOAD 423 436 LOADR
390 LOAD ( xcomp core high )
(entry) _
( Update LATEST )
PC ORG @ 8 + !
," ACIA$ BLK$ " EOT,

2
arch/z80/rc2014/blk/600
View File

@ -1,2 +0,0 @@
601 ACIA 606 Zilog SIO driver
615 SPI relay 619 Xcomp unit

12
arch/z80/rc2014/blk/601
View File

@ -1,12 +0,0 @@
ACIA driver
Manage I/O from an asynchronous communication interface adapter
(ACIA). provides "(emit)" to put c char on the ACIA as well as
an input buffer from which a provided "(key)" reads. This driver
installs an interrupt handler at RST38 to handle RX.
To use, begin by loading declarations (B582) before xcomp is
loaded. These declarations provide default values for ports and
memory offsets that you can override. See B582.
Then, in the driver part, load range 583-588.

14
arch/z80/rc2014/blk/602
View File

@ -1,14 +0,0 @@
0x80 CONSTANT ACIA_CTL ( IO port for ACIA's control register )
0x81 CONSTANT ACIA_IO ( IO port for ACIA's data registers )
0x20 CONSTANT ACIA_BUFSZ ( SZ-1 must be a mask )
( Address in memory that can be used variables shared
with ACIA's native words. 4 bytes used. )
CREATE ACIA_MEM SYSVARS 0x70 + ,
( Points to ACIA buf )
: ACIA( ACIA_MEM @ 2+ ;
( Read buf idx Pre-inc )
: ACIAR> ACIA_MEM @ ;
( Write buf idx Post-inc )
: ACIAW> ACIA_MEM @ 1+ ;
( This means that if W> == R>, buffer is full.
If R>+1 == W>, buffer is empty. )

16
arch/z80/rc2014/blk/603
View File

@ -1,16 +0,0 @@
( ACIA INT handler, read into ACIAW> )
( Set RST 38 jump ) PC ORG @ 0x39 + !
AF PUSH,
ACIA_CTL INAi, 0x01 ANDi, ( is ACIA rcv buf full? )
IFZ, ( no, abort ) AF POP, EI, RETI, THEN,
HL PUSH,
HL ACIAW> LDdi, A (HL) LDrr,
HL DECd, (HL) CPr, ( W> == R> ? )
IFNZ, ( buffer not full )
( get wr ptr ) HL ACIA( LDd(i),
L ADDr, IFC, H INCr, THEN, L A LDrr,
( fetch/write ) ACIA_IO INAi, (HL) A LDrr,
( advance W> ) ACIAW> LDA(i), A INCr,
ACIA_BUFSZ 1- ANDi, ACIAW> LD(i)A,
THEN,
HL POP, AF POP, EI, RETI,

14
arch/z80/rc2014/blk/604
View File

@ -1,14 +0,0 @@
: (key)
( inc then fetch )
[ ACIAR> LITN ] C@ 1+ [ ACIA_BUFSZ 1- LITN ] AND
( As long as R> == W>-1, it means that buffer is empty )
BEGIN DUP [ ACIAW> LITN ] C@ = NOT UNTIL
DUP [ ACIA( LITN ] @ + C@ ( ridx c )
SWAP [ ACIAR> LITN ] C! ( c )
;
: (emit)
( As long at CTL bit 1 is low, we are transmitting. wait )
BEGIN [ ACIA_CTL LITN ] PC@ 0x02 AND UNTIL
( The way is clear, go! )
[ ACIA_IO LITN ] PC!
;

11
arch/z80/rc2014/blk/605
View File

@ -1,11 +0,0 @@
: ACIA$
H@ [ ACIA( LITN ] ! 0 [ ACIAR> LITN ] C!
1 [ ACIAW> LITN ] C! ( write index starts one pos later )
[ ACIA_BUFSZ LITN ] ALLOT
( setup ACIA
CR7 (1) - Receive Interrupt enabled
CR6:5 (00) - RTS low, transmit interrupt disabled.
CR4:2 (101) - 8 bits + 1 stop bit
CR1:0 (10) - Counter divide: 64 )
0b10010110 [ ACIA_CTL LITN ] PC!
(im1) ;

5
arch/z80/rc2014/blk/606
View File

@ -1,5 +0,0 @@
Zilog SIO driver
Declarations at B607
Driver load range at B608-B610

14
arch/z80/rc2014/blk/607
View File

@ -1,14 +0,0 @@
0x80 CONSTANT SIO_ACTL 0x81 CONSTANT SIO_ADATA
0x82 CONSTANT SIO_BCTL 0x83 CONSTANT SIO_BDATA
0x20 CONSTANT SIO_BUFSZ ( SZ-1 must be a mask )
( Address in memory that can be used variables shared
with SIO native words. 4 bytes used. )
CREATE SIO_MEM SYSVARS 0x70 + ,
( Points to SIO buf )
: SIO( SIO_MEM @ 2+ ;
( Read buf idx Pre-inc )
: SIOR> SIO_MEM @ ;
( Write buf idx Post-inc )
: SIOW> SIO_MEM @ 1+ ;
( This means that if W> == R>, buffer is full.
If R>+1 == W>, buffer is empty. )

15
arch/z80/rc2014/blk/608
View File

@ -1,15 +0,0 @@
( INT handler. Set RST 38 jump ) PC ORG @ 0x39 + !
AF PUSH, BEGIN,
SIO_ACTL INAi, ( RR0 ) 0x01 ANDi, ( is recv buf full? )
IFZ, ( nope, exit ) A 0x20 ( CMD 4 ) LDri, SIO_ACTL OUTiA,
AF POP, EI, RETI, THEN,
HL PUSH,
HL SIOW> LDdi, A (HL) LDrr,
HL DECd, (HL) CPr, ( W> == R> ? )
IFNZ, ( buffer not full )
( get wr ptr ) HL SIO( LDd(i),
L ADDr, IFC, H INCr, THEN, L A LDrr,
( fetch/write ) SIO_ADATA INAi, (HL) A LDrr,
( advance W> ) SIOW> LDA(i), A INCr,
SIO_BUFSZ 1- ANDi, SIOW> LD(i)A,
THEN, HL POP, JR, AGAIN,

14
arch/z80/rc2014/blk/609
View File

@ -1,14 +0,0 @@
: (key)
( inc then fetch )
[ SIOR> LITN ] C@ 1+ [ SIO_BUFSZ 1- LITN ] AND
( As long as R> == W>-1, it means that buffer is empty )
BEGIN DUP [ SIOW> LITN ] C@ = NOT UNTIL
DUP [ SIO( LITN ] @ + C@ ( ridx c )
SWAP [ SIOR> LITN ] C! ( c )
;
: (emit)
( As long at CTL bit 2 is low, we are transmitting. wait )
BEGIN [ SIO_ACTL LITN ] PC@ 0x04 AND UNTIL
( The way is clear, go! )
[ SIO_ADATA LITN ] PC!
;

12
arch/z80/rc2014/blk/610
View File

@ -1,12 +0,0 @@
: _ [ SIO_ACTL LITN ] PC! ;
: SIO$
H@ [ SIO( LITN ] ! 0 [ SIOR> LITN ] C!
1 [ SIOW> LITN ] C! ( write index starts one pos later )
[ SIO_BUFSZ LITN ] ALLOT
0x18 _ ( CMD3 )
0x24 _ ( CMD2/PTR4 ) 0b11000100 _ ( WR4/64x/1stop/nopar )
0x03 _ ( PTR3 ) 0b11000001 _ ( WR3/RXen/8char )
0x05 _ ( PTR5 ) 0b01101000 _ ( WR5/TXen/8char )
0x21 _ ( CMD2/PTR1 ) 0b00011000 _ ( WR1/Rx INT all chars )
(im1)
;

15
arch/z80/rc2014/blk/619
View File

@ -1,15 +0,0 @@
0xff00 CONSTANT RS_ADDR 0xfffa CONSTANT PS_ADDR
RS_ADDR 0x80 - CONSTANT SYSVARS
0x8000 CONSTANT HERESTART
4 CONSTANT SPI_DATA 5 CONSTANT SPI_CTL 1 CONSTANT SDC_DEVID
602 LOAD ( acia decl )
5 LOAD ( z80 assembler )
262 LOAD ( xcomp ) 282 LOAD ( boot.z80.decl )
270 LOAD ( xcomp overrides ) 283 335 LOADR ( boot.z80 )
353 LOAD ( xcomp core low ) 603 605 LOADR ( acia )
419 LOAD 423 436 LOADR
390 LOAD ( xcomp core high )
(entry) _
( Update LATEST )
PC ORG @ 8 + !
," ACIA$ BLK$ " EOT,

2
arch/z80/sms/Makefile
View File

@ -16,7 +16,7 @@ $(BLKPACK):
$(MAKE) -C ../tools
blkfs: $(BLKPACK)
$(BLKPACK) $(BASE)/blk blk > $@
cat $(BASE)/blk.fs blk.fs | $(BLKPACK) > $@
$(STAGE):
$(MAKE) -C $(BASE)/cvm stage

189
arch/z80/sms/blk.fs Normal file
View File

@ -0,0 +1,189 @@
( ----- 600 )
Sega Master System Recipe
602 VDP 610 PAD
620 KBD 625 Ports
( ----- 602 )
( VDP Driver. requires TMS9918 driver. Load range B602-B604. )
CREATE _idat
0b00000100 C, 0x80 C, ( Bit 2: Select mode 4 )
0b00000000 C, 0x81 C,
0b00001111 C, 0x82 C, ( Name table: 0x3800, *B0 must be 1* )
0b11111111 C, 0x85 C, ( Sprite table: 0x3f00 )
0b11111111 C, 0x86 C, ( sprite use tiles from 0x2000 )
0b11111111 C, 0x87 C, ( Border uses palette 0xf )
0b00000000 C, 0x88 C, ( BG X scroll )
0b00000000 C, 0x89 C, ( BG Y scroll )
0b11111111 C, 0x8a C, ( Line counter (why have this?) )
( ----- 603 )
: _zero ( x -- send 0 _data x times )
( x ) 0 DO 0 _data LOOP ;
( Each row in ~FNT is a row of the glyph and there is 7 of
them. We insert a blank one at the end of those 7. For each
row we set, we need to send 3 zero-bytes because each pixel in
the tile is actually 4 bits because it can select among 16
palettes. We use only 2 of them, which is why those bytes
always stay zero. )
: _sfont ( a -- Send font to VDP )
7 0 DO C@+ _data 3 _zero LOOP DROP
( blank row ) 4 _zero ;
: CELL! ( tilenum pos )
2 * 0x7800 OR _ctl ( tilenum )
0x5e MOD _data 1 _zero ;
( ----- 604 )
: VDP$
9 0 DO _idat I 2 * + @ _ctl LOOP _blank
( palettes )
0xc000 _ctl
( BG ) 1 _zero 0x3f _data 14 _zero
( sprite, inverted colors ) 0x3f _data 15 _zero
0x4000 _ctl 0x5e 0 DO ~FNT I 7 * + _sfont LOOP
( bit 6, enable display, bit 7, ?? ) 0x81c0 _ctl ;
: COLS 32 ;
: LINES 24 ;
( ----- 610 )
Pad driver - read input from MD controller
Conveniently expose an API to read the status of a MD pad A.
Moreover, implement a mechanism to input arbitrary characters
from it. It goes as follow:
* Direction pad select characters. Up/Down move by one,
Left/Right move by 5
* Start acts like Return
* A acts like Backspace
* B changes "character class": lowercase, uppercase, numbers,
special chars. The space character is the first among special
chars.
* C confirms letter selection
(cont.)
( ----- 611 )
This module is currently hard-wired to VDP driver, that is, it
calls vdp's routines during (key) to update character
selection.
Load range: 632-637
( ----- 612 )
: _prevstat [ PAD_MEM LITN ] ;
: _sel [ PAD_MEM 1+ LITN ] ;
: _next [ PAD_MEM 2+ LITN ] ;
( Put status for port A in register A. Bits, from MSB to LSB:
Start - A - C - B - Right - Left - Down - Up
Each bit is high when button is unpressed and low if button is
pressed. When no button is pressed, 0xff is returned.
This logic below is for the Genesis controller, which is modal.
TH is an output pin that switches the meaning of TL and TR. When
TH is high (unselected), TL = Button B and TR = Button C. When
TH is low (selected), TL = Button A and TR = Start. )
( ----- 613 )
: _status
1 _THA! ( output, high/unselected )
_D1@ 0x3f AND ( low 6 bits are good )
( Start and A are returned when TH is selected, in bits 5 and
4. Well get them, left-shift them and integrate them to B. )
0 _THA! ( output, low/selected )
_D1@ 0x30 AND 2 LSHIFT OR ;
( ----- 614 )
: _chk ( c --, check _sel range )
_sel C@ DUP 0x7f > IF 0x20 _sel C! THEN
0x20 < IF 0x7f _sel C! THEN ;
CREATE _ '0' C, ':' C, 'A' C, '[' C, 'a' C, 0xff C,
: _nxtcls
_sel @ _ BEGIN ( c a ) C@+ 2 PICK > UNTIL ( c a )
1- C@ NIP _sel !
;
( ----- 615 )
: _updsel ( -- f, has an action button been pressed? )
_status _prevstat C@ OVER = IF DROP 0 EXIT THEN
DUP _prevstat C! ( changed, update ) ( s )
0x01 ( UP ) OVER AND NOT IF 1 _sel +! THEN
0x02 ( DOWN ) OVER AND NOT IF -1 _sel +! THEN
0x04 ( LEFT ) OVER AND NOT IF -5 _sel +! THEN
0x08 ( RIGHT ) OVER AND NOT IF 5 _sel +! THEN
0x10 ( BUTB ) OVER AND NOT IF _nxtcls THEN
( update sel in VDP )
_chk _sel C@ (emit) -1 XYPOS +!
( return whether any of the high 3 bits is low )
0xe0 AND 0xe0 <
;
( ----- 616 )
: (key)
_next C@ IF _next C@ 0 _next C! EXIT THEN
BEGIN _updsel UNTIL
_prevstat C@
0x20 ( BUTC ) OVER AND NOT IF DROP _sel C@ EXIT THEN
0x40 ( BUTA ) AND NOT IF 0x8 ( BS ) EXIT THEN
( If not BUTC or BUTA, it has to be START )
0xd _next C! _sel C@
;
( ----- 617 )
: PAD$
0xff _prevstat C! 'a' _sel C! 0 _next C! ;
( ----- 620 )
( kbd - implement (ps2kc) for SMS PS/2 adapter )
: (ps2kcA) ( for port A )
( Before reading a character, we must first verify that there
is something to read. When the adapter is finished filling its
'164 up, it resets the latch, which output's is connected to
TL. When the '164 is full, TL is low. Port A TL is bit 4 )
_D1@ 0x10 AND IF 0 EXIT ( nothing ) THEN
0 _THA! ( Port A TH output, low )
_D1@ ( bit 3:0 go in 3:0 ) 0x0f AND ( n )
1 _THA! ( Port A TH output, high )
_D1@ ( bit 3:0 go in 7:4 ) 0x0f AND 4 LSHIFT OR ( n )
2 _THA! ( TH input ) ;
( ----- 621 )
: (ps2kcB) ( for port B )
( Port B TL is bit 2 )
_D2@ 0x04 AND IF 0 EXIT ( nothing ) THEN
0 _THB! ( Port B TH output, low )
_D1@ ( bit 7:6 go in 1:0 ) 6 RSHIFT ( n )
_D2@ ( bit 1:0 go in 3:2 ) 0x03 AND 2 LSHIFT OR ( n )
1 _THB! ( Port B TH output, high )
_D1@ ( bit 7:6 go in 5:4 ) 0xc0 AND 2 RSHIFT OR ( n )
_D2@ ( bit 1:0 go in 7:6 ) 0x03 AND 6 LSHIFT OR ( n )
2 _THB! ( TH input ) ;
( ----- 622 )
: (spie) DROP ; ( always enabled )
: (spix) ( x -- x, for port B )
0 SWAP ( rx tx ) 8 0 DO
( send current bit to TRB, TR's output bit )
DUP 7 I - RSHIFT 1 AND _TRB!
1 _THB! ( CLK hi )
( read into rx ) SWAP 1 LSHIFT _D1@ ( tx rx<< x )
0 _THB! ( CLK lo )
( out bit is the 6th ) 6 RSHIFT 1 AND OR
SWAP LOOP ( rx tx ) DROP ;
( ----- 625 )
( Routines for interacting with SMS controller ports.
Requires CPORT_MEM, CPORT_CTL, CPORT_D1 and CPORT_D2 to be
defined. CPORT_MEM is a 1 byte buffer for CPORT_CTL. The last
3 consts will usually be 0x3f, 0xdc, 0xdd. )
( mode -- set TR pin on mode a on:
0= output low 1=output high 2=input )
CODE _TRA! HL POP, chkPS, ( B0 -> B4, B1 -> B0 )
L RR, RLA, RLA, RLA, RLA, L RR, RLA,
0x11 ANDi, L A LDrr, CPORT_MEM LDA(i),
0xee ANDi, L ORr, CPORT_CTL OUTiA, CPORT_MEM LD(i)A,
;CODE
CODE _THA! HL POP, chkPS, ( B0 -> B5, B1 -> B1 )
L RR, RLA, RLA, RLA, RLA, L RR, RLA, RLA,
0x22 ANDi, L A LDrr, CPORT_MEM LDA(i),
0xdd ANDi, L ORr, CPORT_CTL OUTiA, CPORT_MEM LD(i)A,
;CODE
( ----- 626 )
CODE _TRB! HL POP, chkPS, ( B0 -> B6, B1 -> B2 )
L RR, RLA, RLA, RLA, RLA, L RR, RLA, RLA, RLA,
0x44 ANDi, L A LDrr, CPORT_MEM LDA(i),
0xbb ANDi, L ORr, CPORT_CTL OUTiA, CPORT_MEM LD(i)A,
;CODE
CODE _THB! HL POP, chkPS, ( B0 -> B7, B1 -> B3 )
L RR, RLA, RLA, RLA, RLA, L RR, RLA, RLA, RLA, RLA,
0x88 ANDi, L A LDrr, CPORT_MEM LDA(i),
0x77 ANDi, L ORr, CPORT_CTL OUTiA, CPORT_MEM LD(i)A,
;CODE
CODE _D1@ CPORT_D1 INAi, PUSHA, ;CODE
CODE _D2@ CPORT_D2 INAi, PUSHA, ;CODE

4
arch/z80/sms/blk/600
View File

@ -1,4 +0,0 @@
Sega Master System Recipe
602 VDP 610 PAD
620 KBD 625 Ports

11
arch/z80/sms/blk/602
View File

@ -1,11 +0,0 @@
( VDP Driver. requires TMS9918 driver. Load range B602-B604. )
CREATE _idat
0b00000100 C, 0x80 C, ( Bit 2: Select mode 4 )
0b00000000 C, 0x81 C,
0b00001111 C, 0x82 C, ( Name table: 0x3800, *B0 must be 1* )
0b11111111 C, 0x85 C, ( Sprite table: 0x3f00 )
0b11111111 C, 0x86 C, ( sprite use tiles from 0x2000 )
0b11111111 C, 0x87 C, ( Border uses palette 0xf )
0b00000000 C, 0x88 C, ( BG X scroll )
0b00000000 C, 0x89 C, ( BG Y scroll )
0b11111111 C, 0x8a C, ( Line counter (why have this?) )

14
arch/z80/sms/blk/603
View File

@ -1,14 +0,0 @@
: _zero ( x -- send 0 _data x times )
( x ) 0 DO 0 _data LOOP ;
( Each row in ~FNT is a row of the glyph and there is 7 of
them. We insert a blank one at the end of those 7. For each
row we set, we need to send 3 zero-bytes because each pixel in
the tile is actually 4 bits because it can select among 16
palettes. We use only 2 of them, which is why those bytes
always stay zero. )
: _sfont ( a -- Send font to VDP )
7 0 DO C@+ _data 3 _zero LOOP DROP
( blank row ) 4 _zero ;
: CELL! ( tilenum pos )
2 * 0x7800 OR _ctl ( tilenum )
0x5e MOD _data 1 _zero ;

11
arch/z80/sms/blk/604
View File

@ -1,11 +0,0 @@
: VDP$
9 0 DO _idat I 2 * + @ _ctl LOOP _blank
( palettes )
0xc000 _ctl
( BG ) 1 _zero 0x3f _data 14 _zero
( sprite, inverted colors ) 0x3f _data 15 _zero
0x4000 _ctl 0x5e 0 DO ~FNT I 7 * + _sfont LOOP
( bit 6, enable display, bit 7, ?? ) 0x81c0 _ctl ;
: COLS 32 ;
: LINES 24 ;

16
arch/z80/sms/blk/610
View File

@ -1,16 +0,0 @@
Pad driver - read input from MD controller
Conveniently expose an API to read the status of a MD pad A.
Moreover, implement a mechanism to input arbitrary characters
from it. It goes as follow:
* Direction pad select characters. Up/Down move by one,
Left/Right move by 5
* Start acts like Return
* A acts like Backspace
* B changes "character class": lowercase, uppercase, numbers,
special chars. The space character is the first among special
chars.
* C confirms letter selection
(cont.)

5
arch/z80/sms/blk/611
View File

@ -1,5 +0,0 @@
This module is currently hard-wired to VDP driver, that is, it
calls vdp's routines during (key) to update character
selection.
Load range: 632-637

12
arch/z80/sms/blk/612
View File

@ -1,12 +0,0 @@
: _prevstat [ PAD_MEM LITN ] ;
: _sel [ PAD_MEM 1+ LITN ] ;
: _next [ PAD_MEM 2+ LITN ] ;
( Put status for port A in register A. Bits, from MSB to LSB:
Start - A - C - B - Right - Left - Down - Up
Each bit is high when button is unpressed and low if button is
pressed. When no button is pressed, 0xff is returned.
This logic below is for the Genesis controller, which is modal.
TH is an output pin that switches the meaning of TL and TR. When
TH is high (unselected), TL = Button B and TR = Button C. When
TH is low (selected), TL = Button A and TR = Start. )

7
arch/z80/sms/blk/613
View File

@ -1,7 +0,0 @@
: _status
1 _THA! ( output, high/unselected )
_D1@ 0x3f AND ( low 6 bits are good )
( Start and A are returned when TH is selected, in bits 5 and
4. Well get them, left-shift them and integrate them to B. )
0 _THA! ( output, low/selected )
_D1@ 0x30 AND 2 LSHIFT OR ;

8
arch/z80/sms/blk/614
View File

@ -1,8 +0,0 @@
: _chk ( c --, check _sel range )
_sel C@ DUP 0x7f > IF 0x20 _sel C! THEN
0x20 < IF 0x7f _sel C! THEN ;
CREATE _ '0' C, ':' C, 'A' C, '[' C, 'a' C, 0xff C,
: _nxtcls
_sel @ _ BEGIN ( c a ) C@+ 2 PICK > UNTIL ( c a )
1- C@ NIP _sel !
;

13
arch/z80/sms/blk/615
View File

@ -1,13 +0,0 @@
: _updsel ( -- f, has an action button been pressed? )
_status _prevstat C@ OVER = IF DROP 0 EXIT THEN
DUP _prevstat C! ( changed, update ) ( s )
0x01 ( UP ) OVER AND NOT IF 1 _sel +! THEN
0x02 ( DOWN ) OVER AND NOT IF -1 _sel +! THEN
0x04 ( LEFT ) OVER AND NOT IF -5 _sel +! THEN
0x08 ( RIGHT ) OVER AND NOT IF 5 _sel +! THEN
0x10 ( BUTB ) OVER AND NOT IF _nxtcls THEN
( update sel in VDP )
_chk _sel C@ (emit) -1 XYPOS +!
( return whether any of the high 3 bits is low )
0xe0 AND 0xe0 <
;

9
arch/z80/sms/blk/616
View File

@ -1,9 +0,0 @@
: (key)
_next C@ IF _next C@ 0 _next C! EXIT THEN
BEGIN _updsel UNTIL
_prevstat C@
0x20 ( BUTC ) OVER AND NOT IF DROP _sel C@ EXIT THEN
0x40 ( BUTA ) AND NOT IF 0x8 ( BS ) EXIT THEN
( If not BUTC or BUTA, it has to be START )
0xd _next C! _sel C@
;

2
arch/z80/sms/blk/617
View File

@ -1,2 +0,0 @@
: PAD$
0xff _prevstat C! 'a' _sel C! 0 _next C! ;

12
arch/z80/sms/blk/620
View File

@ -1,12 +0,0 @@
( kbd - implement (ps2kc) for SMS PS/2 adapter )
: (ps2kcA) ( for port A )
( Before reading a character, we must first verify that there
is something to read. When the adapter is finished filling its
'164 up, it resets the latch, which output's is connected to
TL. When the '164 is full, TL is low. Port A TL is bit 4 )
_D1@ 0x10 AND IF 0 EXIT ( nothing ) THEN
0 _THA! ( Port A TH output, low )
_D1@ ( bit 3:0 go in 3:0 ) 0x0f AND ( n )
1 _THA! ( Port A TH output, high )
_D1@ ( bit 3:0 go in 7:4 ) 0x0f AND 4 LSHIFT OR ( n )
2 _THA! ( TH input ) ;

10
arch/z80/sms/blk/621
View File

@ -1,10 +0,0 @@
: (ps2kcB) ( for port B )
( Port B TL is bit 2 )
_D2@ 0x04 AND IF 0 EXIT ( nothing ) THEN
0 _THB! ( Port B TH output, low )
_D1@ ( bit 7:6 go in 1:0 ) 6 RSHIFT ( n )
_D2@ ( bit 1:0 go in 3:2 ) 0x03 AND 2 LSHIFT OR ( n )
1 _THB! ( Port B TH output, high )
_D1@ ( bit 7:6 go in 5:4 ) 0xc0 AND 2 RSHIFT OR ( n )
_D2@ ( bit 1:0 go in 7:6 ) 0x03 AND 6 LSHIFT OR ( n )
2 _THB! ( TH input ) ;

10
arch/z80/sms/blk/622
View File

@ -1,10 +0,0 @@
: (spie) DROP ; ( always enabled )
: (spix) ( x -- x, for port B )
0 SWAP ( rx tx ) 8 0 DO
( send current bit to TRB, TR's output bit )
DUP 7 I - RSHIFT 1 AND _TRB!
1 _THB! ( CLK hi )
( read into rx ) SWAP 1 LSHIFT _D1@ ( tx rx<< x )
0 _THB! ( CLK lo )
( out bit is the 6th ) 6 RSHIFT 1 AND OR
SWAP LOOP ( rx tx ) DROP ;

16
arch/z80/sms/blk/625
View File

@ -1,16 +0,0 @@
( Routines for interacting with SMS controller ports.
Requires CPORT_MEM, CPORT_CTL, CPORT_D1 and CPORT_D2 to be
defined. CPORT_MEM is a 1 byte buffer for CPORT_CTL. The last
3 consts will usually be 0x3f, 0xdc, 0xdd. )
( mode -- set TR pin on mode a on:
0= output low 1=output high 2=input )
CODE _TRA! HL POP, chkPS, ( B0 -> B4, B1 -> B0 )
L RR, RLA, RLA, RLA, RLA, L RR, RLA,
0x11 ANDi, L A LDrr, CPORT_MEM LDA(i),
0xee ANDi, L ORr, CPORT_CTL OUTiA, CPORT_MEM LD(i)A,
;CODE
CODE _THA! HL POP, chkPS, ( B0 -> B5, B1 -> B1 )
L RR, RLA, RLA, RLA, RLA, L RR, RLA, RLA,
0x22 ANDi, L A LDrr, CPORT_MEM LDA(i),
0xdd ANDi, L ORr, CPORT_CTL OUTiA, CPORT_MEM LD(i)A,
;CODE

12
arch/z80/sms/blk/626
View File

@ -1,12 +0,0 @@
CODE _TRB! HL POP, chkPS, ( B0 -> B6, B1 -> B2 )
L RR, RLA, RLA, RLA, RLA, L RR, RLA, RLA, RLA,
0x44 ANDi, L A LDrr, CPORT_MEM LDA(i),
0xbb ANDi, L ORr, CPORT_CTL OUTiA, CPORT_MEM LD(i)A,
;CODE
CODE _THB! HL POP, chkPS, ( B0 -> B7, B1 -> B3 )
L RR, RLA, RLA, RLA, RLA, L RR, RLA, RLA, RLA, RLA,
0x88 ANDi, L A LDrr, CPORT_MEM LDA(i),
0x77 ANDi, L ORr, CPORT_CTL OUTiA, CPORT_MEM LD(i)A,
;CODE
CODE _D1@ CPORT_D1 INAi, PUSHA, ;CODE
CODE _D2@ CPORT_D2 INAi, PUSHA, ;CODE

2
arch/z80/ti84/Makefile
View File

@ -16,7 +16,7 @@ $(BLKPACK):
$(MAKE) -C ../tools
blkfs: $(BLKPACK)
$(BLKPACK) $(BASE)/blk blk > $@
cat $(BASE)/blk.fs blk.fs | $(BLKPACK) > $@
$(STAGE):
$(MAKE) -C $(CDIR) stage

223
arch/z80/ti84/blk.fs Normal file
View File

@ -0,0 +1,223 @@
( ----- 600 )
TI-84+ Recipe
Support code for the TI-84+ recipe. Contains drivers for the
keyboard and LCD.
551 LCD 564 Keyboard
( ----- 601 )
TI-84+ LCD driver
Implement (emit) on TI-84+ (for now)'s LCD screen.
Load range: 555-560
The screen is 96x64 pixels. The 64 rows are addressed directly
with CMD_ROW but columns are addressed in chunks of 6 or 8 bits
(there are two modes).
In 6-bit mode, there are 16 visible columns. In 8-bit mode,
there are 12.
Note that "X-increment" and "Y-increment" work in the opposite
way than what most people expect. Y moves left and right, X
moves up and down.
(cont.)
( ----- 602 )
# Z-Offset
This LCD has a "Z-Offset" parameter, allowing to offset rows on
the screen however we wish. This is handy because it allows us
to scroll more efficiently. Instead of having to copy the LCD
ram around at each linefeed (or instead of having to maintain
an in-memory buffer), we can use this feature.
The Z-Offset goes upwards, with wrapping. For example, if we
have an 8 pixels high line at row 0 and if our offset is 8,
that line will go up 8 pixels, wrapping itself to the bottom of
the screen.
The principle is this: The active line is always the bottom
one. Therefore, when active row is 0, Z is FNTH+1, when row is
1, Z is (FNTH+1)*2, When row is 8, Z is 0. (cont.)
( ----- 603 )
# 6/8 bit columns and smaller fonts
If your glyphs, including padding, are 6 or 8 pixels wide,
you're in luck because pushing them to the LCD can be done in a
very efficient manner. Unfortunately, this makes the LCD
unsuitable for a Collapse OS shell: 6 pixels per glyph gives us
only 16 characters per line, which is hardly usable.
This is why we have this buffering system. How it works is that
we're always in 8-bit mode and we hold the whole area (8 pixels
wide by FNTH high) in memory. When we want to put a glyph to
screen, we first read the contents of that area, then add our
new glyph, offsetted and masked, to that buffer, then push the
buffer back to the LCD. If the glyph is split, move to the next
area and finish the job.
(cont.)
( ----- 604 )
That being said, it's important to define clearly what CURX and
CURY variable mean. Those variable keep track of the current
position *in pixels*, in both axes.
( ----- 605 )
( Required config: LCD_MEM )
: _mem+ [ LCD_MEM LITN ] @ + ;
: FNTW 3 ; : FNTH 5 ;
: COLS 96 FNTW 1+ / ; : LINES 64 FNTH 1+ / ;
( Wait until the lcd is ready to receive a command. It's a bit
weird to implement a waiting routine in asm, but the forth
version is a bit heavy and we don't want to wait longer than
we have to. )
CODE _wait
BEGIN,
0x10 ( CMD ) INAi,
RLA, ( When 7th bit is clr, we can send a new cmd )
JRC, AGAIN,
;CODE
( ----- 606 )
( two pixel buffers that are 8 pixels wide (1b) by FNTH
pixels high. This is where we compose our resulting pixels
blocks when spitting a glyph. )
: LCD_BUF 0 _mem+ ;
: _cmd 0x10 ( CMD ) PC! _wait ;
: _data! 0x11 ( DATA ) PC! _wait ;
: _data@ 0x11 ( DATA ) PC@ _wait ;
: LCDOFF 0x02 ( CMD_DISABLE ) _cmd ;
: LCDON 0x03 ( CMD_ENABLE ) _cmd ;
( ----- 607 )
: _yinc 0x07 _cmd ; : _xinc 0x05 _cmd ;
: _zoff! ( off -- ) 0x40 + _cmd ;
: _col! ( col -- ) 0x20 + _cmd ;
: _row! ( row -- ) 0x80 + _cmd ;
: LCD$
H@ [ LCD_MEM LITN ] ! FNTH 2 * ALLOT
LCDON 0x01 ( 8-bit mode ) _cmd
FNTH 1+ _zoff!
;
( ----- 608 )
: _clrrows ( n u -- Clears u rows starting at n )
SWAP _row!
( u ) 0 DO
_yinc 0 _col!
11 0 DO 0 _data! LOOP
_xinc 0 _data!
LOOP ;
: NEWLN ( ln -- )
DUP 1+ FNTH 1+ * _zoff!
FNTH 1+ * FNTH 1+ _clrrows ;
: LCDCLR 0 64 _clrrows ;
( ----- 609 )
: _atrow! ( pos -- ) COLS / FNTH 1+ * _row! ;
: _tocol ( pos -- col off ) COLS MOD FNTW 1+ * 8 /MOD ;
: CELL! ( g pos -- )
DUP _atrow! DUP _tocol _col! ROT ( pos coff g )
FNTH * ~FNT + ( pos coff a )
_xinc _data@ DROP
FNTH 0 DO ( pos coff a )
C@+ 2 PICK 8 -^ LSHIFT
_data@ 8 LSHIFT OR
LCD_BUF I + 2DUP FNTH + C!
SWAP 8 RSHIFT SWAP C!
LOOP 2DROP
DUP _atrow!
FNTH 0 DO LCD_BUF I + C@ _data! LOOP
DUP _atrow! _tocol NIP 1+ _col!
FNTH 0 DO LCD_BUF FNTH + I + C@ _data! LOOP ;
( ----- 614 )
Keyboard driver
Load range: 566-570
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.
This routine waits for a key to be pressed, but before that, it
waits for all keys to be de-pressed. It does that to ensure
that two calls to _wait only go through after two actual key
presses (otherwise, the user doesn't have enough time to
de-press the button before the next _wait routine registers the
same key press as a second one).
(cont.)
( ----- 615 )
Sending 0xff to the port resets the keyboard, and then we have
to send groups we want to "listen" to, with a 0 in the group
bit. Thus, to know if *any* key is pressed, we send 0xff to
reset the keypad, then 0x00 to select all groups, if the result
isn't 0xff, at least one key is pressed.
( ----- 616 )
( Requires KBD_MEM, KBD_PORT )
( gm -- pm, get pressed keys mask for group mask gm )
CODE _get
HL POP,
chkPS,
DI,
A 0xff LDri,
KBD_PORT OUTiA,
A L LDrr,
KBD_PORT OUTiA,
KBD_PORT INAi,
EI,
L A LDrr, HL PUSH,
;CODE
( ----- 617 )
( wait until all keys are de-pressed. To avoid repeat keys, we
require 64 subsequent polls to indicate all depressed keys.
all keys are considered depressed when the 0 group returns
0xff. )
: _wait 64 BEGIN 0 _get 0xff = NOT IF DROP 64 THEN
1- DUP NOT UNTIL DROP ;
( digits table. each row represents a group. 0 means
unsupported. no group 7 because it has no key. )
CREATE _dtbl
0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C,
0xd C, '+' C, '-' C, '*' C, '/' C, '^' C, 0 C, 0 C,
0 C, '3' C, '6' C, '9' C, ')' C, 0 C, 0 C, 0 C,
'.' C, '2' C, '5' C, '8' C, '(' C, 0 C, 0 C, 0 C,
'0' C, '1' C, '4' C, '7' C, ',' C, 0 C, 0 C, 0 C,
0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0x80 ( alpha ) C,
0 C, 0 C, 0 C, 0 C, 0 C, 0x81 ( 2nd ) C, 0 C, 0x7f C,
( ----- 618 )
( alpha table. same as _dtbl, for when we're in alpha mode. )
CREATE _atbl
0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C,
0xd C, '"' C, 'W' C, 'R' C, 'M' C, 'H' C, 0 C, 0 C,
'?' C, 0 C, 'V' C, 'Q' C, 'L' C, 'G' C, 0 C, 0 C,
':' C, 'Z' C, 'U' C, 'P' C, 'K' C, 'F' C, 'C' 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, 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! ;
( ----- 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 )
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
;
: KBD$ 0 [ KBD_MEM LITN ] C! ;

6
arch/z80/ti84/blk/600
View File

@ -1,6 +0,0 @@
TI-84+ Recipe
Support code for the TI-84+ recipe. Contains drivers for the
keyboard and LCD.
551 LCD 564 Keyboard

16
arch/z80/ti84/blk/601
View File

@ -1,16 +0,0 @@
TI-84+ LCD driver
Implement (emit) on TI-84+ (for now)'s LCD screen.
Load range: 555-560
The screen is 96x64 pixels. The 64 rows are addressed directly
with CMD_ROW but columns are addressed in chunks of 6 or 8 bits
(there are two modes).
In 6-bit mode, there are 16 visible columns. In 8-bit mode,
there are 12.
Note that "X-increment" and "Y-increment" work in the opposite
way than what most people expect. Y moves left and right, X
moves up and down.
(cont.)

16
arch/z80/ti84/blk/602
View File

@ -1,16 +0,0 @@
# Z-Offset
This LCD has a "Z-Offset" parameter, allowing to offset rows on
the screen however we wish. This is handy because it allows us
to scroll more efficiently. Instead of having to copy the LCD
ram around at each linefeed (or instead of having to maintain
an in-memory buffer), we can use this feature.
The Z-Offset goes upwards, with wrapping. For example, if we
have an 8 pixels high line at row 0 and if our offset is 8,
that line will go up 8 pixels, wrapping itself to the bottom of
the screen.
The principle is this: The active line is always the bottom
one. Therefore, when active row is 0, Z is FNTH+1, when row is
1, Z is (FNTH+1)*2, When row is 8, Z is 0. (cont.)

16
arch/z80/ti84/blk/603
View File

@ -1,16 +0,0 @@
# 6/8 bit columns and smaller fonts
If your glyphs, including padding, are 6 or 8 pixels wide,
you're in luck because pushing them to the LCD can be done in a
very efficient manner. Unfortunately, this makes the LCD
unsuitable for a Collapse OS shell: 6 pixels per glyph gives us
only 16 characters per line, which is hardly usable.
This is why we have this buffering system. How it works is that
we're always in 8-bit mode and we hold the whole area (8 pixels
wide by FNTH high) in memory. When we want to put a glyph to
screen, we first read the contents of that area, then add our
new glyph, offsetted and masked, to that buffer, then push the
buffer back to the LCD. If the glyph is split, move to the next
area and finish the job.
(cont.)

3
arch/z80/ti84/blk/604
View File

@ -1,3 +0,0 @@
That being said, it's important to define clearly what CURX and
CURY variable mean. Those variable keep track of the current
position *in pixels*, in both axes.

14
arch/z80/ti84/blk/605
View File

@ -1,14 +0,0 @@
( Required config: LCD_MEM )
: _mem+ [ LCD_MEM LITN ] @ + ;
: FNTW 3 ; : FNTH 5 ;
: COLS 96 FNTW 1+ / ; : LINES 64 FNTH 1+ / ;
( Wait until the lcd is ready to receive a command. It's a bit
weird to implement a waiting routine in asm, but the forth
version is a bit heavy and we don't want to wait longer than
we have to. )
CODE _wait
BEGIN,
0x10 ( CMD ) INAi,
RLA, ( When 7th bit is clr, we can send a new cmd )
JRC, AGAIN,
;CODE

9
arch/z80/ti84/blk/606
View File

@ -1,9 +0,0 @@
( two pixel buffers that are 8 pixels wide (1b) by FNTH
pixels high. This is where we compose our resulting pixels
blocks when spitting a glyph. )
: LCD_BUF 0 _mem+ ;
: _cmd 0x10 ( CMD ) PC! _wait ;
: _data! 0x11 ( DATA ) PC! _wait ;
: _data@ 0x11 ( DATA ) PC@ _wait ;
: LCDOFF 0x02 ( CMD_DISABLE ) _cmd ;
: LCDON 0x03 ( CMD_ENABLE ) _cmd ;

9
arch/z80/ti84/blk/607
View File

@ -1,9 +0,0 @@
: _yinc 0x07 _cmd ; : _xinc 0x05 _cmd ;
: _zoff! ( off -- ) 0x40 + _cmd ;
: _col! ( col -- ) 0x20 + _cmd ;
: _row! ( row -- ) 0x80 + _cmd ;
: LCD$
H@ [ LCD_MEM LITN ] ! FNTH 2 * ALLOT
LCDON 0x01 ( 8-bit mode ) _cmd
FNTH 1+ _zoff!
;

11
arch/z80/ti84/blk/608
View File

@ -1,11 +0,0 @@
: _clrrows ( n u -- Clears u rows starting at n )
SWAP _row!
( u ) 0 DO
_yinc 0 _col!
11 0 DO 0 _data! LOOP
_xinc 0 _data!
LOOP ;
: NEWLN ( ln -- )
DUP 1+ FNTH 1+ * _zoff!
FNTH 1+ * FNTH 1+ _clrrows ;
: LCDCLR 0 64 _clrrows ;

16
arch/z80/ti84/blk/609
View File

@ -1,16 +0,0 @@
: _atrow! ( pos -- ) COLS / FNTH 1+ * _row! ;
: _tocol ( pos -- col off ) COLS MOD FNTW 1+ * 8 /MOD ;
: CELL! ( g pos -- )
DUP _atrow! DUP _tocol _col! ROT ( pos coff g )
FNTH * ~FNT + ( pos coff a )
_xinc _data@ DROP
FNTH 0 DO ( pos coff a )
C@+ 2 PICK 8 -^ LSHIFT
_data@ 8 LSHIFT OR
LCD_BUF I + 2DUP FNTH + C!
SWAP 8 RSHIFT SWAP C!
LOOP 2DROP
DUP _atrow!
FNTH 0 DO LCD_BUF I + C@ _data! LOOP
DUP _atrow! _tocol NIP 1+ _col!
FNTH 0 DO LCD_BUF FNTH + I + C@ _data! LOOP ;

16
arch/z80/ti84/blk/614
View File

@ -1,16 +0,0 @@
Keyboard driver
Load range: 566-570
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.
This routine waits for a key to be pressed, but before that, it
waits for all keys to be de-pressed. It does that to ensure
that two calls to _wait only go through after two actual key
presses (otherwise, the user doesn't have enough time to
de-press the button before the next _wait routine registers the
same key press as a second one).
(cont.)

5
arch/z80/ti84/blk/615
View File

@ -1,5 +0,0 @@
Sending 0xff to the port resets the keyboard, and then we have
to send groups we want to "listen" to, with a 0 in the group
bit. Thus, to know if *any* key is pressed, we send 0xff to
reset the keypad, then 0x00 to select all groups, if the result
isn't 0xff, at least one key is pressed.

14
arch/z80/ti84/blk/616
View File

@ -1,14 +0,0 @@
( Requires KBD_MEM, KBD_PORT )
( gm -- pm, get pressed keys mask for group mask gm )
CODE _get
HL POP,
chkPS,
DI,
A 0xff LDri,
KBD_PORT OUTiA,
A L LDrr,
KBD_PORT OUTiA,
KBD_PORT INAi,
EI,
L A LDrr, HL PUSH,
;CODE

16
arch/z80/ti84/blk/617
View File

@ -1,16 +0,0 @@
( wait until all keys are de-pressed. To avoid repeat keys, we
require 64 subsequent polls to indicate all depressed keys.
all keys are considered depressed when the 0 group returns
0xff. )
: _wait 64 BEGIN 0 _get 0xff = NOT IF DROP 64 THEN
1- DUP NOT UNTIL DROP ;
( digits table. each row represents a group. 0 means
unsupported. no group 7 because it has no key. )
CREATE _dtbl
0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C,
0xd C, '+' C, '-' C, '*' C, '/' C, '^' C, 0 C, 0 C,
0 C, '3' C, '6' C, '9' C, ')' C, 0 C, 0 C, 0 C,
'.' C, '2' C, '5' C, '8' C, '(' C, 0 C, 0 C, 0 C,
'0' C, '1' C, '4' C, '7' C, ',' C, 0 C, 0 C, 0 C,
0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0x80 ( alpha ) C,
0 C, 0 C, 0 C, 0 C, 0 C, 0x81 ( 2nd ) C, 0 C, 0x7f C,

13
arch/z80/ti84/blk/618
View File

@ -1,13 +0,0 @@
( alpha table. same as _dtbl, for when we're in alpha mode. )
CREATE _atbl
0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C,
0xd C, '"' C, 'W' C, 'R' C, 'M' C, 'H' C, 0 C, 0 C,
'?' C, 0 C, 'V' C, 'Q' C, 'L' C, 'G' C, 0 C, 0 C,
':' C, 'Z' C, 'U' C, 'P' C, 'K' C, 'F' C, 'C' 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, 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! ;

12
arch/z80/ti84/blk/619
View File

@ -1,12 +0,0 @@
: _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 )
0xff XOR ( dpos ) 0 ( dindex )
BEGIN 1+ 2DUP RSHIFT NOT UNTIL 1-
( gid dpos dindex ) NIP
( gid dindex ) SWAP 8 * + ;

14
arch/z80/ti84/blk/620
View File

@ -1,14 +0,0 @@
: _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
;
: KBD$ 0 [ KBD_MEM LITN ] C! ;

2
arch/z80/trs80/Makefile
View File

@ -13,7 +13,7 @@ $(BLKPACK):
$(MAKE) -C ../tools
blkfs: $(BLKPACK)
$(BLKPACK) $(BASE)/blk blk > $@
cat $(BASE)/blk.fs blk.fs | $(BLKPACK) > $@
$(STAGE):
$(MAKE) -C $(BASE)/cvm stage

136
arch/z80/trs80/blk.fs Normal file
View File

@ -0,0 +1,136 @@
( ----- 600 )
TRS-80 Recipe
Support code for the TRS-80 recipe. Contains drivers for the
keyboard, video and floppy. At the moment, they are thin layer
over the drivers provided by TRSDOS' SVC.
Load with "602 LOAD".
There is also the RECV program at B612.
( ----- 602 )
1 8 LOADR+
( ----- 603 )
CODE (key)
A 0x01 LDri, ( @KEY )
0x28 RST,
PUSHA,
;CODE
CODE (emit) EXX, ( protect BC )
BC POP, ( c == @DSP arg ) chkPS,
A 0x02 LDri, ( @DSP )
0x28 RST,
EXX, ( unprotect BC ) ;CODE
CODE AT-XY EXX, ( protect BC )
DE POP, H E LDrr, ( Y )
DE POP, L E LDrr, ( X ) chkPS,
A 0x0f LDri, ( @VDCTL ) B 3 LDri, ( setcur )
0x28 RST,
EXX, ( unprotect BC ) ;CODE
( ----- 604 )
: LINES 24 ; : COLS 80 ;
CODE BYE
HL 0 LDdi,
A 0x16 LDri, ( @EXIT )
0x28 RST,
CODE @DCSTAT ( drv -- f ) EXX, ( protect BC )
BC POP,
chkPS,
A 0x28 LDri, ( @DCSTAT )
0x28 RST,
PUSHZ,
EXX, ( unprotect BC ) ;CODE
( ----- 605 )
CODE @RDSEC ( drv cylsec addr -- f ) EXX, ( protect BC )
HL POP,
DE POP,
BC POP,
chkPS,
A 0x31 LDri, ( @RDSEC )
0x28 RST,
PUSHZ,
EXX, ( unprotect BC ) ;CODE
( ----- 606 )
CODE @WRSEC ( drv cylsec addr -- f ) EXX, ( protect BC )
HL POP,
DE POP,
BC POP,
chkPS,
A 0x35 LDri, ( @WRSEC )
0x28 RST,
PUSHZ,
EXX, ( unprotect BC ) ;CODE
CODE @GET ( a -- c f )
DE POP,
chkPS,
A 0x03 LDri, ( @GET )
0x28 RST,
PUSHA, PUSHZ,
;CODE
( ----- 607 )
CODE @PUT ( c a -- f ) EXX, ( protect BC )
DE POP,
BC POP,
chkPS,
A 0x04 LDri, ( @PUT )
0x28 RST,
PUSHZ,
EXX, ( unprotect BC ) ;CODE
( ----- 609 )
: _err LIT" FDerr" ERR ;
: _cylsec ( sec -- cs, return sector/cylinder for given secid )
( 4 256b sectors per block, 10 sec per cyl, 40 cyl max )
10 /MOD ( sec cyl )
DUP 39 > IF _err THEN
8 LSHIFT + ( cylsec )
;
: FD@! ( wref blk -- )
1 @DCSTAT NOT IF _err THEN
2 LSHIFT ( 4 * -- wr sec )
4 0 DO ( wr sec )
DUP I + _cylsec ( wr sec cs )
I 8 LSHIFT BLK( + ( wr sec cs addr )
1 ROT ROT ( wr sec drv cs addr )
4 PICK EXECUTE NOT IF _err THEN
LOOP 2DROP ;
( ----- 610 )
: FD@ ['] @RDSEC SWAP FD@! ;
: FD! ['] @WRSEC SWAP FD@! ;
: FD$ ['] FD@ BLK@* ! ['] FD! BLK!* ! ;
: _err LIT" *CLerr" ERR ;
: *CL< 0 BEGIN DROP 0x0238 @GET UNTIL ;
: *CL> 0x0238 @PUT NOT IF _err THEN ;
( ----- 612 )
( We process the 0x20 exception by pre-putting a mask in the
(HL) we're going to write to. If it wasn't a 0x20, we put a
0xff mask. If it was a 0x20, we put a 0x7f mask. )
: @GET,
A 0x03 LDri, ( @GET )
DE COM_DRV_ADDR LDdi,
0x28 RST, JRNZ, L2 FWR ( maybeerror )
A ORr,
CZ RETc, ( Sending a straight NULL ends the comm. ) ;
: @PUT, ( @PUT that char back )
C A LDrr,
A 0x04 LDri, ( @PUT )
0x28 RST, JRNZ, L3 FWR ( error )
A C LDrr, ;
H@ ORG !
HL DEST_ADDR LDdi, ( cont. )
( ----- 613 )
BEGIN,
A 0xff LDri, (HL) A LDrr, ( default mask )
L1 BSET ( loop2 ) @GET, @PUT,
0x20 CPi, JRZ, L4 FWR ( escapechar )
( not an escape char, just apply the mask and write )
(HL) ANDr, (HL) A LDrr,
HL INCd,
JR, AGAIN,
L4 FSET ( escapechar, adjust by setting (hl) to 0x7f )
7 (HL) RES, JR, L1 BWR ( loop2 )
L2 FSET ( maybeerror, was it an error? )
A ORr, JRZ, L1 BWR ( loop2, not an error )
L3 FSET ( error )
C A LDrr, ( error code from @GET/@PUT )
A 0x1a LDri, ( @ERROR ) 0x28 RST, RET,

9
arch/z80/trs80/blk/600
View File

@ -1,9 +0,0 @@
TRS-80 Recipe
Support code for the TRS-80 recipe. Contains drivers for the
keyboard, video and floppy. At the moment, they are thin layer
over the drivers provided by TRSDOS' SVC.
Load with "602 LOAD".
There is also the RECV program at B612.

1
arch/z80/trs80/blk/602
View File

@ -1 +0,0 @@
1 8 LOADR+

16
arch/z80/trs80/blk/603
View File

@ -1,16 +0,0 @@
CODE (key)
A 0x01 LDri, ( @KEY )
0x28 RST,
PUSHA,
;CODE
CODE (emit) EXX, ( protect BC )
BC POP, ( c == @DSP arg ) chkPS,
A 0x02 LDri, ( @DSP )
0x28 RST,
EXX, ( unprotect BC ) ;CODE
CODE AT-XY EXX, ( protect BC )
DE POP, H E LDrr, ( Y )
DE POP, L E LDrr, ( X ) chkPS,
A 0x0f LDri, ( @VDCTL ) B 3 LDri, ( setcur )
0x28 RST,
EXX, ( unprotect BC ) ;CODE

12
arch/z80/trs80/blk/604
View File

@ -1,12 +0,0 @@
: LINES 24 ; : COLS 80 ;
CODE BYE
HL 0 LDdi,
A 0x16 LDri, ( @EXIT )
0x28 RST,
CODE @DCSTAT ( drv -- f ) EXX, ( protect BC )
BC POP,
chkPS,
A 0x28 LDri, ( @DCSTAT )
0x28 RST,
PUSHZ,
EXX, ( unprotect BC ) ;CODE

9
arch/z80/trs80/blk/605
View File

@ -1,9 +0,0 @@
CODE @RDSEC ( drv cylsec addr -- f ) EXX, ( protect BC )
HL POP,
DE POP,
BC POP,
chkPS,
A 0x31 LDri, ( @RDSEC )
0x28 RST,
PUSHZ,
EXX, ( unprotect BC ) ;CODE

16
arch/z80/trs80/blk/606
View File

@ -1,16 +0,0 @@
CODE @WRSEC ( drv cylsec addr -- f ) EXX, ( protect BC )
HL POP,
DE POP,
BC POP,
chkPS,
A 0x35 LDri, ( @WRSEC )
0x28 RST,
PUSHZ,
EXX, ( unprotect BC ) ;CODE
CODE @GET ( a -- c f )
DE POP,
chkPS,
A 0x03 LDri, ( @GET )
0x28 RST,
PUSHA, PUSHZ,
;CODE

8
arch/z80/trs80/blk/607
View File

@ -1,8 +0,0 @@
CODE @PUT ( c a -- f ) EXX, ( protect BC )
DE POP,
BC POP,
chkPS,
A 0x04 LDri, ( @PUT )
0x28 RST,
PUSHZ,
EXX, ( unprotect BC ) ;CODE

16
arch/z80/trs80/blk/609
View File

@ -1,16 +0,0 @@
: _err LIT" FDerr" ERR ;
: _cylsec ( sec -- cs, return sector/cylinder for given secid )
( 4 256b sectors per block, 10 sec per cyl, 40 cyl max )
10 /MOD ( sec cyl )
DUP 39 > IF _err THEN
8 LSHIFT + ( cylsec )
;
: FD@! ( wref blk -- )
1 @DCSTAT NOT IF _err THEN
2 LSHIFT ( 4 * -- wr sec )
4 0 DO ( wr sec )
DUP I + _cylsec ( wr sec cs )
I 8 LSHIFT BLK( + ( wr sec cs addr )
1 ROT ROT ( wr sec drv cs addr )
4 PICK EXECUTE NOT IF _err THEN
LOOP 2DROP ;

7
arch/z80/trs80/blk/610
View File

@ -1,7 +0,0 @@
: FD@ ['] @RDSEC SWAP FD@! ;
: FD! ['] @WRSEC SWAP FD@! ;
: FD$ ['] FD@ BLK@* ! ['] FD! BLK!* ! ;
: _err LIT" *CLerr" ERR ;
: *CL< 0 BEGIN DROP 0x0238 @GET UNTIL ;
: *CL> 0x0238 @PUT NOT IF _err THEN ;

16
arch/z80/trs80/blk/612
View File

@ -1,16 +0,0 @@
( We process the 0x20 exception by pre-putting a mask in the
(HL) we're going to write to. If it wasn't a 0x20, we put a
0xff mask. If it was a 0x20, we put a 0x7f mask. )
: @GET,
A 0x03 LDri, ( @GET )
DE COM_DRV_ADDR LDdi,
0x28 RST, JRNZ, L2 FWR ( maybeerror )
A ORr,
CZ RETc, ( Sending a straight NULL ends the comm. ) ;
: @PUT, ( @PUT that char back )
C A LDrr,
A 0x04 LDri, ( @PUT )
0x28 RST, JRNZ, L3 FWR ( error )
A C LDrr, ;
H@ ORG !
HL DEST_ADDR LDdi, ( cont. )

15
arch/z80/trs80/blk/613
View File

@ -1,15 +0,0 @@
BEGIN,
A 0xff LDri, (HL) A LDrr, ( default mask )
L1 BSET ( loop2 ) @GET, @PUT,
0x20 CPi, JRZ, L4 FWR ( escapechar )
( not an escape char, just apply the mask and write )
(HL) ANDr, (HL) A LDrr,
HL INCd,
JR, AGAIN,
L4 FSET ( escapechar, adjust by setting (hl) to 0x7f )
7 (HL) RES, JR, L1 BWR ( loop2 )
L2 FSET ( maybeerror, was it an error? )
A ORr, JRZ, L1 BWR ( loop2, not an error )
L3 FSET ( error )
C A LDrr, ( error code from @GET/@PUT )
A 0x1a LDri, ( @ERROR ) 0x28 RST, RET,

3069
blk.fs Normal file
View File

File diff suppressed because it is too large Load Diff

16
blk/000
View File

@ -1,16 +0,0 @@
Collapse OS
This is the first block of Collapse OS' filesystem which cons-
ists of contiguous blocks of 1024 bytes organized in 16 lines
of 64 characters. You can display a block's content with the
"LIST" command. For example, "123 LIST" shows the contents of
the block 123. If a block contains source code, you can inter-
pret it with "LOAD".
Conventions: When you see "(cont.)" at the bottom right of a
block, it means that the next block continues the same kind of
contents. Block numbers are abbreviated with prefix "B". "BX"
means "block X".
The master index of this filesystem is at B1. You can navi-
gate and edit blocks with the Visual Editor at B120.

13
blk/001
View File

@ -1,13 +0,0 @@
MASTER INDEX
005 Z80 assembler 030 8086 assembler
050 AVR assembler 70-99 unused
100 Block editor 120 Visual Editor
160 AVR SPI programmer
170-259 unused 260 Cross compilation
280 Z80 boot code 350 Core words
400 AT28 EEPROM driver 401 Grid subsystem
410 PS/2 keyboard subsystem 418 Z80 SPI Relay driver
420 SD Card subsystem 440 8086 boot code
470 Z80 TMS9918 driver
480-519 unused 520 Fonts

13
blk/005
View File

@ -1,13 +0,0 @@
( Z80 Assembler
006 Variables & consts
007 Utils 008 OP1
010 OP1r 012 OP1d
013 OP1rr 015 OP2
016 OP2i 017 OP2ri
018 OP2br 019 OProt
020 OP2r 021 OP2d
022 OP3di 023 OP3i
024 Specials 025 Flow
028 Macros )
1 23 LOADR+

8
blk/006
View File

@ -1,8 +0,0 @@
CREATE ORG 0 ,
CREATE BIN( 0 ,
VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4
: A 7 ; : B 0 ; : C 1 ; : D 2 ;
: E 3 ; : H 4 ; : L 5 ; : (HL) 6 ;
: BC 0 ; : DE 1 ; : HL 2 ; : AF 3 ; : SP AF ;
: CNZ 0 ; : CZ 1 ; : CNC 2 ; : CC 3 ;
: CPO 4 ; : CPE 5 ; : CP 6 ; : CM 7 ;

16
blk/007
View File

@ -1,16 +0,0 @@
( Splits word into msb/lsb, lsb being on TOS )
: SPLITB
256 /MOD SWAP
;
: PC H@ ORG @ - BIN( @ + ;
( A, spits an assembled byte, A,, spits an assembled word
Both increase PC. )
: A,, SPLITB A, A, ;
: <<3 3 LSHIFT ; : <<4 4 LSHIFT ;
( As a general rule, IX and IY are equivalent to spitting an
extra 0xdd / 0xfd and then spit the equivalent of HL )
: IX 0xdd A, HL ; : IY 0xfd A, HL ;
: _ix+- 0xff AND 0xdd A, (HL) ;
: _iy+- 0xff AND 0xfd A, (HL) ;
: IX+ _ix+- ; : IX- 0 -^ _ix+- ;
: IY+ _iy+- ; : IY- 0 -^ _iy+- ;

11
blk/008
View File

@ -1,11 +0,0 @@
: OP1 CREATE C, DOES> C@ A, ;
0xf3 OP1 DI, 0xfb OP1 EI,
0xeb OP1 EXDEHL, 0xd9 OP1 EXX,
0x08 OP1 EXAFAF', 0xe3 OP1 EX(SP)HL,
0x76 OP1 HALT, 0xe9 OP1 JP(HL),
0x12 OP1 LD(DE)A, 0x1a OP1 LDA(DE),
0x02 OP1 LD(BC)A, 0x0a OP1 LDA(BC),
0x00 OP1 NOP, 0xc9 OP1 RET,
0x17 OP1 RLA, 0x07 OP1 RLCA,
0x1f OP1 RRA, 0x0f OP1 RRCA,
0x37 OP1 SCF,

9
blk/009
View File

@ -1,9 +0,0 @@
( Relative jumps are a bit special. They're supposed to take
an argument, but they don't take it so they can work with
the label system. Therefore, relative jumps are an OP1 but
when you use them, you're expected to write the offset
afterwards yourself. )
0x18 OP1 JR, 0x10 OP1 DJNZ,
0x38 OP1 JRC, 0x30 OP1 JRNC,
0x28 OP1 JRZ, 0x20 OP1 JRNZ,

14
blk/010
View File

@ -1,14 +0,0 @@
( r -- )
: OP1r
CREATE C,
DOES>
C@ ( r op )
SWAP ( op r )
<<3 ( op r<<3 )
OR A,
;
0x04 OP1r INCr, 0x05 OP1r DECr,
: INC(IXY+), INCr, A, ;
: DEC(IXY+), DECr, A, ;
( also works for c )
0xc0 OP1r RETc,

8
blk/011
View File

@ -1,8 +0,0 @@
: OP1r0 ( r -- )
CREATE C, DOES>
C@ ( r op ) OR A, ;
0x80 OP1r0 ADDr, 0x88 OP1r0 ADCr,
0xa0 OP1r0 ANDr, 0xb8 OP1r0 CPr,
0xb0 OP1r0 ORr, 0x90 OP1r0 SUBr,
0x98 OP1r0 SBCr, 0xa8 OP1r0 XORr,
: CP(IXY+), CPr, A, ;

14
blk/012
View File

@ -1,14 +0,0 @@
: OP1d
CREATE C,
DOES>
C@ ( d op )
SWAP ( op d )
<<4 ( op d<<4 )
OR A,
;
0xc5 OP1d PUSH, 0xc1 OP1d POP,
0x03 OP1d INCd, 0x0b OP1d DECd,
0x09 OP1d ADDHLd,
: ADDIXd, 0xdd A, ADDHLd, ; : ADDIXIX, HL ADDIXd, ;
: ADDIYd, 0xfd A, ADDHLd, ; : ADDIYIY, HL ADDIYd, ;

14
blk/013
View File

@ -1,14 +0,0 @@
: _1rr
C@ ( rd rr op )
ROT ( rr op rd )
<<3 ( rr op rd<<3 )
OR OR A,
;
( rd rr )
: OP1rr
CREATE C,
DOES>
_1rr
;
0x40 OP1rr LDrr,

13
blk/014
View File

@ -1,13 +0,0 @@
( ixy+- HL rd )
: LDIXYr,
( dd/fd has already been spit )
LDrr, ( ixy+- )
A,
;
( rd ixy+- HL )
: LDrIXY,
ROT ( ixy+- HL rd )
SWAP ( ixy+- rd HL )
LDIXYr,
;

9
blk/015
View File

@ -1,9 +0,0 @@
: OP2 CREATE , DOES> @ 256 /MOD A, A, ;
0xeda1 OP2 CPI, 0xedb1 OP2 CPIR,
0xeda9 OP2 CPD, 0xedb9 OP2 CPDR,
0xed46 OP2 IM0, 0xed56 OP2 IM1,
0xed5e OP2 IM2,
0xeda0 OP2 LDI, 0xedb0 OP2 LDIR,
0xeda8 OP2 LDD, 0xedb8 OP2 LDDR,
0xed44 OP2 NEG,
0xed4d OP2 RETI, 0xed45 OP2 RETN,

13
blk/016
View File

@ -1,13 +0,0 @@
: OP2i ( i -- )
CREATE C,
DOES>
C@ A, A,
;
0xd3 OP2i OUTiA,
0xdb OP2i INAi,
0xc6 OP2i ADDi,
0xe6 OP2i ANDi,
0xf6 OP2i ORi,
0xd6 OP2i SUBi,
0xee OP2i XORi,
0xfe OP2i CPi,

9
blk/017
View File

@ -1,9 +0,0 @@
: OP2ri ( r i -- )
CREATE C,
DOES>
C@ ( r i op )
ROT ( i op r )
<<3 ( i op r<<3 )
OR A, A,
;
0x06 OP2ri LDri,

13
blk/018
View File

@ -1,13 +0,0 @@
( b r -- )
: OP2br
CREATE C,
DOES>
0xcb A,
C@ ( b r op )
ROT ( r op b )
<<3 ( r op b<<3 )
OR OR A,
;
0xc0 OP2br SET,
0x80 OP2br RES,
0x40 OP2br BIT,

14
blk/019
View File

@ -1,14 +0,0 @@
( bitwise rotation ops have a similar sig )
: OProt ( r -- )
CREATE C,
DOES>
0xcb A,
C@ ( r op )
OR A,
;
0x10 OProt RL,
0x00 OProt RLC,
0x18 OProt RR,
0x08 OProt RRC,
0x20 OProt SLA,
0x38 OProt SRL,

13
blk/020
View File

@ -1,13 +0,0 @@
( cell contains both bytes. MSB is spit as-is, LSB is ORed
with r )
( r -- )
: OP2r
CREATE ,
DOES>
@ SPLITB SWAP ( r lsb msb )
A, ( r lsb )
SWAP <<3 ( lsb r<<3 )
OR A,
;
0xed41 OP2r OUT(C)r,
0xed40 OP2r INr(C),

10
blk/021
View File

@ -1,10 +0,0 @@
: OP2d ( d -- )
CREATE C,
DOES>
0xed A,
C@ SWAP ( op d )
<<4 ( op d<< 4 )
OR A,
;
0x4a OP2d ADCHLd,
0x42 OP2d SBCHLd,

11
blk/022
View File

@ -1,11 +0,0 @@
( d i -- )
: OP3di
CREATE C,
DOES>
C@ ( d n op )
ROT ( n op d )
<<4 ( n op d<<4 )
OR A,
A,,
;
0x01 OP3di LDdi,

11
blk/023
View File

@ -1,11 +0,0 @@
( i -- )
: OP3i
CREATE C,
DOES>
C@ A,
A,,
;
0xcd OP3i CALL,
0xc3 OP3i JP,
0x22 OP3i LD(i)HL, 0x2a OP3i LDHL(i),
0x32 OP3i LD(i)A, 0x3a OP3i LDA(i),

14
blk/024
View File

@ -1,14 +0,0 @@
: LDd(i), ( d i -- )
0xed A,
SWAP <<4 0x4b OR A,
A,,
;
: LD(i)d, ( i d -- )
0xed A,
<<4 0x43 OR A,
A,,
;
: RST, 0xc7 OR A, ;
: JP(IX), IX DROP JP(HL), ;
: JP(IY), IY DROP JP(HL), ;

12
blk/025
View File

@ -1,12 +0,0 @@
: JPc, SWAP <<3 0xc2 OR A, A,, ;
: BCALL, BIN( @ + CALL, ;
: BJP, BIN( @ + JP, ;
: BJPc, BIN( @ + JPc, ;
CREATE lblchkPS 0 ,
: chkPS, lblchkPS @ CALL, ; ( chkPS, B305 )
CREATE lblnext 0 , ( stable ABI until set in B300 )
: JPNEXT, lblnext @ ?DUP IF JP, ELSE 0x1a BJP, THEN ;
: CODE ( same as CREATE, but with native word )
(entry) 0 C, ( 0 == native ) ;
: ;CODE JPNEXT, ;

Some files were not shown because too many files have changed in this diff Show More