diff --git a/README.md b/README.md index b36d92e..137ad12 100644 --- a/README.md +++ b/README.md @@ -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] diff --git a/arch/8086/pcat/Makefile b/arch/8086/pcat/Makefile index 94f7aff..5fbd6c9 100644 --- a/arch/8086/pcat/Makefile +++ b/arch/8086/pcat/Makefile @@ -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 diff --git a/arch/8086/pcat/blk.fs b/arch/8086/pcat/blk.fs new file mode 100644 index 0000000..e724513 --- /dev/null +++ b/arch/8086/pcat/blk.fs @@ -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, diff --git a/arch/8086/pcat/blk/600 b/arch/8086/pcat/blk/600 deleted file mode 100644 index ce63d16..0000000 --- a/arch/8086/pcat/blk/600 +++ /dev/null @@ -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 diff --git a/arch/8086/pcat/blk/602 b/arch/8086/pcat/blk/602 deleted file mode 100644 index 2091f30..0000000 --- a/arch/8086/pcat/blk/602 +++ /dev/null @@ -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, diff --git a/arch/8086/pcat/blk/604 b/arch/8086/pcat/blk/604 deleted file mode 100644 index 04aa32f..0000000 --- a/arch/8086/pcat/blk/604 +++ /dev/null @@ -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 diff --git a/arch/8086/pcat/blk/606 b/arch/8086/pcat/blk/606 deleted file mode 100644 index 22838b4..0000000 --- a/arch/8086/pcat/blk/606 +++ /dev/null @@ -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+ ; diff --git a/arch/8086/pcat/blk/607 b/arch/8086/pcat/blk/607 deleted file mode 100644 index c6a117b..0000000 --- a/arch/8086/pcat/blk/607 +++ /dev/null @@ -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 -; diff --git a/arch/8086/pcat/blk/608 b/arch/8086/pcat/blk/608 deleted file mode 100644 index 25eb72f..0000000 --- a/arch/8086/pcat/blk/608 +++ /dev/null @@ -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! -; diff --git a/arch/8086/pcat/blk/610 b/arch/8086/pcat/blk/610 deleted file mode 100644 index a7f513c..0000000 --- a/arch/8086/pcat/blk/610 +++ /dev/null @@ -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 diff --git a/arch/8086/pcat/blk/612 b/arch/8086/pcat/blk/612 deleted file mode 100644 index 15c383a..0000000 --- a/arch/8086/pcat/blk/612 +++ /dev/null @@ -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, diff --git a/arch/z80/rc2014/Makefile b/arch/z80/rc2014/Makefile index 87a93e2..81f7c33 100644 --- a/arch/z80/rc2014/Makefile +++ b/arch/z80/rc2014/Makefile @@ -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 diff --git a/arch/z80/rc2014/blk.fs b/arch/z80/rc2014/blk.fs new file mode 100644 index 0000000..61a6bc1 --- /dev/null +++ b/arch/z80/rc2014/blk.fs @@ -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, diff --git a/arch/z80/rc2014/blk/600 b/arch/z80/rc2014/blk/600 deleted file mode 100644 index 7e55833..0000000 --- a/arch/z80/rc2014/blk/600 +++ /dev/null @@ -1,2 +0,0 @@ -601 ACIA 606 Zilog SIO driver -615 SPI relay 619 Xcomp unit diff --git a/arch/z80/rc2014/blk/601 b/arch/z80/rc2014/blk/601 deleted file mode 100644 index c54687a..0000000 --- a/arch/z80/rc2014/blk/601 +++ /dev/null @@ -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. diff --git a/arch/z80/rc2014/blk/602 b/arch/z80/rc2014/blk/602 deleted file mode 100644 index fa6f941..0000000 --- a/arch/z80/rc2014/blk/602 +++ /dev/null @@ -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. ) diff --git a/arch/z80/rc2014/blk/603 b/arch/z80/rc2014/blk/603 deleted file mode 100644 index 6c7f90d..0000000 --- a/arch/z80/rc2014/blk/603 +++ /dev/null @@ -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, diff --git a/arch/z80/rc2014/blk/604 b/arch/z80/rc2014/blk/604 deleted file mode 100644 index d8c58e2..0000000 --- a/arch/z80/rc2014/blk/604 +++ /dev/null @@ -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! -; diff --git a/arch/z80/rc2014/blk/605 b/arch/z80/rc2014/blk/605 deleted file mode 100644 index 6ac8ded..0000000 --- a/arch/z80/rc2014/blk/605 +++ /dev/null @@ -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) ; diff --git a/arch/z80/rc2014/blk/606 b/arch/z80/rc2014/blk/606 deleted file mode 100644 index ca714d2..0000000 --- a/arch/z80/rc2014/blk/606 +++ /dev/null @@ -1,5 +0,0 @@ -Zilog SIO driver - -Declarations at B607 - -Driver load range at B608-B610 diff --git a/arch/z80/rc2014/blk/607 b/arch/z80/rc2014/blk/607 deleted file mode 100644 index 523a4f7..0000000 --- a/arch/z80/rc2014/blk/607 +++ /dev/null @@ -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. ) diff --git a/arch/z80/rc2014/blk/608 b/arch/z80/rc2014/blk/608 deleted file mode 100644 index 7b6fcf8..0000000 --- a/arch/z80/rc2014/blk/608 +++ /dev/null @@ -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, diff --git a/arch/z80/rc2014/blk/609 b/arch/z80/rc2014/blk/609 deleted file mode 100644 index 2175d30..0000000 --- a/arch/z80/rc2014/blk/609 +++ /dev/null @@ -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! -; diff --git a/arch/z80/rc2014/blk/610 b/arch/z80/rc2014/blk/610 deleted file mode 100644 index 52f0039..0000000 --- a/arch/z80/rc2014/blk/610 +++ /dev/null @@ -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) -; diff --git a/arch/z80/rc2014/blk/619 b/arch/z80/rc2014/blk/619 deleted file mode 100644 index 50e3c68..0000000 --- a/arch/z80/rc2014/blk/619 +++ /dev/null @@ -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, diff --git a/arch/z80/sms/Makefile b/arch/z80/sms/Makefile index a2ab8dc..1f4b9ae 100644 --- a/arch/z80/sms/Makefile +++ b/arch/z80/sms/Makefile @@ -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 diff --git a/arch/z80/sms/blk.fs b/arch/z80/sms/blk.fs new file mode 100644 index 0000000..516435a --- /dev/null +++ b/arch/z80/sms/blk.fs @@ -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 diff --git a/arch/z80/sms/blk/600 b/arch/z80/sms/blk/600 deleted file mode 100644 index f24014a..0000000 --- a/arch/z80/sms/blk/600 +++ /dev/null @@ -1,4 +0,0 @@ -Sega Master System Recipe - -602 VDP 610 PAD -620 KBD 625 Ports diff --git a/arch/z80/sms/blk/602 b/arch/z80/sms/blk/602 deleted file mode 100644 index 28d617c..0000000 --- a/arch/z80/sms/blk/602 +++ /dev/null @@ -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?) ) diff --git a/arch/z80/sms/blk/603 b/arch/z80/sms/blk/603 deleted file mode 100644 index ef7ef09..0000000 --- a/arch/z80/sms/blk/603 +++ /dev/null @@ -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 ; diff --git a/arch/z80/sms/blk/604 b/arch/z80/sms/blk/604 deleted file mode 100644 index f3913e1..0000000 --- a/arch/z80/sms/blk/604 +++ /dev/null @@ -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 ; diff --git a/arch/z80/sms/blk/610 b/arch/z80/sms/blk/610 deleted file mode 100644 index ccfced2..0000000 --- a/arch/z80/sms/blk/610 +++ /dev/null @@ -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.) diff --git a/arch/z80/sms/blk/611 b/arch/z80/sms/blk/611 deleted file mode 100644 index de0da38..0000000 --- a/arch/z80/sms/blk/611 +++ /dev/null @@ -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 diff --git a/arch/z80/sms/blk/612 b/arch/z80/sms/blk/612 deleted file mode 100644 index 58d9a5b..0000000 --- a/arch/z80/sms/blk/612 +++ /dev/null @@ -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. ) diff --git a/arch/z80/sms/blk/613 b/arch/z80/sms/blk/613 deleted file mode 100644 index c6d4002..0000000 --- a/arch/z80/sms/blk/613 +++ /dev/null @@ -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 ; diff --git a/arch/z80/sms/blk/614 b/arch/z80/sms/blk/614 deleted file mode 100644 index 1fc3e5d..0000000 --- a/arch/z80/sms/blk/614 +++ /dev/null @@ -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 ! -; diff --git a/arch/z80/sms/blk/615 b/arch/z80/sms/blk/615 deleted file mode 100644 index 2ea7ea7..0000000 --- a/arch/z80/sms/blk/615 +++ /dev/null @@ -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 < -; diff --git a/arch/z80/sms/blk/616 b/arch/z80/sms/blk/616 deleted file mode 100644 index 6ea0980..0000000 --- a/arch/z80/sms/blk/616 +++ /dev/null @@ -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@ -; diff --git a/arch/z80/sms/blk/617 b/arch/z80/sms/blk/617 deleted file mode 100644 index 39cffdb..0000000 --- a/arch/z80/sms/blk/617 +++ /dev/null @@ -1,2 +0,0 @@ -: PAD$ - 0xff _prevstat C! 'a' _sel C! 0 _next C! ; diff --git a/arch/z80/sms/blk/620 b/arch/z80/sms/blk/620 deleted file mode 100644 index 164f362..0000000 --- a/arch/z80/sms/blk/620 +++ /dev/null @@ -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 ) ; diff --git a/arch/z80/sms/blk/621 b/arch/z80/sms/blk/621 deleted file mode 100644 index dce6c26..0000000 --- a/arch/z80/sms/blk/621 +++ /dev/null @@ -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 ) ; diff --git a/arch/z80/sms/blk/622 b/arch/z80/sms/blk/622 deleted file mode 100644 index 5be8ded..0000000 --- a/arch/z80/sms/blk/622 +++ /dev/null @@ -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 ; diff --git a/arch/z80/sms/blk/625 b/arch/z80/sms/blk/625 deleted file mode 100644 index 970cf69..0000000 --- a/arch/z80/sms/blk/625 +++ /dev/null @@ -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 diff --git a/arch/z80/sms/blk/626 b/arch/z80/sms/blk/626 deleted file mode 100644 index c7f9d10..0000000 --- a/arch/z80/sms/blk/626 +++ /dev/null @@ -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 diff --git a/arch/z80/ti84/Makefile b/arch/z80/ti84/Makefile index d602b89..50b5a7e 100644 --- a/arch/z80/ti84/Makefile +++ b/arch/z80/ti84/Makefile @@ -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 diff --git a/arch/z80/ti84/blk.fs b/arch/z80/ti84/blk.fs new file mode 100644 index 0000000..061f78f --- /dev/null +++ b/arch/z80/ti84/blk.fs @@ -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! ; diff --git a/arch/z80/ti84/blk/600 b/arch/z80/ti84/blk/600 deleted file mode 100644 index 5820af0..0000000 --- a/arch/z80/ti84/blk/600 +++ /dev/null @@ -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 diff --git a/arch/z80/ti84/blk/601 b/arch/z80/ti84/blk/601 deleted file mode 100644 index e27fedb..0000000 --- a/arch/z80/ti84/blk/601 +++ /dev/null @@ -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.) diff --git a/arch/z80/ti84/blk/602 b/arch/z80/ti84/blk/602 deleted file mode 100644 index f06e04c..0000000 --- a/arch/z80/ti84/blk/602 +++ /dev/null @@ -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.) diff --git a/arch/z80/ti84/blk/603 b/arch/z80/ti84/blk/603 deleted file mode 100644 index e8e9659..0000000 --- a/arch/z80/ti84/blk/603 +++ /dev/null @@ -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.) diff --git a/arch/z80/ti84/blk/604 b/arch/z80/ti84/blk/604 deleted file mode 100644 index 3d65dbc..0000000 --- a/arch/z80/ti84/blk/604 +++ /dev/null @@ -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. diff --git a/arch/z80/ti84/blk/605 b/arch/z80/ti84/blk/605 deleted file mode 100644 index 0cc07fb..0000000 --- a/arch/z80/ti84/blk/605 +++ /dev/null @@ -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 diff --git a/arch/z80/ti84/blk/606 b/arch/z80/ti84/blk/606 deleted file mode 100644 index 2c6929b..0000000 --- a/arch/z80/ti84/blk/606 +++ /dev/null @@ -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 ; diff --git a/arch/z80/ti84/blk/607 b/arch/z80/ti84/blk/607 deleted file mode 100644 index fca2988..0000000 --- a/arch/z80/ti84/blk/607 +++ /dev/null @@ -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! -; diff --git a/arch/z80/ti84/blk/608 b/arch/z80/ti84/blk/608 deleted file mode 100644 index dfc10cf..0000000 --- a/arch/z80/ti84/blk/608 +++ /dev/null @@ -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 ; diff --git a/arch/z80/ti84/blk/609 b/arch/z80/ti84/blk/609 deleted file mode 100644 index e27cc14..0000000 --- a/arch/z80/ti84/blk/609 +++ /dev/null @@ -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 ; diff --git a/arch/z80/ti84/blk/614 b/arch/z80/ti84/blk/614 deleted file mode 100644 index d21ac6a..0000000 --- a/arch/z80/ti84/blk/614 +++ /dev/null @@ -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.) diff --git a/arch/z80/ti84/blk/615 b/arch/z80/ti84/blk/615 deleted file mode 100644 index 510fd80..0000000 --- a/arch/z80/ti84/blk/615 +++ /dev/null @@ -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. diff --git a/arch/z80/ti84/blk/616 b/arch/z80/ti84/blk/616 deleted file mode 100644 index cebcca5..0000000 --- a/arch/z80/ti84/blk/616 +++ /dev/null @@ -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 diff --git a/arch/z80/ti84/blk/617 b/arch/z80/ti84/blk/617 deleted file mode 100644 index 1353dc0..0000000 --- a/arch/z80/ti84/blk/617 +++ /dev/null @@ -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, diff --git a/arch/z80/ti84/blk/618 b/arch/z80/ti84/blk/618 deleted file mode 100644 index 377fd39..0000000 --- a/arch/z80/ti84/blk/618 +++ /dev/null @@ -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! ; diff --git a/arch/z80/ti84/blk/619 b/arch/z80/ti84/blk/619 deleted file mode 100644 index dea7c07..0000000 --- a/arch/z80/ti84/blk/619 +++ /dev/null @@ -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 * + ; diff --git a/arch/z80/ti84/blk/620 b/arch/z80/ti84/blk/620 deleted file mode 100644 index 446e894..0000000 --- a/arch/z80/ti84/blk/620 +++ /dev/null @@ -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! ; diff --git a/arch/z80/trs80/Makefile b/arch/z80/trs80/Makefile index 0b82132..c711f3e 100644 --- a/arch/z80/trs80/Makefile +++ b/arch/z80/trs80/Makefile @@ -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 diff --git a/arch/z80/trs80/blk.fs b/arch/z80/trs80/blk.fs new file mode 100644 index 0000000..13c0eac --- /dev/null +++ b/arch/z80/trs80/blk.fs @@ -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, diff --git a/arch/z80/trs80/blk/600 b/arch/z80/trs80/blk/600 deleted file mode 100644 index ac3b45a..0000000 --- a/arch/z80/trs80/blk/600 +++ /dev/null @@ -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. diff --git a/arch/z80/trs80/blk/602 b/arch/z80/trs80/blk/602 deleted file mode 100644 index dcc3342..0000000 --- a/arch/z80/trs80/blk/602 +++ /dev/null @@ -1 +0,0 @@ -1 8 LOADR+ diff --git a/arch/z80/trs80/blk/603 b/arch/z80/trs80/blk/603 deleted file mode 100644 index 9d81501..0000000 --- a/arch/z80/trs80/blk/603 +++ /dev/null @@ -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 diff --git a/arch/z80/trs80/blk/604 b/arch/z80/trs80/blk/604 deleted file mode 100644 index e8c02af..0000000 --- a/arch/z80/trs80/blk/604 +++ /dev/null @@ -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 diff --git a/arch/z80/trs80/blk/605 b/arch/z80/trs80/blk/605 deleted file mode 100644 index 09905da..0000000 --- a/arch/z80/trs80/blk/605 +++ /dev/null @@ -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 diff --git a/arch/z80/trs80/blk/606 b/arch/z80/trs80/blk/606 deleted file mode 100644 index aae8484..0000000 --- a/arch/z80/trs80/blk/606 +++ /dev/null @@ -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 diff --git a/arch/z80/trs80/blk/607 b/arch/z80/trs80/blk/607 deleted file mode 100644 index 93996d7..0000000 --- a/arch/z80/trs80/blk/607 +++ /dev/null @@ -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 diff --git a/arch/z80/trs80/blk/609 b/arch/z80/trs80/blk/609 deleted file mode 100644 index a1bf643..0000000 --- a/arch/z80/trs80/blk/609 +++ /dev/null @@ -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 ; diff --git a/arch/z80/trs80/blk/610 b/arch/z80/trs80/blk/610 deleted file mode 100644 index d9aa0f1..0000000 --- a/arch/z80/trs80/blk/610 +++ /dev/null @@ -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 ; diff --git a/arch/z80/trs80/blk/612 b/arch/z80/trs80/blk/612 deleted file mode 100644 index 0fca03d..0000000 --- a/arch/z80/trs80/blk/612 +++ /dev/null @@ -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. ) diff --git a/arch/z80/trs80/blk/613 b/arch/z80/trs80/blk/613 deleted file mode 100644 index ebd6956..0000000 --- a/arch/z80/trs80/blk/613 +++ /dev/null @@ -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, diff --git a/blk.fs b/blk.fs new file mode 100644 index 0000000..7bf1e37 --- /dev/null +++ b/blk.fs @@ -0,0 +1,3069 @@ +( ----- 000 ) +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. +( ----- 001 ) +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 +( ----- 005 ) +( 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+ +( ----- 006 ) +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 ; +( ----- 007 ) +( 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+- ; +( ----- 008 ) +: 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, +( ----- 009 ) +( 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, +( ----- 010 ) +( 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, +( ----- 011 ) +: 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, ; +( ----- 012 ) +: 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, ; +( ----- 013 ) +: _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, +( ----- 014 ) +( 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, +; +( ----- 015 ) +: 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, +( ----- 016 ) +: 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, +( ----- 017 ) +: 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, +( ----- 018 ) +( 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, +( ----- 019 ) +( 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, +( ----- 020 ) +( 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), +( ----- 021 ) +: OP2d ( d -- ) + CREATE C, + DOES> + 0xed A, + C@ SWAP ( op d ) + <<4 ( op d<< 4 ) + OR A, +; +0x4a OP2d ADCHLd, +0x42 OP2d SBCHLd, +( ----- 022 ) +( 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, +( ----- 023 ) +( 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), +( ----- 024 ) +: 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), ; +( ----- 025 ) +: 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, ; +( ----- 026 ) +( Place BEGIN, where you want to jump back and AGAIN after + a relative jump operator. Just like BSET and BWR. ) +: BEGIN, PC ; +: BSET PC SWAP ! ; +( same as BSET, but we need to write a placeholder ) +: FJR, PC 0 A, ; +: IFZ, JRNZ, FJR, ; +: IFNZ, JRZ, FJR, ; +: IFC, JRNC, FJR, ; +: IFNC, JRC, FJR, ; +: THEN, + DUP PC ( l l pc ) + -^ 1- ( l off ) + ( warning: l is a PC offset, not a mem addr! ) + SWAP ORG @ + BIN( @ - ( off addr ) + C! ; +( ----- 027 ) +: FWR BSET 0 A, ; +: FSET @ THEN, ; +: BREAK, FJR, 0x8000 OR ; +: BREAK?, DUP 0x8000 AND IF + 0x7fff AND 1 ALLOT THEN, -1 ALLOT + THEN ; +: AGAIN, BREAK?, PC - 1- A, ; +: BWR @ AGAIN, ; +( ----- 028 ) +( Macros ) +( clear carry + SBC ) +: SUBHLd, A ORr, SBCHLd, ; +: PUSH0, DE 0 LDdi, DE PUSH, ; +: PUSH1, DE 1 LDdi, DE PUSH, ; +: PUSHZ, DE 0 LDdi, IFZ, DE INCd, THEN, DE PUSH, ; +: PUSHA, D 0 LDri, E A LDrr, DE PUSH, ; +: HLZ, A H LDrr, L ORr, ; +: DEZ, A D LDrr, E ORr, ; +: LDDE(HL), E (HL) LDrr, HL INCd, D (HL) LDrr, ; +: OUTHL, DUP A H LDrr, OUTiA, A L LDrr, OUTiA, ; +: OUTDE, DUP A D LDrr, OUTiA, A E LDrr, OUTiA, ; +( ----- 030 ) +( 8086 assembler. See doc/asm.txt ) +1 13 LOADR+ +( ----- 031 ) +VARIABLE ORG +CREATE BIN( 0 , : BIN(+ BIN( @ + ; +VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4 +: AL 0 ; : CL 1 ; : DL 2 ; : BL 3 ; +: AH 4 ; : CH 5 ; : DH 6 ; : BH 7 ; +: AX 0 ; : CX 1 ; : DX 2 ; : BX 3 ; +: SP 4 ; : BP 5 ; : SI 6 ; : DI 7 ; +: ES 0 ; : CS 1 ; : SS 2 ; : DS 3 ; +: [BX+SI] 0 ; : [BX+DI] 1 ; : [BP+SI] 2 ; : [BP+DI] 3 ; +: [SI] 4 ; : [DI] 5 ; : [BP] 6 ; : [BX] 7 ; +: <<3 3 LSHIFT ; +( ----- 032 ) +( Splits word into msb/lsb, lsb being on TOS ) +: SPLITB + 256 /MOD SWAP +; +: PC H@ ORG @ - BIN( @ + ; +: A,, SPLITB A, A, ; +( ----- 033 ) +: OP1 CREATE C, DOES> C@ A, ; +0xc3 OP1 RET, 0xfa OP1 CLI, 0xfb OP1 STI, +0xf4 OP1 HLT, 0xfc OP1 CLD, 0xfd OP1 STD, +0x90 OP1 NOP, 0x98 OP1 CBW, +0xf3 OP1 REPZ, 0xf2 OP1 REPNZ, 0xac OP1 LODSB, +0xad OP1 LODSW, 0xa6 OP1 CMPSB, 0xa7 OP1 CMPSW, +0xa4 OP1 MOVSB, 0xa5 OP1 MOVSW, 0xae OP1 SCASB, +0xaf OP1 SCASW, 0xaa OP1 STOSB, 0xab OP1 STOSW, +( no argument, jumps with relative addrs are special ) +0xeb OP1 JMPs, 0xe9 OP1 JMPn, 0x74 OP1 JZ, +0x75 OP1 JNZ, 0x72 OP1 JC, 0x73 OP1 JNC, +0xe8 OP1 CALL, + +: OP1r CREATE C, DOES> C@ + A, ; +0x40 OP1r INCx, 0x48 OP1r DECx, +0x58 OP1r POPx, 0x50 OP1r PUSHx, +( ----- 034 ) +: OPr0 ( reg op ) CREATE C, C, DOES> + C@+ A, C@ <<3 OR 0xc0 OR A, ; +0 0xd0 OPr0 ROLr1, 0 0xd1 OPr0 ROLx1, 4 0xf6 OPr0 MULr, +1 0xd0 OPr0 RORr1, 1 0xd1 OPr0 RORx1, 4 0xf7 OPr0 MULx, +4 0xd0 OPr0 SHLr1, 4 0xd1 OPr0 SHLx1, 6 0xf6 OPr0 DIVr, +5 0xd0 OPr0 SHRr1, 5 0xd1 OPr0 SHRx1, 6 0xf7 OPr0 DIVx, +0 0xd2 OPr0 ROLrCL, 0 0xd3 OPr0 ROLxCL, 1 0xfe OPr0 DECr, +1 0xd2 OPr0 RORrCL, 1 0xd3 OPr0 RORxCL, 0 0xfe OPr0 INCr, +4 0xd2 OPr0 SHLrCL, 4 0xd3 OPr0 SHLxCL, +5 0xd2 OPr0 SHRrCL, 5 0xd3 OPr0 SHRxCL, +( ----- 035 ) +: OPrr CREATE C, DOES> C@ A, <<3 OR 0xc0 OR A, ; +0x31 OPrr XORxx, 0x30 OPrr XORrr, +0x88 OPrr MOVrr, 0x89 OPrr MOVxx, 0x28 OPrr SUBrr, +0x29 OPrr SUBxx, 0x08 OPrr ORrr, 0x09 OPrr ORxx, +0x38 OPrr CMPrr, 0x39 OPrr CMPxx, 0x00 OPrr ADDrr, +0x01 OPrr ADDxx, 0x20 OPrr ANDrr, 0x21 OPrr ANDxx, +( ----- 036 ) +: OPm ( modrm op ) CREATE C, C, DOES> C@+ A, C@ OR A, ; +0 0xff OPm INC[w], 0 0xfe OPm INC[b], +0x8 0xff OPm DEC[w], 0x8 0xfe OPm DEC[b], +0x30 0xff OPm PUSH[w], 0 0x8f OPm POP[w], + +: OPm+ ( modrm op ) CREATE C, C, DOES> + ( m off ) C@+ A, C@ ROT OR A, A, ; +0x40 0xff OPm+ INC[w]+, 0x40 0xfe OPm+ INC[b]+, +0x48 0xff OPm+ DEC[w]+, 0x48 0xfe OPm+ DEC[b]+, +0x70 0xff OPm+ PUSH[w]+, 0x40 0x8f OPm+ POP[w]+, +( ----- 037 ) +: OPrm CREATE C, DOES> C@ A, SWAP 3 LSHIFT OR A, ; +0x8a OPrm MOVr[], 0x8b OPrm MOVx[], +0x3a OPrm CMPr[], 0x3b OPrm CMPx[], + +: OPmr CREATE C, DOES> C@ A, 3 LSHIFT OR A, ; +0x88 OPmr MOV[]r, 0x89 OPmr MOV[]x, + +: OPrm+ ( r m off ) CREATE C, DOES> + C@ A, ROT 3 LSHIFT ROT OR 0x40 OR A, A, ; +0x8a OPrm+ MOVr[]+, 0x8b OPrm+ MOVx[]+, +0x3a OPrm+ CMPr[]+, 0x3b OPrm+ CMPx[]+, + +: OPm+r ( m off r ) CREATE C, DOES> + C@ A, 3 LSHIFT ROT OR 0x40 OR A, A, ; +0x88 OPm+r MOV[]+r, 0x89 OPm+r MOV[]+x, +( ----- 038 ) +: OPi CREATE C, DOES> C@ A, A, ; +0x04 OPi ADDALi, 0x24 OPi ANDALi, 0x2c OPi SUBALi, +0xcd OPi INT, +: OPI CREATE C, DOES> C@ A, A,, ; +0x05 OPI ADDAXI, 0x25 OPI ANDAXI, 0x2d OPI SUBAXI, +( ----- 040 ) +: MOVri, SWAP 0xb0 OR A, A, ; +: MOVxI, SWAP 0xb8 OR A, A,, ; +: MOVsx, 0x8e A, SWAP <<3 OR 0xc0 OR A, ; +: MOVrm, 0x8a A, SWAP <<3 0x6 OR A, A,, ; +: MOVxm, 0x8b A, SWAP <<3 0x6 OR A, A,, ; +: MOVmr, 0x88 A, <<3 0x6 OR A, A,, ; +: MOVmx, 0x89 A, <<3 0x6 OR A, A,, ; +: PUSHs, <<3 0x06 OR A, ; : POPs, <<3 0x07 OR A, ; +: SUBxi, 0x83 A, SWAP 0xe8 OR A, A, ; +: ADDxi, 0x83 A, SWAP 0xc0 OR A, A, ; +: JMPr, 0xff A, 7 AND 0xe0 OR A, ; +: JMPf, ( seg off ) 0xea A, SPLITB A, A, A,, ; +( ----- 041 ) +( Place BEGIN, where you want to jump back and AGAIN after + a relative jump operator. Just like BSET and BWR. ) +: BEGIN, PC ; +: BSET PC SWAP ! ; +( same as BSET, but we need to write a placeholder ) +: FJR, PC 0 A, ; +: IFZ, JNZ, FJR, ; +: IFNZ, JZ, FJR, ; +: IFC, JNC, FJR, ; +: IFNC, JC, FJR, ; +: THEN, + DUP PC ( l l pc ) + -^ 1- ( l off ) + ( warning: l is a PC offset, not a mem addr! ) + SWAP ORG @ + BIN( @ - ( off addr ) + C! ; +( ----- 042 ) +: FWRs BSET 0 A, ; +: FSET @ THEN, ; +( : BREAK, FJR, 0x8000 OR ; +: BREAK?, DUP 0x8000 AND IF + 0x7fff AND 1 ALLOT THEN, -1 ALLOT + THEN ; ) +: RPCs, PC - 1- DUP 128 + 0xff > IF ABORT" PC ovfl" THEN A, ; +: RPCn, PC - 2- A,, ; +: AGAIN, ( BREAK?, ) RPCs, ; +( Use RPCx with appropriate JMP/CALL op. Example: + JMPs, 0x42 RPCs, or CALL, 0x1234 RPCn, ) +( ----- 043 ) +: PUSHZ, CX 0 MOVxI, IFZ, CX INCx, THEN, CX PUSHx, ; +: CODE ( same as CREATE, but with native word ) + (entry) 0 ( native ) C, ; +: ;CODE JMPn, 0x1a ( next ) RPCn, ; +VARIABLE lblchkPS +: chkPS, ( sz -- ) + CX SWAP 2 * MOVxI, CALL, lblchkPS @ RPCn, ; +( ----- 050 ) +1 12 LOADR+ +( ----- 051 ) +VARIABLE ORG +VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4 +: SPLITB + 256 /MOD SWAP +; +( We divide by 2 because each PC represents a word. ) +: PC H@ ORG @ - 1 RSHIFT ; +( A, spits an assembled byte, A,, spits an assembled word + Both increase PC. ) +: A,, SPLITB A, A, ; +( ----- 052 ) +: _oor ." arg out of range: " .X SPC ." PC: " PC .X NL ABORT ; +: _r8c DUP 7 > IF _oor THEN ; +: _r32c DUP 31 > IF _oor THEN ; +: _r16+c _r32c DUP 16 < IF _oor THEN ; +: _r64c DUP 63 > IF _oor THEN ; +: _r256c DUP 255 > IF _oor THEN ; +: _Rdp ( op rd -- op', place Rd ) 4 LSHIFT OR ; +( ----- 053 ) +( 0000 000d dddd 0000 ) +: OPRd CREATE , DOES> @ SWAP _r32c _Rdp A,, ; +0b1001010000000101 OPRd ASR, 0b1001010000000000 OPRd COM, +0b1001010000001010 OPRd DEC, 0b1001010000000011 OPRd INC, +0b1001001000000110 OPRd LAC, 0b1001001000000101 OPRd LAS, +0b1001001000000111 OPRd LAT, +0b1001010000000110 OPRd LSR, 0b1001010000000001 OPRd NEG, +0b1001000000001111 OPRd POP, 0b1001001000001111 OPRd PUSH, +0b1001010000000111 OPRd ROR, 0b1001010000000010 OPRd SWAP, +0b1001001000000100 OPRd XCH, +( ----- 054 ) +( 0000 00rd dddd rrrr ) +: OPRdRr CREATE C, DOES> C@ ( rd rr op ) + OVER _r32c 0x10 AND 3 RSHIFT OR ( rd rr op' ) + 8 LSHIFT OR 0xff0f AND ( rd op' ) + SWAP _r32c _Rdp A,, ; +0x1c OPRdRr ADC, 0x0c OPRdRr ADD, 0x20 OPRdRr AND, +0x14 OPRdRr CP, 0x04 OPRdRr CPC, 0x10 OPRdRr CPSE, +0x24 OPRdRr EOR, 0x2c OPRdRr MOV, 0x9c OPRdRr MUL, +0x28 OPRdRr OR, 0x08 OPRdRr SBC, 0x18 OPRdRr SUB, + +( 0000 0AAd dddd AAAA ) +: OPRdA CREATE C, DOES> C@ ( rd A op ) + OVER _r64c 0x30 AND 3 RSHIFT OR ( rd A op' ) + 8 LSHIFT OR 0xff0f AND ( rd op' ) SWAP _r32c _Rdp A,, ; +0xb0 OPRdA IN, 0xb8 OPRdA _ : OUT, SWAP _ ; +( ----- 055 ) +( 0000 KKKK dddd KKKK ) +: OPRdK CREATE C, DOES> C@ ( rd K op ) + OVER _r256c 0xf0 AND 4 RSHIFT OR ( rd K op' ) + ROT _r16+c 4 LSHIFT ROT 0x0f AND OR ( op' rdK ) A, A, ; +0x70 OPRdK ANDI, 0x30 OPRdK CPI, 0xe0 OPRdK LDI, +0x60 OPRdK ORI, 0x40 OPRdK SBCI, 0x60 OPRdK SBR, +0x50 OPRdK SUBI, + +( 0000 0000 AAAA Abbb ) +: OPAb CREATE C, DOES> C@ ( A b op ) + ROT _r32c 3 LSHIFT ROT _r8c OR A, A, ; +0x98 OPAb CBI, 0x9a OPAb SBI, 0x99 OPAb SBIC, +0x9b OPAb SBIS, +( ----- 056 ) +: OPNA CREATE , DOES> @ A,, ; +0x9598 OPNA BREAK, 0x9488 OPNA CLC, 0x94d8 OPNA CLH, +0x94f8 OPNA CLI, 0x94a8 OPNA CLN, 0x94c8 OPNA CLS, +0x94e8 OPNA CLT, 0x94b8 OPNA CLV, 0x9498 OPNA CLZ, +0x9419 OPNA EIJMP, 0x9509 OPNA ICALL, 0x9519 OPNA EICALL, +0x9409 OPNA IJMP, 0x0000 OPNA NOP, 0x9508 OPNA RET, +0x9518 OPNA RETI, 0x9408 OPNA SEC, 0x9458 OPNA SEH, +0x9478 OPNA SEI, 0x9428 OPNA SEN, 0x9448 OPNA SES, +0x9468 OPNA SET, 0x9438 OPNA SEV, 0x9418 OPNA SEZ, +0x9588 OPNA SLEEP, 0x95a8 OPNA WDR, +( ----- 057 ) +( 0000 0000 0sss 0000 ) +: OPb CREATE , DOES> @ ( b op ) + SWAP _r8c _Rdp A,, ; +0b1001010010001000 OPb BCLR, 0b1001010000001000 OPb BSET, + +( 0000 000d dddd 0bbb ) +: OPRdb CREATE , DOES> @ ( rd b op ) + ROT _r32c _Rdp SWAP _r8c OR A,, ; +0b1111100000000000 OPRdb BLD, 0b1111101000000000 OPRdb BST, +0b1111110000000000 OPRdb SBRC, 0b1111111000000000 OPRdb SBRS, + +( special cases ) +: CLR, DUP EOR, ; : TST, DUP AND, ; : LSL, DUP ADD, ; +( ----- 058 ) +( a -- k12, absolute addr a, relative to PC in a k12 addr ) +: _r7ffc DUP 0x7ff > IF _oor THEN ; +: _raddr12 + PC - DUP 0< IF 0x800 + _r7ffc 0x800 OR ELSE _r7ffc THEN ; +: RJMP _raddr12 0xc000 OR ; +: RCALL _raddr12 0xd000 OR ; +: RJMP, RJMP A,, ; : RCALL, RCALL A,, ; +( ----- 059 ) +( a -- k7, absolute addr a, relative to PC in a k7 addr ) +: _r3fc DUP 0x3f > IF _oor THEN ; +: _raddr7 + PC - DUP 0< IF 0x40 + _r3fc 0x40 OR ELSE _r3fc THEN ; +: _brbx ( a b op -- a ) OR SWAP _raddr7 3 LSHIFT OR ; +: BRBC 0xf400 _brbx ; : BRBS 0xf000 _brbx ; : BRCC 0 BRBC ; +: BRCS 0 BRBS ; : BREQ 1 BRBS ; : BRNE 1 BRBC ; : BRGE 4 BRBC ; +: BRHC 5 BRBC ; : BRHS 5 BRBS ; : BRID 7 BRBC ; : BRIE 7 BRBS ; +: BRLO BRCS ; : BRLT 4 BRBS ; : BRMI 2 BRBS ; : BRPL 2 BRBC ; +: BRSH BRCC ; : BRTC 6 BRBC ; : BRTS 6 BRBS ; : BRVC 3 BRBC ; +: BRVS 3 BRBS ; +( ----- 060 ) +0b11100 CONSTANT X 0b01000 CONSTANT Y 0b00000 CONSTANT Z +0b11101 CONSTANT X+ 0b11001 CONSTANT Y+ 0b10001 CONSTANT Z+ +0b11110 CONSTANT -X 0b11010 CONSTANT -Y 0b10010 CONSTANT -Z +: _ldst ( Rd XYZ op ) SWAP DUP 0x10 AND 8 LSHIFT SWAP 0xf AND + OR OR ( Rd op' ) SWAP _Rdp A,, ; +: LD, 0x8000 _ldst ; : ST, SWAP 0x8200 _ldst ; +( ----- 061 ) +( L1 LBL! .. L1 ' RJMP LBL, ) +: LBL! ( l -- ) PC SWAP ! ; +: LBL, ( l op -- ) SWAP @ 1- SWAP EXECUTE A,, ; +: SKIP, PC 0 A,, ; +: TO, ( opw pc ) + ( warning: pc is a PC offset, not a mem addr! ) + 2 * ORG @ + PC 1- H@ ( opw addr tgt hbkp ) + ROT HERE ! ( opw tgt hbkp ) SWAP ROT EXECUTE H@ ! ( hbkp ) + HERE ! ; +( L1 FLBL, .. L1 ' RJMP FLBL! ) +: FLBL, ( l -- ) LBL! 0 A,, ; +: FLBL! ( l opw -- ) SWAP @ TO, ; +: BEGIN, PC ; : AGAIN?, ( op ) SWAP 1- SWAP EXECUTE A,, ; +: AGAIN, ['] RJMP AGAIN?, ; +: IF, ['] BREQ SKIP, ; : THEN, TO, ; +( ----- 062 ) +( Constant common to all AVR models ) +: R0 0 ; : R1 1 ; : R2 2 ; : R3 3 ; : R4 4 ; : R5 5 ; : R6 6 ; +: R7 7 ; : R8 8 ; : R9 9 ; : R10 10 ; : R11 11 ; : R12 12 ; +: R13 13 ; : R14 14 ; : R15 15 ; : R16 16 ; : R17 17 ; +: R18 18 ; : R19 19 ; : R20 20 ; : R21 21 ; : R22 22 ; +: R24 24 ; : R25 25 ; : R26 26 ; : R27 27 ; : R28 28 ; +: R29 29 ; : R30 30 ; : R31 31 ; : XL R26 ; : XH R27 ; +: YL R28 ; : YH R29 ; : ZL R30 ; : ZH R31 ; +( ----- 065 ) +( ATmega328P definitions ) : > CONSTANT ; +0xc6 > UDR0 0xc4 > UBRR0L 0xc5 > UBRR0H 0xc2 > UCSR0C +0xc1 > UCSR0B 0xc0 > UCSR0A 0xbd > TWAMR 0xbc > TWCR +0xbb > TWDR 0xba > TWAR 0xb9 > TWSR 0xb8 > TWBR 0xb6 > ASSR +0xb4 > OCR2B 0xb3 > OCR2A 0xb2 > TCNT2 0xb1 > TCCR2B +0xb0 > TCCR2A 0x8a > OCR1BL 0x8b > OCR1BH 0x88 > OCR1AL +0x89 > OCR1AH 0x86 > ICR1L 0x87 > ICR1H 0x84 > TCNT1L +0x85 > TCNT1H 0x82 > TCCR1C 0x81 > TCCR1B 0x80 > TCCR1A +0x7f > DIDR1 0x7e > DIDR0 0x7c > ADMUX 0x7b > ADCSRB +0x7a > ADCSRA 0x79 > ADCH 0x78 > ADCL 0x70 > TIMSK2 +0x6f > TIMSK1 0x6e > TIMSK0 0x6c > PCMSK1 0x6d > PCMSK2 +0x6b > PCMSK0 0x69 > EICRA 0x68 > PCICR 0x66 > OSCCAL +0x64 > PRR 0x61 > CLKPR 0x60 > WDTCSR 0x3f > SREG 0x3d > SPL +0x3e > SPH 0x37 > SPMCSR 0x35 > MCUCR 0x34 > MCUSR 0x33 > SMCR +0x30 > ACSR 0x2e > SPDR 0x2d > SPSR 0x2c > SPCR 0x2b > GPIOR2 +0x2a > GPIOR1 0x28 > OCR0B 0x27 > OCR0A 0x26 > TCNT0 ( cont. ) +( ----- 066 ) +( cont. ) 0x25 > TCCR0B 0x24 > TCCR0A 0x23 > GTCCR +0x22 > EEARH 0x21 > EEARL 0x20 > EEDR 0x1f > EECR +0x1e > GPIOR0 0x1d > EIMSK 0x1c > EIFR 0x1b > PCIFR +0x17 > TIFR2 0x16 > TIFR1 0x15 > TIFR0 0x0b > PORTD 0x0a > DDRD +0x09 > PIND 0x08 > PORTC 0x07 > DDRC 0x06 > PINC 0x05 > PORTB +0x04 > DDRB 0x03 > PINB +( ----- 100 ) +Block editor + +This is an application to conveniently browse the contents of +the disk blocks and edit them. You can load it with "105 LOAD". + +See doc/ed.txt +( ----- 105 ) +1 7 LOADR+ +( ----- 106 ) +CREATE ACC 0 , +: _LIST ." Block " DUP . NL LIST ; +: L BLK> @ _LIST ; +: B BLK> @ 1- BLK@ L ; +: N BLK> @ 1+ BLK@ L ; +( ----- 107 ) +( Cursor position in buffer. EDPOS/64 is line number ) +CREATE EDPOS 0 , +CREATE IBUF 64 ALLOT0 +CREATE FBUF 64 ALLOT0 +: _cpos BLK( + ; +: _lpos 64 * _cpos ; +: _pln ( lineno -- ) + DUP _lpos DUP 64 + SWAP DO ( lno ) + I EDPOS @ _cpos = IF '^' EMIT THEN + I C@ DUP 0x20 < IF DROP 0x20 THEN + EMIT + LOOP ( lno ) 1+ . ; +: _zbuf 64 0 FILL ; ( buf -- ) +( ----- 108 ) +: _type ( buf -- ) + C< DUP 0xd = IF 2DROP EXIT THEN SWAP DUP _zbuf ( c a ) + BEGIN ( c a ) C!+ C< TUCK 0x0d = UNTIL ( c a ) C! ; +( user-facing lines are 1-based ) +: T 1- DUP 64 * EDPOS ! _pln ; +: P IBUF _type IBUF EDPOS @ _cpos 64 MOVE BLK!! ; +: _mvln+ ( ln -- move ln 1 line down ) + DUP 14 > IF DROP EXIT THEN + _lpos DUP 64 + 64 MOVE ; +: _mvln- ( ln -- move ln 1 line up ) + DUP 14 > IF DROP 15 _lpos _zbuf + ELSE 1+ _lpos DUP 64 - 64 MOVE THEN ; +( ----- 109 ) +: _U ( U without P, used in VE ) + 15 EDPOS @ 64 / - ?DUP IF + 0 DO + 14 I - _mvln+ + LOOP THEN ; +: U _U P ; +( ----- 110 ) +: _F ( F without _type and _pln. used in VE ) + FBUF EDPOS @ _cpos 1+ ( a1 a2 ) + BEGIN + C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 ) + = NOT IF DROP FBUF THEN ( a2 a1 ) + TUCK C@ 0xd = ( a1 a2 f1 ) + OVER BLK) = OR ( a1 a2 f1|f2 ) + UNTIL ( a1 a2 ) + DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! ELSE DROP THEN ; +: F FBUF _type _F EDPOS @ 64 / _pln ; +( ----- 111 ) +: _blen ( buf -- length of str in buf ) + DUP BEGIN C@+ 0x20 < UNTIL -^ 1- ; +: _rbufsz ( size of linebuf to the right of curpos ) + EDPOS @ 64 MOD 63 -^ ; +: _i ( i without _pln and _type. used in VE ) + _rbufsz IBUF _blen 2DUP > IF + TUCK - ( ilen chars-to-move ) + SWAP EDPOS @ _cpos 2DUP + ( ctm ilen a a+ilen ) + 3 PICK MOVE- ( ctm ilen ) NIP ( ilen ) + ELSE DROP 1+ ( ilen becomes rbuffsize+1 ) THEN + DUP IBUF EDPOS @ _cpos ROT MOVE ( ilen ) EDPOS +! BLK!! ; +: i IBUF _type _i EDPOS @ 64 / _pln ; +( ----- 112 ) +: icpy ( n -- copy n chars from cursor to IBUF ) + IBUF _zbuf EDPOS @ _cpos IBUF ( n a buf ) ROT MOVE ; +: _X ( n -- ) + DUP icpy EDPOS @ _cpos 2DUP + ( n a1 a1+n ) + SWAP _rbufsz MOVE ( n ) + ( get to next line - n ) + DUP EDPOS @ 0xffc0 AND 0x40 + -^ _cpos ( n a ) + SWAP 0 FILL BLK!! ; +: X _X EDPOS @ 64 / _pln ; +: _E FBUF _blen _X ; +: E FBUF _blen X ; +: Y FBUF _blen icpy ; +( ----- 120 ) +Visual Editor + +This editor, unlike the Block Editor (B100), is grid-based +instead of being command-based. It requires the AT-XY, COLS +and LINES words to be implemented. If you don't have those, +use the Block Editor. + +It is loaded with "125 LOAD" and invoked with "VE". Note that +this also fully loads the Block Editor. + +This editor uses 19 lines. The top line is the status line and +it's followed by 2 lines showing the contents of IBUF and +FBUF (see B100). There are then 16 contents lines. The contents +shown is that of the currently selected block. + + (cont.) +( ----- 121 ) +The status line displays the active block number, then the +"modifier" and then the cursor position. When the block is dir- +ty, an "*" is displayed next. At the right corner, a mode letter +can appear. 'R' for replace, 'I' for insert, 'F' for find. + + + + + + + + + + + + (cont.) +( ----- 122 ) +All keystrokes are directly interpreted by VE and have the +effect described below. + +Pressing a 0-9 digit accumulates that digit into what is named +the "modifier". That modifier affects the behavior of many +keystrokes described below. The modifier starts at zero, but +most commands interpret a zero as a 1 so that they can have an +effect. + +'G' selects the block specified by the modifier as the current +block. Any change made to the previously selected block is +saved beforehand. + +'[' and ']' advances the selected block by "modifier". 't' opens +the previously opened block. + (cont.) +( ----- 123 ) +'h' and 'l' move the cursor by "modifier" characters. 'j' and +'k', by lines. 'g' moves to "modifier" line. + +'H' goes to the beginning of the line, 'L' to the end. + +'w' moves forward by "modifier" words. 'b' moves backward. +'W' moves to end-of-word. 'B', backwards. + +'I', 'F', 'Y', 'X' and 'E' invoke the corresponding command + +'o' inserts a blank line after the cursor. 'O', before. + +'D' deletes "modifier" lines at the cursor. The first of those +lines is copied to IBUF. + (cont.) +( ----- 124 ) +'f' puts the contents of your previous cursor movement into +FBUF. If that movement was a forward movement, it brings the +cursor back where it was. This allows for an efficient combi- +nation of movements and 'E'. For example, if you want to delete +the next word, you type 'w', then 'f', then check your FBUF to +be sure, then press 'E'. + +'R' goes into replace mode at current cursor position. +Following keystrokes replace current character and advance +cursor. Press return to return to normal mode. + +'@' re-reads current block even if it's dirty, thus undoing +recent changes. +( ----- 125 ) +-20 LOAD+ ( B105, block editor ) +1 7 LOADR+ +( ----- 126 ) +CREATE CMD 2 C, '$' C, 0 C, +CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 , +: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ; +: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ; +: large? COLS 67 > ; : col- 67 COLS MIN -^ ; +: width large? IF 64 ELSE COLS THEN ; +: acc@ ACC @ 1 MAX ; : pos@ ( x y -- ) EDPOS @ 64 /MOD ; +: num ACC @ SWAP _pdacc IF ACC ! ELSE DROP THEN ; +: nspcs ( n -- , spit n space ) 0 DO SPC LOOP ; +: aty 0 SWAP AT-XY ; +: clrscr LINES 0 DO I aty COLS nspcs LOOP ; +: gutter ( ln n ) OVER + SWAP DO 67 I AT-XY '|' EMIT LOOP ; +: status 0 aty ." BLK" SPC BLK> ? SPC ACC ? + SPC pos@ . ',' EMIT . xoff @ IF '>' EMIT THEN SPC + BLKDTY @ IF '*' EMIT THEN 4 nspcs ; +: nums 17 1 DO 2 I + aty I . SPC SPC LOOP ; +( ----- 127 ) +: mode! ( c -- ) 4 col- 0 AT-XY ; +: contents + 16 0 DO + large? IF 3 ELSE 0 THEN I 3 + AT-XY + 64 I * BLK( + ( lineaddr ) xoff @ + DUP width + SWAP + DO I C@ 0x20 MAX EMIT LOOP LOOP + large? IF 3 16 gutter THEN ; +: selblk BLK> @ PREVBLK ! BLK@ contents ; +: pos! ( newpos -- ) EDPOS @ PREVPOS ! + DUP 0< IF DROP 0 THEN 1023 MIN EDPOS ! ; +: xoff? pos@ DROP ( x ) + xoff @ ?DUP IF < IF 0 xoff ! contents THEN ELSE + width >= IF 64 COLS - xoff ! contents THEN THEN ; +: setpos ( -- ) pos@ 3 + ( header ) SWAP ( y x ) xoff @ - + large? IF 3 + ( gutter ) THEN SWAP AT-XY ; +: cmv ( n -- , char movement ) acc@ * EDPOS @ + pos! ; +( ----- 128 ) +: buftype ( buf ln -- ) + 3 OVER AT-XY KEY DUP EMIT + DUP 0x20 < IF 2DROP DROP EXIT THEN + ( buf ln c ) 4 col- nspcs SWAP 4 SWAP AT-XY ( buf c ) + SWAP C!+ IN( _zbuf (rdln) IN( SWAP 63 MOVE ; +( ----- 129 ) +: $G ACC @ selblk ; +: $[ BLK> @ acc@ - selblk ; +: $] BLK> @ acc@ + selblk ; +: $t PREVBLK @ selblk ; +: $I mode! 'I' EMIT IBUF 1 buftype _i contents mode! SPC ; +: $F mode! 'F' EMIT FBUF 2 buftype _F setpos mode! SPC ; +: $Y Y ; +: $E _E contents ; +: $X acc@ _X contents ; +: $h -1 cmv ; : $l 1 cmv ; : $k -64 cmv ; : $j 64 cmv ; +: $H EDPOS @ 0x3c0 AND pos! ; +: $L EDPOS @ 0x3f OR pos! ; +: $g ACC @ 1 MAX 1- 64 * pos! ; +: $@ BLK> @ BLK@* @ EXECUTE 0 BLKDTY ! contents ; +( ----- 130 ) +: $w EDPOS @ BLK( + acc@ 0 DO + BEGIN C@+ WS? UNTIL BEGIN C@+ WS? NOT UNTIL LOOP + 1- BLK( - pos! ; +: $W EDPOS @ BLK( + acc@ 0 DO + 1+ BEGIN C@+ WS? NOT UNTIL BEGIN C@+ WS? UNTIL LOOP + 2- BLK( - pos! ; +: $b EDPOS @ BLK( + acc@ 0 DO + 1- BEGIN C@- WS? NOT UNTIL BEGIN C@- WS? UNTIL LOOP + 2+ BLK( - pos! ; +: $B EDPOS @ BLK( + acc@ 0 DO + BEGIN C@- WS? UNTIL BEGIN C@- WS? NOT UNTIL LOOP + 1+ BLK( - pos! ; +( ----- 131 ) +: $f EDPOS @ PREVPOS @ 2DUP = IF 2DROP EXIT THEN + 2DUP > IF DUP pos! SWAP THEN + ( p1 p2, p1 < p2 ) OVER - 64 MIN ( pos len ) FBUF _zbuf + SWAP _cpos FBUF ( len src dst ) ROT MOVE ; +: $R ( replace mode ) + mode! 'R' EMIT + BEGIN setpos KEY DUP BS? IF -1 EDPOS +! DROP 0 THEN + DUP 0x20 >= IF + DUP EMIT EDPOS @ _cpos C! 1 EDPOS +! BLK!! 0 + THEN UNTIL mode! SPC contents ; +: $O _U EDPOS @ 0x3c0 AND DUP pos! _cpos _zbuf BLK!! contents ; +: $o EDPOS @ 0x3c0 < IF EDPOS @ 64 + EDPOS ! $O THEN ; +: $D $H 64 icpy + acc@ 0 DO 16 EDPOS @ 64 / DO I _mvln- LOOP LOOP + BLK!! contents ; +( ----- 132 ) +: UPPER DUP 'a' 'z' =><= IF 32 - THEN ; +: handle ( c -- f ) + DUP '0' '9' =><= IF num 0 EXIT THEN + DUP CMD 2+ C! CMD FIND IF EXECUTE ELSE DROP THEN + 0 ACC ! UPPER 'Q' = ; +: bufp ( buf -- ) + DUP 3 col- + SWAP DO I C@ 0x20 MAX EMIT LOOP ; +: bufs + 1 aty ." I: " IBUF bufp + 2 aty ." F: " FBUF bufp + large? IF 0 3 gutter THEN ; +: VE + clrscr 0 ACC ! 0 PREVPOS ! nums contents + BEGIN xoff? status bufs setpos KEY handle UNTIL + 19 aty (infl) ; +( ----- 160 ) +( AVR Programmer, load range 160-163. doc/avr.txt ) +( page size in words, 64 is default on atmega328P ) +CREATE aspfpgsz 64 , +VARIABLE aspprevx +: _x ( a -- b ) DUP aspprevx ! (spix) ; +: _xc ( a -- b ) DUP (spix) ( a b ) + DUP aspprevx @ = NOT IF ABORT" AVR err" THEN ( a b ) + SWAP aspprevx ! ( b ) ; +: _cmd ( b4 b3 b2 b1 -- r4 ) _xc DROP _xc DROP _xc DROP _x ; +: asprdy ( -- ) BEGIN 0 0 0 0xf0 _cmd 1 AND NOT UNTIL ; +: asp$ ( spidevid -- ) + ( RESET pulse ) DUP (spie) 0 (spie) (spie) + ( wait >20ms ) 220 TICKS + ( enable prog ) 0xac (spix) DROP + 0x53 _x DROP 0 _xc DROP 0 _x DROP ; +: asperase 0 0 0x80 0xac _cmd asprdy ; +( ----- 161 ) +( fuse access. read/write one byte at a time ) +: aspfl@ ( -- lfuse ) 0 0 0 0x50 _cmd ; +: aspfh@ ( -- hfuse ) 0 0 0x08 0x58 _cmd ; +: aspfe@ ( -- efuse ) 0 0 0x00 0x58 _cmd ; +: aspfl! ( lfuse -- ) 0 0xa0 0xac _cmd ; +: aspfh! ( hfuse -- ) 0 0xa8 0xac _cmd ; +: aspfe! ( efuse -- ) 0 0xa4 0xac _cmd ; +( ----- 162 ) +: aspfb! ( n a --, write word n to flash buffer addr a ) + SWAP 256 /MOD ( a lo hi ) SWAP ROT ( hi lo a ) + DUP ROT ( hi a a lo ) SWAP ( hi a lo a ) + 0 0x40 ( hi a lo a 0 0x40 ) _cmd DROP ( hi a ) + 0 0x48 _cmd DROP ; +: aspfp! ( page --, write buffer to page ) + 0 SWAP aspfpgsz @ * 256 /MOD ( 0 lsb msb ) + 0x4c _cmd DROP asprdy ; +: aspf@ ( page a -- n, read word from flash ) + SWAP aspfpgsz @ * OR ( addr ) 256 /MOD ( lsb msb ) + 2DUP 0 ROT> ( lsb msb 0 lsb msb ) + 0x20 _cmd ( lsb msb low ) + ROT> 0 ROT> ( low 0 lsb msb ) 0x28 _cmd 8 LSHIFT OR ; +( ----- 163 ) +: aspe@ ( addr -- byte, read from EEPROM ) + 0 SWAP 256 /MOD ( 0 lsb msb ) SWAP + 0xa0 ( 0 msb lsb 0xa0 ) _cmd ; +: aspe! ( byte addr --, write to EEPROM ) + 256 /MOD ( b lsb msb ) SWAP + 0xc0 ( b msb lsb 0xc0 ) _cmd DROP asprdy ; +( ----- 260 ) +Cross compilation program + +This programs allows cross compilation of boot binary and +core. Run "262 LOAD" right before your cross compilation and +then "270 LOAD" to apply xcomp overrides. + +This unit depends on a properly initialized z80a with ORG and +BIN( set. That is how we determine compilation offsets. + +This redefines defining words to achieve cross compilation. +The goal is two-fold: + +1. Add an offset to all word references in definitions. +2. Don't shadow important words we need right now. + + (cont.) +( ----- 261 ) +Words overrides like ":", "IMMEDIATE" and "CODE" are not +automatically shadowed to allow the harmless inclusion of +this unit. This shadowing has to take place in your xcomp +configuration. + +See /doc/cross.txt for details. +( ----- 262 ) +1 3 LOADR+ +( ----- 263 ) +CREATE XCURRENT 0 , +: XCON XCURRENT CURRENT* ! ; : XCOFF 0x02 RAM+ CURRENT* ! ; +: (xentry) XCON (entry) XCOFF ; : XCREATE (xentry) 2 C, ; +: X:** (xentry) 5 C, , ; +: XCODE XCON CODE XCOFF ; : XIMM XCON IMMEDIATE XCOFF ; +: _xapply ( a -- a-off ) + DUP ORG @ > IF ORG @ - BIN( @ + THEN ; +: XFIND XCURRENT @ SWAP _find DROP _xapply ; +: XLITN LIT" (n)" XFIND , , ; +: X' XCON ' XCOFF ; : X'? XCON '? XCOFF ; +: X['] XCON ' _xapply XLITN XCOFF ; +: XCOMPILE XCON ' _xapply XLITN + LIT" ," FIND DROP _xapply , XCOFF ; +: X[COMPILE] XCON ' _xapply , XCOFF ; +( ----- 264 ) +: XDO LIT" 2>R" XFIND , H@ ; +: XLOOP LIT" (loop)" XFIND , H@ - C, ; +: XIF LIT" (?br)" XFIND , H@ 1 ALLOT ; +: XELSE LIT" (br)" XFIND , 1 ALLOT [COMPILE] THEN H@ 1- ; +: XAGAIN LIT" (br)" XFIND , H@ - C, ; +: XUNTIL LIT" (?br)" XFIND , H@ - C, ; +: XLIT" + LIT" (s)" XFIND , H@ 0 C, ," + DUP H@ -^ 1- SWAP C! +; +( ----- 265 ) +: X: + (xentry) 1 ( compiled ) C, + BEGIN + WORD DUP LIT" ;" S= IF + DROP LIT" EXIT" XFIND , EXIT THEN + XCURRENT @ SWAP ( xcur w ) _find ( a f ) + IF ( a ) + DUP IMMED? IF ABORT THEN + _xapply , + ELSE ( w ) + 0x02 RAM+ @ SWAP ( cur w ) _find ( a f ) + IF DUP IMMED? NOT IF ABORT THEN EXECUTE + ELSE (parse) XLITN THEN + THEN + AGAIN ; +( ----- 270 ) +: CODE XCODE ; +: '? X'? ; +: ['] X['] ; IMMEDIATE +: COMPILE XCOMPILE ; IMMEDIATE +: [COMPILE] X[COMPILE] ; IMMEDIATE +: DO XDO ; IMMEDIATE : LOOP XLOOP ; IMMEDIATE +: IF XIF ; IMMEDIATE : ELSE XELSE ; IMMEDIATE +: AGAIN XAGAIN ; IMMEDIATE : UNTIL XUNTIL ; IMMEDIATE +: LIT" XLIT" ; IMMEDIATE : LITN XLITN ; +: IMMEDIATE XIMM ; +: (entry) (xentry) ; : CREATE XCREATE ; : :** X:** ; +: : [ ' X: , ] ; + +CURRENT @ XCURRENT ! +( ----- 280 ) +Z80 boot code + +This assembles the boot binary. It requires the Z80 assembler +(B5) and cross compilation setup (B260). It requires some +constants to be set. See doc/bootstrap.txt for details. + +RESERVED REGISTERS: At all times, IX points to RSP TOS and BC +is IP. SP points to PSP TOS, but you can still use the stack +in native code. you just have to make sure you've restored it +before "next". + +The boot binary is loaded in 2 parts. The first part, "decla- +rations", are loaded after xcomp, before xcomp overrides, with +"282 LOAD". The rest, after xcomp overrides, with "283 335 +LOADR". +( ----- 282 ) +VARIABLE lbluflw VARIABLE lblexec +( see comment at TICKS' definition ) +( 7.373MHz target: 737t. outer: 37t inner: 16t ) +( tickfactor = (737 - 37) / 16 ) +CREATE tickfactor 44 , +( ----- 283 ) +H@ ORG ! ( STABLE ABI ) +0 JP, ( 00, main ) NOP, ( unused ) NOP, NOP, ( 04, BOOT ) +NOP, NOP, ( 06, uflw ) NOP, NOP, ( 08, LATEST ) +NOP, NOP, NOP, NOP, NOP, NOP, ( unused ) +0 JP, ( RST 10 ) NOP, NOP, ( 13, oflw ) +NOP, NOP, NOP, NOP, NOP, ( unused ) +0 JP, ( 1a, next ) NOP, NOP, NOP, ( unused ) +0 JP, ( RST 20 ) 0 A, 0 A, 0 A, 0 A, 0 A, ( unused ) +0 JP, ( RST 28 ) 0 A, 0 A, 0 A, 0 A, 0 A, ( unused ) +0 JP, ( RST 30 ) 0 A, 0 A, 0 A, 0 A, 0 A, ( unused ) +0 JP, ( RST 38 ) +( ----- 284 ) +PC ORG @ 1 + ! ( main ) + SP PS_ADDR LDdi, IX RS_ADDR LDdi, +( LATEST is a label to the latest entry of the dict. It is + written at offset 0x08 by the process or person building + Forth. ) + BIN( @ 0x08 + LDHL(i), + SYSVARS 0x02 ( CURRENT ) + LD(i)HL, +HERESTART [IF] + HL HERESTART LDdi, +[THEN] + SYSVARS 0x04 + LD(i)HL, ( RAM+04 == HERE ) + DE BIN( @ 0x04 ( BOOT ) + LDd(i), + JR, L1 FWR ( execute, B287 ) +( ----- 286 ) +lblnext BSET PC ORG @ 0x1b + ! ( next ) +( This routine is jumped to at the end of every word. In it, + we jump to current IP, but we also take care of increasing + it by 2 before jumping. ) + ( Before we continue: are we overflowing? ) + IX PUSH, EX(SP)HL, ( do EX to count the IX push in SP ) + SP SUBHLd, HL POP, + IFNC, ( SP <= IX? overflow ) + SP PS_ADDR LDdi, IX RS_ADDR LDdi, + DE BIN( @ 0x13 ( oflw ) + LDd(i), + JR, L2 FWR ( execute, B287 ) + THEN, + LDA(BC), E A LDrr, BC INCd, + LDA(BC), D A LDrr, BC INCd, + ( continue to execute ) +( ----- 287 ) +lblexec BSET L1 FSET ( B284 ) L2 FSET ( B286 ) + ( DE -> wordref ) + LDA(DE), DE INCd, EXDEHL, ( HL points to PFA ) + A ORr, IFZ, JP(HL), THEN, + A DECr, ( compiled? ) IFNZ, ( no ) + 3 CPi, IFZ, ( alias ) LDDE(HL), JR, lblexec BWR THEN, + IFNC, ( switch ) + LDDE(HL), EXDEHL, LDDE(HL), JR, lblexec BWR THEN, + ( cell or does. push PFA ) HL PUSH, + A DECr, JRZ, lblnext BWR ( cell ) + HL INCd, HL INCd, LDDE(HL), EXDEHL, ( does ) + THEN, ( continue to compiledWord ) +( ----- 289 ) +( compiled word + 1. Push current IP to RS + 2. Set new IP to the second atom of the list + 3. Execute the first atom of the list. ) + IX INCd, IX INCd, + 0 IX+ C LDIXYr, + 1 IX+ B LDIXYr, +( While we inc, dereference into DE for execute call later. ) + LDDE(HL), + HL INCd, + B H LDrr, C L LDrr, ( --> IP ) + JR, lblexec BWR ( execute-B287 ) +( ----- 290 ) +lblchkPS BSET ( chkPS ) + ( thread carefully in there: sometimes, we're in the + middle of a EXX to protect BC. BC must never be touched + here. ) + EXX, +( We have the return address for this very call on the stack + and protected registers. 2- is to compensate that. ) + HL PS_ADDR 2- LDdi, + SP SUBHLd, + EXX, + CNC RETc, ( PS_ADDR >= SP? good ) + ( continue to uflw ) +lbluflw BSET ( abortUnderflow ) + DE BIN( @ 0x06 ( uflw ) + LDd(i), + JR, lblexec BWR +( ----- 291 ) +( Native words ) +H@ 5 + XCURRENT ! ( make next CODE have 0 prev field ) +CODE _find ( cur w -- a f ) + HL POP, ( w ) DE POP, ( cur ) chkPS, + HL PUSH, ( --> lvl 1 ) + ( First, figure out string len ) + A (HL) LDrr, A ORr, + ( special case. zero len? we never find anything. ) + IFZ, PUSH0, JPNEXT, THEN, + BC PUSH, ( --> lvl 2, protect ) +( Let's do something weird: We'll hold HL by the *tail*. + Because of our dict structure and because we know our + lengths, it's easier to compare starting from the end. ) + C A LDrr, B 0 LDri, ( C holds our length ) + BC ADDHLd, HL INCd, ( HL points to after-last-char ) + ( cont . ) +( ----- 292 ) + BEGIN, ( loop ) + ( DE is a wordref, first step, do our len correspond? ) + HL PUSH, ( --> lvl 3 ) + DE PUSH, ( --> lvl 4 ) + DE DECd, + LDA(DE), + 0x7f ANDi, ( remove IMMEDIATE flag ) + C CPr, ( cont. ) +( ----- 293 ) + IFZ, + ( match, let's compare the string then ) + DE DECd, ( Skip prev field. One less because we ) + DE DECd, ( pre-decrement ) + B C LDrr, ( loop C times ) + BEGIN, + ( pre-decrement for easier Z matching ) + DE DECd, + HL DECd, + LDA(DE), + (HL) CPr, + JRNZ, BREAK, + DJNZ, AGAIN, + THEN, + ( cont. ) +( ----- 294 ) +( At this point, Z is set if we have a match. In all cases, + we want to pop HL and DE ) + DE POP, ( <-- lvl 4 ) + IFZ, ( match, we're done! ) + HL POP, BC POP, HL POP, ( <-- lvl 1-3 ) DE PUSH, + PUSH1, JPNEXT, + THEN, + ( no match, go to prev and continue ) + DE DECd, DE DECd, DE DECd, ( prev field ) + DE PUSH, ( --> lvl 4 ) + EXDEHL, + LDDE(HL), + + + ( cont. ) +( ----- 295 ) + ( DE contains prev offset ) + HL POP, ( <-- lvl 4, prev field ) + DEZ, IFNZ, ( offset not zero ) + ( get absolute addr from offset ) + ( carry cleared from "or e" ) + DE SBCHLd, + EXDEHL, ( result in DE ) + THEN, + HL POP, ( <-- lvl 3 ) + JRNZ, AGAIN, ( loop-B292, try to match again ) + BC POP, ( <-- lvl 2 ) + ( Z set? end of dict, not found. "w" already on PSP TOS ) + PUSH0, +;CODE +( ----- 297 ) +CODE (br) +L1 BSET ( used in ?br and loop ) + LDA(BC), H 0 LDri, L A LDrr, + RLA, IFC, H DECr, THEN, + BC ADDHLd, B H LDrr, C L LDrr, +;CODE +CODE (?br) + HL POP, + HLZ, + JRZ, L1 BWR ( br + 1. False, branch ) + ( True, skip next byte and don't branch ) + BC INCd, +;CODE +( ----- 298 ) +CODE (loop) + 0 IX+ INC(IXY+), IFZ, 1 IX+ INC(IXY+), THEN, ( I++ ) + ( Jump if I <> I' ) + A 0 IX+ LDrIXY, 2 IX- CP(IXY+), JRNZ, L1 BWR ( branch ) + A 1 IX+ LDrIXY, 1 IX- CP(IXY+), JRNZ, L1 BWR ( branch ) + ( don't branch ) + IX DECd, IX DECd, IX DECd, IX DECd, + BC INCd, +;CODE +( ----- 305 ) +CODE EXECUTE + DE POP, + chkPS, + lblexec @ JP, + +CODE EXIT + C 0 IX+ LDrIXY, + B 1 IX+ LDrIXY, + IX DECd, IX DECd, + JPNEXT, +( ----- 306 ) +CODE (n) ( number literal ) + ( Literal value to push to stack is next to (n) reference + in the atom list. That is where IP is currently pointing. + Read, push, then advance IP. ) + LDA(BC), L A LDrr, BC INCd, + LDA(BC), H A LDrr, BC INCd, + HL PUSH, +;CODE +( ----- 307 ) +CODE (s) ( string literal ) +( Like (n) but instead of being followed by a 2 bytes + number, it's followed by a string. When called, puts the + string's address on PS ) + BC PUSH, + LDA(BC), C ADDr, + IFC, B INCr, THEN, + C A LDrr, + BC INCd, +;CODE +( ----- 308 ) +CODE ROT ( a b c -- b c a ) + HL POP, ( C ) DE POP, ( B ) IY POP, ( A ) chkPS, + DE PUSH, ( B ) HL PUSH, ( C ) IY PUSH, ( A ) +;CODE +CODE ROT> ( a b c -- c a b ) + HL POP, ( C ) DE POP, ( B ) IY POP, ( A ) chkPS, + HL PUSH, ( C ) IY PUSH, ( A ) DE PUSH, ( B ) +;CODE +CODE DUP ( a -- a a ) + HL POP, chkPS, + HL PUSH, HL PUSH, +;CODE +CODE ?DUP + HL POP, chkPS, HL PUSH, + HLZ, IFNZ, HL PUSH, THEN, +;CODE +( ----- 309 ) +CODE DROP ( a -- ) + HL POP, chkPS, +;CODE +CODE SWAP ( a b -- b a ) + HL POP, ( B ) DE POP, ( A ) + chkPS, + HL PUSH, ( B ) DE PUSH, ( A ) +;CODE +CODE OVER ( a b -- a b a ) + HL POP, ( B ) DE POP, ( A ) + chkPS, + DE PUSH, ( A ) HL PUSH, ( B ) DE PUSH, ( A ) +;CODE +( ----- 310 ) +CODE PICK EXX, ( protect BC ) + HL POP, + ( x2 ) + L SLA, H RL, + SP ADDHLd, + C (HL) LDrr, + HL INCd, + B (HL) LDrr, + ( check PS range before returning ) + EXDEHL, + HL PS_ADDR LDdi, + DE SUBHLd, + IFC, EXX, lbluflw @ JP, THEN, + BC PUSH, +EXX, ( unprotect BC ) ;CODE +( ----- 311 ) +( Low-level part of ROLL. Example: + "1 2 3 4 4 (roll)" --> "1 3 4 4". No sanity checks, never + call with 0. ) +CODE (roll) + HL POP, + B H LDrr, + C L LDrr, + SP ADDHLd, + HL INCd, + D H LDrr, + E L LDrr, + HL DECd, + HL DECd, + LDDR, +;CODE +( ----- 312 ) +CODE 2DROP ( a b -- ) + HL POP, HL POP, chkPS, +;CODE + +CODE 2DUP ( a b -- a b a b ) + HL POP, ( b ) DE POP, ( a ) + chkPS, + DE PUSH, HL PUSH, + DE PUSH, HL PUSH, +;CODE +( ----- 313 ) +CODE S0 + HL PS_ADDR LDdi, + HL PUSH, +;CODE + +CODE 'S + HL 0 LDdi, + SP ADDHLd, + HL PUSH, +;CODE +( ----- 314 ) +CODE AND + HL POP, + DE POP, + chkPS, + A E LDrr, + L ANDr, + L A LDrr, + A D LDrr, + H ANDr, + H A LDrr, + HL PUSH, +;CODE +( ----- 315 ) +CODE OR + HL POP, + DE POP, + chkPS, + A E LDrr, + L ORr, + L A LDrr, + A D LDrr, + H ORr, + H A LDrr, + HL PUSH, +;CODE +( ----- 316 ) +CODE XOR + HL POP, + DE POP, + chkPS, + A E LDrr, + L XORr, + L A LDrr, + A D LDrr, + H XORr, + H A LDrr, + HL PUSH, +;CODE +( ----- 317 ) +CODE NOT + HL POP, + chkPS, + HLZ, + PUSHZ, +;CODE +( ----- 318 ) +CODE + + HL POP, + DE POP, + chkPS, + DE ADDHLd, + HL PUSH, +;CODE + +CODE - + DE POP, + HL POP, + chkPS, + DE SUBHLd, + HL PUSH, +;CODE +( ----- 319 ) +CODE * EXX, ( protect BC ) + ( DE * BC -> DE (high) and HL (low) ) + DE POP, BC POP, chkPS, + HL 0 LDdi, + A 0x10 LDri, + BEGIN, + HL ADDHLd, + E RL, D RL, + IFC, + BC ADDHLd, + IFC, DE INCd, THEN, + THEN, + A DECr, + JRNZ, AGAIN, + HL PUSH, +EXX, ( unprotect BC ) ;CODE +( ----- 320 ) +( Borrowed from http://wikiti.brandonw.net/ ) +( Divides AC by DE and places the quotient in AC and the + remainder in HL ) +CODE /MOD EXX, ( protect BC ) + DE POP, BC POP, chkPS, + A B LDrr, B 16 LDri, + HL 0 LDdi, + BEGIN, + SCF, C RL, RLA, + HL ADCHLd, DE SBCHLd, + IFC, DE ADDHLd, C DECr, THEN, + DJNZ, AGAIN, + B A LDrr, + HL PUSH, BC PUSH, +EXX, ( unprotect BC ) ;CODE +( ----- 321 ) +( The word below is designed to wait the proper 100us per tick + at 500kHz when tickfactor is 1. If the CPU runs faster, + tickfactor has to be adjusted accordingly. "t" in comments + below means "T-cycle", which at 500kHz is worth 2us. ) +CODE TICKS + HL POP, chkPS, + ( we pre-dec to compensate for initialization ) + BEGIN, + HL DECd, ( 6t ) + IFZ, ( 12t ) JPNEXT, THEN, + A tickfactor @ LDri, ( 7t ) + BEGIN, A DECr, ( 4t ) JRNZ, ( 12t ) AGAIN, + JR, ( 12t ) AGAIN, ( outer: 37t inner: 16t ) +( ----- 322 ) +CODE ! + HL POP, DE POP, chkPS, + (HL) E LDrr, + HL INCd, + (HL) D LDrr, +;CODE +CODE @ + HL POP, chkPS, + E (HL) LDrr, + HL INCd, + D (HL) LDrr, + DE PUSH, +;CODE +( ----- 323 ) +CODE C! + HL POP, DE POP, chkPS, + (HL) E LDrr, +;CODE + +CODE C@ + HL POP, chkPS, + L (HL) LDrr, + H 0 LDri, + HL PUSH, +;CODE +( ----- 324 ) +CODE PC! EXX, ( protect BC ) + BC POP, HL POP, chkPS, + L OUT(C)r, +EXX, ( unprotect BC ) ;CODE + +CODE PC@ EXX, ( protect BC ) + BC POP, chkPS, + H 0 LDri, + L INr(C), + HL PUSH, +EXX, ( unprotect BC ) ;CODE +( ----- 325 ) +CODE I + L 0 IX+ LDrIXY, H 1 IX+ LDrIXY, + HL PUSH, +;CODE +CODE I' + L 2 IX- LDrIXY, H 1 IX- LDrIXY, + HL PUSH, +;CODE +CODE J + L 4 IX- LDrIXY, H 3 IX- LDrIXY, + HL PUSH, +;CODE +CODE >R + HL POP, chkPS, + IX INCd, IX INCd, 0 IX+ L LDIXYr, 1 IX+ H LDIXYr, +;CODE +( ----- 326 ) +CODE R> + L 0 IX+ LDrIXY, H 1 IX+ LDrIXY, IX DECd, IX DECd, HL PUSH, +;CODE +CODE 2>R + DE POP, HL POP, chkPS, + IX INCd, IX INCd, 0 IX+ L LDIXYr, 1 IX+ H LDIXYr, + IX INCd, IX INCd, 0 IX+ E LDIXYr, 1 IX+ D LDIXYr, +;CODE +CODE 2R> + L 0 IX+ LDrIXY, H 1 IX+ LDrIXY, IX DECd, IX DECd, + E 0 IX+ LDrIXY, D 1 IX+ LDrIXY, IX DECd, IX DECd, + DE PUSH, HL PUSH, +;CODE +( ----- 327 ) +CODE BYE + HALT, +;CODE + +CODE (resSP) + SP PS_ADDR LDdi, +;CODE + +CODE (resRS) + IX RS_ADDR LDdi, +;CODE +( ----- 328 ) +CODE S= EXX, ( protect BC ) + DE POP, HL POP, chkPS, + LDA(DE), + (HL) CPr, + IFZ, ( same size? ) + B A LDrr, ( loop A times ) + BEGIN, + HL INCd, DE INCd, + LDA(DE), + (HL) CPr, + JRNZ, BREAK, ( not equal? break early. NZ is set. ) + DJNZ, AGAIN, + THEN, + PUSHZ, +EXX, ( unprotect BC ) ;CODE +( ----- 329 ) +CODE CMP + HL POP, + DE POP, + chkPS, + DE SUBHLd, + DE 0 LDdi, + IFNZ, ( < or > ) + DE INCd, + IFNC, ( < ) + DE DECd, + DE DECd, + THEN, + THEN, + DE PUSH, +;CODE +( ----- 331 ) +CODE (im1) + IM1, + EI, +;CODE + +CODE 0 PUSH0, ;CODE +CODE 1 PUSH1, ;CODE + +CODE -1 + HL -1 LDdi, + HL PUSH, +;CODE +( ----- 332 ) +CODE 1+ + HL POP, + chkPS, + HL INCd, + HL PUSH, +;CODE + +CODE 1- + HL POP, + chkPS, + HL DECd, + HL PUSH, +;CODE +( ----- 333 ) +CODE 2+ + HL POP, + chkPS, + HL INCd, + HL INCd, + HL PUSH, +;CODE + +CODE 2- + HL POP, + chkPS, + HL DECd, + HL DECd, + HL PUSH, +;CODE +( ----- 334 ) +CODE RSHIFT ( n u -- n ) + DE POP, ( u ) + HL POP, ( n ) + chkPS, + A E LDrr, + A ORr, IFNZ, + BEGIN, + H SRL, L RR, + A DECr, + JRNZ, AGAIN, + THEN, + HL PUSH, +;CODE +( ----- 335 ) +CODE LSHIFT ( n u -- n ) + DE POP, ( u ) + HL POP, ( n ) + chkPS, + A E LDrr, + A ORr, IFNZ, + BEGIN, + L SLA, H RL, + A DECr, + JRNZ, AGAIN, + THEN, + HL PUSH, +;CODE +( ----- 350 ) +Core words + +This section contains arch-independent core words of Collapse +OS. Those words are written in a way that make them entirely +cross-compilable (see B260). When building Collapse OS, these +words come right after the boot binary (B280). + +Because this unit is designed to be cross-compiled, things are +a little weird. It is compiling in the context of a full +Forth interpreter with all bells and whistles (and z80 +assembler), but it has to obey strict rules: + +1. Although it cannot compile a word that isn't defined yet, + it can still execute an immediate from the host system. + + (cont.) +( ----- 351 ) +2. Immediate words that have been cross compiled *cannot* be + used. Only immediates from the host system can be used. +3. If an immediate word compiles words, it can only be words + that are part of the stable ABI. + +All of this is because when cross compiling, all atom ref- +erences are offsetted to the target system and are thus +unusable directly. For the same reason, any reference to a word +in the host system will obviously be wrong in the target +system. More details in B260. + + + + + + (cont.) +( ----- 352 ) +This unit is loaded in two "low" and "high" parts. The low part +is the biggest chunk and has the most definitions. The high +part is the "sensitive" chunk and contains "LITN", ":" and ";" +definitions which, once defined, kind of make any more defs +impossible. + +The gap between these 2 parts is the ideal place to put device +driver code. Load the low part with "353 LOAD", the high part +with "390 LOAD" +( ----- 353 ) +: RAM+ [ SYSVARS LITN ] + ; : BIN+ [ BIN( @ LITN ] + ; +: HERE 0x04 RAM+ ; +: CURRENT* 0x51 RAM+ ; : CURRENT CURRENT* @ ; +: H@ HERE @ ; +: FIND ( w -- a f ) CURRENT @ SWAP _find ; +: IN> 0x30 RAM+ ; ( current position in INBUF ) +: IN( 0x32 RAM+ @ ; ( points to INBUF ) +: IN) 0x40 ( buffer size ) IN( + ; ( INBUF's end ) +: (infl) 0 IN( DUP IN> ! ! ; ( flush input buffer ) +: QUIT + (resRS) 0 0x08 RAM+ ! ( C<* override ) (infl) + LIT" (main)" FIND DROP EXECUTE +; +1 33 LOADR+ +( ----- 354 ) +: ABORT (resSP) QUIT ; +: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ; +: 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ; +: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT> > AND ; +: =><= 2 PICK >= ( n l f ) ROT> >= AND ; +: NIP SWAP DROP ; : TUCK SWAP OVER ; +: -^ SWAP - ; +: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ; +: C!+ ( c a -- a+1 ) TUCK C! 1+ ; +: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ; +: C!- ( c a -- a-1 ) TUCK C! 1- ; +: LEAVE R> R> DROP I 1- >R >R ; : UNLOOP R> 2R> 2DROP >R ; +( ----- 355 ) +: +! TUCK @ + SWAP ! ; +: *! ( addr alias -- ) 1+ ! ; +: **! ( addr switch -- ) 1+ @ ! ; +: / /MOD NIP ; +: MOD /MOD DROP ; +: ALLOT HERE +! ; +: FILL ( a n b -- ) + SWAP 2 PICK + ( a b a+n ) ROT ( b a+n a ) DO ( b ) + DUP I C! + LOOP DROP ; +: ALLOT0 ( n -- ) H@ OVER 0 FILL ALLOT ; +SYSVARS 0x3e + :** A@ +SYSVARS 0x40 + :** A! +SYSVARS 0x42 + :** A, +( ----- 356 ) +SYSVARS 0x53 + :** EMIT +: (print) C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ; +: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ; +: CRLF CR LF ; : SPC 32 EMIT ; +SYSVARS 0x0a + :** NL +: ERR (print) ABORT ; +: (uflw) LIT" stack underflow" ERR ; +XCURRENT @ _xapply ORG @ 0x06 ( stable ABI uflw ) + ! +: (oflw) LIT" stack overflow" ERR ; +XCURRENT @ _xapply ORG @ 0x13 ( stable ABI oflw ) + ! +: (wnf) (print) LIT" word not found" ERR ; +( ----- 357 ) +( r c -- r f ) +( Parse digit c and accumulate into result r. + Flag f is true when c was a valid digit ) +: _pdacc + '0' - DUP 10 < IF ( good, add to running result ) + SWAP 10 * + 1 ( r*10+n f ) + ELSE ( bad ) DROP 0 THEN ; +( ----- 358 ) +: _pd ( a -- n f, parse decimal ) + C@+ OVER C@ 0 ( a len firstchar startat ) +( if we have '-', we only advance. more processing later. ) + SWAP '-' = IF 1+ THEN ( a len startat ) +( if we can do the whole string, success. if _pdacc returns + false before, failure. ) + 0 ROT> ( len ) ( startat ) DO ( a r ) + OVER I + C@ ( a r c ) _pdacc ( a r f ) + NOT IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r ) +( if we had '-', we need to invert result. ) + SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ; +( ----- 359 ) +( strings being sent to parse routines are always null + terminated ) + +: _pc ( a -- n f, parse character ) + ( apostrophe is ASCII 39 ) + DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f ) + NOT IF 0 EXIT THEN ( a 0 ) + ( surrounded by apos, good, return ) + 2+ C@ 1 ( n 1 ) +; +( ----- 360 ) +( returns negative value on error ) +: _ ( c -- n ) + DUP '0' '9' =><= IF '0' - EXIT THEN + DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN + DROP -1 ( bad ) +; +: _ph ( a -- n f, parse hex ) + ( '0': ASCII 0x30 'x': 0x78 0x7830 ) + DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 ) + ( We have "0x" prefix ) + DUP C@ ( a len ) + 0 SWAP 1+ ( len+1 ) 3 DO ( a r ) + OVER I + C@ ( a r c ) _ ( a r n ) + DUP 0< IF 2DROP 0 UNLOOP EXIT THEN + SWAP 4 LSHIFT + ( a r*16+n ) LOOP + NIP 1 ; +( ----- 361 ) +: _pb ( a -- n f, parse binary ) + ( '0': ASCII 0x30 'b': 0x62 0x6230 ) + DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 ) + ( We have "0b" prefix ) + DUP C@ ( a len ) + 0 SWAP 1+ ( len+1 ) 3 DO ( a r ) + OVER I + C@ ( a r c ) + DUP '0' '1' =><= NOT IF 2DROP 0 UNLOOP EXIT THEN + '0' - SWAP 1 LSHIFT + ( a r*2+n ) LOOP + NIP 1 ; +( ----- 362 ) +: (parse) ( a -- n ) + _pc IF EXIT THEN + _ph IF EXIT THEN + _pb IF EXIT THEN + _pd IF EXIT THEN + ( nothing works ) + (wnf) +; +( ----- 363 ) +: C + ( Overwrite cellWord in CURRENT ) + 3 ( does ) CURRENT @ C! + ( When we have a DOES>, we forcefully place HERE to 4 + bytes after CURRENT. This allows a DOES word to use "," + and "C," without messing everything up. ) + CURRENT @ 3 + HERE ! + ( HERE points to where we should write R> ) + R> , + ( We're done. Because we've popped RS, we'll exit parent + definition ) +; +: CONSTANT CREATE , DOES> @ ; +( ----- 371 ) +: [IF] + IF EXIT THEN + LIT" [THEN]" BEGIN DUP WORD S= UNTIL DROP ; +: [THEN] ; +( ----- 372 ) +( n -- Fetches block n and write it to BLK( ) +: BLK@* 0x34 RAM+ ; +( n -- Write back BLK( to storage at block n ) +: BLK!* 0x36 RAM+ ; +( Current blk pointer in ( ) +: BLK> 0x38 RAM+ ; +( Whether buffer is dirty ) +: BLKDTY 0x3a RAM+ ; +: BLK( 0x3c RAM+ @ ; +: BLK) BLK( 1024 + ; +( ----- 373 ) +: BLK$ + H@ 0x3c ( BLK(* ) RAM+ ! + 1024 ALLOT + ( LOAD detects end of block with ASCII EOT. This is why + we write it there. ) + EOT, + 0 BLKDTY ! + -1 BLK> ! +; +( ----- 374 ) +: BLK! ( -- ) + BLK> @ BLK!* @ EXECUTE + 0 BLKDTY ! ; +: FLUSH BLKDTY @ IF BLK! THEN ; +: BLK@ ( n -- ) + DUP BLK> @ = IF DROP EXIT THEN + FLUSH DUP BLK> ! BLK@* @ EXECUTE ; +: BLK!! 1 BLKDTY ! ; +: WIPE BLK( 1024 0 FILL BLK!! ; +: WIPED? ( -- f ) + 1 ( f ) BLK) BLK( DO + I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ; +: COPY ( src dst -- ) + FLUSH SWAP BLK@ BLK> ! BLK! ; +( ----- 375 ) +: _ + 999 SWAP ( stop indicator ) + BEGIN + ?DUP NOT IF EXIT THEN + 10 /MOD ( r q ) + SWAP '0' + SWAP ( d q ) + AGAIN ; +: . ( n -- ) + ?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case ) + ( handle negative ) + DUP 0< IF '-' EMIT -1 * THEN + _ + BEGIN + DUP '9' > IF DROP EXIT THEN ( stop indicator ) + EMIT + AGAIN ; +( ----- 376 ) +: ? @ . ; +: _ + DUP 9 > IF 10 - 'a' + + ELSE '0' + THEN +; +( For hex display, there are no negatives ) +: .x + 256 MOD ( ensure < 0x100 ) + 16 /MOD ( l h ) + _ EMIT ( l ) + _ EMIT +; +: .X + 256 /MOD ( l h ) + .x .x +; +( ----- 377 ) +: _ ( a -- a+8 ) + DUP ( a a ) + ':' EMIT DUP .x SPC + 4 0 DO DUP @ 256 /MOD SWAP .x .x SPC 2+ LOOP + DROP ( a ) + 8 0 DO + C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT + LOOP NL ; +: DUMP ( n a -- ) + LF + SWAP 8 /MOD SWAP IF 1+ THEN + 0 DO _ LOOP +; +( ----- 378 ) +( handle backspace: go back one char in IN>, if possible, then + emit BS + SPC + BS ) +: _bs + ( already at IN( ? ) + IN> @ IN( = IF EXIT THEN + IN> @ 1- IN> ! + BS SPC BS +; +( del is same as backspace ) +: BS? DUP 0x7f = SWAP 0x8 = OR ; +SYSVARS 0x55 + :** KEY +( cont.: read one char into input buffer and returns whether we + should continue, that is, whether CR was not met. ) +( ----- 379 ) +: (rdlnc) ( -- c ) + ( buffer overflow? same as if we typed a newline ) + IN> @ IN) = IF 0x0a ELSE KEY THEN ( c ) + DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr ) + ( backspace? handle and exit ) + DUP BS? IF _bs EXIT THEN + ( echo back ) + DUP EMIT ( c ) + ( write and advance ) + DUP ( keep as result ) ( c c ) +( We take advantage of the fact that c's MSB is always zero and + thus ! automatically null-terminates our string ) + IN> @ ! 1 IN> +! ( c ) + ( if newline, replace with zero to indicate EOL ) + DUP 0xd = IF DROP 0 THEN ; +( ----- 380 ) +( Read one line in input buffer and make IN> point to it ) +: (rdln) + ( EOT or less triggers line flush ) + (infl) BEGIN (rdlnc) 5 < UNTIL + LF IN( IN> ! ; +( And finally, implement C<* ) +: RDLN< + IN> @ C@ + DUP IF ( not EOL? good, inc and return ) + 1 IN> +! + ELSE ( EOL ? readline. we still return null though ) + (rdln) + THEN + ( update C @ C@ 0 > 0x06 RAM+ ! ( 06 == C IF EMIT ELSE DROP LEAVE THEN + LOOP + NL + LOOP ; +( ----- 383 ) +: INTERPRET + BEGIN + WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN + FIND NOT IF (parse) ELSE EXECUTE THEN + C @ >R ( save restorable variables to RSP ) + 0x08 RAM+ @ >R ( 08 == C<* override ) + 0x06 RAM+ @ >R ( CR ( boot ptr ) + BLK@ + BLK( 0x2e RAM+ ! ( Point to beginning of BLK ) + ['] (boot<) 0x08 RAM+ ! + 1 0x06 RAM+ ! ( 06 == C 0x2e RAM+ ! R> 0x06 RAM+ ! + I 0x08 RAM+ @ = IF ( nested load ) + R> DROP ( C<* ) R> BLK@ + ELSE ( not nested ) + R> 0x08 RAM+ ! R> DROP ( BLK> ) + THEN ; +( ----- 385 ) +: LOAD+ BLK> @ + LOAD ; +( b1 b2 -- ) +: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ; +: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; +( ----- 390 ) +( xcomp core high ) +: (main) INTERPRET BYE ; +: BOOT + 0x02 RAM+ CURRENT* ! + CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR ) + 0 0x08 RAM+ ! ( 08 == C<* override ) + ['] (emit) ['] EMIT **! ['] (key) ['] KEY **! + ['] CRLF ['] NL **! + ['] (boot<) ['] C<* **! + ['] C@ ['] A@ **! ['] C! ['] A! **! ['] C, ['] A, **! + ( boot< always has a char waiting. 06 == C IF LIT" br ovfl" (print) ABORT THEN ; +: DO COMPILE 2>R H@ ; IMMEDIATE +: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE +( LEAVE is implemented in low xcomp ) +: LITN COMPILE (n) , ; +( gets its name at the very end. can't comment afterwards ) +: _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE +: _ ( : will get its name almost at the very end ) + (entry) 1 ( compiled ) C, + BEGIN + WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN + FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN + ELSE ( maybe number ) (parse) LITN THEN + AGAIN ; +( ----- 393 ) +: IF ( -- a | a: br cell addr ) + COMPILE (?br) H@ 1 ALLOT ( br cell allot ) +; IMMEDIATE +: THEN ( a -- | a: br cell addr ) + DUP H@ -^ _bchk SWAP ( a-H a ) C! +; IMMEDIATE +: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) + COMPILE (br) + 1 ALLOT + [COMPILE] THEN + H@ 1- ( push a. 1- for allot offset ) +; IMMEDIATE +: LIT" + COMPILE (s) H@ 0 C, ," + DUP H@ -^ 1- ( a len ) SWAP C! +; IMMEDIATE +( ----- 394 ) +( We don't use ." and ABORT in core, they're not xcomp-ed ) +: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE +: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE +: BEGIN H@ ; IMMEDIATE +: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE +: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE +: [ INTERPRET ; IMMEDIATE +: ] R> DROP ; +: COMPILE ' LITN ['] , , ; IMMEDIATE +: [COMPILE] ' , ; IMMEDIATE +: ['] ' LITN ; IMMEDIATE +':' X' _ 4 - C! ( give : its name ) +'(' X' _ 4 - C! +( ----- 400 ) +( With dst being assumed to be an AT28 EEPROM, perform ! + operation while doing the right thing. Checks data integrity + and ABORT on mismatch. ) +: AT28! ( n a -- ) + 2DUP C! + ( as long as writing operation is running, IO/6 will toggle + at each read attempt. We know that write is finished when + we read the same value twice. ) + BEGIN ( n1 a ) + DUP C@ ( n1 a n2 ) + OVER C@ ( n1 a n2 n3 ) + = UNTIL + ( We're finished writing. do we have a mismatch? ) + C@ = NOT IF ABORT" mismatch" THEN +; +( ----- 401 ) +Grid subsystem + +Given a device driver following the Grid protocol, implement +AT-XY and (emit). (emit) makes the grid behave like a regular +terminal, honoring line feeds and backspaces, wrapping at the +end of a line. + +2 bytes of system memory at GRID_MEM are needed for cursor +position. + +Load range: B402-B403 +( ----- 402 ) +: XYPOS [ GRID_MEM LITN ] ; +: _cl* COLS LINES * ; +: AT-XY ( x y -- ) LINES * + _cl* MOD XYPOS ! ; +'? NEWLN NIP NOT [IF] +: NEWLN ( ln -- ) COLS * DUP COLS + SWAP DO 0 I CELL! LOOP ; +[THEN] +: _lf + XYPOS @ COLS / 1+ LINES MOD DUP NEWLN + COLS * XYPOS ! ; +: _bs 0 ( blank ) XYPOS @ TUCK CELL! ( pos ) 1- + _cl* MOD XYPOS ! ; +( ----- 403 ) +: (emit) + DUP 0x08 = IF DROP _bs EXIT THEN + DUP 0x0d = IF DROP _lf EXIT THEN + 0x20 - DUP 0< IF DROP EXIT THEN + XYPOS @ CELL! + XYPOS @ 1+ DUP COLS MOD IF XYPOS ! ELSE _lf THEN ; +( ----- 410 ) +PS/2 keyboard subsystem + +Provides (key) from a driver providing the PS/2 protocol. That +is, for a driver taking care of providing all key codes emanat- +ing from a PS/2 keyboard, this subsystem takes care of mapping +those keystrokes to ASCII characters. This code is designed to +be cross-compiled and loaded with drivers. + +Requires PS2_MEM to be defined. + +Load range: 411-414 +( ----- 411 ) +: PS2_SHIFT [ PS2_MEM LITN ] ; +: PS2$ 0 PS2_SHIFT C! ; + +( 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 +value. That value is a character that can be read in (key) +No make code in the PS/2 set 2 reaches 0x80. ) +CREATE PS2_CODES +( 00 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, +( 08 ) 0 C, 0 C, 0 C, 0 C, 0 C, 9 C, '`' C, 0 C, +( 10 ) 0 C, 0 C, 0 C, 0 C, 0 C, 'q' C, '1' C, 0 C, +( I don't know why, but the key 2 is sent as 0x1f by 2 of my + keyboards. Is it a timing problem on the ATtiny? TODO ) +( 18 ) 0 C, 0 C, 'z' C, 's' C, 'a' C, 'w' C, '2' C, '2' C, +( 20 ) 0 C, 'c' C, 'x' C, 'd' C, 'e' C, '4' C, '3' C, 0 C, +( 28 ) 0 C, 32 C, 'v' C, 'f' C, 't' C, 'r' C, '5' C, 0 C, +( ----- 412 ) +( 30 ) 0 C, 'n' C, 'b' C, 'h' C, 'g' C, 'y' C, '6' C, 0 C, +( 38 ) 0 C, 0 C, 'm' C, 'j' C, 'u' C, '7' C, '8' C, 0 C, +( 40 ) 0 C, ',' C, 'k' C, 'i' C, 'o' C, '0' C, '9' C, 0 C, +( 48 ) 0 C, '.' C, '/' C, 'l' C, ';' C, 'p' C, '-' C, 0 C, +( 50 ) 0 C, 0 C, ''' C, 0 C, '[' C, '=' C, 0 C, 0 C, +( 58 ) 0 C, 0 C, 13 C, ']' C, 0 C, '\' C, 0 C, 0 C, +( 60 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 8 C, 0 C, +( 68 ) 0 C, '1' C, 0 C, '4' C, '7' C, 0 C, 0 C, 0 C, +( 70 ) '0' C, '.' C, '2' C, '5' C, '6' C, '8' C, 27 C, 0 C, +( 78 ) 0 C, 0 C, '3' C, 0 C, 0 C, '9' C, 0 C, 0 C, +( Same values, but shifted ) +( 00 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, +( 08 ) 0 C, 0 C, 0 C, 0 C, 0 C, 9 C, '~' C, 0 C, +( 10 ) 0 C, 0 C, 0 C, 0 C, 0 C, 'Q' C, '!' C, 0 C, +( 18 ) 0 C, 0 C, 'Z' C, 'S' C, 'A' C, 'W' C, '@' C, '@' C, +( 20 ) 0 C, 'C' C, 'X' C, 'D' C, 'E' C, '$' C, '#' C, 0 C, +( ----- 413 ) +( 28 ) 0 C, 32 C, 'V' C, 'F' C, 'T' C, 'R' C, '%' C, 0 C, +( 30 ) 0 C, 'N' C, 'B' C, 'H' C, 'G' C, 'Y' C, '^' C, 0 C, +( 38 ) 0 C, 0 C, 'M' C, 'J' C, 'U' C, '&' C, '*' C, 0 C, +( 40 ) 0 C, '<' C, 'K' C, 'I' C, 'O' C, ')' C, '(' C, 0 C, +( 48 ) 0 C, '>' C, '?' C, 'L' C, ':' C, 'P' C, '_' C, 0 C, +( 50 ) 0 C, 0 C, '"' C, 0 C, '{' C, '+' C, 0 C, 0 C, +( 58 ) 0 C, 0 C, 13 C, '}' C, 0 C, '|' C, 0 C, 0 C, +( 60 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 8 C, 0 C, +( 68 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, +( 70 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 27 C, 0 C, +( 78 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, +( ----- 414 ) +: _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 + DUP 0xf0 ( break ) = IF DROP ( ) + ( get next kc and see if it's a shift ) + _get _shift? IF ( drop shift ) 0 PS2_SHIFT C! THEN + ( 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 + ( 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 ; +( ----- 418 ) +SPI relay driver + +This driver is designed for a ad-hoc adapter card that acts as a +SPI relay between the z80 bus and the SPI device. When writing +to SPI_CTL, we expect a bitmask of the device to select, with +0 meaning that everything is de-selected. Reading SPI_CTL +returns 0 if the device is ready or 1 if it's still running an +exchange. Writing to SPI_DATA initiates an exchange. + +Provides the SPI relay protocol. Load driver with "419 LOAD". +( ----- 419 ) +CODE (spix) ( n -- n ) + HL POP, chkPS, A L LDrr, + SPI_DATA OUTiA, + ( wait until xchg is done ) + BEGIN, SPI_CTL INAi, 1 ANDi, JRNZ, AGAIN, + SPI_DATA INAi, + L A LDrr, + HL PUSH, +;CODE +CODE (spie) ( n -- ) + HL POP, chkPS, A L LDrr, + SPI_CTL OUTiA, +;CODE +( ----- 420 ) +SD Card subsystem + +Load range: B423-B436 + +This subsystem is designed for a ad-hoc adapter card that acts +as a SPI relay between the z80 bus and the SD card. It requires +a driver providing the SPI Relay protocol. You need to define +SDC_DEVID to specify which ID will be supplied to (spie). + +Through that layer, this driver implements the SDC protocol +allowing it to provide BLK@ and BLK!. +( ----- 423 ) +( Computes n into crc c with polynomial 0x1021 ) +CODE _crc16 ( c n -- c ) EXX, ( protect BC ) + HL POP, ( n ) DE POP, ( c ) + A L LDrr, D XORr, D A LDrr, + B 8 LDri, + BEGIN, + E SLA, D RL, + IFC, ( msb is set, apply polynomial ) + A D LDrr, 0x10 XORi, D A LDrr, + A E LDrr, 0x21 XORi, E A LDrr, + THEN, + DJNZ, AGAIN, + DE PUSH, +EXX, ( unprotect BC ) ;CODE +( ----- 424 ) +( -- n ) +: _idle 0xff (spix) ; + +( -- n ) +( spix 0xff until the response is something else than 0xff + for a maximum of 20 times. Returns 0xff if no response. ) +: _wait + 0 ( dummy ) 20 0 DO + DROP _idle DUP 0xff = NOT IF LEAVE THEN + LOOP ; +( ----- 425 ) +( -- ) +( The opposite of sdcWaitResp: we wait until response is 0xff. + After a successful read or write operation, the card will be + busy for a while. We need to give it time before interacting + with it again. Technically, we could continue processing on + our side while the card it busy, and maybe we will one day, + but at the moment, I'm having random write errors if I don't + do this right after a write, so I prefer to stay cautious + for now. ) +: _ready BEGIN _idle 0xff = UNTIL ; +( ----- 426 ) +( c n -- c ) +( Computes n into crc c with polynomial 0x09 + Note that the result is "left aligned", that is, that 8th + bit to the "right" is insignificant (will be stop bit). ) +: _crc7 + XOR ( c ) + 8 0 DO + 2 * ( <<1 ) + DUP 255 > IF + ( MSB was set, apply polynomial ) + 0xff AND + 0x12 XOR ( 0x09 << 1, we apply CRC on high bits ) + THEN + LOOP +; +( ----- 427 ) +( send-and-crc7 ) +( n c -- c ) +: _s+crc SWAP DUP (spix) DROP _crc7 ; +( ----- 428 ) +( cmd arg1 arg2 -- resp ) +( Sends a command to the SD card, along with arguments and + specified CRC fields. (CRC is only needed in initial commands + though). This does *not* handle CS. You have to + select/deselect the card outside this routine. ) +: _cmd + _wait DROP ROT ( a1 a2 cmd ) + 0 _s+crc ( a1 a2 crc ) + ROT 256 /MOD ROT ( a2 h l crc ) + _s+crc _s+crc ( a2 crc ) + SWAP 256 /MOD ROT ( h l crc ) + _s+crc _s+crc ( crc ) + 1 OR ( ensure stop bit ) + (spix) DROP ( send CRC ) + _wait ( wait for a valid response... ) +; +( ----- 429 ) +( cmd arg1 arg2 -- r ) +( Send a command that expects a R1 response, handling CS. ) +: SDCMDR1 [ SDC_DEVID LITN ] (spie) _cmd 0 (spie) ; + +( cmd arg1 arg2 -- r arg1 arg2 ) +( Send a command that expects a R7 response, handling CS. A R7 + is a R1 followed by 4 bytes. arg1 contains bytes 0:1, arg2 + has 2:3 ) +: SDCMDR7 + [ SDC_DEVID LITN ] (spie) + _cmd ( r ) + _idle 8 LSHIFT _idle + ( r arg1 ) + _idle 8 LSHIFT _idle + ( r arg1 arg2 ) + 0 (spie) +; +( ----- 430 ) +: _err 0 (spie) LIT" SDerr" ERR ; + +( Tight definition ahead, pre-comment. + + Initialize a SD card. This should be called at least 1ms + after the powering up of the card. We begin by waking up the + SD card. After power up, a SD card has to receive at least + 74 dummy clocks with CS and DI high. We send 80. + Then send cmd0 for a maximum of 10 times, success is when + we get 0x01. Then comes the CMD8. We send it with a 0x01aa + argument and expect a 0x01aa argument back, along with a + 0x01 R1 response. After that, we need to repeatedly run + CMD55+CMD41 (0x40000000) until the card goes out of idle + mode, that is, when it stops sending us 0x01 response and + send us 0x00 instead. Any other response means that + initialization failed. ) +( ----- 431 ) +: SDC$ + 10 0 DO _idle DROP LOOP + 0 ( dummy ) 10 0 DO ( r ) + DROP 0x40 0 0 SDCMDR1 ( CMD0 ) + 1 = DUP IF LEAVE THEN + LOOP NOT IF _err THEN + 0x48 0 0x1aa ( CMD8 ) SDCMDR7 ( r arg1 arg2 ) + ( expected 1 0 0x1aa ) + 0x1aa = ROT ( arg1 f r ) 1 = AND SWAP ( f&f arg1 ) + NOT ( 0 expected ) AND ( f&f&f ) NOT IF _err THEN + BEGIN + 0x77 0 0 SDCMDR1 ( CMD55 ) + 1 = NOT IF _err THEN + 0x69 0x4000 0 SDCMDR1 ( CMD41 ) + DUP 1 > IF _err THEN + NOT UNTIL ; ( out of idle mode, success! ) +( ----- 432 ) +: _ ( dstaddr blkno -- ) + [ SDC_DEVID LITN ] (spie) + 0x51 ( CMD17 ) 0 ROT ( a cmd 0 blkno ) _cmd + IF _err THEN + _wait 0xfe = NOT IF _err THEN + 0 SWAP ( crc a ) + 512 0 DO ( crc a ) + _idle ( crc a n ) + DUP ROT C!+ ( crc n a+1 ) + ROT> _crc16 ( a+1 crc ) + SWAP ( crc a+1 ) + LOOP + DROP ( crc1 ) + _idle 8 LSHIFT _idle + ( crc2 ) + _wait DROP 0 (spie) + = NOT IF _err THEN ; +( ----- 433 ) +: SDC@ + 2 * DUP BLK( SWAP ( b a b ) _ + 1+ BLK( 512 + SWAP _ +; +( ----- 434 ) +: _ ( srcaddr blkno -- ) + [ SDC_DEVID LITN ] (spie) + 0x58 ( CMD24 ) 0 ROT ( a cmd 0 blkno ) _cmd + IF _err THEN + _idle DROP 0xfe (spix) DROP 0 SWAP ( crc a ) + 512 0 DO ( crc a ) + C@+ ( crc a+1 n ) + ROT OVER ( a n crc n ) + _crc16 ( a n crc ) + SWAP ( a crc n ) + (spix) DROP ( a crc ) + SWAP ( crc a ) + LOOP + DROP ( crc ) 256 /MOD ( lsb msb ) + (spix) DROP (spix) DROP + _wait DROP 0 (spie) ; +( ----- 435 ) +: SDC! + 2 * DUP BLK( SWAP ( b a b ) _ + 1+ BLK( 512 + SWAP _ +; +( ----- 440 ) +8086 boot code + +Code in the following blocks assemble into a binary that is +suitable to plug into Core words (B350) to achieve a fully +functional Collapse OS. It is structured in a way that is +very similar to Z80 boot code (B280) and requires the same +constants to be pre-declared. + +RESERVED REGISTERS: SP is reserved for PSP, BP is for RSP and +DX is for IP. Whenever you use these registers for another +purpose, be sure to protect their initial value. Like with +Z80, you can use SP freely in native code, but you have to make +sure it goes back to its previous level before next is called. + + + (cont.) +( ----- 441 ) +STABLE ABI: As a compatible binary, this binary follows the +same stable ABI as its z80 counterpart. + +PS CHECKS: Unlike z80 boot code, we don't check PS at each next +call (we do check RS though). It is the responsibility of every +native PSP-modifying word to call chkPS, . Also, chkPS, is a +bit different than in z80: it is parametrizable. The idea is +that we always call chkPS, before popping, telling the expected +size of stack. This allows for some interesting optimization. +For example, in SWAP, no need to pop, chkPS, then push, we can +chkPS and then proceed to optimized swapping in PS. + +To assemble, load blocks 445 through 461 +( ----- 445 ) +VARIABLE lblexec VARIABLE lblnext +H@ ORG ! +JMPn, 0 A,, ( 00, main ) 0 A, ( 03, boot driveno ) +0 A,, ( 04, BOOT ) +0 A,, ( 06, uflw ) 0 A,, ( 08, LATEST ) 0 A,, ( unused ) +0 A, 0 A,, ( 0b, EXIT ) +0 A,, 0 A,, ( unused ) 0 A,, ( 13, oflw ) +0 A,, 0 A,, 0 A, ( unused ) +JMPn, 0 A,, ( 1a, next ) +( ----- 446 ) +( TODO: move these words with other native words. ) +H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) +CODE (br) L1 BSET ( used in ?br ) + DI DX MOVxx, AL [DI] MOVr[], AH AH XORrr, CBW, + DX AX ADDxx, +;CODE +CODE (?br) + AX POPx, AX AX ORxx, JZ, L1 @ RPCs, ( False, branch ) + ( True, skip next byte and don't branch ) + DX INCx, +;CODE +( ----- 447 ) +CODE (loop) + [BP] 0 INC[w]+, ( I++ ) + ( Jump if I <> I' ) + AX [BP] 0 MOVx[]+, AX [BP] -2 CMPx[]+, + JNZ, L1 @ RPCs, ( branch ) + ( don't branch ) + BP 4 SUBxi, DX INCx, +;CODE +( ----- 448 ) +lblnext BSET PC 0x1d - ORG @ 0x1b + ! ( next ) + ( ovfl check ) + BP SP CMPxx, + IFNC, ( BP >= SP ) + SP PS_ADDR MOVxI, BP RS_ADDR MOVxI, + DI 0x13 ( oflw ) MOVxm, JMPs, L1 FWRs ( execute ) + THEN, + DI DX MOVxx, ( <-- IP ) DX INCx, DX INCx, + DI [DI] MOVx[], ( wordref ) + ( continue to execute ) L1 FSET +( ----- 449 ) +lblexec BSET ( DI -> wordref ) + AL [DI] MOVr[], DI INCx, ( PFA ) + AL AL ORrr, IFZ, DI JMPr, THEN, ( native ) + AL DECr, IFNZ, ( not compiled ) + AL DECr, IFZ, ( cell ) + DI PUSHx, JMPs, lblnext @ RPCs, THEN, + AL DECr, IFZ, ( does ) + DI PUSHx, DI INCx, DI INCx, DI [DI] MOVx[], THEN, + ( alias or switch ) DI [DI] MOVx[], + AL DECr, IFNZ, ( switch ) DI [DI] MOVx[], THEN, + JMPs, lblexec @ RPCs, + THEN, ( continue to compiled ) + BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS ) + DX DI MOVxx, DX INCx, DX INCx, ( --> IP ) + DI [DI] MOVx[], JMPs, lblexec @ RPCs, +( ----- 450 ) +lblchkPS BSET ( CX -> expected size ) + AX PS_ADDR MOVxI, AX SP SUBxx, 2 SUBAXI, ( CALL adjust ) + AX CX CMPxx, + IFNC, ( we're good ) RET, THEN, + ( underflow ) DI 0x06 MOVxm, JMPs, lblexec @ RPCs, + +PC 3 - ORG @ 1+ ! ( main ) + DX POPx, ( boot drive no ) 0x03 DL MOVmr, + SP PS_ADDR MOVxI, BP RS_ADDR MOVxI, + DI 0x08 MOVxm, ( LATEST ) +( HERE begins at CURRENT ) + SYSVARS 0x4 ( HERE ) + DI MOVmx, + SYSVARS 0x2 ( CURRENT ) + DI MOVmx, + DI 0x04 ( BOOT ) MOVxm, + JMPn, lblexec @ RPCn, ( execute ) +( ----- 451 ) +( native words ) +CODE EXECUTE 1 chkPS, + DI POPx, JMPn, lblexec @ RPCn, +CODE EXIT + DX [BP] 0 MOVx[]+, BP DECx, BP DECx, ( popRS ) +;CODE +( ----- 452 ) +CODE (n) ( number literal ) + DI DX MOVxx, DI [DI] MOVx[], DI PUSHx, + DX INCx, DX INCx, +;CODE +CODE (s) ( string literal, see B287 ) + DI DX MOVxx, ( IP ) + AH AH XORrr, AL [DI] MOVr[], ( slen ) + DX PUSHx, DX INCx, DX AX ADDxx, +;CODE +( ----- 453 ) +CODE >R 1 chkPS, + BP INCx, BP INCx, [BP] 0 POP[w]+, +;CODE NOP, NOP, NOP, +CODE R> + [BP] 0 PUSH[w]+, BP DECx, BP DECx, +;CODE +CODE 2>R + [BP] 4 POP[w]+, [BP] 2 POP[w]+, BP 4 ADDxi, +;CODE +CODE 2R> 2 chkPS, + [BP] -2 PUSH[w]+, [BP] 0 PUSH[w]+, BP 4 SUBxi, +;CODE +( ----- 454 ) +CODE ROT ( a b c -- b c a ) 3 chkPS, + CX POPx, BX POPx, AX POPx, + BX PUSHx, CX PUSHx, AX PUSHx, ;CODE +CODE ROT> ( a b c -- c a b ) 3 chkPS, + CX POPx, BX POPx, AX POPx, + CX PUSHx, AX PUSHx, BX PUSHx, ;CODE +CODE DUP 1 chkPS, AX POPx, AX PUSHx, AX PUSHx, ;CODE +CODE ?DUP 1 chkPS, AX POPx, AX AX ORxx, AX PUSHx, + IFNZ, AX PUSHx, THEN, ;CODE +CODE OVER ( a b -- a b a ) 2 chkPS, + DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx, ;CODE +CODE PICK + DI POPx, DI SHLx1, ( x2 ) + CX DI MOVxx, CX 2 ADDxi, CALL, lblchkPS @ RPCn, + DI SP ADDxx, DI [DI] MOVx[], DI PUSHx, +;CODE +( ----- 455 ) +CODE (roll) ( "2 3 4 5 4 --> 2 4 5 5". See B311 ) + CX POPx, CX 2 ADDxi, CALL, lblchkPS @ RPCn, CX 2 SUBxi, + SI SP MOVxx, SI CX ADDxx, + DI SI MOVxx, DI 2 ADDxi, STD, REPZ, MOVSB, +;CODE +CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE +CODE DROP 1 chkPS, AX POPx, ;CODE +CODE 2DROP 2 chkPS, SP 4 ADDxi, ;CODE +CODE 2DUP 2 chkPS, + AX POPx, BX POPx, + BX PUSHx, AX PUSHx, BX PUSHx, AX PUSHx, +;CODE +CODE S0 AX PS_ADDR MOVxI, AX PUSHx, ;CODE +CODE 'S SP PUSHx, ;CODE +CODE AND 2 chkPS, + AX POPx, BX POPx, AX BX ANDxx, AX PUSHx, ;CODE +( ----- 456 ) +CODE OR 2 chkPS, + AX POPx, BX POPx, AX BX ORxx, AX PUSHx, ;CODE +CODE XOR 2 chkPS, + AX POPx, BX POPx, AX BX XORxx, AX PUSHx, ;CODE +CODE NOT 1 chkPS, + AX POPx, AX AX ORxx, + IFNZ, AX -1 MOVxI, THEN, AX INCx, AX PUSHx, ;CODE +CODE + 2 chkPS, + AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE +CODE - 2 chkPS, + BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE +CODE * 2 chkPS, + AX POPx, BX POPx, + DX PUSHx, ( protect from MUL ) BX MULx, DX POPx, + AX PUSHx, ;CODE +( ----- 457 ) +CODE /MOD 2 chkPS, + BX POPx, AX POPx, DX PUSHx, ( protect ) + DX DX XORxx, BX DIVx, + BX DX MOVxx, DX POPx, ( unprotect ) + BX PUSHx, ( modulo ) AX PUSHx, ( division ) +;CODE +CODE ! 2 chkPS, DI POPx, AX POPx, [DI] AX MOV[]x, ;CODE +CODE @ 1 chkPS, DI POPx, AX [DI] MOVx[], AX PUSHx, ;CODE +CODE C! 2 chkPS, DI POPx, AX POPx, [DI] AX MOV[]r, ;CODE +CODE C@ 1 chkPS, + DI POPx, AH AH XORrr, AL [DI] MOVr[], AX PUSHx, ;CODE +CODE I [BP] 0 PUSH[w]+, ;CODE +CODE I' [BP] -2 PUSH[w]+, ;CODE +CODE J [BP] -4 PUSH[w]+, ;CODE +CODE (resSP) SP PS_ADDR MOVxI, ;CODE +CODE (resRS) BP RS_ADDR MOVxI, ;CODE +( ----- 458 ) +CODE BYE HLT, BEGIN, JMPs, AGAIN, ;CODE +CODE S= 2 chkPS, + SI POPx, DI POPx, CH CH XORrr, CL [SI] MOVr[], + CL [DI] CMPr[], + IFZ, ( same size? ) + SI INCx, DI INCx, CLD, REPZ, CMPSB, + THEN, + PUSHZ, +;CODE +CODE CMP 2 chkPS, + BX POPx, AX POPx, CX CX XORxx, AX BX CMPxx, + IFNZ, ( < or > ) + CX INCx, IFC, ( < ) CX DECx, CX DECx, THEN, + THEN, + CX PUSHx, +;CODE +( ----- 459 ) +CODE _find ( cur w -- a f ) 2 chkPS, + SI POPx, ( w ) DI POPx, ( cur ) + CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen ) + SI INCx, ( first char ) AX AX XORxx, ( initial prev ) + BEGIN, ( loop ) + DI AX SUBxx, ( jump to prev wordref ) + AL [DI] -1 MOVr[]+, 0x7f ANDALi, ( strlen ) + CL AL CMPrr, IFZ, ( same len ) + SI PUSHx, DI PUSHx, CX PUSHx, ( --> lvl 3 ) + 3 ADDALi, ( header ) AH AH XORrr, DI AX SUBxx, + CLD, REPZ, CMPSB, + CX POPx, DI POPx, SI POPx, ( <-- lvl 3 ) + IFZ, DI PUSHx, AX 1 MOVxI, AX PUSHx, + JMPn, lblnext @ RPCn, THEN, + THEN, + DI 3 SUBxi, AX [DI] MOVx[], ( prev ) AX AX ORxx, ( cont. ) +( ----- 460 ) +( cont. find ) JNZ, AGAIN, ( loop ) + SI DECx, SI PUSHx, AX AX XORrr, AX PUSHx, +;CODE +CODE 0 AX AX XORxx, AX PUSHx, ;CODE +CODE 1 AX 1 MOVxI, AX PUSHx, ;CODE +CODE -1 AX -1 MOVxI, AX PUSHx, ;CODE +CODE 1+ 1 chkPS, DI SP MOVxx, [DI] INC[w], ;CODE +CODE 1- 1 chkPS, DI SP MOVxx, [DI] DEC[w], ;CODE +CODE 2+ 1 chkPS, DI SP MOVxx, [DI] INC[w], [DI] INC[w], ;CODE +CODE 2- 1 chkPS, DI SP MOVxx, [DI] DEC[w], [DI] DEC[w], ;CODE +CODE RSHIFT ( n u -- n ) 2 chkPS, + CX POPx, AX POPx, AX SHRxCL, AX PUSHx, ;CODE +CODE LSHIFT ( n u -- n ) 2 chkPS, + CX POPx, AX POPx, AX SHLxCL, AX PUSHx, ;CODE +( ----- 461 ) +( See comment in B321. TODO: test on real hardware. in qemu, + the resulting delay is more than 10x too long. ) +CODE TICKS 1 chkPS, ( n=100us ) + SI DX MOVxx, ( protect IP ) + AX POPx, BX 100 MOVxI, BX MULx, + CX DX MOVxx, ( high ) DX AX MOVxx, ( low ) + AX 0x8600 MOVxI, ( 86h, WAIT ) 0x15 INT, + DX SI MOVxx, ( restore IP ) +;CODE +( ----- 470 ) +( Z80 driver for TMS9918. Implements grid protocol. Requires +TMS_CTLPORT, TMS_DATAPORT and ~FNT from the Font compiler at +B520. Load range B470-472 ) +CODE _ctl ( a -- sends LSB then MSB ) + HL POP, chkPS, + A L LDrr, TMS_CTLPORT OUTiA, + A H LDrr, TMS_CTLPORT OUTiA, +;CODE +CODE _data + HL POP, chkPS, + A L LDrr, TMS_DATAPORT OUTiA, +;CODE +( ----- 471 ) +CODE _blank ( this is way too slow in Forth ) + A XORr, TMS_CTLPORT OUTiA, + A 0x40 LDri, TMS_CTLPORT OUTiA, + HL 0x4000 LDdi, + BEGIN, + A XORr, TMS_DATAPORT OUTiA, + HL DECd, HLZ, + JRNZ, AGAIN, +;CODE +( ----- 472 ) +( 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. ) +: _sfont ( a -- Send font to TMS ) + 7 0 DO C@+ _data LOOP DROP + ( blank row ) 0 _data ; +: CELL! ( tilenum pos ) + 0x7800 OR _ctl ( tilenum ) + 0x5e MOD _data ; +: COLS 40 ; : LINES 24 ; +: TMS$ + 0x8100 _ctl ( blank screen ) _blank + 0x4000 _ctl 0x5e 0 DO ~FNT I 7 * + _sfont LOOP + 0x820e _ctl ( name table 0x3800 ) + 0x8400 _ctl ( patter table 0x0000 ) + 0x87f0 _ctl ( colors 0 and 1 ) + 0x8000 _ctl 0x81d0 _ctl ( text mode, display on ) ; +( ----- 520 ) +Fonts + +Fonts are kept in "source" form in the following blocks and +then compiled to binary bitmasks by the following code. In +source form, fonts are a simple sequence of '.' and 'X'. '.' +means empty, 'X' means filled. Glyphs are entered one after the +other, starting at 0x21 and ending at 0x7e. To be space +efficient in blocks, we align glyphs horizontally in the blocks +to fit as many character as we can. For example, a 5x7 font +would mean that we would have 12x2 glyphs per block. + +521 Font compiler 530 3x5 font +532 5x7 font 536 7x7 font +( ----- 521 ) +( Converts "dot-X" fonts to binary "glyph rows". One byte for + each row. In a 5x7 font, each glyph thus use 7 bytes. + Resulting bytes are aligned to the left of the byte. + Therefore, for a 5-bit wide char, "X.X.X" translates to + 0b10101000. Left-aligned bytes are easier to work with when + compositing glyphs. ) +( ----- 522 ) +: _g ( given a top-left of dot-X in BLK(, spit 5 bin lines ) + 5 0 DO + 0 3 0 DO ( a r ) + 1 LSHIFT + OVER J 64 * I + + C@ 'X' = IF 1+ THEN + LOOP 5 LSHIFT C, LOOP DROP ; +: _l ( a u -- a, spit a line of u glyphs ) + ( u ) 0 DO ( a ) + DUP I 3 * + _g + LOOP ; +: CPFNT3x5 + 0 , 0 , 0 C, ( space char ) + 530 BLK@ BLK( 21 _l 320 + 21 _l 320 + 21 _l DROP ( 63 ) + 531 BLK@ BLK( 21 _l 320 + 10 _l DROP ( 94! ) +; +( ----- 523 ) +: _g ( given a top-left of dot-X in BLK(, spit 7 bin lines ) + 7 0 DO + 0 5 0 DO ( a r ) + 1 LSHIFT + OVER J 64 * I + + C@ 'X' = IF 1+ THEN + LOOP 3 LSHIFT C, LOOP DROP ; +: _l ( a u -- a, spit a line of u glyphs ) + ( u ) 0 DO ( a ) + DUP I 5 * + _g + LOOP ; +: CPFNT5x7 + 0 , 0 , 0 , 0 C, ( space char ) + 535 532 DO I BLK@ BLK( 12 _l 448 + 12 _l DROP LOOP ( 72 ) + 535 BLK@ BLK( 12 _l 448 + 10 _l DROP ( 94! ) +; +( ----- 524 ) +: _g ( given a top-left of dot-X in BLK(, spit 7 bin lines ) + 7 0 DO + 0 7 0 DO ( a r ) + 1 LSHIFT + OVER J 64 * I + + C@ 'X' = IF 1+ THEN + LOOP 1 LSHIFT C, LOOP DROP ; +: _l ( a u -- a, spit a line of u glyphs ) + ( u ) 0 DO ( a ) + DUP I 7 * + _g + LOOP ; +: CPFNT7x7 + 0 , 0 , 0 , 0 C, ( space char ) + 541 536 DO I BLK@ BLK( 9 _l 448 + 9 _l DROP LOOP ( 90 ) + 542 BLK@ BLK( 4 _l DROP ( 94! ) +; +( ----- 530 ) +.X.X.XX.X.XXX...X..X...XX...X...............X.X..X.XX.XX.X.XXXX +.X.X.XXXXXX...XX.X.X..X..X.XXX.X............XX.XXX...X..XX.XX.. +.X........XX.X..X.....X..X..X.XXX...XXX....X.X.X.X..X.XX.XXXXX. +......XXXXX.X..X.X....X..X.X.X.X..X.......X..X.X.X.X....X..X..X +.X....X.X.X...X.XX.....XX........X......X.X...X.XXXXXXXX...XXX. +.XXXXXXXXXXX........X...X..XX..X..X.XX..XXXX.XXXXXX.XXX.XXXXXXX +X....XX.XX.X.X..X..X.XXX.X...XXXXX.XX.XX..X.XX..X..X..X.X.X...X +XXX.X.XXXXXX......X.......X.X.XXXXXXXX.X..X.XXX.XX.X.XXXX.X...X +X.XX..X.X..X.X..X..X.XXX.X....X..X.XX.XX..X.XX..X..X.XX.X.X...X +XXXX..XXXXX....X....X...X...X..XXX.XXX..XXXX.XXXX...XXX.XXXXXX. +X.XX..X.XXX.XXXXX.XXXXX..XXXXXX.XX.XX.XX.XX.XXXXXXXX..XXX.X.... +XX.X..XXXX.XX.XX.XX.XX.XX...X.X.XX.XX.XX.XX.X..XX..X....XX.X... +X..X..XXXX.XX.XXX.X.XXX..X..X.X.XX.XXXX.X..X..X.X...X...X...... +XX.X..X.XX.XX.XX..XXXX.X..X.X.X.XX.XXXXX.X.X.X..X....X..X...... +X.XXXXX.XX.XXXXX...XXX.XXX..X.XXX.X.X.XX.X.X.XXXXXX..XXXX...XXX +!"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ +( ----- 531 ) +X.....X.......X....XX...X...X...XX..XX.......................X. +.X.XX.X...XX..X.X.X...X.X........X.X.X.X.XXX..X.XX..XX.XX.XXXXX +.....XXX.X...XXX.XXX.X.XXX..X...XXX..X.XXXX.XX.XX.XX.XX..XX..X. +...XXXX.XX..X.XXX.X...XXX.X.X...XX.X.X.X.XX.XX.XXX..XXX....X.X. +...XXXXX..XX.XX.XXX..XX.X.X.X.XX.X.X.XXX.XX.X.X.X....XX..XX..XX +...................XX.X.XX..................................... +X.XX.XX.XX.XX.XXXX.X..X..X..XX +X.XX.XX.X.X..X..XXX...X...XXX. +X.XX.XXXX.X..X.XX..X..X..X.... +XXX.X.X.XX.X.X.XXX.XX.X.XX.... +`abcdefghijklmnopqrstuvwxyz{|}~ +( ----- 532 ) +..X...X.X........X..............X....X....X...............X. +..X...X.X..X.X..XXXXX...X.XX....X...X......X.X.X.X..X....X.. +..X.......XXXXXX.......X.X..X......X........X.XXX...X....... +..X........X.X..XXX...X...XX.......X........XXXXXXXXXXX..... +..........XXXXX....X.X....XX.X.....X........X.XXX...X....... +..X........X.X.XXXX.X...XX..X.......X......X.X.X.X..X....... +..X..............X.......XXX.X.......X....X................. +................XXX...XX..XXX..XXX...XX.XXXXX.XXX.XXXXX.XXX. +..............XX...X.X.X.X...XX...X.X.X.X....X........XX...X +.............X.X..XX...X.....X....XX..X.XXXX.X........XX...X +XXXXX.......X..X.X.X...X....X...XX.XXXXX....XXXXX....X..XXX. +...........X...XX..X...X...X......X...X.....XX...X..X..X...X +......XX..X....X...X...X..X...X...X...X.X...XX...X.X...X...X +......XX........XXX..XXXXXXXXX.XXX....X..XXX..XXX.X.....XXX. +!"#$%&'()*+,-./012345678 +( ----- 533 ) +.XXX...............X.....X.....XXX..XXX..XXX.XXXX..XXX.XXXX. +X...X..X....X....XX.......XX..X...XX...XX...XX...XX...XX...X +X...X..X....X...XX..XXXXX..XX.....XX..XXX...XX...XX....X...X +.XXX...........X.............X...X.X..XXXXXXXXXXX.X....X...X +....X..X....X...XX..XXXXX..XX...X..X....X...XX...XX....X...X +....X..X...X.....XX.......XX.......X...XX...XX...XX...XX...X +.XXX...............X.....X......X...XXX.X...XXXXX..XXX.XXXX. +XXXXXXXXXX.XXX.X...X.XXX....XXX..X.X....X...XX...X.XXX.XXXX. +X....X....X...XX...X..X......XX.X..X....XX.XXXX..XX...XX...X +X....X....X....X...X..X......XXX...X....X.X.XXX..XX...XX...X +XXXX.XXXX.X..XXXXXXX..X......XX....X....X...XX.X.XX...XXXXX. +X....X....X...XX...X..X......XXX...X....X...XX..XXX...XX.... +X....X....X...XX...X..X..X...XX.X..X....X...XX..XXX...XX.... +XXXXXX.....XXX.X...X.XXX..XXX.X..X.XXXXXX...XX...X.XXX.X.... +9:;<=>?@ABCDEFGHIJKLMNOP +( ----- 534 ) +.XXX.XXXX..XXX.XXXXXX...XX...XX...XX...XX...XXXXXXXXX....... +X...XX...XX...X..X..X...XX...XX...XX...XX...XX...XX....X.... +X...XX...XX......X..X...XX...XX...X.X.X..X.X....X.X.....X... +X...XXXXX..XXX...X..X...XX...XX...X..X....X....X..X......X.. +X.X.XX.X......X..X..X...XX...XX.X.X.X.X...X...X...X.......X. +X..XXX..X.X...X..X..X...X.X.X.X.X.XX...X..X..X...XX........X +.XXXXX...X.XXX...X...XXX...X...X.X.X...X..X..XXXXXXXX....... +..XXX..X.........X.......................................... +....X.X.X.........X......................................... +....XX...X...........XXX.X.....XXX.....X.XXX..XX....XXXX.... +....X...................XX....X...X....XX...XX..X..X..XX.... +....X................XXXXXXX..X......XXXXXXXXX......XXXXXX.. +....X...............X...XX..X.X...X.X..XX....XXX......XX..X. +..XXX.....XXXXX......XXXXXXX...XXX...XXX.XXXXX......XX.X..X. +QRSTUVWXYZ[\]^_`abcdefgh +( ----- 535 ) +............................................................ +............................................................ +..X......XX..X..XX...X.X.XXX...XXX.XXX....XXXX.XX..XXX..X... +..........X.X....X..X.X.XX..X.X...XX..X..X..XXX...X....XXX.. +..X......XXX.....X..X...XX...XX...XXXX....XXXX.....XXX..X... +..X...X..XX.X....X..X...XX...XX...XX........XX........X.X... +..X....XX.X..X...XX.X...XX...X.XXX.X........XX.....XXX...XX. +................................XX...X...XX....... +...............................X.....X.....X...... +X...XX...XX...XX...XX...XXXXXX.X.....X.....X..X.X. +X...XX...XX...X.X.X..X.X....X.X......X......XX.X.. +X...XX...XX...X..X....X....X...X.....X.....X...... +X...X.X.X.X.X.X.X.X..X....X....X.....X.....X...... +.XXX...X...X.X.X...XX....XXXXX..XX...X...XX....... +ijklmnopqrstuvwxyz{|}~ +( ----- 536 ) +..XX....XX.XX..XX.XX....XX..XX......XXX......XX.....XX...XX.... +..XX....XX.XX..XX.XX..XXXXXXXX..XX.XX.XX....XX.....XX.....XX... +..XX....XX.XX.XXXXXXXXX.X......XX..XX.XX...XX.....XX.......XX.. +..XX...........XX.XX..XXXXX...XX....XXX...........XX.......XX.. +..XX..........XXXXXXX...X.XX.XX....XX.XX.X........XX.......XX.. +...............XX.XX.XXXXXX.XX..XX.XX..XX..........XX.....XX... +..XX...........XX.XX...XX.......XX..XXX.XX..........XX...XX.... +...........................................XXXX....XX....XXXX.. +..XX.....XX............................XX.XX..XX..XXX...XX..XX. +XXXXXX...XX...........................XX..XX.XXX...XX.......XX. +.XXXX..XXXXXX........XXXXXX..........XX...XXXXXX...XX......XX.. +XXXXXX...XX.........................XX....XXX.XX...XX.....XX... +..XX.....XX.....XX............XX...XX.....XX..XX...XX....XX.... +...............XX.............XX...........XXXX..XXXXXX.XXXXXX. +!"#$%&'()*+,-./012 +( ----- 537 ) +.XXXX.....XX..XXXXXX...XXX..XXXXXX..XXXX...XXXX................ +XX..XX...XXX..XX......XX........XX.XX..XX.XX..XX............... +....XX..XXXX..XXXXX..XX........XX..XX..XX.XX..XX...XX.....XX... +..XXX..XX.XX......XX.XXXXX....XX....XXXX...XXXXX...XX.....XX... +....XX.XXXXXX.....XX.XX..XX..XX....XX..XX.....XX............... +XX..XX....XX..XX..XX.XX..XX..XX....XX..XX....XX....XX.....XX... +.XXXX.....XX...XXXX...XXXX...XX.....XXXX...XXX.....XX....XX.... +...XX.........XX......XXXX...XXXX...XXXX..XXXXX...XXXX..XXXX... +..XX...........XX....XX..XX.XX..XX.XX..XX.XX..XX.XX..XX.XX.XX.. +.XX....XXXXXX...XX......XX..XX.XXX.XX..XX.XX..XX.XX.....XX..XX. +XX...............XX....XX...XX.X.X.XXXXXX.XXXXX..XX.....XX..XX. +.XX....XXXXXX...XX.....XX...XX.XXX.XX..XX.XX..XX.XX.....XX..XX. +..XX...........XX...........XX.....XX..XX.XX..XX.XX..XX.XX.XX.. +...XX.........XX.......XX....XXXX..XX..XX.XXXXX...XXXX..XXXX... +3456789:;<=>?@ABCD +( ----- 538 ) +XXXXXX.XXXXXX..XXXX..XX..XX.XXXXXX..XXXXX.XX..XX.XX.....XX...XX +XX.....XX.....XX..XX.XX..XX...XX......XX..XX.XX..XX.....XXX.XXX +XX.....XX.....XX.....XX..XX...XX......XX..XXXX...XX.....XXXXXXX +XXXXX..XXXXX..XX.XXX.XXXXXX...XX......XX..XXX....XX.....XX.X.XX +XX.....XX.....XX..XX.XX..XX...XX......XX..XXXX...XX.....XX.X.XX +XX.....XX.....XX..XX.XX..XX...XX...XX.XX..XX.XX..XX.....XX...XX +XXXXXX.XX......XXXX..XX..XX.XXXXXX..XXX...XX..XX.XXXXXX.XX...XX +XX..XX..XXXX..XXXXX...XXXX..XXXXX...XXXX..XXXXXX.XX..XX.XX..XX. +XX..XX.XX..XX.XX..XX.XX..XX.XX..XX.XX..XX...XX...XX..XX.XX..XX. +XXX.XX.XX..XX.XX..XX.XX..XX.XX..XX.XX.......XX...XX..XX.XX..XX. +XXXXXX.XX..XX.XXXXX..XX..XX.XXXXX...XXXX....XX...XX..XX.XX..XX. +XX.XXX.XX..XX.XX.....XX.X.X.XX.XX......XX...XX...XX..XX.XX..XX. +XX..XX.XX..XX.XX.....XX.XX..XX..XX.XX..XX...XX...XX..XX..XXXX.. +XX..XX..XXXX..XX......XX.XX.XX..XX..XXXX....XX....XXXX....XX... +EFGHIJKLMNOPQRSTUVWXYZ[\]^_ +( ----- 539 ) +XX...XXXX..XX.XX..XX.XXXXXX.XXXXX.........XXXXX....XX.......... +XX...XXXX..XX.XX..XX.....XX.XX.....XX........XX...XXXX......... +XX.X.XX.XXXX..XX..XX....XX..XX......XX.......XX..XX..XX........ +XX.X.XX..XX....XXXX....XX...XX.......XX......XX..X....X........ +XXXXXXX.XXXX....XX....XX....XX........XX.....XX................ +XXX.XXXXX..XX...XX...XX.....XX.........XX....XX................ +XX...XXXX..XX...XX...XXXXXX.XXXXX.........XXXXX.........XXXXXXX +.XX...........XX................XX..........XXX.........XX..... +..XX..........XX................XX.........XX.....XXXX..XX..... +...XX...XXXX..XXXXX...XXXX...XXXXX..XXXX...XX....XX..XX.XXXXX.. +...........XX.XX..XX.XX..XX.XX..XX.XX..XX.XXXXX..XX..XX.XX..XX. +........XXXXX.XX..XX.XX.....XX..XX.XXXXXX..XX.....XXXXX.XX..XX. +.......XX..XX.XX..XX.XX..XX.XX..XX.XX......XX........XX.XX..XX. +........XXXXX.XXXXX...XXXX...XXXXX..XXXX...XX.....XXX...XX..XX. +WXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ +( ----- 540 ) +..XX.....XX...XX......XXX...................................... +..............XX.......XX...................................... +.XXX....XXX...XX..XX...XX....XX.XX.XXXXX...XXXX..XXXXX...XXXXX. +..XX.....XX...XX.XX....XX...XXXXXXXXX..XX.XX..XX.XX..XX.XX..XX. +..XX.....XX...XXXX.....XX...XX.X.XXXX..XX.XX..XX.XX..XX.XX..XX. +..XX.....XX...XX.XX....XX...XX.X.XXXX..XX.XX..XX.XXXXX...XXXXX. +.XXXX..XX.....XX..XX..XXXX..XX...XXXX..XX..XXXX..XX.........XX. +...............XX.............................................. +...............XX.............................................. +XX.XX...XXXXX.XXXXX..XX..XX.XX..XX.XX...XXXX..XX.XX..XX.XXXXXX. +XXX.XX.XX......XX....XX..XX.XX..XX.XX.X.XX.XXXX..XX..XX....XX.. +XX......XXXX...XX....XX..XX.XX..XX.XX.X.XX..XX...XX..XX...XX... +XX.........XX..XX....XX..XX..XXXX..XXXXXXX.XXXX...XXXXX..XX.... +XX.....XXXXX....XXX...XXXXX...XX....XX.XX.XX..XX.....XX.XXXXXX. +ijklmnopqrstuvwxyz{|}~ +( ----- 541 ) +...XX....XX...XX......XX...X +..XX.....XX....XX....XX.X.XX +..XX.....XX....XX....X...XX. +XXX......XX.....XXX......... +..XX.....XX....XX........... +..XX.....XX....XX........... +...XX....XX...XX............ +{|}~ diff --git a/blk/000 b/blk/000 deleted file mode 100644 index 6ffaeb0..0000000 --- a/blk/000 +++ /dev/null @@ -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. diff --git a/blk/001 b/blk/001 deleted file mode 100644 index e90bb4d..0000000 --- a/blk/001 +++ /dev/null @@ -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 diff --git a/blk/005 b/blk/005 deleted file mode 100644 index 4f2da2e..0000000 --- a/blk/005 +++ /dev/null @@ -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+ diff --git a/blk/006 b/blk/006 deleted file mode 100644 index 8872d61..0000000 --- a/blk/006 +++ /dev/null @@ -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 ; diff --git a/blk/007 b/blk/007 deleted file mode 100644 index e58362d..0000000 --- a/blk/007 +++ /dev/null @@ -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+- ; diff --git a/blk/008 b/blk/008 deleted file mode 100644 index 7e8c1ec..0000000 --- a/blk/008 +++ /dev/null @@ -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, diff --git a/blk/009 b/blk/009 deleted file mode 100644 index 948cfc2..0000000 --- a/blk/009 +++ /dev/null @@ -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, diff --git a/blk/010 b/blk/010 deleted file mode 100644 index 9101b3c..0000000 --- a/blk/010 +++ /dev/null @@ -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, diff --git a/blk/011 b/blk/011 deleted file mode 100644 index 8d8fcc5..0000000 --- a/blk/011 +++ /dev/null @@ -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, ; diff --git a/blk/012 b/blk/012 deleted file mode 100644 index d7b8a10..0000000 --- a/blk/012 +++ /dev/null @@ -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, ; diff --git a/blk/013 b/blk/013 deleted file mode 100644 index 216b23b..0000000 --- a/blk/013 +++ /dev/null @@ -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, diff --git a/blk/014 b/blk/014 deleted file mode 100644 index 946aa69..0000000 --- a/blk/014 +++ /dev/null @@ -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, -; diff --git a/blk/015 b/blk/015 deleted file mode 100644 index b67e602..0000000 --- a/blk/015 +++ /dev/null @@ -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, diff --git a/blk/016 b/blk/016 deleted file mode 100644 index 13dc760..0000000 --- a/blk/016 +++ /dev/null @@ -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, diff --git a/blk/017 b/blk/017 deleted file mode 100644 index 4c3dfbb..0000000 --- a/blk/017 +++ /dev/null @@ -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, diff --git a/blk/018 b/blk/018 deleted file mode 100644 index 9ab2acc..0000000 --- a/blk/018 +++ /dev/null @@ -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, diff --git a/blk/019 b/blk/019 deleted file mode 100644 index 636df85..0000000 --- a/blk/019 +++ /dev/null @@ -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, diff --git a/blk/020 b/blk/020 deleted file mode 100644 index b48f5cf..0000000 --- a/blk/020 +++ /dev/null @@ -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), diff --git a/blk/021 b/blk/021 deleted file mode 100644 index ccb06e1..0000000 --- a/blk/021 +++ /dev/null @@ -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, diff --git a/blk/022 b/blk/022 deleted file mode 100644 index f366475..0000000 --- a/blk/022 +++ /dev/null @@ -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, diff --git a/blk/023 b/blk/023 deleted file mode 100644 index a200e00..0000000 --- a/blk/023 +++ /dev/null @@ -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), diff --git a/blk/024 b/blk/024 deleted file mode 100644 index 09169f8..0000000 --- a/blk/024 +++ /dev/null @@ -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), ; diff --git a/blk/025 b/blk/025 deleted file mode 100644 index 6303e25..0000000 --- a/blk/025 +++ /dev/null @@ -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, ; diff --git a/blk/026 b/blk/026 deleted file mode 100644 index 89581ad..0000000 --- a/blk/026 +++ /dev/null @@ -1,16 +0,0 @@ -( Place BEGIN, where you want to jump back and AGAIN after - a relative jump operator. Just like BSET and BWR. ) -: BEGIN, PC ; -: BSET PC SWAP ! ; -( same as BSET, but we need to write a placeholder ) -: FJR, PC 0 A, ; -: IFZ, JRNZ, FJR, ; -: IFNZ, JRZ, FJR, ; -: IFC, JRNC, FJR, ; -: IFNC, JRC, FJR, ; -: THEN, - DUP PC ( l l pc ) - -^ 1- ( l off ) - ( warning: l is a PC offset, not a mem addr! ) - SWAP ORG @ + BIN( @ - ( off addr ) - C! ; diff --git a/blk/027 b/blk/027 deleted file mode 100644 index e0d77cc..0000000 --- a/blk/027 +++ /dev/null @@ -1,8 +0,0 @@ -: FWR BSET 0 A, ; -: FSET @ THEN, ; -: BREAK, FJR, 0x8000 OR ; -: BREAK?, DUP 0x8000 AND IF - 0x7fff AND 1 ALLOT THEN, -1 ALLOT - THEN ; -: AGAIN, BREAK?, PC - 1- A, ; -: BWR @ AGAIN, ; diff --git a/blk/028 b/blk/028 deleted file mode 100644 index a0c089a..0000000 --- a/blk/028 +++ /dev/null @@ -1,12 +0,0 @@ -( Macros ) -( clear carry + SBC ) -: SUBHLd, A ORr, SBCHLd, ; -: PUSH0, DE 0 LDdi, DE PUSH, ; -: PUSH1, DE 1 LDdi, DE PUSH, ; -: PUSHZ, DE 0 LDdi, IFZ, DE INCd, THEN, DE PUSH, ; -: PUSHA, D 0 LDri, E A LDrr, DE PUSH, ; -: HLZ, A H LDrr, L ORr, ; -: DEZ, A D LDrr, E ORr, ; -: LDDE(HL), E (HL) LDrr, HL INCd, D (HL) LDrr, ; -: OUTHL, DUP A H LDrr, OUTiA, A L LDrr, OUTiA, ; -: OUTDE, DUP A D LDrr, OUTiA, A E LDrr, OUTiA, ; diff --git a/blk/030 b/blk/030 deleted file mode 100644 index 56ea9c5..0000000 --- a/blk/030 +++ /dev/null @@ -1,2 +0,0 @@ -( 8086 assembler. See doc/asm.txt ) -1 13 LOADR+ diff --git a/blk/031 b/blk/031 deleted file mode 100644 index 8ea06c4..0000000 --- a/blk/031 +++ /dev/null @@ -1,11 +0,0 @@ -VARIABLE ORG -CREATE BIN( 0 , : BIN(+ BIN( @ + ; -VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4 -: AL 0 ; : CL 1 ; : DL 2 ; : BL 3 ; -: AH 4 ; : CH 5 ; : DH 6 ; : BH 7 ; -: AX 0 ; : CX 1 ; : DX 2 ; : BX 3 ; -: SP 4 ; : BP 5 ; : SI 6 ; : DI 7 ; -: ES 0 ; : CS 1 ; : SS 2 ; : DS 3 ; -: [BX+SI] 0 ; : [BX+DI] 1 ; : [BP+SI] 2 ; : [BP+DI] 3 ; -: [SI] 4 ; : [DI] 5 ; : [BP] 6 ; : [BX] 7 ; -: <<3 3 LSHIFT ; diff --git a/blk/032 b/blk/032 deleted file mode 100644 index f92d7c0..0000000 --- a/blk/032 +++ /dev/null @@ -1,6 +0,0 @@ -( Splits word into msb/lsb, lsb being on TOS ) -: SPLITB - 256 /MOD SWAP -; -: PC H@ ORG @ - BIN( @ + ; -: A,, SPLITB A, A, ; diff --git a/blk/033 b/blk/033 deleted file mode 100644 index 1dbce6d..0000000 --- a/blk/033 +++ /dev/null @@ -1,16 +0,0 @@ -: OP1 CREATE C, DOES> C@ A, ; -0xc3 OP1 RET, 0xfa OP1 CLI, 0xfb OP1 STI, -0xf4 OP1 HLT, 0xfc OP1 CLD, 0xfd OP1 STD, -0x90 OP1 NOP, 0x98 OP1 CBW, -0xf3 OP1 REPZ, 0xf2 OP1 REPNZ, 0xac OP1 LODSB, -0xad OP1 LODSW, 0xa6 OP1 CMPSB, 0xa7 OP1 CMPSW, -0xa4 OP1 MOVSB, 0xa5 OP1 MOVSW, 0xae OP1 SCASB, -0xaf OP1 SCASW, 0xaa OP1 STOSB, 0xab OP1 STOSW, -( no argument, jumps with relative addrs are special ) -0xeb OP1 JMPs, 0xe9 OP1 JMPn, 0x74 OP1 JZ, -0x75 OP1 JNZ, 0x72 OP1 JC, 0x73 OP1 JNC, -0xe8 OP1 CALL, - -: OP1r CREATE C, DOES> C@ + A, ; -0x40 OP1r INCx, 0x48 OP1r DECx, -0x58 OP1r POPx, 0x50 OP1r PUSHx, diff --git a/blk/034 b/blk/034 deleted file mode 100644 index 328a007..0000000 --- a/blk/034 +++ /dev/null @@ -1,10 +0,0 @@ -: OPr0 ( reg op ) CREATE C, C, DOES> - C@+ A, C@ <<3 OR 0xc0 OR A, ; -0 0xd0 OPr0 ROLr1, 0 0xd1 OPr0 ROLx1, 4 0xf6 OPr0 MULr, -1 0xd0 OPr0 RORr1, 1 0xd1 OPr0 RORx1, 4 0xf7 OPr0 MULx, -4 0xd0 OPr0 SHLr1, 4 0xd1 OPr0 SHLx1, 6 0xf6 OPr0 DIVr, -5 0xd0 OPr0 SHRr1, 5 0xd1 OPr0 SHRx1, 6 0xf7 OPr0 DIVx, -0 0xd2 OPr0 ROLrCL, 0 0xd3 OPr0 ROLxCL, 1 0xfe OPr0 DECr, -1 0xd2 OPr0 RORrCL, 1 0xd3 OPr0 RORxCL, 0 0xfe OPr0 INCr, -4 0xd2 OPr0 SHLrCL, 4 0xd3 OPr0 SHLxCL, -5 0xd2 OPr0 SHRrCL, 5 0xd3 OPr0 SHRxCL, diff --git a/blk/035 b/blk/035 deleted file mode 100644 index e45d35b..0000000 --- a/blk/035 +++ /dev/null @@ -1,6 +0,0 @@ -: OPrr CREATE C, DOES> C@ A, <<3 OR 0xc0 OR A, ; -0x31 OPrr XORxx, 0x30 OPrr XORrr, -0x88 OPrr MOVrr, 0x89 OPrr MOVxx, 0x28 OPrr SUBrr, -0x29 OPrr SUBxx, 0x08 OPrr ORrr, 0x09 OPrr ORxx, -0x38 OPrr CMPrr, 0x39 OPrr CMPxx, 0x00 OPrr ADDrr, -0x01 OPrr ADDxx, 0x20 OPrr ANDrr, 0x21 OPrr ANDxx, diff --git a/blk/036 b/blk/036 deleted file mode 100644 index 472d027..0000000 --- a/blk/036 +++ /dev/null @@ -1,10 +0,0 @@ -: OPm ( modrm op ) CREATE C, C, DOES> C@+ A, C@ OR A, ; -0 0xff OPm INC[w], 0 0xfe OPm INC[b], -0x8 0xff OPm DEC[w], 0x8 0xfe OPm DEC[b], -0x30 0xff OPm PUSH[w], 0 0x8f OPm POP[w], - -: OPm+ ( modrm op ) CREATE C, C, DOES> - ( m off ) C@+ A, C@ ROT OR A, A, ; -0x40 0xff OPm+ INC[w]+, 0x40 0xfe OPm+ INC[b]+, -0x48 0xff OPm+ DEC[w]+, 0x48 0xfe OPm+ DEC[b]+, -0x70 0xff OPm+ PUSH[w]+, 0x40 0x8f OPm+ POP[w]+, diff --git a/blk/037 b/blk/037 deleted file mode 100644 index 63f1800..0000000 --- a/blk/037 +++ /dev/null @@ -1,15 +0,0 @@ -: OPrm CREATE C, DOES> C@ A, SWAP 3 LSHIFT OR A, ; -0x8a OPrm MOVr[], 0x8b OPrm MOVx[], -0x3a OPrm CMPr[], 0x3b OPrm CMPx[], - -: OPmr CREATE C, DOES> C@ A, 3 LSHIFT OR A, ; -0x88 OPmr MOV[]r, 0x89 OPmr MOV[]x, - -: OPrm+ ( r m off ) CREATE C, DOES> - C@ A, ROT 3 LSHIFT ROT OR 0x40 OR A, A, ; -0x8a OPrm+ MOVr[]+, 0x8b OPrm+ MOVx[]+, -0x3a OPrm+ CMPr[]+, 0x3b OPrm+ CMPx[]+, - -: OPm+r ( m off r ) CREATE C, DOES> - C@ A, 3 LSHIFT ROT OR 0x40 OR A, A, ; -0x88 OPm+r MOV[]+r, 0x89 OPm+r MOV[]+x, diff --git a/blk/038 b/blk/038 deleted file mode 100644 index b841eea..0000000 --- a/blk/038 +++ /dev/null @@ -1,5 +0,0 @@ -: OPi CREATE C, DOES> C@ A, A, ; -0x04 OPi ADDALi, 0x24 OPi ANDALi, 0x2c OPi SUBALi, -0xcd OPi INT, -: OPI CREATE C, DOES> C@ A, A,, ; -0x05 OPI ADDAXI, 0x25 OPI ANDAXI, 0x2d OPI SUBAXI, diff --git a/blk/040 b/blk/040 deleted file mode 100644 index 3bd1d16..0000000 --- a/blk/040 +++ /dev/null @@ -1,12 +0,0 @@ -: MOVri, SWAP 0xb0 OR A, A, ; -: MOVxI, SWAP 0xb8 OR A, A,, ; -: MOVsx, 0x8e A, SWAP <<3 OR 0xc0 OR A, ; -: MOVrm, 0x8a A, SWAP <<3 0x6 OR A, A,, ; -: MOVxm, 0x8b A, SWAP <<3 0x6 OR A, A,, ; -: MOVmr, 0x88 A, <<3 0x6 OR A, A,, ; -: MOVmx, 0x89 A, <<3 0x6 OR A, A,, ; -: PUSHs, <<3 0x06 OR A, ; : POPs, <<3 0x07 OR A, ; -: SUBxi, 0x83 A, SWAP 0xe8 OR A, A, ; -: ADDxi, 0x83 A, SWAP 0xc0 OR A, A, ; -: JMPr, 0xff A, 7 AND 0xe0 OR A, ; -: JMPf, ( seg off ) 0xea A, SPLITB A, A, A,, ; diff --git a/blk/041 b/blk/041 deleted file mode 100644 index 5625538..0000000 --- a/blk/041 +++ /dev/null @@ -1,16 +0,0 @@ -( Place BEGIN, where you want to jump back and AGAIN after - a relative jump operator. Just like BSET and BWR. ) -: BEGIN, PC ; -: BSET PC SWAP ! ; -( same as BSET, but we need to write a placeholder ) -: FJR, PC 0 A, ; -: IFZ, JNZ, FJR, ; -: IFNZ, JZ, FJR, ; -: IFC, JNC, FJR, ; -: IFNC, JC, FJR, ; -: THEN, - DUP PC ( l l pc ) - -^ 1- ( l off ) - ( warning: l is a PC offset, not a mem addr! ) - SWAP ORG @ + BIN( @ - ( off addr ) - C! ; diff --git a/blk/042 b/blk/042 deleted file mode 100644 index cac2fcf..0000000 --- a/blk/042 +++ /dev/null @@ -1,11 +0,0 @@ -: FWRs BSET 0 A, ; -: FSET @ THEN, ; -( : BREAK, FJR, 0x8000 OR ; -: BREAK?, DUP 0x8000 AND IF - 0x7fff AND 1 ALLOT THEN, -1 ALLOT - THEN ; ) -: RPCs, PC - 1- DUP 128 + 0xff > IF ABORT" PC ovfl" THEN A, ; -: RPCn, PC - 2- A,, ; -: AGAIN, ( BREAK?, ) RPCs, ; -( Use RPCx with appropriate JMP/CALL op. Example: - JMPs, 0x42 RPCs, or CALL, 0x1234 RPCn, ) diff --git a/blk/043 b/blk/043 deleted file mode 100644 index 7955e94..0000000 --- a/blk/043 +++ /dev/null @@ -1,7 +0,0 @@ -: PUSHZ, CX 0 MOVxI, IFZ, CX INCx, THEN, CX PUSHx, ; -: CODE ( same as CREATE, but with native word ) - (entry) 0 ( native ) C, ; -: ;CODE JMPn, 0x1a ( next ) RPCn, ; -VARIABLE lblchkPS -: chkPS, ( sz -- ) - CX SWAP 2 * MOVxI, CALL, lblchkPS @ RPCn, ; diff --git a/blk/050 b/blk/050 deleted file mode 100644 index 6b830ca..0000000 --- a/blk/050 +++ /dev/null @@ -1 +0,0 @@ -1 12 LOADR+ diff --git a/blk/051 b/blk/051 deleted file mode 100644 index be5ac92..0000000 --- a/blk/051 +++ /dev/null @@ -1,10 +0,0 @@ -VARIABLE ORG -VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4 -: SPLITB - 256 /MOD SWAP -; -( We divide by 2 because each PC represents a word. ) -: PC H@ ORG @ - 1 RSHIFT ; -( A, spits an assembled byte, A,, spits an assembled word - Both increase PC. ) -: A,, SPLITB A, A, ; diff --git a/blk/052 b/blk/052 deleted file mode 100644 index 504a7fa..0000000 --- a/blk/052 +++ /dev/null @@ -1,7 +0,0 @@ -: _oor ." arg out of range: " .X SPC ." PC: " PC .X NL ABORT ; -: _r8c DUP 7 > IF _oor THEN ; -: _r32c DUP 31 > IF _oor THEN ; -: _r16+c _r32c DUP 16 < IF _oor THEN ; -: _r64c DUP 63 > IF _oor THEN ; -: _r256c DUP 255 > IF _oor THEN ; -: _Rdp ( op rd -- op', place Rd ) 4 LSHIFT OR ; diff --git a/blk/053 b/blk/053 deleted file mode 100644 index 021b926..0000000 --- a/blk/053 +++ /dev/null @@ -1,10 +0,0 @@ -( 0000 000d dddd 0000 ) -: OPRd CREATE , DOES> @ SWAP _r32c _Rdp A,, ; -0b1001010000000101 OPRd ASR, 0b1001010000000000 OPRd COM, -0b1001010000001010 OPRd DEC, 0b1001010000000011 OPRd INC, -0b1001001000000110 OPRd LAC, 0b1001001000000101 OPRd LAS, -0b1001001000000111 OPRd LAT, -0b1001010000000110 OPRd LSR, 0b1001010000000001 OPRd NEG, -0b1001000000001111 OPRd POP, 0b1001001000001111 OPRd PUSH, -0b1001010000000111 OPRd ROR, 0b1001010000000010 OPRd SWAP, -0b1001001000000100 OPRd XCH, diff --git a/blk/054 b/blk/054 deleted file mode 100644 index 6aff3dd..0000000 --- a/blk/054 +++ /dev/null @@ -1,15 +0,0 @@ -( 0000 00rd dddd rrrr ) -: OPRdRr CREATE C, DOES> C@ ( rd rr op ) - OVER _r32c 0x10 AND 3 RSHIFT OR ( rd rr op' ) - 8 LSHIFT OR 0xff0f AND ( rd op' ) - SWAP _r32c _Rdp A,, ; -0x1c OPRdRr ADC, 0x0c OPRdRr ADD, 0x20 OPRdRr AND, -0x14 OPRdRr CP, 0x04 OPRdRr CPC, 0x10 OPRdRr CPSE, -0x24 OPRdRr EOR, 0x2c OPRdRr MOV, 0x9c OPRdRr MUL, -0x28 OPRdRr OR, 0x08 OPRdRr SBC, 0x18 OPRdRr SUB, - -( 0000 0AAd dddd AAAA ) -: OPRdA CREATE C, DOES> C@ ( rd A op ) - OVER _r64c 0x30 AND 3 RSHIFT OR ( rd A op' ) - 8 LSHIFT OR 0xff0f AND ( rd op' ) SWAP _r32c _Rdp A,, ; -0xb0 OPRdA IN, 0xb8 OPRdA _ : OUT, SWAP _ ; diff --git a/blk/055 b/blk/055 deleted file mode 100644 index 236bb0a..0000000 --- a/blk/055 +++ /dev/null @@ -1,13 +0,0 @@ -( 0000 KKKK dddd KKKK ) -: OPRdK CREATE C, DOES> C@ ( rd K op ) - OVER _r256c 0xf0 AND 4 RSHIFT OR ( rd K op' ) - ROT _r16+c 4 LSHIFT ROT 0x0f AND OR ( op' rdK ) A, A, ; -0x70 OPRdK ANDI, 0x30 OPRdK CPI, 0xe0 OPRdK LDI, -0x60 OPRdK ORI, 0x40 OPRdK SBCI, 0x60 OPRdK SBR, -0x50 OPRdK SUBI, - -( 0000 0000 AAAA Abbb ) -: OPAb CREATE C, DOES> C@ ( A b op ) - ROT _r32c 3 LSHIFT ROT _r8c OR A, A, ; -0x98 OPAb CBI, 0x9a OPAb SBI, 0x99 OPAb SBIC, -0x9b OPAb SBIS, diff --git a/blk/056 b/blk/056 deleted file mode 100644 index 6a05bb7..0000000 --- a/blk/056 +++ /dev/null @@ -1,10 +0,0 @@ -: OPNA CREATE , DOES> @ A,, ; -0x9598 OPNA BREAK, 0x9488 OPNA CLC, 0x94d8 OPNA CLH, -0x94f8 OPNA CLI, 0x94a8 OPNA CLN, 0x94c8 OPNA CLS, -0x94e8 OPNA CLT, 0x94b8 OPNA CLV, 0x9498 OPNA CLZ, -0x9419 OPNA EIJMP, 0x9509 OPNA ICALL, 0x9519 OPNA EICALL, -0x9409 OPNA IJMP, 0x0000 OPNA NOP, 0x9508 OPNA RET, -0x9518 OPNA RETI, 0x9408 OPNA SEC, 0x9458 OPNA SEH, -0x9478 OPNA SEI, 0x9428 OPNA SEN, 0x9448 OPNA SES, -0x9468 OPNA SET, 0x9438 OPNA SEV, 0x9418 OPNA SEZ, -0x9588 OPNA SLEEP, 0x95a8 OPNA WDR, diff --git a/blk/057 b/blk/057 deleted file mode 100644 index f5e79dd..0000000 --- a/blk/057 +++ /dev/null @@ -1,13 +0,0 @@ -( 0000 0000 0sss 0000 ) -: OPb CREATE , DOES> @ ( b op ) - SWAP _r8c _Rdp A,, ; -0b1001010010001000 OPb BCLR, 0b1001010000001000 OPb BSET, - -( 0000 000d dddd 0bbb ) -: OPRdb CREATE , DOES> @ ( rd b op ) - ROT _r32c _Rdp SWAP _r8c OR A,, ; -0b1111100000000000 OPRdb BLD, 0b1111101000000000 OPRdb BST, -0b1111110000000000 OPRdb SBRC, 0b1111111000000000 OPRdb SBRS, - -( special cases ) -: CLR, DUP EOR, ; : TST, DUP AND, ; : LSL, DUP ADD, ; diff --git a/blk/058 b/blk/058 deleted file mode 100644 index 0b21fe6..0000000 --- a/blk/058 +++ /dev/null @@ -1,7 +0,0 @@ -( a -- k12, absolute addr a, relative to PC in a k12 addr ) -: _r7ffc DUP 0x7ff > IF _oor THEN ; -: _raddr12 - PC - DUP 0< IF 0x800 + _r7ffc 0x800 OR ELSE _r7ffc THEN ; -: RJMP _raddr12 0xc000 OR ; -: RCALL _raddr12 0xd000 OR ; -: RJMP, RJMP A,, ; : RCALL, RCALL A,, ; diff --git a/blk/059 b/blk/059 deleted file mode 100644 index d4828a4..0000000 --- a/blk/059 +++ /dev/null @@ -1,11 +0,0 @@ -( a -- k7, absolute addr a, relative to PC in a k7 addr ) -: _r3fc DUP 0x3f > IF _oor THEN ; -: _raddr7 - PC - DUP 0< IF 0x40 + _r3fc 0x40 OR ELSE _r3fc THEN ; -: _brbx ( a b op -- a ) OR SWAP _raddr7 3 LSHIFT OR ; -: BRBC 0xf400 _brbx ; : BRBS 0xf000 _brbx ; : BRCC 0 BRBC ; -: BRCS 0 BRBS ; : BREQ 1 BRBS ; : BRNE 1 BRBC ; : BRGE 4 BRBC ; -: BRHC 5 BRBC ; : BRHS 5 BRBS ; : BRID 7 BRBC ; : BRIE 7 BRBS ; -: BRLO BRCS ; : BRLT 4 BRBS ; : BRMI 2 BRBS ; : BRPL 2 BRBC ; -: BRSH BRCC ; : BRTC 6 BRBC ; : BRTS 6 BRBS ; : BRVC 3 BRBC ; -: BRVS 3 BRBS ; diff --git a/blk/060 b/blk/060 deleted file mode 100644 index df8ccd5..0000000 --- a/blk/060 +++ /dev/null @@ -1,6 +0,0 @@ -0b11100 CONSTANT X 0b01000 CONSTANT Y 0b00000 CONSTANT Z -0b11101 CONSTANT X+ 0b11001 CONSTANT Y+ 0b10001 CONSTANT Z+ -0b11110 CONSTANT -X 0b11010 CONSTANT -Y 0b10010 CONSTANT -Z -: _ldst ( Rd XYZ op ) SWAP DUP 0x10 AND 8 LSHIFT SWAP 0xf AND - OR OR ( Rd op' ) SWAP _Rdp A,, ; -: LD, 0x8000 _ldst ; : ST, SWAP 0x8200 _ldst ; diff --git a/blk/061 b/blk/061 deleted file mode 100644 index 4e30db4..0000000 --- a/blk/061 +++ /dev/null @@ -1,15 +0,0 @@ -( L1 LBL! .. L1 ' RJMP LBL, ) -: LBL! ( l -- ) PC SWAP ! ; -: LBL, ( l op -- ) SWAP @ 1- SWAP EXECUTE A,, ; -: SKIP, PC 0 A,, ; -: TO, ( opw pc ) - ( warning: pc is a PC offset, not a mem addr! ) - 2 * ORG @ + PC 1- H@ ( opw addr tgt hbkp ) - ROT HERE ! ( opw tgt hbkp ) SWAP ROT EXECUTE H@ ! ( hbkp ) - HERE ! ; -( L1 FLBL, .. L1 ' RJMP FLBL! ) -: FLBL, ( l -- ) LBL! 0 A,, ; -: FLBL! ( l opw -- ) SWAP @ TO, ; -: BEGIN, PC ; : AGAIN?, ( op ) SWAP 1- SWAP EXECUTE A,, ; -: AGAIN, ['] RJMP AGAIN?, ; -: IF, ['] BREQ SKIP, ; : THEN, TO, ; diff --git a/blk/062 b/blk/062 deleted file mode 100644 index 87b1c11..0000000 --- a/blk/062 +++ /dev/null @@ -1,8 +0,0 @@ -( Constant common to all AVR models ) -: R0 0 ; : R1 1 ; : R2 2 ; : R3 3 ; : R4 4 ; : R5 5 ; : R6 6 ; -: R7 7 ; : R8 8 ; : R9 9 ; : R10 10 ; : R11 11 ; : R12 12 ; -: R13 13 ; : R14 14 ; : R15 15 ; : R16 16 ; : R17 17 ; -: R18 18 ; : R19 19 ; : R20 20 ; : R21 21 ; : R22 22 ; -: R24 24 ; : R25 25 ; : R26 26 ; : R27 27 ; : R28 28 ; -: R29 29 ; : R30 30 ; : R31 31 ; : XL R26 ; : XH R27 ; -: YL R28 ; : YH R29 ; : ZL R30 ; : ZH R31 ; diff --git a/blk/065 b/blk/065 deleted file mode 100644 index 1de4477..0000000 --- a/blk/065 +++ /dev/null @@ -1,16 +0,0 @@ -( ATmega328P definitions ) : > CONSTANT ; -0xc6 > UDR0 0xc4 > UBRR0L 0xc5 > UBRR0H 0xc2 > UCSR0C -0xc1 > UCSR0B 0xc0 > UCSR0A 0xbd > TWAMR 0xbc > TWCR -0xbb > TWDR 0xba > TWAR 0xb9 > TWSR 0xb8 > TWBR 0xb6 > ASSR -0xb4 > OCR2B 0xb3 > OCR2A 0xb2 > TCNT2 0xb1 > TCCR2B -0xb0 > TCCR2A 0x8a > OCR1BL 0x8b > OCR1BH 0x88 > OCR1AL -0x89 > OCR1AH 0x86 > ICR1L 0x87 > ICR1H 0x84 > TCNT1L -0x85 > TCNT1H 0x82 > TCCR1C 0x81 > TCCR1B 0x80 > TCCR1A -0x7f > DIDR1 0x7e > DIDR0 0x7c > ADMUX 0x7b > ADCSRB -0x7a > ADCSRA 0x79 > ADCH 0x78 > ADCL 0x70 > TIMSK2 -0x6f > TIMSK1 0x6e > TIMSK0 0x6c > PCMSK1 0x6d > PCMSK2 -0x6b > PCMSK0 0x69 > EICRA 0x68 > PCICR 0x66 > OSCCAL -0x64 > PRR 0x61 > CLKPR 0x60 > WDTCSR 0x3f > SREG 0x3d > SPL -0x3e > SPH 0x37 > SPMCSR 0x35 > MCUCR 0x34 > MCUSR 0x33 > SMCR -0x30 > ACSR 0x2e > SPDR 0x2d > SPSR 0x2c > SPCR 0x2b > GPIOR2 -0x2a > GPIOR1 0x28 > OCR0B 0x27 > OCR0A 0x26 > TCNT0 ( cont. ) diff --git a/blk/066 b/blk/066 deleted file mode 100644 index 3c6f9eb..0000000 --- a/blk/066 +++ /dev/null @@ -1,6 +0,0 @@ -( cont. ) 0x25 > TCCR0B 0x24 > TCCR0A 0x23 > GTCCR -0x22 > EEARH 0x21 > EEARL 0x20 > EEDR 0x1f > EECR -0x1e > GPIOR0 0x1d > EIMSK 0x1c > EIFR 0x1b > PCIFR -0x17 > TIFR2 0x16 > TIFR1 0x15 > TIFR0 0x0b > PORTD 0x0a > DDRD -0x09 > PIND 0x08 > PORTC 0x07 > DDRC 0x06 > PINC 0x05 > PORTB -0x04 > DDRB 0x03 > PINB diff --git a/blk/100 b/blk/100 deleted file mode 100644 index 79ecb65..0000000 --- a/blk/100 +++ /dev/null @@ -1,6 +0,0 @@ -Block editor - -This is an application to conveniently browse the contents of -the disk blocks and edit them. You can load it with "105 LOAD". - -See doc/ed.txt diff --git a/blk/105 b/blk/105 deleted file mode 100644 index 2bb238b..0000000 --- a/blk/105 +++ /dev/null @@ -1 +0,0 @@ -1 7 LOADR+ diff --git a/blk/106 b/blk/106 deleted file mode 100644 index 035e816..0000000 --- a/blk/106 +++ /dev/null @@ -1,5 +0,0 @@ -CREATE ACC 0 , -: _LIST ." Block " DUP . NL LIST ; -: L BLK> @ _LIST ; -: B BLK> @ 1- BLK@ L ; -: N BLK> @ 1+ BLK@ L ; diff --git a/blk/107 b/blk/107 deleted file mode 100644 index a64046c..0000000 --- a/blk/107 +++ /dev/null @@ -1,13 +0,0 @@ -( Cursor position in buffer. EDPOS/64 is line number ) -CREATE EDPOS 0 , -CREATE IBUF 64 ALLOT0 -CREATE FBUF 64 ALLOT0 -: _cpos BLK( + ; -: _lpos 64 * _cpos ; -: _pln ( lineno -- ) - DUP _lpos DUP 64 + SWAP DO ( lno ) - I EDPOS @ _cpos = IF '^' EMIT THEN - I C@ DUP 0x20 < IF DROP 0x20 THEN - EMIT - LOOP ( lno ) 1+ . ; -: _zbuf 64 0 FILL ; ( buf -- ) diff --git a/blk/108 b/blk/108 deleted file mode 100644 index 176a01b..0000000 --- a/blk/108 +++ /dev/null @@ -1,12 +0,0 @@ -: _type ( buf -- ) - C< DUP 0xd = IF 2DROP EXIT THEN SWAP DUP _zbuf ( c a ) - BEGIN ( c a ) C!+ C< TUCK 0x0d = UNTIL ( c a ) C! ; -( user-facing lines are 1-based ) -: T 1- DUP 64 * EDPOS ! _pln ; -: P IBUF _type IBUF EDPOS @ _cpos 64 MOVE BLK!! ; -: _mvln+ ( ln -- move ln 1 line down ) - DUP 14 > IF DROP EXIT THEN - _lpos DUP 64 + 64 MOVE ; -: _mvln- ( ln -- move ln 1 line up ) - DUP 14 > IF DROP 15 _lpos _zbuf - ELSE 1+ _lpos DUP 64 - 64 MOVE THEN ; diff --git a/blk/109 b/blk/109 deleted file mode 100644 index 27a6944..0000000 --- a/blk/109 +++ /dev/null @@ -1,6 +0,0 @@ -: _U ( U without P, used in VE ) - 15 EDPOS @ 64 / - ?DUP IF - 0 DO - 14 I - _mvln+ - LOOP THEN ; -: U _U P ; diff --git a/blk/110 b/blk/110 deleted file mode 100644 index cb7aade..0000000 --- a/blk/110 +++ /dev/null @@ -1,10 +0,0 @@ -: _F ( F without _type and _pln. used in VE ) - FBUF EDPOS @ _cpos 1+ ( a1 a2 ) - BEGIN - C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 ) - = NOT IF DROP FBUF THEN ( a2 a1 ) - TUCK C@ 0xd = ( a1 a2 f1 ) - OVER BLK) = OR ( a1 a2 f1|f2 ) - UNTIL ( a1 a2 ) - DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! ELSE DROP THEN ; -: F FBUF _type _F EDPOS @ 64 / _pln ; diff --git a/blk/111 b/blk/111 deleted file mode 100644 index 19046fa..0000000 --- a/blk/111 +++ /dev/null @@ -1,12 +0,0 @@ -: _blen ( buf -- length of str in buf ) - DUP BEGIN C@+ 0x20 < UNTIL -^ 1- ; -: _rbufsz ( size of linebuf to the right of curpos ) - EDPOS @ 64 MOD 63 -^ ; -: _i ( i without _pln and _type. used in VE ) - _rbufsz IBUF _blen 2DUP > IF - TUCK - ( ilen chars-to-move ) - SWAP EDPOS @ _cpos 2DUP + ( ctm ilen a a+ilen ) - 3 PICK MOVE- ( ctm ilen ) NIP ( ilen ) - ELSE DROP 1+ ( ilen becomes rbuffsize+1 ) THEN - DUP IBUF EDPOS @ _cpos ROT MOVE ( ilen ) EDPOS +! BLK!! ; -: i IBUF _type _i EDPOS @ 64 / _pln ; diff --git a/blk/112 b/blk/112 deleted file mode 100644 index 0fe482e..0000000 --- a/blk/112 +++ /dev/null @@ -1,12 +0,0 @@ -: icpy ( n -- copy n chars from cursor to IBUF ) - IBUF _zbuf EDPOS @ _cpos IBUF ( n a buf ) ROT MOVE ; -: _X ( n -- ) - DUP icpy EDPOS @ _cpos 2DUP + ( n a1 a1+n ) - SWAP _rbufsz MOVE ( n ) - ( get to next line - n ) - DUP EDPOS @ 0xffc0 AND 0x40 + -^ _cpos ( n a ) - SWAP 0 FILL BLK!! ; -: X _X EDPOS @ 64 / _pln ; -: _E FBUF _blen _X ; -: E FBUF _blen X ; -: Y FBUF _blen icpy ; diff --git a/blk/120 b/blk/120 deleted file mode 100644 index ce24149..0000000 --- a/blk/120 +++ /dev/null @@ -1,16 +0,0 @@ -Visual Editor - -This editor, unlike the Block Editor (B100), is grid-based -instead of being command-based. It requires the AT-XY, COLS -and LINES words to be implemented. If you don't have those, -use the Block Editor. - -It is loaded with "125 LOAD" and invoked with "VE". Note that -this also fully loads the Block Editor. - -This editor uses 19 lines. The top line is the status line and -it's followed by 2 lines showing the contents of IBUF and -FBUF (see B100). There are then 16 contents lines. The contents -shown is that of the currently selected block. - - (cont.) diff --git a/blk/121 b/blk/121 deleted file mode 100644 index fdde484..0000000 --- a/blk/121 +++ /dev/null @@ -1,16 +0,0 @@ -The status line displays the active block number, then the -"modifier" and then the cursor position. When the block is dir- -ty, an "*" is displayed next. At the right corner, a mode letter -can appear. 'R' for replace, 'I' for insert, 'F' for find. - - - - - - - - - - - - (cont.) diff --git a/blk/122 b/blk/122 deleted file mode 100644 index 3d948dc..0000000 --- a/blk/122 +++ /dev/null @@ -1,16 +0,0 @@ -All keystrokes are directly interpreted by VE and have the -effect described below. - -Pressing a 0-9 digit accumulates that digit into what is named -the "modifier". That modifier affects the behavior of many -keystrokes described below. The modifier starts at zero, but -most commands interpret a zero as a 1 so that they can have an -effect. - -'G' selects the block specified by the modifier as the current -block. Any change made to the previously selected block is -saved beforehand. - -'[' and ']' advances the selected block by "modifier". 't' opens -the previously opened block. - (cont.) diff --git a/blk/123 b/blk/123 deleted file mode 100644 index c56f7dc..0000000 --- a/blk/123 +++ /dev/null @@ -1,15 +0,0 @@ -'h' and 'l' move the cursor by "modifier" characters. 'j' and -'k', by lines. 'g' moves to "modifier" line. - -'H' goes to the beginning of the line, 'L' to the end. - -'w' moves forward by "modifier" words. 'b' moves backward. -'W' moves to end-of-word. 'B', backwards. - -'I', 'F', 'Y', 'X' and 'E' invoke the corresponding command - -'o' inserts a blank line after the cursor. 'O', before. - -'D' deletes "modifier" lines at the cursor. The first of those -lines is copied to IBUF. - (cont.) diff --git a/blk/124 b/blk/124 deleted file mode 100644 index 1372dbe..0000000 --- a/blk/124 +++ /dev/null @@ -1,13 +0,0 @@ -'f' puts the contents of your previous cursor movement into -FBUF. If that movement was a forward movement, it brings the -cursor back where it was. This allows for an efficient combi- -nation of movements and 'E'. For example, if you want to delete -the next word, you type 'w', then 'f', then check your FBUF to -be sure, then press 'E'. - -'R' goes into replace mode at current cursor position. -Following keystrokes replace current character and advance -cursor. Press return to return to normal mode. - -'@' re-reads current block even if it's dirty, thus undoing -recent changes. diff --git a/blk/125 b/blk/125 deleted file mode 100644 index 007a046..0000000 --- a/blk/125 +++ /dev/null @@ -1,2 +0,0 @@ --20 LOAD+ ( B105, block editor ) -1 7 LOADR+ diff --git a/blk/126 b/blk/126 deleted file mode 100644 index b1bbe90..0000000 --- a/blk/126 +++ /dev/null @@ -1,16 +0,0 @@ -CREATE CMD 2 C, '$' C, 0 C, -CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 , -: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ; -: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ; -: large? COLS 67 > ; : col- 67 COLS MIN -^ ; -: width large? IF 64 ELSE COLS THEN ; -: acc@ ACC @ 1 MAX ; : pos@ ( x y -- ) EDPOS @ 64 /MOD ; -: num ACC @ SWAP _pdacc IF ACC ! ELSE DROP THEN ; -: nspcs ( n -- , spit n space ) 0 DO SPC LOOP ; -: aty 0 SWAP AT-XY ; -: clrscr LINES 0 DO I aty COLS nspcs LOOP ; -: gutter ( ln n ) OVER + SWAP DO 67 I AT-XY '|' EMIT LOOP ; -: status 0 aty ." BLK" SPC BLK> ? SPC ACC ? - SPC pos@ . ',' EMIT . xoff @ IF '>' EMIT THEN SPC - BLKDTY @ IF '*' EMIT THEN 4 nspcs ; -: nums 17 1 DO 2 I + aty I . SPC SPC LOOP ; diff --git a/blk/127 b/blk/127 deleted file mode 100644 index 95dfba2..0000000 --- a/blk/127 +++ /dev/null @@ -1,16 +0,0 @@ -: mode! ( c -- ) 4 col- 0 AT-XY ; -: contents - 16 0 DO - large? IF 3 ELSE 0 THEN I 3 + AT-XY - 64 I * BLK( + ( lineaddr ) xoff @ + DUP width + SWAP - DO I C@ 0x20 MAX EMIT LOOP LOOP - large? IF 3 16 gutter THEN ; -: selblk BLK> @ PREVBLK ! BLK@ contents ; -: pos! ( newpos -- ) EDPOS @ PREVPOS ! - DUP 0< IF DROP 0 THEN 1023 MIN EDPOS ! ; -: xoff? pos@ DROP ( x ) - xoff @ ?DUP IF < IF 0 xoff ! contents THEN ELSE - width >= IF 64 COLS - xoff ! contents THEN THEN ; -: setpos ( -- ) pos@ 3 + ( header ) SWAP ( y x ) xoff @ - - large? IF 3 + ( gutter ) THEN SWAP AT-XY ; -: cmv ( n -- , char movement ) acc@ * EDPOS @ + pos! ; diff --git a/blk/128 b/blk/128 deleted file mode 100644 index a7c0369..0000000 --- a/blk/128 +++ /dev/null @@ -1,6 +0,0 @@ -: buftype ( buf ln -- ) - 3 OVER AT-XY KEY DUP EMIT - DUP 0x20 < IF 2DROP DROP EXIT THEN - ( buf ln c ) 4 col- nspcs SWAP 4 SWAP AT-XY ( buf c ) - SWAP C!+ IN( _zbuf (rdln) IN( SWAP 63 MOVE ; - diff --git a/blk/129 b/blk/129 deleted file mode 100644 index 17e494f..0000000 --- a/blk/129 +++ /dev/null @@ -1,14 +0,0 @@ -: $G ACC @ selblk ; -: $[ BLK> @ acc@ - selblk ; -: $] BLK> @ acc@ + selblk ; -: $t PREVBLK @ selblk ; -: $I mode! 'I' EMIT IBUF 1 buftype _i contents mode! SPC ; -: $F mode! 'F' EMIT FBUF 2 buftype _F setpos mode! SPC ; -: $Y Y ; -: $E _E contents ; -: $X acc@ _X contents ; -: $h -1 cmv ; : $l 1 cmv ; : $k -64 cmv ; : $j 64 cmv ; -: $H EDPOS @ 0x3c0 AND pos! ; -: $L EDPOS @ 0x3f OR pos! ; -: $g ACC @ 1 MAX 1- 64 * pos! ; -: $@ BLK> @ BLK@* @ EXECUTE 0 BLKDTY ! contents ; diff --git a/blk/130 b/blk/130 deleted file mode 100644 index 8536a4b..0000000 --- a/blk/130 +++ /dev/null @@ -1,12 +0,0 @@ -: $w EDPOS @ BLK( + acc@ 0 DO - BEGIN C@+ WS? UNTIL BEGIN C@+ WS? NOT UNTIL LOOP - 1- BLK( - pos! ; -: $W EDPOS @ BLK( + acc@ 0 DO - 1+ BEGIN C@+ WS? NOT UNTIL BEGIN C@+ WS? UNTIL LOOP - 2- BLK( - pos! ; -: $b EDPOS @ BLK( + acc@ 0 DO - 1- BEGIN C@- WS? NOT UNTIL BEGIN C@- WS? UNTIL LOOP - 2+ BLK( - pos! ; -: $B EDPOS @ BLK( + acc@ 0 DO - BEGIN C@- WS? UNTIL BEGIN C@- WS? NOT UNTIL LOOP - 1+ BLK( - pos! ; diff --git a/blk/131 b/blk/131 deleted file mode 100644 index 3d94658..0000000 --- a/blk/131 +++ /dev/null @@ -1,15 +0,0 @@ -: $f EDPOS @ PREVPOS @ 2DUP = IF 2DROP EXIT THEN - 2DUP > IF DUP pos! SWAP THEN - ( p1 p2, p1 < p2 ) OVER - 64 MIN ( pos len ) FBUF _zbuf - SWAP _cpos FBUF ( len src dst ) ROT MOVE ; -: $R ( replace mode ) - mode! 'R' EMIT - BEGIN setpos KEY DUP BS? IF -1 EDPOS +! DROP 0 THEN - DUP 0x20 >= IF - DUP EMIT EDPOS @ _cpos C! 1 EDPOS +! BLK!! 0 - THEN UNTIL mode! SPC contents ; -: $O _U EDPOS @ 0x3c0 AND DUP pos! _cpos _zbuf BLK!! contents ; -: $o EDPOS @ 0x3c0 < IF EDPOS @ 64 + EDPOS ! $O THEN ; -: $D $H 64 icpy - acc@ 0 DO 16 EDPOS @ 64 / DO I _mvln- LOOP LOOP - BLK!! contents ; diff --git a/blk/132 b/blk/132 deleted file mode 100644 index b055207..0000000 --- a/blk/132 +++ /dev/null @@ -1,15 +0,0 @@ -: UPPER DUP 'a' 'z' =><= IF 32 - THEN ; -: handle ( c -- f ) - DUP '0' '9' =><= IF num 0 EXIT THEN - DUP CMD 2+ C! CMD FIND IF EXECUTE ELSE DROP THEN - 0 ACC ! UPPER 'Q' = ; -: bufp ( buf -- ) - DUP 3 col- + SWAP DO I C@ 0x20 MAX EMIT LOOP ; -: bufs - 1 aty ." I: " IBUF bufp - 2 aty ." F: " FBUF bufp - large? IF 0 3 gutter THEN ; -: VE - clrscr 0 ACC ! 0 PREVPOS ! nums contents - BEGIN xoff? status bufs setpos KEY handle UNTIL - 19 aty (infl) ; diff --git a/blk/160 b/blk/160 deleted file mode 100644 index 002b509..0000000 --- a/blk/160 +++ /dev/null @@ -1,16 +0,0 @@ -( AVR Programmer, load range 160-163. doc/avr.txt ) -( page size in words, 64 is default on atmega328P ) -CREATE aspfpgsz 64 , -VARIABLE aspprevx -: _x ( a -- b ) DUP aspprevx ! (spix) ; -: _xc ( a -- b ) DUP (spix) ( a b ) - DUP aspprevx @ = NOT IF ABORT" AVR err" THEN ( a b ) - SWAP aspprevx ! ( b ) ; -: _cmd ( b4 b3 b2 b1 -- r4 ) _xc DROP _xc DROP _xc DROP _x ; -: asprdy ( -- ) BEGIN 0 0 0 0xf0 _cmd 1 AND NOT UNTIL ; -: asp$ ( spidevid -- ) - ( RESET pulse ) DUP (spie) 0 (spie) (spie) - ( wait >20ms ) 220 TICKS - ( enable prog ) 0xac (spix) DROP - 0x53 _x DROP 0 _xc DROP 0 _x DROP ; -: asperase 0 0 0x80 0xac _cmd asprdy ; diff --git a/blk/161 b/blk/161 deleted file mode 100644 index 37f2327..0000000 --- a/blk/161 +++ /dev/null @@ -1,7 +0,0 @@ -( fuse access. read/write one byte at a time ) -: aspfl@ ( -- lfuse ) 0 0 0 0x50 _cmd ; -: aspfh@ ( -- hfuse ) 0 0 0x08 0x58 _cmd ; -: aspfe@ ( -- efuse ) 0 0 0x00 0x58 _cmd ; -: aspfl! ( lfuse -- ) 0 0xa0 0xac _cmd ; -: aspfh! ( hfuse -- ) 0 0xa8 0xac _cmd ; -: aspfe! ( efuse -- ) 0 0xa4 0xac _cmd ; diff --git a/blk/162 b/blk/162 deleted file mode 100644 index 4f8c8f5..0000000 --- a/blk/162 +++ /dev/null @@ -1,13 +0,0 @@ -: aspfb! ( n a --, write word n to flash buffer addr a ) - SWAP 256 /MOD ( a lo hi ) SWAP ROT ( hi lo a ) - DUP ROT ( hi a a lo ) SWAP ( hi a lo a ) - 0 0x40 ( hi a lo a 0 0x40 ) _cmd DROP ( hi a ) - 0 0x48 _cmd DROP ; -: aspfp! ( page --, write buffer to page ) - 0 SWAP aspfpgsz @ * 256 /MOD ( 0 lsb msb ) - 0x4c _cmd DROP asprdy ; -: aspf@ ( page a -- n, read word from flash ) - SWAP aspfpgsz @ * OR ( addr ) 256 /MOD ( lsb msb ) - 2DUP 0 ROT> ( lsb msb 0 lsb msb ) - 0x20 _cmd ( lsb msb low ) - ROT> 0 ROT> ( low 0 lsb msb ) 0x28 _cmd 8 LSHIFT OR ; diff --git a/blk/163 b/blk/163 deleted file mode 100644 index abb04cf..0000000 --- a/blk/163 +++ /dev/null @@ -1,6 +0,0 @@ -: aspe@ ( addr -- byte, read from EEPROM ) - 0 SWAP 256 /MOD ( 0 lsb msb ) SWAP - 0xa0 ( 0 msb lsb 0xa0 ) _cmd ; -: aspe! ( byte addr --, write to EEPROM ) - 256 /MOD ( b lsb msb ) SWAP - 0xc0 ( b msb lsb 0xc0 ) _cmd DROP asprdy ; diff --git a/blk/260 b/blk/260 deleted file mode 100644 index 7a12010..0000000 --- a/blk/260 +++ /dev/null @@ -1,16 +0,0 @@ -Cross compilation program - -This programs allows cross compilation of boot binary and -core. Run "262 LOAD" right before your cross compilation and -then "270 LOAD" to apply xcomp overrides. - -This unit depends on a properly initialized z80a with ORG and -BIN( set. That is how we determine compilation offsets. - -This redefines defining words to achieve cross compilation. -The goal is two-fold: - -1. Add an offset to all word references in definitions. -2. Don't shadow important words we need right now. - - (cont.) diff --git a/blk/261 b/blk/261 deleted file mode 100644 index fe70f57..0000000 --- a/blk/261 +++ /dev/null @@ -1,6 +0,0 @@ -Words overrides like ":", "IMMEDIATE" and "CODE" are not -automatically shadowed to allow the harmless inclusion of -this unit. This shadowing has to take place in your xcomp -configuration. - -See /doc/cross.txt for details. diff --git a/blk/262 b/blk/262 deleted file mode 100644 index 2a492bf..0000000 --- a/blk/262 +++ /dev/null @@ -1 +0,0 @@ -1 3 LOADR+ diff --git a/blk/263 b/blk/263 deleted file mode 100644 index 4b4adb8..0000000 --- a/blk/263 +++ /dev/null @@ -1,14 +0,0 @@ -CREATE XCURRENT 0 , -: XCON XCURRENT CURRENT* ! ; : XCOFF 0x02 RAM+ CURRENT* ! ; -: (xentry) XCON (entry) XCOFF ; : XCREATE (xentry) 2 C, ; -: X:** (xentry) 5 C, , ; -: XCODE XCON CODE XCOFF ; : XIMM XCON IMMEDIATE XCOFF ; -: _xapply ( a -- a-off ) - DUP ORG @ > IF ORG @ - BIN( @ + THEN ; -: XFIND XCURRENT @ SWAP _find DROP _xapply ; -: XLITN LIT" (n)" XFIND , , ; -: X' XCON ' XCOFF ; : X'? XCON '? XCOFF ; -: X['] XCON ' _xapply XLITN XCOFF ; -: XCOMPILE XCON ' _xapply XLITN - LIT" ," FIND DROP _xapply , XCOFF ; -: X[COMPILE] XCON ' _xapply , XCOFF ; diff --git a/blk/264 b/blk/264 deleted file mode 100644 index 0f0a625..0000000 --- a/blk/264 +++ /dev/null @@ -1,10 +0,0 @@ -: XDO LIT" 2>R" XFIND , H@ ; -: XLOOP LIT" (loop)" XFIND , H@ - C, ; -: XIF LIT" (?br)" XFIND , H@ 1 ALLOT ; -: XELSE LIT" (br)" XFIND , 1 ALLOT [COMPILE] THEN H@ 1- ; -: XAGAIN LIT" (br)" XFIND , H@ - C, ; -: XUNTIL LIT" (?br)" XFIND , H@ - C, ; -: XLIT" - LIT" (s)" XFIND , H@ 0 C, ," - DUP H@ -^ 1- SWAP C! -; diff --git a/blk/265 b/blk/265 deleted file mode 100644 index 534dbcb..0000000 --- a/blk/265 +++ /dev/null @@ -1,15 +0,0 @@ -: X: - (xentry) 1 ( compiled ) C, - BEGIN - WORD DUP LIT" ;" S= IF - DROP LIT" EXIT" XFIND , EXIT THEN - XCURRENT @ SWAP ( xcur w ) _find ( a f ) - IF ( a ) - DUP IMMED? IF ABORT THEN - _xapply , - ELSE ( w ) - 0x02 RAM+ @ SWAP ( cur w ) _find ( a f ) - IF DUP IMMED? NOT IF ABORT THEN EXECUTE - ELSE (parse) XLITN THEN - THEN - AGAIN ; diff --git a/blk/270 b/blk/270 deleted file mode 100644 index d110bcf..0000000 --- a/blk/270 +++ /dev/null @@ -1,14 +0,0 @@ -: CODE XCODE ; -: '? X'? ; -: ['] X['] ; IMMEDIATE -: COMPILE XCOMPILE ; IMMEDIATE -: [COMPILE] X[COMPILE] ; IMMEDIATE -: DO XDO ; IMMEDIATE : LOOP XLOOP ; IMMEDIATE -: IF XIF ; IMMEDIATE : ELSE XELSE ; IMMEDIATE -: AGAIN XAGAIN ; IMMEDIATE : UNTIL XUNTIL ; IMMEDIATE -: LIT" XLIT" ; IMMEDIATE : LITN XLITN ; -: IMMEDIATE XIMM ; -: (entry) (xentry) ; : CREATE XCREATE ; : :** X:** ; -: : [ ' X: , ] ; - -CURRENT @ XCURRENT ! diff --git a/blk/280 b/blk/280 deleted file mode 100644 index 1bc50e8..0000000 --- a/blk/280 +++ /dev/null @@ -1,15 +0,0 @@ -Z80 boot code - -This assembles the boot binary. It requires the Z80 assembler -(B5) and cross compilation setup (B260). It requires some -constants to be set. See doc/bootstrap.txt for details. - -RESERVED REGISTERS: At all times, IX points to RSP TOS and BC -is IP. SP points to PSP TOS, but you can still use the stack -in native code. you just have to make sure you've restored it -before "next". - -The boot binary is loaded in 2 parts. The first part, "decla- -rations", are loaded after xcomp, before xcomp overrides, with -"282 LOAD". The rest, after xcomp overrides, with "283 335 -LOADR". diff --git a/blk/282 b/blk/282 deleted file mode 100644 index 8b0c70b..0000000 --- a/blk/282 +++ /dev/null @@ -1,5 +0,0 @@ -VARIABLE lbluflw VARIABLE lblexec -( see comment at TICKS' definition ) -( 7.373MHz target: 737t. outer: 37t inner: 16t ) -( tickfactor = (737 - 37) / 16 ) -CREATE tickfactor 44 , diff --git a/blk/283 b/blk/283 deleted file mode 100644 index de4815d..0000000 --- a/blk/283 +++ /dev/null @@ -1,11 +0,0 @@ -H@ ORG ! ( STABLE ABI ) -0 JP, ( 00, main ) NOP, ( unused ) NOP, NOP, ( 04, BOOT ) -NOP, NOP, ( 06, uflw ) NOP, NOP, ( 08, LATEST ) -NOP, NOP, NOP, NOP, NOP, NOP, ( unused ) -0 JP, ( RST 10 ) NOP, NOP, ( 13, oflw ) -NOP, NOP, NOP, NOP, NOP, ( unused ) -0 JP, ( 1a, next ) NOP, NOP, NOP, ( unused ) -0 JP, ( RST 20 ) 0 A, 0 A, 0 A, 0 A, 0 A, ( unused ) -0 JP, ( RST 28 ) 0 A, 0 A, 0 A, 0 A, 0 A, ( unused ) -0 JP, ( RST 30 ) 0 A, 0 A, 0 A, 0 A, 0 A, ( unused ) -0 JP, ( RST 38 ) diff --git a/blk/284 b/blk/284 deleted file mode 100644 index 632f00b..0000000 --- a/blk/284 +++ /dev/null @@ -1,13 +0,0 @@ -PC ORG @ 1 + ! ( main ) - SP PS_ADDR LDdi, IX RS_ADDR LDdi, -( LATEST is a label to the latest entry of the dict. It is - written at offset 0x08 by the process or person building - Forth. ) - BIN( @ 0x08 + LDHL(i), - SYSVARS 0x02 ( CURRENT ) + LD(i)HL, -HERESTART [IF] - HL HERESTART LDdi, -[THEN] - SYSVARS 0x04 + LD(i)HL, ( RAM+04 == HERE ) - DE BIN( @ 0x04 ( BOOT ) + LDd(i), - JR, L1 FWR ( execute, B287 ) diff --git a/blk/286 b/blk/286 deleted file mode 100644 index eaccad7..0000000 --- a/blk/286 +++ /dev/null @@ -1,15 +0,0 @@ -lblnext BSET PC ORG @ 0x1b + ! ( next ) -( This routine is jumped to at the end of every word. In it, - we jump to current IP, but we also take care of increasing - it by 2 before jumping. ) - ( Before we continue: are we overflowing? ) - IX PUSH, EX(SP)HL, ( do EX to count the IX push in SP ) - SP SUBHLd, HL POP, - IFNC, ( SP <= IX? overflow ) - SP PS_ADDR LDdi, IX RS_ADDR LDdi, - DE BIN( @ 0x13 ( oflw ) + LDd(i), - JR, L2 FWR ( execute, B287 ) - THEN, - LDA(BC), E A LDrr, BC INCd, - LDA(BC), D A LDrr, BC INCd, - ( continue to execute ) diff --git a/blk/287 b/blk/287 deleted file mode 100644 index 930a860..0000000 --- a/blk/287 +++ /dev/null @@ -1,12 +0,0 @@ -lblexec BSET L1 FSET ( B284 ) L2 FSET ( B286 ) - ( DE -> wordref ) - LDA(DE), DE INCd, EXDEHL, ( HL points to PFA ) - A ORr, IFZ, JP(HL), THEN, - A DECr, ( compiled? ) IFNZ, ( no ) - 3 CPi, IFZ, ( alias ) LDDE(HL), JR, lblexec BWR THEN, - IFNC, ( switch ) - LDDE(HL), EXDEHL, LDDE(HL), JR, lblexec BWR THEN, - ( cell or does. push PFA ) HL PUSH, - A DECr, JRZ, lblnext BWR ( cell ) - HL INCd, HL INCd, LDDE(HL), EXDEHL, ( does ) - THEN, ( continue to compiledWord ) diff --git a/blk/289 b/blk/289 deleted file mode 100644 index 6850943..0000000 --- a/blk/289 +++ /dev/null @@ -1,12 +0,0 @@ -( compiled word - 1. Push current IP to RS - 2. Set new IP to the second atom of the list - 3. Execute the first atom of the list. ) - IX INCd, IX INCd, - 0 IX+ C LDIXYr, - 1 IX+ B LDIXYr, -( While we inc, dereference into DE for execute call later. ) - LDDE(HL), - HL INCd, - B H LDrr, C L LDrr, ( --> IP ) - JR, lblexec BWR ( execute-B287 ) diff --git a/blk/290 b/blk/290 deleted file mode 100644 index 2f66532..0000000 --- a/blk/290 +++ /dev/null @@ -1,15 +0,0 @@ -lblchkPS BSET ( chkPS ) - ( thread carefully in there: sometimes, we're in the - middle of a EXX to protect BC. BC must never be touched - here. ) - EXX, -( We have the return address for this very call on the stack - and protected registers. 2- is to compensate that. ) - HL PS_ADDR 2- LDdi, - SP SUBHLd, - EXX, - CNC RETc, ( PS_ADDR >= SP? good ) - ( continue to uflw ) -lbluflw BSET ( abortUnderflow ) - DE BIN( @ 0x06 ( uflw ) + LDd(i), - JR, lblexec BWR diff --git a/blk/291 b/blk/291 deleted file mode 100644 index 8bf267c..0000000 --- a/blk/291 +++ /dev/null @@ -1,16 +0,0 @@ -( Native words ) -H@ 5 + XCURRENT ! ( make next CODE have 0 prev field ) -CODE _find ( cur w -- a f ) - HL POP, ( w ) DE POP, ( cur ) chkPS, - HL PUSH, ( --> lvl 1 ) - ( First, figure out string len ) - A (HL) LDrr, A ORr, - ( special case. zero len? we never find anything. ) - IFZ, PUSH0, JPNEXT, THEN, - BC PUSH, ( --> lvl 2, protect ) -( Let's do something weird: We'll hold HL by the *tail*. - Because of our dict structure and because we know our - lengths, it's easier to compare starting from the end. ) - C A LDrr, B 0 LDri, ( C holds our length ) - BC ADDHLd, HL INCd, ( HL points to after-last-char ) - ( cont . ) diff --git a/blk/292 b/blk/292 deleted file mode 100644 index 7d5350a..0000000 --- a/blk/292 +++ /dev/null @@ -1,8 +0,0 @@ - BEGIN, ( loop ) - ( DE is a wordref, first step, do our len correspond? ) - HL PUSH, ( --> lvl 3 ) - DE PUSH, ( --> lvl 4 ) - DE DECd, - LDA(DE), - 0x7f ANDi, ( remove IMMEDIATE flag ) - C CPr, ( cont. ) diff --git a/blk/293 b/blk/293 deleted file mode 100644 index 27acb89..0000000 --- a/blk/293 +++ /dev/null @@ -1,15 +0,0 @@ - IFZ, - ( match, let's compare the string then ) - DE DECd, ( Skip prev field. One less because we ) - DE DECd, ( pre-decrement ) - B C LDrr, ( loop C times ) - BEGIN, - ( pre-decrement for easier Z matching ) - DE DECd, - HL DECd, - LDA(DE), - (HL) CPr, - JRNZ, BREAK, - DJNZ, AGAIN, - THEN, - ( cont. ) diff --git a/blk/294 b/blk/294 deleted file mode 100644 index 43f9880..0000000 --- a/blk/294 +++ /dev/null @@ -1,15 +0,0 @@ -( At this point, Z is set if we have a match. In all cases, - we want to pop HL and DE ) - DE POP, ( <-- lvl 4 ) - IFZ, ( match, we're done! ) - HL POP, BC POP, HL POP, ( <-- lvl 1-3 ) DE PUSH, - PUSH1, JPNEXT, - THEN, - ( no match, go to prev and continue ) - DE DECd, DE DECd, DE DECd, ( prev field ) - DE PUSH, ( --> lvl 4 ) - EXDEHL, - LDDE(HL), - - - ( cont. ) diff --git a/blk/295 b/blk/295 deleted file mode 100644 index 5bd0c8c..0000000 --- a/blk/295 +++ /dev/null @@ -1,14 +0,0 @@ - ( DE contains prev offset ) - HL POP, ( <-- lvl 4, prev field ) - DEZ, IFNZ, ( offset not zero ) - ( get absolute addr from offset ) - ( carry cleared from "or e" ) - DE SBCHLd, - EXDEHL, ( result in DE ) - THEN, - HL POP, ( <-- lvl 3 ) - JRNZ, AGAIN, ( loop-B292, try to match again ) - BC POP, ( <-- lvl 2 ) - ( Z set? end of dict, not found. "w" already on PSP TOS ) - PUSH0, -;CODE diff --git a/blk/297 b/blk/297 deleted file mode 100644 index 119318b..0000000 --- a/blk/297 +++ /dev/null @@ -1,13 +0,0 @@ -CODE (br) -L1 BSET ( used in ?br and loop ) - LDA(BC), H 0 LDri, L A LDrr, - RLA, IFC, H DECr, THEN, - BC ADDHLd, B H LDrr, C L LDrr, -;CODE -CODE (?br) - HL POP, - HLZ, - JRZ, L1 BWR ( br + 1. False, branch ) - ( True, skip next byte and don't branch ) - BC INCd, -;CODE diff --git a/blk/298 b/blk/298 deleted file mode 100644 index 210b73b..0000000 --- a/blk/298 +++ /dev/null @@ -1,11 +0,0 @@ -CODE (loop) - 0 IX+ INC(IXY+), IFZ, 1 IX+ INC(IXY+), THEN, ( I++ ) - ( Jump if I <> I' ) - A 0 IX+ LDrIXY, 2 IX- CP(IXY+), JRNZ, L1 BWR ( branch ) - A 1 IX+ LDrIXY, 1 IX- CP(IXY+), JRNZ, L1 BWR ( branch ) - ( don't branch ) - IX DECd, IX DECd, IX DECd, IX DECd, - BC INCd, -;CODE - - diff --git a/blk/305 b/blk/305 deleted file mode 100644 index 26fb37a..0000000 --- a/blk/305 +++ /dev/null @@ -1,10 +0,0 @@ -CODE EXECUTE - DE POP, - chkPS, - lblexec @ JP, - -CODE EXIT - C 0 IX+ LDrIXY, - B 1 IX+ LDrIXY, - IX DECd, IX DECd, - JPNEXT, diff --git a/blk/306 b/blk/306 deleted file mode 100644 index cd12709..0000000 --- a/blk/306 +++ /dev/null @@ -1,8 +0,0 @@ -CODE (n) ( number literal ) - ( Literal value to push to stack is next to (n) reference - in the atom list. That is where IP is currently pointing. - Read, push, then advance IP. ) - LDA(BC), L A LDrr, BC INCd, - LDA(BC), H A LDrr, BC INCd, - HL PUSH, -;CODE diff --git a/blk/307 b/blk/307 deleted file mode 100644 index 8628e38..0000000 --- a/blk/307 +++ /dev/null @@ -1,10 +0,0 @@ -CODE (s) ( string literal ) -( Like (n) but instead of being followed by a 2 bytes - number, it's followed by a string. When called, puts the - string's address on PS ) - BC PUSH, - LDA(BC), C ADDr, - IFC, B INCr, THEN, - C A LDrr, - BC INCd, -;CODE diff --git a/blk/308 b/blk/308 deleted file mode 100644 index 2a2f227..0000000 --- a/blk/308 +++ /dev/null @@ -1,16 +0,0 @@ -CODE ROT ( a b c -- b c a ) - HL POP, ( C ) DE POP, ( B ) IY POP, ( A ) chkPS, - DE PUSH, ( B ) HL PUSH, ( C ) IY PUSH, ( A ) -;CODE -CODE ROT> ( a b c -- c a b ) - HL POP, ( C ) DE POP, ( B ) IY POP, ( A ) chkPS, - HL PUSH, ( C ) IY PUSH, ( A ) DE PUSH, ( B ) -;CODE -CODE DUP ( a -- a a ) - HL POP, chkPS, - HL PUSH, HL PUSH, -;CODE -CODE ?DUP - HL POP, chkPS, HL PUSH, - HLZ, IFNZ, HL PUSH, THEN, -;CODE diff --git a/blk/309 b/blk/309 deleted file mode 100644 index fafcfd2..0000000 --- a/blk/309 +++ /dev/null @@ -1,13 +0,0 @@ -CODE DROP ( a -- ) - HL POP, chkPS, -;CODE -CODE SWAP ( a b -- b a ) - HL POP, ( B ) DE POP, ( A ) - chkPS, - HL PUSH, ( B ) DE PUSH, ( A ) -;CODE -CODE OVER ( a b -- a b a ) - HL POP, ( B ) DE POP, ( A ) - chkPS, - DE PUSH, ( A ) HL PUSH, ( B ) DE PUSH, ( A ) -;CODE diff --git a/blk/310 b/blk/310 deleted file mode 100644 index e2aabb9..0000000 --- a/blk/310 +++ /dev/null @@ -1,15 +0,0 @@ -CODE PICK EXX, ( protect BC ) - HL POP, - ( x2 ) - L SLA, H RL, - SP ADDHLd, - C (HL) LDrr, - HL INCd, - B (HL) LDrr, - ( check PS range before returning ) - EXDEHL, - HL PS_ADDR LDdi, - DE SUBHLd, - IFC, EXX, lbluflw @ JP, THEN, - BC PUSH, -EXX, ( unprotect BC ) ;CODE diff --git a/blk/311 b/blk/311 deleted file mode 100644 index 71e3b41..0000000 --- a/blk/311 +++ /dev/null @@ -1,15 +0,0 @@ -( Low-level part of ROLL. Example: - "1 2 3 4 4 (roll)" --> "1 3 4 4". No sanity checks, never - call with 0. ) -CODE (roll) - HL POP, - B H LDrr, - C L LDrr, - SP ADDHLd, - HL INCd, - D H LDrr, - E L LDrr, - HL DECd, - HL DECd, - LDDR, -;CODE diff --git a/blk/312 b/blk/312 deleted file mode 100644 index 9be0e6f..0000000 --- a/blk/312 +++ /dev/null @@ -1,10 +0,0 @@ -CODE 2DROP ( a b -- ) - HL POP, HL POP, chkPS, -;CODE - -CODE 2DUP ( a b -- a b a b ) - HL POP, ( b ) DE POP, ( a ) - chkPS, - DE PUSH, HL PUSH, - DE PUSH, HL PUSH, -;CODE diff --git a/blk/313 b/blk/313 deleted file mode 100644 index cf6aae3..0000000 --- a/blk/313 +++ /dev/null @@ -1,10 +0,0 @@ -CODE S0 - HL PS_ADDR LDdi, - HL PUSH, -;CODE - -CODE 'S - HL 0 LDdi, - SP ADDHLd, - HL PUSH, -;CODE diff --git a/blk/314 b/blk/314 deleted file mode 100644 index 473fa53..0000000 --- a/blk/314 +++ /dev/null @@ -1,12 +0,0 @@ -CODE AND - HL POP, - DE POP, - chkPS, - A E LDrr, - L ANDr, - L A LDrr, - A D LDrr, - H ANDr, - H A LDrr, - HL PUSH, -;CODE diff --git a/blk/315 b/blk/315 deleted file mode 100644 index 28b3226..0000000 --- a/blk/315 +++ /dev/null @@ -1,12 +0,0 @@ -CODE OR - HL POP, - DE POP, - chkPS, - A E LDrr, - L ORr, - L A LDrr, - A D LDrr, - H ORr, - H A LDrr, - HL PUSH, -;CODE diff --git a/blk/316 b/blk/316 deleted file mode 100644 index 2af518a..0000000 --- a/blk/316 +++ /dev/null @@ -1,12 +0,0 @@ -CODE XOR - HL POP, - DE POP, - chkPS, - A E LDrr, - L XORr, - L A LDrr, - A D LDrr, - H XORr, - H A LDrr, - HL PUSH, -;CODE diff --git a/blk/317 b/blk/317 deleted file mode 100644 index 368e121..0000000 --- a/blk/317 +++ /dev/null @@ -1,6 +0,0 @@ -CODE NOT - HL POP, - chkPS, - HLZ, - PUSHZ, -;CODE diff --git a/blk/318 b/blk/318 deleted file mode 100644 index 533f502..0000000 --- a/blk/318 +++ /dev/null @@ -1,15 +0,0 @@ -CODE + - HL POP, - DE POP, - chkPS, - DE ADDHLd, - HL PUSH, -;CODE - -CODE - - DE POP, - HL POP, - chkPS, - DE SUBHLd, - HL PUSH, -;CODE diff --git a/blk/319 b/blk/319 deleted file mode 100644 index 1fe8def..0000000 --- a/blk/319 +++ /dev/null @@ -1,16 +0,0 @@ -CODE * EXX, ( protect BC ) - ( DE * BC -> DE (high) and HL (low) ) - DE POP, BC POP, chkPS, - HL 0 LDdi, - A 0x10 LDri, - BEGIN, - HL ADDHLd, - E RL, D RL, - IFC, - BC ADDHLd, - IFC, DE INCd, THEN, - THEN, - A DECr, - JRNZ, AGAIN, - HL PUSH, -EXX, ( unprotect BC ) ;CODE diff --git a/blk/320 b/blk/320 deleted file mode 100644 index 6fc05a9..0000000 --- a/blk/320 +++ /dev/null @@ -1,15 +0,0 @@ -( Borrowed from http://wikiti.brandonw.net/ ) -( Divides AC by DE and places the quotient in AC and the - remainder in HL ) -CODE /MOD EXX, ( protect BC ) - DE POP, BC POP, chkPS, - A B LDrr, B 16 LDri, - HL 0 LDdi, - BEGIN, - SCF, C RL, RLA, - HL ADCHLd, DE SBCHLd, - IFC, DE ADDHLd, C DECr, THEN, - DJNZ, AGAIN, - B A LDrr, - HL PUSH, BC PUSH, -EXX, ( unprotect BC ) ;CODE diff --git a/blk/321 b/blk/321 deleted file mode 100644 index 334b18c..0000000 --- a/blk/321 +++ /dev/null @@ -1,13 +0,0 @@ -( The word below is designed to wait the proper 100us per tick - at 500kHz when tickfactor is 1. If the CPU runs faster, - tickfactor has to be adjusted accordingly. "t" in comments - below means "T-cycle", which at 500kHz is worth 2us. ) -CODE TICKS - HL POP, chkPS, - ( we pre-dec to compensate for initialization ) - BEGIN, - HL DECd, ( 6t ) - IFZ, ( 12t ) JPNEXT, THEN, - A tickfactor @ LDri, ( 7t ) - BEGIN, A DECr, ( 4t ) JRNZ, ( 12t ) AGAIN, - JR, ( 12t ) AGAIN, ( outer: 37t inner: 16t ) diff --git a/blk/322 b/blk/322 deleted file mode 100644 index d67257c..0000000 --- a/blk/322 +++ /dev/null @@ -1,13 +0,0 @@ -CODE ! - HL POP, DE POP, chkPS, - (HL) E LDrr, - HL INCd, - (HL) D LDrr, -;CODE -CODE @ - HL POP, chkPS, - E (HL) LDrr, - HL INCd, - D (HL) LDrr, - DE PUSH, -;CODE diff --git a/blk/323 b/blk/323 deleted file mode 100644 index 7090be3..0000000 --- a/blk/323 +++ /dev/null @@ -1,11 +0,0 @@ -CODE C! - HL POP, DE POP, chkPS, - (HL) E LDrr, -;CODE - -CODE C@ - HL POP, chkPS, - L (HL) LDrr, - H 0 LDri, - HL PUSH, -;CODE diff --git a/blk/324 b/blk/324 deleted file mode 100644 index c76b669..0000000 --- a/blk/324 +++ /dev/null @@ -1,11 +0,0 @@ -CODE PC! EXX, ( protect BC ) - BC POP, HL POP, chkPS, - L OUT(C)r, -EXX, ( unprotect BC ) ;CODE - -CODE PC@ EXX, ( protect BC ) - BC POP, chkPS, - H 0 LDri, - L INr(C), - HL PUSH, -EXX, ( unprotect BC ) ;CODE diff --git a/blk/325 b/blk/325 deleted file mode 100644 index 5d661be..0000000 --- a/blk/325 +++ /dev/null @@ -1,16 +0,0 @@ -CODE I - L 0 IX+ LDrIXY, H 1 IX+ LDrIXY, - HL PUSH, -;CODE -CODE I' - L 2 IX- LDrIXY, H 1 IX- LDrIXY, - HL PUSH, -;CODE -CODE J - L 4 IX- LDrIXY, H 3 IX- LDrIXY, - HL PUSH, -;CODE -CODE >R - HL POP, chkPS, - IX INCd, IX INCd, 0 IX+ L LDIXYr, 1 IX+ H LDIXYr, -;CODE diff --git a/blk/326 b/blk/326 deleted file mode 100644 index 077c9ca..0000000 --- a/blk/326 +++ /dev/null @@ -1,13 +0,0 @@ -CODE R> - L 0 IX+ LDrIXY, H 1 IX+ LDrIXY, IX DECd, IX DECd, HL PUSH, -;CODE -CODE 2>R - DE POP, HL POP, chkPS, - IX INCd, IX INCd, 0 IX+ L LDIXYr, 1 IX+ H LDIXYr, - IX INCd, IX INCd, 0 IX+ E LDIXYr, 1 IX+ D LDIXYr, -;CODE -CODE 2R> - L 0 IX+ LDrIXY, H 1 IX+ LDrIXY, IX DECd, IX DECd, - E 0 IX+ LDrIXY, D 1 IX+ LDrIXY, IX DECd, IX DECd, - DE PUSH, HL PUSH, -;CODE diff --git a/blk/327 b/blk/327 deleted file mode 100644 index 4b24bda..0000000 --- a/blk/327 +++ /dev/null @@ -1,11 +0,0 @@ -CODE BYE - HALT, -;CODE - -CODE (resSP) - SP PS_ADDR LDdi, -;CODE - -CODE (resRS) - IX RS_ADDR LDdi, -;CODE diff --git a/blk/328 b/blk/328 deleted file mode 100644 index bfa90b0..0000000 --- a/blk/328 +++ /dev/null @@ -1,15 +0,0 @@ -CODE S= EXX, ( protect BC ) - DE POP, HL POP, chkPS, - LDA(DE), - (HL) CPr, - IFZ, ( same size? ) - B A LDrr, ( loop A times ) - BEGIN, - HL INCd, DE INCd, - LDA(DE), - (HL) CPr, - JRNZ, BREAK, ( not equal? break early. NZ is set. ) - DJNZ, AGAIN, - THEN, - PUSHZ, -EXX, ( unprotect BC ) ;CODE diff --git a/blk/329 b/blk/329 deleted file mode 100644 index 6b6a2b9..0000000 --- a/blk/329 +++ /dev/null @@ -1,15 +0,0 @@ -CODE CMP - HL POP, - DE POP, - chkPS, - DE SUBHLd, - DE 0 LDdi, - IFNZ, ( < or > ) - DE INCd, - IFNC, ( < ) - DE DECd, - DE DECd, - THEN, - THEN, - DE PUSH, -;CODE diff --git a/blk/331 b/blk/331 deleted file mode 100644 index 99ce033..0000000 --- a/blk/331 +++ /dev/null @@ -1,12 +0,0 @@ -CODE (im1) - IM1, - EI, -;CODE - -CODE 0 PUSH0, ;CODE -CODE 1 PUSH1, ;CODE - -CODE -1 - HL -1 LDdi, - HL PUSH, -;CODE diff --git a/blk/332 b/blk/332 deleted file mode 100644 index 611f6c2..0000000 --- a/blk/332 +++ /dev/null @@ -1,13 +0,0 @@ -CODE 1+ - HL POP, - chkPS, - HL INCd, - HL PUSH, -;CODE - -CODE 1- - HL POP, - chkPS, - HL DECd, - HL PUSH, -;CODE diff --git a/blk/333 b/blk/333 deleted file mode 100644 index 83542f1..0000000 --- a/blk/333 +++ /dev/null @@ -1,15 +0,0 @@ -CODE 2+ - HL POP, - chkPS, - HL INCd, - HL INCd, - HL PUSH, -;CODE - -CODE 2- - HL POP, - chkPS, - HL DECd, - HL DECd, - HL PUSH, -;CODE diff --git a/blk/334 b/blk/334 deleted file mode 100644 index f3dbd67..0000000 --- a/blk/334 +++ /dev/null @@ -1,13 +0,0 @@ -CODE RSHIFT ( n u -- n ) - DE POP, ( u ) - HL POP, ( n ) - chkPS, - A E LDrr, - A ORr, IFNZ, - BEGIN, - H SRL, L RR, - A DECr, - JRNZ, AGAIN, - THEN, - HL PUSH, -;CODE diff --git a/blk/335 b/blk/335 deleted file mode 100644 index 4db4520..0000000 --- a/blk/335 +++ /dev/null @@ -1,13 +0,0 @@ -CODE LSHIFT ( n u -- n ) - DE POP, ( u ) - HL POP, ( n ) - chkPS, - A E LDrr, - A ORr, IFNZ, - BEGIN, - L SLA, H RL, - A DECr, - JRNZ, AGAIN, - THEN, - HL PUSH, -;CODE diff --git a/blk/350 b/blk/350 deleted file mode 100644 index 7083c02..0000000 --- a/blk/350 +++ /dev/null @@ -1,16 +0,0 @@ -Core words - -This section contains arch-independent core words of Collapse -OS. Those words are written in a way that make them entirely -cross-compilable (see B260). When building Collapse OS, these -words come right after the boot binary (B280). - -Because this unit is designed to be cross-compiled, things are -a little weird. It is compiling in the context of a full -Forth interpreter with all bells and whistles (and z80 -assembler), but it has to obey strict rules: - -1. Although it cannot compile a word that isn't defined yet, - it can still execute an immediate from the host system. - - (cont.) diff --git a/blk/351 b/blk/351 deleted file mode 100644 index d1e0f66..0000000 --- a/blk/351 +++ /dev/null @@ -1,16 +0,0 @@ -2. Immediate words that have been cross compiled *cannot* be - used. Only immediates from the host system can be used. -3. If an immediate word compiles words, it can only be words - that are part of the stable ABI. - -All of this is because when cross compiling, all atom ref- -erences are offsetted to the target system and are thus -unusable directly. For the same reason, any reference to a word -in the host system will obviously be wrong in the target -system. More details in B260. - - - - - - (cont.) diff --git a/blk/352 b/blk/352 deleted file mode 100644 index 2e2c3a0..0000000 --- a/blk/352 +++ /dev/null @@ -1,9 +0,0 @@ -This unit is loaded in two "low" and "high" parts. The low part -is the biggest chunk and has the most definitions. The high -part is the "sensitive" chunk and contains "LITN", ":" and ";" -definitions which, once defined, kind of make any more defs -impossible. - -The gap between these 2 parts is the ideal place to put device -driver code. Load the low part with "353 LOAD", the high part -with "390 LOAD" diff --git a/blk/353 b/blk/353 deleted file mode 100644 index 6c38024..0000000 --- a/blk/353 +++ /dev/null @@ -1,14 +0,0 @@ -: RAM+ [ SYSVARS LITN ] + ; : BIN+ [ BIN( @ LITN ] + ; -: HERE 0x04 RAM+ ; -: CURRENT* 0x51 RAM+ ; : CURRENT CURRENT* @ ; -: H@ HERE @ ; -: FIND ( w -- a f ) CURRENT @ SWAP _find ; -: IN> 0x30 RAM+ ; ( current position in INBUF ) -: IN( 0x32 RAM+ @ ; ( points to INBUF ) -: IN) 0x40 ( buffer size ) IN( + ; ( INBUF's end ) -: (infl) 0 IN( DUP IN> ! ! ; ( flush input buffer ) -: QUIT - (resRS) 0 0x08 RAM+ ! ( C<* override ) (infl) - LIT" (main)" FIND DROP EXECUTE -; -1 33 LOADR+ diff --git a/blk/354 b/blk/354 deleted file mode 100644 index 90c2ace..0000000 --- a/blk/354 +++ /dev/null @@ -1,12 +0,0 @@ -: ABORT (resSP) QUIT ; -: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ; -: 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ; -: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT> > AND ; -: =><= 2 PICK >= ( n l f ) ROT> >= AND ; -: NIP SWAP DROP ; : TUCK SWAP OVER ; -: -^ SWAP - ; -: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ; -: C!+ ( c a -- a+1 ) TUCK C! 1+ ; -: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ; -: C!- ( c a -- a-1 ) TUCK C! 1- ; -: LEAVE R> R> DROP I 1- >R >R ; : UNLOOP R> 2R> 2DROP >R ; diff --git a/blk/355 b/blk/355 deleted file mode 100644 index f8305a7..0000000 --- a/blk/355 +++ /dev/null @@ -1,14 +0,0 @@ -: +! TUCK @ + SWAP ! ; -: *! ( addr alias -- ) 1+ ! ; -: **! ( addr switch -- ) 1+ @ ! ; -: / /MOD NIP ; -: MOD /MOD DROP ; -: ALLOT HERE +! ; -: FILL ( a n b -- ) - SWAP 2 PICK + ( a b a+n ) ROT ( b a+n a ) DO ( b ) - DUP I C! - LOOP DROP ; -: ALLOT0 ( n -- ) H@ OVER 0 FILL ALLOT ; -SYSVARS 0x3e + :** A@ -SYSVARS 0x40 + :** A! -SYSVARS 0x42 + :** A, diff --git a/blk/356 b/blk/356 deleted file mode 100644 index 1b48772..0000000 --- a/blk/356 +++ /dev/null @@ -1,11 +0,0 @@ -SYSVARS 0x53 + :** EMIT -: (print) C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ; -: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ; -: CRLF CR LF ; : SPC 32 EMIT ; -SYSVARS 0x0a + :** NL -: ERR (print) ABORT ; -: (uflw) LIT" stack underflow" ERR ; -XCURRENT @ _xapply ORG @ 0x06 ( stable ABI uflw ) + ! -: (oflw) LIT" stack overflow" ERR ; -XCURRENT @ _xapply ORG @ 0x13 ( stable ABI oflw ) + ! -: (wnf) (print) LIT" word not found" ERR ; diff --git a/blk/357 b/blk/357 deleted file mode 100644 index 464ab29..0000000 --- a/blk/357 +++ /dev/null @@ -1,7 +0,0 @@ -( r c -- r f ) -( Parse digit c and accumulate into result r. - Flag f is true when c was a valid digit ) -: _pdacc - '0' - DUP 10 < IF ( good, add to running result ) - SWAP 10 * + 1 ( r*10+n f ) - ELSE ( bad ) DROP 0 THEN ; diff --git a/blk/358 b/blk/358 deleted file mode 100644 index faad96c..0000000 --- a/blk/358 +++ /dev/null @@ -1,11 +0,0 @@ -: _pd ( a -- n f, parse decimal ) - C@+ OVER C@ 0 ( a len firstchar startat ) -( if we have '-', we only advance. more processing later. ) - SWAP '-' = IF 1+ THEN ( a len startat ) -( if we can do the whole string, success. if _pdacc returns - false before, failure. ) - 0 ROT> ( len ) ( startat ) DO ( a r ) - OVER I + C@ ( a r c ) _pdacc ( a r f ) - NOT IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r ) -( if we had '-', we need to invert result. ) - SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ; diff --git a/blk/359 b/blk/359 deleted file mode 100644 index 0665b8b..0000000 --- a/blk/359 +++ /dev/null @@ -1,10 +0,0 @@ -( strings being sent to parse routines are always null - terminated ) - -: _pc ( a -- n f, parse character ) - ( apostrophe is ASCII 39 ) - DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f ) - NOT IF 0 EXIT THEN ( a 0 ) - ( surrounded by apos, good, return ) - 2+ C@ 1 ( n 1 ) -; diff --git a/blk/360 b/blk/360 deleted file mode 100644 index d56e25a..0000000 --- a/blk/360 +++ /dev/null @@ -1,16 +0,0 @@ -( returns negative value on error ) -: _ ( c -- n ) - DUP '0' '9' =><= IF '0' - EXIT THEN - DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN - DROP -1 ( bad ) -; -: _ph ( a -- n f, parse hex ) - ( '0': ASCII 0x30 'x': 0x78 0x7830 ) - DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 ) - ( We have "0x" prefix ) - DUP C@ ( a len ) - 0 SWAP 1+ ( len+1 ) 3 DO ( a r ) - OVER I + C@ ( a r c ) _ ( a r n ) - DUP 0< IF 2DROP 0 UNLOOP EXIT THEN - SWAP 4 LSHIFT + ( a r*16+n ) LOOP - NIP 1 ; diff --git a/blk/361 b/blk/361 deleted file mode 100644 index 7af8415..0000000 --- a/blk/361 +++ /dev/null @@ -1,10 +0,0 @@ -: _pb ( a -- n f, parse binary ) - ( '0': ASCII 0x30 'b': 0x62 0x6230 ) - DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 ) - ( We have "0b" prefix ) - DUP C@ ( a len ) - 0 SWAP 1+ ( len+1 ) 3 DO ( a r ) - OVER I + C@ ( a r c ) - DUP '0' '1' =><= NOT IF 2DROP 0 UNLOOP EXIT THEN - '0' - SWAP 1 LSHIFT + ( a r*2+n ) LOOP - NIP 1 ; diff --git a/blk/362 b/blk/362 deleted file mode 100644 index 2a1e2d3..0000000 --- a/blk/362 +++ /dev/null @@ -1,8 +0,0 @@ -: (parse) ( a -- n ) - _pc IF EXIT THEN - _ph IF EXIT THEN - _pb IF EXIT THEN - _pd IF EXIT THEN - ( nothing works ) - (wnf) -; diff --git a/blk/363 b/blk/363 deleted file mode 100644 index 256bee0..0000000 --- a/blk/363 +++ /dev/null @@ -1,11 +0,0 @@ -: C - ( Overwrite cellWord in CURRENT ) - 3 ( does ) CURRENT @ C! - ( When we have a DOES>, we forcefully place HERE to 4 - bytes after CURRENT. This allows a DOES word to use "," - and "C," without messing everything up. ) - CURRENT @ 3 + HERE ! - ( HERE points to where we should write R> ) - R> , - ( We're done. Because we've popped RS, we'll exit parent - definition ) -; -: CONSTANT CREATE , DOES> @ ; diff --git a/blk/371 b/blk/371 deleted file mode 100644 index 5919535..0000000 --- a/blk/371 +++ /dev/null @@ -1,4 +0,0 @@ -: [IF] - IF EXIT THEN - LIT" [THEN]" BEGIN DUP WORD S= UNTIL DROP ; -: [THEN] ; diff --git a/blk/372 b/blk/372 deleted file mode 100644 index 180249e..0000000 --- a/blk/372 +++ /dev/null @@ -1,10 +0,0 @@ -( n -- Fetches block n and write it to BLK( ) -: BLK@* 0x34 RAM+ ; -( n -- Write back BLK( to storage at block n ) -: BLK!* 0x36 RAM+ ; -( Current blk pointer in ( ) -: BLK> 0x38 RAM+ ; -( Whether buffer is dirty ) -: BLKDTY 0x3a RAM+ ; -: BLK( 0x3c RAM+ @ ; -: BLK) BLK( 1024 + ; diff --git a/blk/373 b/blk/373 deleted file mode 100644 index 89f4193..0000000 --- a/blk/373 +++ /dev/null @@ -1,9 +0,0 @@ -: BLK$ - H@ 0x3c ( BLK(* ) RAM+ ! - 1024 ALLOT - ( LOAD detects end of block with ASCII EOT. This is why - we write it there. ) - EOT, - 0 BLKDTY ! - -1 BLK> ! -; diff --git a/blk/374 b/blk/374 deleted file mode 100644 index 9cd31f9..0000000 --- a/blk/374 +++ /dev/null @@ -1,14 +0,0 @@ -: BLK! ( -- ) - BLK> @ BLK!* @ EXECUTE - 0 BLKDTY ! ; -: FLUSH BLKDTY @ IF BLK! THEN ; -: BLK@ ( n -- ) - DUP BLK> @ = IF DROP EXIT THEN - FLUSH DUP BLK> ! BLK@* @ EXECUTE ; -: BLK!! 1 BLKDTY ! ; -: WIPE BLK( 1024 0 FILL BLK!! ; -: WIPED? ( -- f ) - 1 ( f ) BLK) BLK( DO - I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ; -: COPY ( src dst -- ) - FLUSH SWAP BLK@ BLK> ! BLK! ; diff --git a/blk/375 b/blk/375 deleted file mode 100644 index 514c5bd..0000000 --- a/blk/375 +++ /dev/null @@ -1,16 +0,0 @@ -: _ - 999 SWAP ( stop indicator ) - BEGIN - ?DUP NOT IF EXIT THEN - 10 /MOD ( r q ) - SWAP '0' + SWAP ( d q ) - AGAIN ; -: . ( n -- ) - ?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case ) - ( handle negative ) - DUP 0< IF '-' EMIT -1 * THEN - _ - BEGIN - DUP '9' > IF DROP EXIT THEN ( stop indicator ) - EMIT - AGAIN ; diff --git a/blk/376 b/blk/376 deleted file mode 100644 index e5f9b51..0000000 --- a/blk/376 +++ /dev/null @@ -1,16 +0,0 @@ -: ? @ . ; -: _ - DUP 9 > IF 10 - 'a' + - ELSE '0' + THEN -; -( For hex display, there are no negatives ) -: .x - 256 MOD ( ensure < 0x100 ) - 16 /MOD ( l h ) - _ EMIT ( l ) - _ EMIT -; -: .X - 256 /MOD ( l h ) - .x .x -; diff --git a/blk/377 b/blk/377 deleted file mode 100644 index 31b564d..0000000 --- a/blk/377 +++ /dev/null @@ -1,13 +0,0 @@ -: _ ( a -- a+8 ) - DUP ( a a ) - ':' EMIT DUP .x SPC - 4 0 DO DUP @ 256 /MOD SWAP .x .x SPC 2+ LOOP - DROP ( a ) - 8 0 DO - C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT - LOOP NL ; -: DUMP ( n a -- ) - LF - SWAP 8 /MOD SWAP IF 1+ THEN - 0 DO _ LOOP -; diff --git a/blk/378 b/blk/378 deleted file mode 100644 index e88f70c..0000000 --- a/blk/378 +++ /dev/null @@ -1,13 +0,0 @@ -( handle backspace: go back one char in IN>, if possible, then - emit BS + SPC + BS ) -: _bs - ( already at IN( ? ) - IN> @ IN( = IF EXIT THEN - IN> @ 1- IN> ! - BS SPC BS -; -( del is same as backspace ) -: BS? DUP 0x7f = SWAP 0x8 = OR ; -SYSVARS 0x55 + :** KEY -( cont.: read one char into input buffer and returns whether we - should continue, that is, whether CR was not met. ) diff --git a/blk/379 b/blk/379 deleted file mode 100644 index c5e63ee..0000000 --- a/blk/379 +++ /dev/null @@ -1,15 +0,0 @@ -: (rdlnc) ( -- c ) - ( buffer overflow? same as if we typed a newline ) - IN> @ IN) = IF 0x0a ELSE KEY THEN ( c ) - DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr ) - ( backspace? handle and exit ) - DUP BS? IF _bs EXIT THEN - ( echo back ) - DUP EMIT ( c ) - ( write and advance ) - DUP ( keep as result ) ( c c ) -( We take advantage of the fact that c's MSB is always zero and - thus ! automatically null-terminates our string ) - IN> @ ! 1 IN> +! ( c ) - ( if newline, replace with zero to indicate EOL ) - DUP 0xd = IF DROP 0 THEN ; diff --git a/blk/380 b/blk/380 deleted file mode 100644 index 96de653..0000000 --- a/blk/380 +++ /dev/null @@ -1,16 +0,0 @@ -( Read one line in input buffer and make IN> point to it ) -: (rdln) - ( EOT or less triggers line flush ) - (infl) BEGIN (rdlnc) 5 < UNTIL - LF IN( IN> ! ; -( And finally, implement C<* ) -: RDLN< - IN> @ C@ - DUP IF ( not EOL? good, inc and return ) - 1 IN> +! - ELSE ( EOL ? readline. we still return null though ) - (rdln) - THEN - ( update C @ C@ 0 > 0x06 RAM+ ! ( 06 == C IF EMIT ELSE DROP LEAVE THEN - LOOP - NL - LOOP ; diff --git a/blk/383 b/blk/383 deleted file mode 100644 index 0364a2f..0000000 --- a/blk/383 +++ /dev/null @@ -1,15 +0,0 @@ -: INTERPRET - BEGIN - WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN - FIND NOT IF (parse) ELSE EXECUTE THEN - C @ >R ( save restorable variables to RSP ) - 0x08 RAM+ @ >R ( 08 == C<* override ) - 0x06 RAM+ @ >R ( CR ( boot ptr ) - BLK@ - BLK( 0x2e RAM+ ! ( Point to beginning of BLK ) - ['] (boot<) 0x08 RAM+ ! - 1 0x06 RAM+ ! ( 06 == C 0x2e RAM+ ! R> 0x06 RAM+ ! - I 0x08 RAM+ @ = IF ( nested load ) - R> DROP ( C<* ) R> BLK@ - ELSE ( not nested ) - R> 0x08 RAM+ ! R> DROP ( BLK> ) - THEN ; diff --git a/blk/385 b/blk/385 deleted file mode 100644 index db838a0..0000000 --- a/blk/385 +++ /dev/null @@ -1,4 +0,0 @@ -: LOAD+ BLK> @ + LOAD ; -( b1 b2 -- ) -: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ; -: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; diff --git a/blk/390 b/blk/390 deleted file mode 100644 index fd1b233..0000000 --- a/blk/390 +++ /dev/null @@ -1,16 +0,0 @@ -( xcomp core high ) -: (main) INTERPRET BYE ; -: BOOT - 0x02 RAM+ CURRENT* ! - CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR ) - 0 0x08 RAM+ ! ( 08 == C<* override ) - ['] (emit) ['] EMIT **! ['] (key) ['] KEY **! - ['] CRLF ['] NL **! - ['] (boot<) ['] C<* **! - ['] C@ ['] A@ **! ['] C! ['] A! **! ['] C, ['] A, **! - ( boot< always has a char waiting. 06 == C IF LIT" br ovfl" (print) ABORT THEN ; -: DO COMPILE 2>R H@ ; IMMEDIATE -: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE -( LEAVE is implemented in low xcomp ) -: LITN COMPILE (n) , ; -( gets its name at the very end. can't comment afterwards ) -: _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE -: _ ( : will get its name almost at the very end ) - (entry) 1 ( compiled ) C, - BEGIN - WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN - FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN - ELSE ( maybe number ) (parse) LITN THEN - AGAIN ; diff --git a/blk/393 b/blk/393 deleted file mode 100644 index 8afba32..0000000 --- a/blk/393 +++ /dev/null @@ -1,16 +0,0 @@ -: IF ( -- a | a: br cell addr ) - COMPILE (?br) H@ 1 ALLOT ( br cell allot ) -; IMMEDIATE -: THEN ( a -- | a: br cell addr ) - DUP H@ -^ _bchk SWAP ( a-H a ) C! -; IMMEDIATE -: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) - COMPILE (br) - 1 ALLOT - [COMPILE] THEN - H@ 1- ( push a. 1- for allot offset ) -; IMMEDIATE -: LIT" - COMPILE (s) H@ 0 C, ," - DUP H@ -^ 1- ( a len ) SWAP C! -; IMMEDIATE diff --git a/blk/394 b/blk/394 deleted file mode 100644 index 6bc303f..0000000 --- a/blk/394 +++ /dev/null @@ -1,13 +0,0 @@ -( We don't use ." and ABORT in core, they're not xcomp-ed ) -: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE -: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE -: BEGIN H@ ; IMMEDIATE -: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE -: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE -: [ INTERPRET ; IMMEDIATE -: ] R> DROP ; -: COMPILE ' LITN ['] , , ; IMMEDIATE -: [COMPILE] ' , ; IMMEDIATE -: ['] ' LITN ; IMMEDIATE -':' X' _ 4 - C! ( give : its name ) -'(' X' _ 4 - C! diff --git a/blk/400 b/blk/400 deleted file mode 100644 index bb49b54..0000000 --- a/blk/400 +++ /dev/null @@ -1,15 +0,0 @@ -( With dst being assumed to be an AT28 EEPROM, perform ! - operation while doing the right thing. Checks data integrity - and ABORT on mismatch. ) -: AT28! ( n a -- ) - 2DUP C! - ( as long as writing operation is running, IO/6 will toggle - at each read attempt. We know that write is finished when - we read the same value twice. ) - BEGIN ( n1 a ) - DUP C@ ( n1 a n2 ) - OVER C@ ( n1 a n2 n3 ) - = UNTIL - ( We're finished writing. do we have a mismatch? ) - C@ = NOT IF ABORT" mismatch" THEN -; diff --git a/blk/401 b/blk/401 deleted file mode 100644 index a378f49..0000000 --- a/blk/401 +++ /dev/null @@ -1,11 +0,0 @@ -Grid subsystem - -Given a device driver following the Grid protocol, implement -AT-XY and (emit). (emit) makes the grid behave like a regular -terminal, honoring line feeds and backspaces, wrapping at the -end of a line. - -2 bytes of system memory at GRID_MEM are needed for cursor -position. - -Load range: B402-B403 diff --git a/blk/402 b/blk/402 deleted file mode 100644 index c5c59ce..0000000 --- a/blk/402 +++ /dev/null @@ -1,11 +0,0 @@ -: XYPOS [ GRID_MEM LITN ] ; -: _cl* COLS LINES * ; -: AT-XY ( x y -- ) LINES * + _cl* MOD XYPOS ! ; -'? NEWLN NIP NOT [IF] -: NEWLN ( ln -- ) COLS * DUP COLS + SWAP DO 0 I CELL! LOOP ; -[THEN] -: _lf - XYPOS @ COLS / 1+ LINES MOD DUP NEWLN - COLS * XYPOS ! ; -: _bs 0 ( blank ) XYPOS @ TUCK CELL! ( pos ) 1- - _cl* MOD XYPOS ! ; diff --git a/blk/403 b/blk/403 deleted file mode 100644 index 0d8ab68..0000000 --- a/blk/403 +++ /dev/null @@ -1,6 +0,0 @@ -: (emit) - DUP 0x08 = IF DROP _bs EXIT THEN - DUP 0x0d = IF DROP _lf EXIT THEN - 0x20 - DUP 0< IF DROP EXIT THEN - XYPOS @ CELL! - XYPOS @ 1+ DUP COLS MOD IF XYPOS ! ELSE _lf THEN ; diff --git a/blk/410 b/blk/410 deleted file mode 100644 index e14dd28..0000000 --- a/blk/410 +++ /dev/null @@ -1,11 +0,0 @@ -PS/2 keyboard subsystem - -Provides (key) from a driver providing the PS/2 protocol. That -is, for a driver taking care of providing all key codes emanat- -ing from a PS/2 keyboard, this subsystem takes care of mapping -those keystrokes to ASCII characters. This code is designed to -be cross-compiled and loaded with drivers. - -Requires PS2_MEM to be defined. - -Load range: 411-414 diff --git a/blk/411 b/blk/411 deleted file mode 100644 index 9595585..0000000 --- a/blk/411 +++ /dev/null @@ -1,16 +0,0 @@ -: PS2_SHIFT [ PS2_MEM LITN ] ; -: PS2$ 0 PS2_SHIFT C! ; - -( 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 -value. That value is a character that can be read in (key) -No make code in the PS/2 set 2 reaches 0x80. ) -CREATE PS2_CODES -( 00 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, -( 08 ) 0 C, 0 C, 0 C, 0 C, 0 C, 9 C, '`' C, 0 C, -( 10 ) 0 C, 0 C, 0 C, 0 C, 0 C, 'q' C, '1' C, 0 C, -( I don't know why, but the key 2 is sent as 0x1f by 2 of my - keyboards. Is it a timing problem on the ATtiny? TODO ) -( 18 ) 0 C, 0 C, 'z' C, 's' C, 'a' C, 'w' C, '2' C, '2' C, -( 20 ) 0 C, 'c' C, 'x' C, 'd' C, 'e' C, '4' C, '3' C, 0 C, -( 28 ) 0 C, 32 C, 'v' C, 'f' C, 't' C, 'r' C, '5' C, 0 C, diff --git a/blk/412 b/blk/412 deleted file mode 100644 index be030d9..0000000 --- a/blk/412 +++ /dev/null @@ -1,16 +0,0 @@ -( 30 ) 0 C, 'n' C, 'b' C, 'h' C, 'g' C, 'y' C, '6' C, 0 C, -( 38 ) 0 C, 0 C, 'm' C, 'j' C, 'u' C, '7' C, '8' C, 0 C, -( 40 ) 0 C, ',' C, 'k' C, 'i' C, 'o' C, '0' C, '9' C, 0 C, -( 48 ) 0 C, '.' C, '/' C, 'l' C, ';' C, 'p' C, '-' C, 0 C, -( 50 ) 0 C, 0 C, ''' C, 0 C, '[' C, '=' C, 0 C, 0 C, -( 58 ) 0 C, 0 C, 13 C, ']' C, 0 C, '\' C, 0 C, 0 C, -( 60 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 8 C, 0 C, -( 68 ) 0 C, '1' C, 0 C, '4' C, '7' C, 0 C, 0 C, 0 C, -( 70 ) '0' C, '.' C, '2' C, '5' C, '6' C, '8' C, 27 C, 0 C, -( 78 ) 0 C, 0 C, '3' C, 0 C, 0 C, '9' C, 0 C, 0 C, -( Same values, but shifted ) -( 00 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, -( 08 ) 0 C, 0 C, 0 C, 0 C, 0 C, 9 C, '~' C, 0 C, -( 10 ) 0 C, 0 C, 0 C, 0 C, 0 C, 'Q' C, '!' C, 0 C, -( 18 ) 0 C, 0 C, 'Z' C, 'S' C, 'A' C, 'W' C, '@' C, '@' C, -( 20 ) 0 C, 'C' C, 'X' C, 'D' C, 'E' C, '$' C, '#' C, 0 C, diff --git a/blk/413 b/blk/413 deleted file mode 100644 index cc60439..0000000 --- a/blk/413 +++ /dev/null @@ -1,11 +0,0 @@ -( 28 ) 0 C, 32 C, 'V' C, 'F' C, 'T' C, 'R' C, '%' C, 0 C, -( 30 ) 0 C, 'N' C, 'B' C, 'H' C, 'G' C, 'Y' C, '^' C, 0 C, -( 38 ) 0 C, 0 C, 'M' C, 'J' C, 'U' C, '&' C, '*' C, 0 C, -( 40 ) 0 C, '<' C, 'K' C, 'I' C, 'O' C, ')' C, '(' C, 0 C, -( 48 ) 0 C, '>' C, '?' C, 'L' C, ':' C, 'P' C, '_' C, 0 C, -( 50 ) 0 C, 0 C, '"' C, 0 C, '{' C, '+' C, 0 C, 0 C, -( 58 ) 0 C, 0 C, 13 C, '}' C, 0 C, '|' C, 0 C, 0 C, -( 60 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 8 C, 0 C, -( 68 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, -( 70 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 27 C, 0 C, -( 78 ) 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, 0 C, diff --git a/blk/414 b/blk/414 deleted file mode 100644 index db6991a..0000000 --- a/blk/414 +++ /dev/null @@ -1,14 +0,0 @@ -: _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 - DUP 0xf0 ( break ) = IF DROP ( ) - ( get next kc and see if it's a shift ) - _get _shift? IF ( drop shift ) 0 PS2_SHIFT C! THEN - ( 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 - ( 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 ; diff --git a/blk/418 b/blk/418 deleted file mode 100644 index f14c60e..0000000 --- a/blk/418 +++ /dev/null @@ -1,10 +0,0 @@ -SPI relay driver - -This driver is designed for a ad-hoc adapter card that acts as a -SPI relay between the z80 bus and the SPI device. When writing -to SPI_CTL, we expect a bitmask of the device to select, with -0 meaning that everything is de-selected. Reading SPI_CTL -returns 0 if the device is ready or 1 if it's still running an -exchange. Writing to SPI_DATA initiates an exchange. - -Provides the SPI relay protocol. Load driver with "419 LOAD". diff --git a/blk/419 b/blk/419 deleted file mode 100644 index c3f0228..0000000 --- a/blk/419 +++ /dev/null @@ -1,13 +0,0 @@ -CODE (spix) ( n -- n ) - HL POP, chkPS, A L LDrr, - SPI_DATA OUTiA, - ( wait until xchg is done ) - BEGIN, SPI_CTL INAi, 1 ANDi, JRNZ, AGAIN, - SPI_DATA INAi, - L A LDrr, - HL PUSH, -;CODE -CODE (spie) ( n -- ) - HL POP, chkPS, A L LDrr, - SPI_CTL OUTiA, -;CODE diff --git a/blk/420 b/blk/420 deleted file mode 100644 index 1aad5e6..0000000 --- a/blk/420 +++ /dev/null @@ -1,11 +0,0 @@ -SD Card subsystem - -Load range: B423-B436 - -This subsystem is designed for a ad-hoc adapter card that acts -as a SPI relay between the z80 bus and the SD card. It requires -a driver providing the SPI Relay protocol. You need to define -SDC_DEVID to specify which ID will be supplied to (spie). - -Through that layer, this driver implements the SDC protocol -allowing it to provide BLK@ and BLK!. diff --git a/blk/423 b/blk/423 deleted file mode 100644 index cbbd2ac..0000000 --- a/blk/423 +++ /dev/null @@ -1,14 +0,0 @@ -( Computes n into crc c with polynomial 0x1021 ) -CODE _crc16 ( c n -- c ) EXX, ( protect BC ) - HL POP, ( n ) DE POP, ( c ) - A L LDrr, D XORr, D A LDrr, - B 8 LDri, - BEGIN, - E SLA, D RL, - IFC, ( msb is set, apply polynomial ) - A D LDrr, 0x10 XORi, D A LDrr, - A E LDrr, 0x21 XORi, E A LDrr, - THEN, - DJNZ, AGAIN, - DE PUSH, -EXX, ( unprotect BC ) ;CODE diff --git a/blk/424 b/blk/424 deleted file mode 100644 index e6d55fb..0000000 --- a/blk/424 +++ /dev/null @@ -1,10 +0,0 @@ -( -- n ) -: _idle 0xff (spix) ; - -( -- n ) -( spix 0xff until the response is something else than 0xff - for a maximum of 20 times. Returns 0xff if no response. ) -: _wait - 0 ( dummy ) 20 0 DO - DROP _idle DUP 0xff = NOT IF LEAVE THEN - LOOP ; diff --git a/blk/425 b/blk/425 deleted file mode 100644 index e3b2953..0000000 --- a/blk/425 +++ /dev/null @@ -1,10 +0,0 @@ -( -- ) -( The opposite of sdcWaitResp: we wait until response is 0xff. - After a successful read or write operation, the card will be - busy for a while. We need to give it time before interacting - with it again. Technically, we could continue processing on - our side while the card it busy, and maybe we will one day, - but at the moment, I'm having random write errors if I don't - do this right after a write, so I prefer to stay cautious - for now. ) -: _ready BEGIN _idle 0xff = UNTIL ; diff --git a/blk/426 b/blk/426 deleted file mode 100644 index 60247fe..0000000 --- a/blk/426 +++ /dev/null @@ -1,15 +0,0 @@ -( c n -- c ) -( Computes n into crc c with polynomial 0x09 - Note that the result is "left aligned", that is, that 8th - bit to the "right" is insignificant (will be stop bit). ) -: _crc7 - XOR ( c ) - 8 0 DO - 2 * ( <<1 ) - DUP 255 > IF - ( MSB was set, apply polynomial ) - 0xff AND - 0x12 XOR ( 0x09 << 1, we apply CRC on high bits ) - THEN - LOOP -; diff --git a/blk/427 b/blk/427 deleted file mode 100644 index 0d944fe..0000000 --- a/blk/427 +++ /dev/null @@ -1,3 +0,0 @@ -( send-and-crc7 ) -( n c -- c ) -: _s+crc SWAP DUP (spix) DROP _crc7 ; diff --git a/blk/428 b/blk/428 deleted file mode 100644 index a5093ca..0000000 --- a/blk/428 +++ /dev/null @@ -1,16 +0,0 @@ -( cmd arg1 arg2 -- resp ) -( Sends a command to the SD card, along with arguments and - specified CRC fields. (CRC is only needed in initial commands - though). This does *not* handle CS. You have to - select/deselect the card outside this routine. ) -: _cmd - _wait DROP ROT ( a1 a2 cmd ) - 0 _s+crc ( a1 a2 crc ) - ROT 256 /MOD ROT ( a2 h l crc ) - _s+crc _s+crc ( a2 crc ) - SWAP 256 /MOD ROT ( h l crc ) - _s+crc _s+crc ( crc ) - 1 OR ( ensure stop bit ) - (spix) DROP ( send CRC ) - _wait ( wait for a valid response... ) -; diff --git a/blk/429 b/blk/429 deleted file mode 100644 index f826569..0000000 --- a/blk/429 +++ /dev/null @@ -1,15 +0,0 @@ -( cmd arg1 arg2 -- r ) -( Send a command that expects a R1 response, handling CS. ) -: SDCMDR1 [ SDC_DEVID LITN ] (spie) _cmd 0 (spie) ; - -( cmd arg1 arg2 -- r arg1 arg2 ) -( Send a command that expects a R7 response, handling CS. A R7 - is a R1 followed by 4 bytes. arg1 contains bytes 0:1, arg2 - has 2:3 ) -: SDCMDR7 - [ SDC_DEVID LITN ] (spie) - _cmd ( r ) - _idle 8 LSHIFT _idle + ( r arg1 ) - _idle 8 LSHIFT _idle + ( r arg1 arg2 ) - 0 (spie) -; diff --git a/blk/430 b/blk/430 deleted file mode 100644 index f74a84d..0000000 --- a/blk/430 +++ /dev/null @@ -1,16 +0,0 @@ -: _err 0 (spie) LIT" SDerr" ERR ; - -( Tight definition ahead, pre-comment. - - Initialize a SD card. This should be called at least 1ms - after the powering up of the card. We begin by waking up the - SD card. After power up, a SD card has to receive at least - 74 dummy clocks with CS and DI high. We send 80. - Then send cmd0 for a maximum of 10 times, success is when - we get 0x01. Then comes the CMD8. We send it with a 0x01aa - argument and expect a 0x01aa argument back, along with a - 0x01 R1 response. After that, we need to repeatedly run - CMD55+CMD41 (0x40000000) until the card goes out of idle - mode, that is, when it stops sending us 0x01 response and - send us 0x00 instead. Any other response means that - initialization failed. ) diff --git a/blk/431 b/blk/431 deleted file mode 100644 index 467c942..0000000 --- a/blk/431 +++ /dev/null @@ -1,16 +0,0 @@ -: SDC$ - 10 0 DO _idle DROP LOOP - 0 ( dummy ) 10 0 DO ( r ) - DROP 0x40 0 0 SDCMDR1 ( CMD0 ) - 1 = DUP IF LEAVE THEN - LOOP NOT IF _err THEN - 0x48 0 0x1aa ( CMD8 ) SDCMDR7 ( r arg1 arg2 ) - ( expected 1 0 0x1aa ) - 0x1aa = ROT ( arg1 f r ) 1 = AND SWAP ( f&f arg1 ) - NOT ( 0 expected ) AND ( f&f&f ) NOT IF _err THEN - BEGIN - 0x77 0 0 SDCMDR1 ( CMD55 ) - 1 = NOT IF _err THEN - 0x69 0x4000 0 SDCMDR1 ( CMD41 ) - DUP 1 > IF _err THEN - NOT UNTIL ; ( out of idle mode, success! ) diff --git a/blk/432 b/blk/432 deleted file mode 100644 index 3db170e..0000000 --- a/blk/432 +++ /dev/null @@ -1,16 +0,0 @@ -: _ ( dstaddr blkno -- ) - [ SDC_DEVID LITN ] (spie) - 0x51 ( CMD17 ) 0 ROT ( a cmd 0 blkno ) _cmd - IF _err THEN - _wait 0xfe = NOT IF _err THEN - 0 SWAP ( crc a ) - 512 0 DO ( crc a ) - _idle ( crc a n ) - DUP ROT C!+ ( crc n a+1 ) - ROT> _crc16 ( a+1 crc ) - SWAP ( crc a+1 ) - LOOP - DROP ( crc1 ) - _idle 8 LSHIFT _idle + ( crc2 ) - _wait DROP 0 (spie) - = NOT IF _err THEN ; diff --git a/blk/433 b/blk/433 deleted file mode 100644 index 6bd635b..0000000 --- a/blk/433 +++ /dev/null @@ -1,4 +0,0 @@ -: SDC@ - 2 * DUP BLK( SWAP ( b a b ) _ - 1+ BLK( 512 + SWAP _ -; diff --git a/blk/434 b/blk/434 deleted file mode 100644 index 5f071a6..0000000 --- a/blk/434 +++ /dev/null @@ -1,16 +0,0 @@ -: _ ( srcaddr blkno -- ) - [ SDC_DEVID LITN ] (spie) - 0x58 ( CMD24 ) 0 ROT ( a cmd 0 blkno ) _cmd - IF _err THEN - _idle DROP 0xfe (spix) DROP 0 SWAP ( crc a ) - 512 0 DO ( crc a ) - C@+ ( crc a+1 n ) - ROT OVER ( a n crc n ) - _crc16 ( a n crc ) - SWAP ( a crc n ) - (spix) DROP ( a crc ) - SWAP ( crc a ) - LOOP - DROP ( crc ) 256 /MOD ( lsb msb ) - (spix) DROP (spix) DROP - _wait DROP 0 (spie) ; diff --git a/blk/435 b/blk/435 deleted file mode 100644 index f7828e9..0000000 --- a/blk/435 +++ /dev/null @@ -1,4 +0,0 @@ -: SDC! - 2 * DUP BLK( SWAP ( b a b ) _ - 1+ BLK( 512 + SWAP _ -; diff --git a/blk/440 b/blk/440 deleted file mode 100644 index d9795a7..0000000 --- a/blk/440 +++ /dev/null @@ -1,16 +0,0 @@ -8086 boot code - -Code in the following blocks assemble into a binary that is -suitable to plug into Core words (B350) to achieve a fully -functional Collapse OS. It is structured in a way that is -very similar to Z80 boot code (B280) and requires the same -constants to be pre-declared. - -RESERVED REGISTERS: SP is reserved for PSP, BP is for RSP and -DX is for IP. Whenever you use these registers for another -purpose, be sure to protect their initial value. Like with -Z80, you can use SP freely in native code, but you have to make -sure it goes back to its previous level before next is called. - - - (cont.) diff --git a/blk/441 b/blk/441 deleted file mode 100644 index ccb89dc..0000000 --- a/blk/441 +++ /dev/null @@ -1,13 +0,0 @@ -STABLE ABI: As a compatible binary, this binary follows the -same stable ABI as its z80 counterpart. - -PS CHECKS: Unlike z80 boot code, we don't check PS at each next -call (we do check RS though). It is the responsibility of every -native PSP-modifying word to call chkPS, . Also, chkPS, is a -bit different than in z80: it is parametrizable. The idea is -that we always call chkPS, before popping, telling the expected -size of stack. This allows for some interesting optimization. -For example, in SWAP, no need to pop, chkPS, then push, we can -chkPS and then proceed to optimized swapping in PS. - -To assemble, load blocks 445 through 461 diff --git a/blk/445 b/blk/445 deleted file mode 100644 index dbc7e12..0000000 --- a/blk/445 +++ /dev/null @@ -1,9 +0,0 @@ -VARIABLE lblexec VARIABLE lblnext -H@ ORG ! -JMPn, 0 A,, ( 00, main ) 0 A, ( 03, boot driveno ) -0 A,, ( 04, BOOT ) -0 A,, ( 06, uflw ) 0 A,, ( 08, LATEST ) 0 A,, ( unused ) -0 A, 0 A,, ( 0b, EXIT ) -0 A,, 0 A,, ( unused ) 0 A,, ( 13, oflw ) -0 A,, 0 A,, 0 A, ( unused ) -JMPn, 0 A,, ( 1a, next ) diff --git a/blk/446 b/blk/446 deleted file mode 100644 index b517fba..0000000 --- a/blk/446 +++ /dev/null @@ -1,11 +0,0 @@ -( TODO: move these words with other native words. ) -H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) -CODE (br) L1 BSET ( used in ?br ) - DI DX MOVxx, AL [DI] MOVr[], AH AH XORrr, CBW, - DX AX ADDxx, -;CODE -CODE (?br) - AX POPx, AX AX ORxx, JZ, L1 @ RPCs, ( False, branch ) - ( True, skip next byte and don't branch ) - DX INCx, -;CODE diff --git a/blk/447 b/blk/447 deleted file mode 100644 index fa2ea22..0000000 --- a/blk/447 +++ /dev/null @@ -1,8 +0,0 @@ -CODE (loop) - [BP] 0 INC[w]+, ( I++ ) - ( Jump if I <> I' ) - AX [BP] 0 MOVx[]+, AX [BP] -2 CMPx[]+, - JNZ, L1 @ RPCs, ( branch ) - ( don't branch ) - BP 4 SUBxi, DX INCx, -;CODE diff --git a/blk/448 b/blk/448 deleted file mode 100644 index b047e62..0000000 --- a/blk/448 +++ /dev/null @@ -1,10 +0,0 @@ -lblnext BSET PC 0x1d - ORG @ 0x1b + ! ( next ) - ( ovfl check ) - BP SP CMPxx, - IFNC, ( BP >= SP ) - SP PS_ADDR MOVxI, BP RS_ADDR MOVxI, - DI 0x13 ( oflw ) MOVxm, JMPs, L1 FWRs ( execute ) - THEN, - DI DX MOVxx, ( <-- IP ) DX INCx, DX INCx, - DI [DI] MOVx[], ( wordref ) - ( continue to execute ) L1 FSET diff --git a/blk/449 b/blk/449 deleted file mode 100644 index 094161d..0000000 --- a/blk/449 +++ /dev/null @@ -1,15 +0,0 @@ -lblexec BSET ( DI -> wordref ) - AL [DI] MOVr[], DI INCx, ( PFA ) - AL AL ORrr, IFZ, DI JMPr, THEN, ( native ) - AL DECr, IFNZ, ( not compiled ) - AL DECr, IFZ, ( cell ) - DI PUSHx, JMPs, lblnext @ RPCs, THEN, - AL DECr, IFZ, ( does ) - DI PUSHx, DI INCx, DI INCx, DI [DI] MOVx[], THEN, - ( alias or switch ) DI [DI] MOVx[], - AL DECr, IFNZ, ( switch ) DI [DI] MOVx[], THEN, - JMPs, lblexec @ RPCs, - THEN, ( continue to compiled ) - BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS ) - DX DI MOVxx, DX INCx, DX INCx, ( --> IP ) - DI [DI] MOVx[], JMPs, lblexec @ RPCs, diff --git a/blk/450 b/blk/450 deleted file mode 100644 index bc45bd4..0000000 --- a/blk/450 +++ /dev/null @@ -1,15 +0,0 @@ -lblchkPS BSET ( CX -> expected size ) - AX PS_ADDR MOVxI, AX SP SUBxx, 2 SUBAXI, ( CALL adjust ) - AX CX CMPxx, - IFNC, ( we're good ) RET, THEN, - ( underflow ) DI 0x06 MOVxm, JMPs, lblexec @ RPCs, - -PC 3 - ORG @ 1+ ! ( main ) - DX POPx, ( boot drive no ) 0x03 DL MOVmr, - SP PS_ADDR MOVxI, BP RS_ADDR MOVxI, - DI 0x08 MOVxm, ( LATEST ) -( HERE begins at CURRENT ) - SYSVARS 0x4 ( HERE ) + DI MOVmx, - SYSVARS 0x2 ( CURRENT ) + DI MOVmx, - DI 0x04 ( BOOT ) MOVxm, - JMPn, lblexec @ RPCn, ( execute ) diff --git a/blk/451 b/blk/451 deleted file mode 100644 index f4a2892..0000000 --- a/blk/451 +++ /dev/null @@ -1,7 +0,0 @@ -( native words ) -CODE EXECUTE 1 chkPS, - DI POPx, JMPn, lblexec @ RPCn, -CODE EXIT - DX [BP] 0 MOVx[]+, BP DECx, BP DECx, ( popRS ) -;CODE - diff --git a/blk/452 b/blk/452 deleted file mode 100644 index 9512b18..0000000 --- a/blk/452 +++ /dev/null @@ -1,9 +0,0 @@ -CODE (n) ( number literal ) - DI DX MOVxx, DI [DI] MOVx[], DI PUSHx, - DX INCx, DX INCx, -;CODE -CODE (s) ( string literal, see B287 ) - DI DX MOVxx, ( IP ) - AH AH XORrr, AL [DI] MOVr[], ( slen ) - DX PUSHx, DX INCx, DX AX ADDxx, -;CODE diff --git a/blk/453 b/blk/453 deleted file mode 100644 index 8541046..0000000 --- a/blk/453 +++ /dev/null @@ -1,12 +0,0 @@ -CODE >R 1 chkPS, - BP INCx, BP INCx, [BP] 0 POP[w]+, -;CODE NOP, NOP, NOP, -CODE R> - [BP] 0 PUSH[w]+, BP DECx, BP DECx, -;CODE -CODE 2>R - [BP] 4 POP[w]+, [BP] 2 POP[w]+, BP 4 ADDxi, -;CODE -CODE 2R> 2 chkPS, - [BP] -2 PUSH[w]+, [BP] 0 PUSH[w]+, BP 4 SUBxi, -;CODE diff --git a/blk/454 b/blk/454 deleted file mode 100644 index 6bcdc43..0000000 --- a/blk/454 +++ /dev/null @@ -1,16 +0,0 @@ -CODE ROT ( a b c -- b c a ) 3 chkPS, - CX POPx, BX POPx, AX POPx, - BX PUSHx, CX PUSHx, AX PUSHx, ;CODE -CODE ROT> ( a b c -- c a b ) 3 chkPS, - CX POPx, BX POPx, AX POPx, - CX PUSHx, AX PUSHx, BX PUSHx, ;CODE -CODE DUP 1 chkPS, AX POPx, AX PUSHx, AX PUSHx, ;CODE -CODE ?DUP 1 chkPS, AX POPx, AX AX ORxx, AX PUSHx, - IFNZ, AX PUSHx, THEN, ;CODE -CODE OVER ( a b -- a b a ) 2 chkPS, - DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx, ;CODE -CODE PICK - DI POPx, DI SHLx1, ( x2 ) - CX DI MOVxx, CX 2 ADDxi, CALL, lblchkPS @ RPCn, - DI SP ADDxx, DI [DI] MOVx[], DI PUSHx, -;CODE diff --git a/blk/455 b/blk/455 deleted file mode 100644 index 35e061b..0000000 --- a/blk/455 +++ /dev/null @@ -1,16 +0,0 @@ -CODE (roll) ( "2 3 4 5 4 --> 2 4 5 5". See B311 ) - CX POPx, CX 2 ADDxi, CALL, lblchkPS @ RPCn, CX 2 SUBxi, - SI SP MOVxx, SI CX ADDxx, - DI SI MOVxx, DI 2 ADDxi, STD, REPZ, MOVSB, -;CODE -CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE -CODE DROP 1 chkPS, AX POPx, ;CODE -CODE 2DROP 2 chkPS, SP 4 ADDxi, ;CODE -CODE 2DUP 2 chkPS, - AX POPx, BX POPx, - BX PUSHx, AX PUSHx, BX PUSHx, AX PUSHx, -;CODE -CODE S0 AX PS_ADDR MOVxI, AX PUSHx, ;CODE -CODE 'S SP PUSHx, ;CODE -CODE AND 2 chkPS, - AX POPx, BX POPx, AX BX ANDxx, AX PUSHx, ;CODE diff --git a/blk/456 b/blk/456 deleted file mode 100644 index 617f7db..0000000 --- a/blk/456 +++ /dev/null @@ -1,15 +0,0 @@ -CODE OR 2 chkPS, - AX POPx, BX POPx, AX BX ORxx, AX PUSHx, ;CODE -CODE XOR 2 chkPS, - AX POPx, BX POPx, AX BX XORxx, AX PUSHx, ;CODE -CODE NOT 1 chkPS, - AX POPx, AX AX ORxx, - IFNZ, AX -1 MOVxI, THEN, AX INCx, AX PUSHx, ;CODE -CODE + 2 chkPS, - AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE -CODE - 2 chkPS, - BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE -CODE * 2 chkPS, - AX POPx, BX POPx, - DX PUSHx, ( protect from MUL ) BX MULx, DX POPx, - AX PUSHx, ;CODE diff --git a/blk/457 b/blk/457 deleted file mode 100644 index 3ddea8b..0000000 --- a/blk/457 +++ /dev/null @@ -1,16 +0,0 @@ -CODE /MOD 2 chkPS, - BX POPx, AX POPx, DX PUSHx, ( protect ) - DX DX XORxx, BX DIVx, - BX DX MOVxx, DX POPx, ( unprotect ) - BX PUSHx, ( modulo ) AX PUSHx, ( division ) -;CODE -CODE ! 2 chkPS, DI POPx, AX POPx, [DI] AX MOV[]x, ;CODE -CODE @ 1 chkPS, DI POPx, AX [DI] MOVx[], AX PUSHx, ;CODE -CODE C! 2 chkPS, DI POPx, AX POPx, [DI] AX MOV[]r, ;CODE -CODE C@ 1 chkPS, - DI POPx, AH AH XORrr, AL [DI] MOVr[], AX PUSHx, ;CODE -CODE I [BP] 0 PUSH[w]+, ;CODE -CODE I' [BP] -2 PUSH[w]+, ;CODE -CODE J [BP] -4 PUSH[w]+, ;CODE -CODE (resSP) SP PS_ADDR MOVxI, ;CODE -CODE (resRS) BP RS_ADDR MOVxI, ;CODE diff --git a/blk/458 b/blk/458 deleted file mode 100644 index 52ab807..0000000 --- a/blk/458 +++ /dev/null @@ -1,16 +0,0 @@ -CODE BYE HLT, BEGIN, JMPs, AGAIN, ;CODE -CODE S= 2 chkPS, - SI POPx, DI POPx, CH CH XORrr, CL [SI] MOVr[], - CL [DI] CMPr[], - IFZ, ( same size? ) - SI INCx, DI INCx, CLD, REPZ, CMPSB, - THEN, - PUSHZ, -;CODE -CODE CMP 2 chkPS, - BX POPx, AX POPx, CX CX XORxx, AX BX CMPxx, - IFNZ, ( < or > ) - CX INCx, IFC, ( < ) CX DECx, CX DECx, THEN, - THEN, - CX PUSHx, -;CODE diff --git a/blk/459 b/blk/459 deleted file mode 100644 index 069e7a1..0000000 --- a/blk/459 +++ /dev/null @@ -1,16 +0,0 @@ -CODE _find ( cur w -- a f ) 2 chkPS, - SI POPx, ( w ) DI POPx, ( cur ) - CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen ) - SI INCx, ( first char ) AX AX XORxx, ( initial prev ) - BEGIN, ( loop ) - DI AX SUBxx, ( jump to prev wordref ) - AL [DI] -1 MOVr[]+, 0x7f ANDALi, ( strlen ) - CL AL CMPrr, IFZ, ( same len ) - SI PUSHx, DI PUSHx, CX PUSHx, ( --> lvl 3 ) - 3 ADDALi, ( header ) AH AH XORrr, DI AX SUBxx, - CLD, REPZ, CMPSB, - CX POPx, DI POPx, SI POPx, ( <-- lvl 3 ) - IFZ, DI PUSHx, AX 1 MOVxI, AX PUSHx, - JMPn, lblnext @ RPCn, THEN, - THEN, - DI 3 SUBxi, AX [DI] MOVx[], ( prev ) AX AX ORxx, ( cont. ) diff --git a/blk/460 b/blk/460 deleted file mode 100644 index f7ce66c..0000000 --- a/blk/460 +++ /dev/null @@ -1,14 +0,0 @@ -( cont. find ) JNZ, AGAIN, ( loop ) - SI DECx, SI PUSHx, AX AX XORrr, AX PUSHx, -;CODE -CODE 0 AX AX XORxx, AX PUSHx, ;CODE -CODE 1 AX 1 MOVxI, AX PUSHx, ;CODE -CODE -1 AX -1 MOVxI, AX PUSHx, ;CODE -CODE 1+ 1 chkPS, DI SP MOVxx, [DI] INC[w], ;CODE -CODE 1- 1 chkPS, DI SP MOVxx, [DI] DEC[w], ;CODE -CODE 2+ 1 chkPS, DI SP MOVxx, [DI] INC[w], [DI] INC[w], ;CODE -CODE 2- 1 chkPS, DI SP MOVxx, [DI] DEC[w], [DI] DEC[w], ;CODE -CODE RSHIFT ( n u -- n ) 2 chkPS, - CX POPx, AX POPx, AX SHRxCL, AX PUSHx, ;CODE -CODE LSHIFT ( n u -- n ) 2 chkPS, - CX POPx, AX POPx, AX SHLxCL, AX PUSHx, ;CODE diff --git a/blk/461 b/blk/461 deleted file mode 100644 index 2be56ea..0000000 --- a/blk/461 +++ /dev/null @@ -1,9 +0,0 @@ -( See comment in B321. TODO: test on real hardware. in qemu, - the resulting delay is more than 10x too long. ) -CODE TICKS 1 chkPS, ( n=100us ) - SI DX MOVxx, ( protect IP ) - AX POPx, BX 100 MOVxI, BX MULx, - CX DX MOVxx, ( high ) DX AX MOVxx, ( low ) - AX 0x8600 MOVxI, ( 86h, WAIT ) 0x15 INT, - DX SI MOVxx, ( restore IP ) -;CODE diff --git a/blk/470 b/blk/470 deleted file mode 100644 index b8fdc3d..0000000 --- a/blk/470 +++ /dev/null @@ -1,12 +0,0 @@ -( Z80 driver for TMS9918. Implements grid protocol. Requires -TMS_CTLPORT, TMS_DATAPORT and ~FNT from the Font compiler at -B520. Load range B470-472 ) -CODE _ctl ( a -- sends LSB then MSB ) - HL POP, chkPS, - A L LDrr, TMS_CTLPORT OUTiA, - A H LDrr, TMS_CTLPORT OUTiA, -;CODE -CODE _data - HL POP, chkPS, - A L LDrr, TMS_DATAPORT OUTiA, -;CODE diff --git a/blk/471 b/blk/471 deleted file mode 100644 index d6b063f..0000000 --- a/blk/471 +++ /dev/null @@ -1,9 +0,0 @@ -CODE _blank ( this is way too slow in Forth ) - A XORr, TMS_CTLPORT OUTiA, - A 0x40 LDri, TMS_CTLPORT OUTiA, - HL 0x4000 LDdi, - BEGIN, - A XORr, TMS_DATAPORT OUTiA, - HL DECd, HLZ, - JRNZ, AGAIN, -;CODE diff --git a/blk/472 b/blk/472 deleted file mode 100644 index 98cdf96..0000000 --- a/blk/472 +++ /dev/null @@ -1,16 +0,0 @@ -( 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. ) -: _sfont ( a -- Send font to TMS ) - 7 0 DO C@+ _data LOOP DROP - ( blank row ) 0 _data ; -: CELL! ( tilenum pos ) - 0x7800 OR _ctl ( tilenum ) - 0x5e MOD _data ; -: COLS 40 ; : LINES 24 ; -: TMS$ - 0x8100 _ctl ( blank screen ) _blank - 0x4000 _ctl 0x5e 0 DO ~FNT I 7 * + _sfont LOOP - 0x820e _ctl ( name table 0x3800 ) - 0x8400 _ctl ( patter table 0x0000 ) - 0x87f0 _ctl ( colors 0 and 1 ) - 0x8000 _ctl 0x81d0 _ctl ( text mode, display on ) ; diff --git a/blk/520 b/blk/520 deleted file mode 100644 index a317715..0000000 --- a/blk/520 +++ /dev/null @@ -1,13 +0,0 @@ -Fonts - -Fonts are kept in "source" form in the following blocks and -then compiled to binary bitmasks by the following code. In -source form, fonts are a simple sequence of '.' and 'X'. '.' -means empty, 'X' means filled. Glyphs are entered one after the -other, starting at 0x21 and ending at 0x7e. To be space -efficient in blocks, we align glyphs horizontally in the blocks -to fit as many character as we can. For example, a 5x7 font -would mean that we would have 12x2 glyphs per block. - -521 Font compiler 530 3x5 font -532 5x7 font 536 7x7 font diff --git a/blk/521 b/blk/521 deleted file mode 100644 index f2bc28d..0000000 --- a/blk/521 +++ /dev/null @@ -1,6 +0,0 @@ -( Converts "dot-X" fonts to binary "glyph rows". One byte for - each row. In a 5x7 font, each glyph thus use 7 bytes. - Resulting bytes are aligned to the left of the byte. - Therefore, for a 5-bit wide char, "X.X.X" translates to - 0b10101000. Left-aligned bytes are easier to work with when - compositing glyphs. ) diff --git a/blk/522 b/blk/522 deleted file mode 100644 index 7866101..0000000 --- a/blk/522 +++ /dev/null @@ -1,15 +0,0 @@ -: _g ( given a top-left of dot-X in BLK(, spit 5 bin lines ) - 5 0 DO - 0 3 0 DO ( a r ) - 1 LSHIFT - OVER J 64 * I + + C@ 'X' = IF 1+ THEN - LOOP 5 LSHIFT C, LOOP DROP ; -: _l ( a u -- a, spit a line of u glyphs ) - ( u ) 0 DO ( a ) - DUP I 3 * + _g - LOOP ; -: CPFNT3x5 - 0 , 0 , 0 C, ( space char ) - 530 BLK@ BLK( 21 _l 320 + 21 _l 320 + 21 _l DROP ( 63 ) - 531 BLK@ BLK( 21 _l 320 + 10 _l DROP ( 94! ) -; diff --git a/blk/523 b/blk/523 deleted file mode 100644 index eda6cb8..0000000 --- a/blk/523 +++ /dev/null @@ -1,15 +0,0 @@ -: _g ( given a top-left of dot-X in BLK(, spit 7 bin lines ) - 7 0 DO - 0 5 0 DO ( a r ) - 1 LSHIFT - OVER J 64 * I + + C@ 'X' = IF 1+ THEN - LOOP 3 LSHIFT C, LOOP DROP ; -: _l ( a u -- a, spit a line of u glyphs ) - ( u ) 0 DO ( a ) - DUP I 5 * + _g - LOOP ; -: CPFNT5x7 - 0 , 0 , 0 , 0 C, ( space char ) - 535 532 DO I BLK@ BLK( 12 _l 448 + 12 _l DROP LOOP ( 72 ) - 535 BLK@ BLK( 12 _l 448 + 10 _l DROP ( 94! ) -; diff --git a/blk/524 b/blk/524 deleted file mode 100644 index b4bb0f8..0000000 --- a/blk/524 +++ /dev/null @@ -1,15 +0,0 @@ -: _g ( given a top-left of dot-X in BLK(, spit 7 bin lines ) - 7 0 DO - 0 7 0 DO ( a r ) - 1 LSHIFT - OVER J 64 * I + + C@ 'X' = IF 1+ THEN - LOOP 1 LSHIFT C, LOOP DROP ; -: _l ( a u -- a, spit a line of u glyphs ) - ( u ) 0 DO ( a ) - DUP I 7 * + _g - LOOP ; -: CPFNT7x7 - 0 , 0 , 0 , 0 C, ( space char ) - 541 536 DO I BLK@ BLK( 9 _l 448 + 9 _l DROP LOOP ( 90 ) - 542 BLK@ BLK( 4 _l DROP ( 94! ) -; diff --git a/blk/530 b/blk/530 deleted file mode 100644 index 13ae8ef..0000000 --- a/blk/530 +++ /dev/null @@ -1,16 +0,0 @@ -.X.X.XX.X.XXX...X..X...XX...X...............X.X..X.XX.XX.X.XXXX -.X.X.XXXXXX...XX.X.X..X..X.XXX.X............XX.XXX...X..XX.XX.. -.X........XX.X..X.....X..X..X.XXX...XXX....X.X.X.X..X.XX.XXXXX. -......XXXXX.X..X.X....X..X.X.X.X..X.......X..X.X.X.X....X..X..X -.X....X.X.X...X.XX.....XX........X......X.X...X.XXXXXXXX...XXX. -.XXXXXXXXXXX........X...X..XX..X..X.XX..XXXX.XXXXXX.XXX.XXXXXXX -X....XX.XX.X.X..X..X.XXX.X...XXXXX.XX.XX..X.XX..X..X..X.X.X...X -XXX.X.XXXXXX......X.......X.X.XXXXXXXX.X..X.XXX.XX.X.XXXX.X...X -X.XX..X.X..X.X..X..X.XXX.X....X..X.XX.XX..X.XX..X..X.XX.X.X...X -XXXX..XXXXX....X....X...X...X..XXX.XXX..XXXX.XXXX...XXX.XXXXXX. -X.XX..X.XXX.XXXXX.XXXXX..XXXXXX.XX.XX.XX.XX.XXXXXXXX..XXX.X.... -XX.X..XXXX.XX.XX.XX.XX.XX...X.X.XX.XX.XX.XX.X..XX..X....XX.X... -X..X..XXXX.XX.XXX.X.XXX..X..X.X.XX.XXXX.X..X..X.X...X...X...... -XX.X..X.XX.XX.XX..XXXX.X..X.X.X.XX.XXXXX.X.X.X..X....X..X...... -X.XXXXX.XX.XXXXX...XXX.XXX..X.XXX.X.X.XX.X.X.XXXXXX..XXXX...XXX -!"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ diff --git a/blk/531 b/blk/531 deleted file mode 100644 index db3e3d0..0000000 --- a/blk/531 +++ /dev/null @@ -1,11 +0,0 @@ -X.....X.......X....XX...X...X...XX..XX.......................X. -.X.XX.X...XX..X.X.X...X.X........X.X.X.X.XXX..X.XX..XX.XX.XXXXX -.....XXX.X...XXX.XXX.X.XXX..X...XXX..X.XXXX.XX.XX.XX.XX..XX..X. -...XXXX.XX..X.XXX.X...XXX.X.X...XX.X.X.X.XX.XX.XXX..XXX....X.X. -...XXXXX..XX.XX.XXX..XX.X.X.X.XX.X.X.XXX.XX.X.X.X....XX..XX..XX -...................XX.X.XX..................................... -X.XX.XX.XX.XX.XXXX.X..X..X..XX -X.XX.XX.X.X..X..XXX...X...XXX. -X.XX.XXXX.X..X.XX..X..X..X.... -XXX.X.X.XX.X.X.XXX.XX.X.XX.... -`abcdefghijklmnopqrstuvwxyz{|}~ diff --git a/blk/532 b/blk/532 deleted file mode 100644 index 589729d..0000000 --- a/blk/532 +++ /dev/null @@ -1,15 +0,0 @@ -..X...X.X........X..............X....X....X...............X. -..X...X.X..X.X..XXXXX...X.XX....X...X......X.X.X.X..X....X.. -..X.......XXXXXX.......X.X..X......X........X.XXX...X....... -..X........X.X..XXX...X...XX.......X........XXXXXXXXXXX..... -..........XXXXX....X.X....XX.X.....X........X.XXX...X....... -..X........X.X.XXXX.X...XX..X.......X......X.X.X.X..X....... -..X..............X.......XXX.X.......X....X................. -................XXX...XX..XXX..XXX...XX.XXXXX.XXX.XXXXX.XXX. -..............XX...X.X.X.X...XX...X.X.X.X....X........XX...X -.............X.X..XX...X.....X....XX..X.XXXX.X........XX...X -XXXXX.......X..X.X.X...X....X...XX.XXXXX....XXXXX....X..XXX. -...........X...XX..X...X...X......X...X.....XX...X..X..X...X -......XX..X....X...X...X..X...X...X...X.X...XX...X.X...X...X -......XX........XXX..XXXXXXXXX.XXX....X..XXX..XXX.X.....XXX. -!"#$%&'()*+,-./012345678 diff --git a/blk/533 b/blk/533 deleted file mode 100644 index a74f57f..0000000 --- a/blk/533 +++ /dev/null @@ -1,15 +0,0 @@ -.XXX...............X.....X.....XXX..XXX..XXX.XXXX..XXX.XXXX. -X...X..X....X....XX.......XX..X...XX...XX...XX...XX...XX...X -X...X..X....X...XX..XXXXX..XX.....XX..XXX...XX...XX....X...X -.XXX...........X.............X...X.X..XXXXXXXXXXX.X....X...X -....X..X....X...XX..XXXXX..XX...X..X....X...XX...XX....X...X -....X..X...X.....XX.......XX.......X...XX...XX...XX...XX...X -.XXX...............X.....X......X...XXX.X...XXXXX..XXX.XXXX. -XXXXXXXXXX.XXX.X...X.XXX....XXX..X.X....X...XX...X.XXX.XXXX. -X....X....X...XX...X..X......XX.X..X....XX.XXXX..XX...XX...X -X....X....X....X...X..X......XXX...X....X.X.XXX..XX...XX...X -XXXX.XXXX.X..XXXXXXX..X......XX....X....X...XX.X.XX...XXXXX. -X....X....X...XX...X..X......XXX...X....X...XX..XXX...XX.... -X....X....X...XX...X..X..X...XX.X..X....X...XX..XXX...XX.... -XXXXXX.....XXX.X...X.XXX..XXX.X..X.XXXXXX...XX...X.XXX.X.... -9:;<=>?@ABCDEFGHIJKLMNOP diff --git a/blk/534 b/blk/534 deleted file mode 100644 index a03f060..0000000 --- a/blk/534 +++ /dev/null @@ -1,15 +0,0 @@ -.XXX.XXXX..XXX.XXXXXX...XX...XX...XX...XX...XXXXXXXXX....... -X...XX...XX...X..X..X...XX...XX...XX...XX...XX...XX....X.... -X...XX...XX......X..X...XX...XX...X.X.X..X.X....X.X.....X... -X...XXXXX..XXX...X..X...XX...XX...X..X....X....X..X......X.. -X.X.XX.X......X..X..X...XX...XX.X.X.X.X...X...X...X.......X. -X..XXX..X.X...X..X..X...X.X.X.X.X.XX...X..X..X...XX........X -.XXXXX...X.XXX...X...XXX...X...X.X.X...X..X..XXXXXXXX....... -..XXX..X.........X.......................................... -....X.X.X.........X......................................... -....XX...X...........XXX.X.....XXX.....X.XXX..XX....XXXX.... -....X...................XX....X...X....XX...XX..X..X..XX.... -....X................XXXXXXX..X......XXXXXXXXX......XXXXXX.. -....X...............X...XX..X.X...X.X..XX....XXX......XX..X. -..XXX.....XXXXX......XXXXXXX...XXX...XXX.XXXXX......XX.X..X. -QRSTUVWXYZ[\]^_`abcdefgh diff --git a/blk/535 b/blk/535 deleted file mode 100644 index 48f71ad..0000000 --- a/blk/535 +++ /dev/null @@ -1,15 +0,0 @@ -............................................................ -............................................................ -..X......XX..X..XX...X.X.XXX...XXX.XXX....XXXX.XX..XXX..X... -..........X.X....X..X.X.XX..X.X...XX..X..X..XXX...X....XXX.. -..X......XXX.....X..X...XX...XX...XXXX....XXXX.....XXX..X... -..X...X..XX.X....X..X...XX...XX...XX........XX........X.X... -..X....XX.X..X...XX.X...XX...X.XXX.X........XX.....XXX...XX. -................................XX...X...XX....... -...............................X.....X.....X...... -X...XX...XX...XX...XX...XXXXXX.X.....X.....X..X.X. -X...XX...XX...X.X.X..X.X....X.X......X......XX.X.. -X...XX...XX...X..X....X....X...X.....X.....X...... -X...X.X.X.X.X.X.X.X..X....X....X.....X.....X...... -.XXX...X...X.X.X...XX....XXXXX..XX...X...XX....... -ijklmnopqrstuvwxyz{|}~ diff --git a/blk/536 b/blk/536 deleted file mode 100644 index cc945be..0000000 --- a/blk/536 +++ /dev/null @@ -1,15 +0,0 @@ -..XX....XX.XX..XX.XX....XX..XX......XXX......XX.....XX...XX.... -..XX....XX.XX..XX.XX..XXXXXXXX..XX.XX.XX....XX.....XX.....XX... -..XX....XX.XX.XXXXXXXXX.X......XX..XX.XX...XX.....XX.......XX.. -..XX...........XX.XX..XXXXX...XX....XXX...........XX.......XX.. -..XX..........XXXXXXX...X.XX.XX....XX.XX.X........XX.......XX.. -...............XX.XX.XXXXXX.XX..XX.XX..XX..........XX.....XX... -..XX...........XX.XX...XX.......XX..XXX.XX..........XX...XX.... -...........................................XXXX....XX....XXXX.. -..XX.....XX............................XX.XX..XX..XXX...XX..XX. -XXXXXX...XX...........................XX..XX.XXX...XX.......XX. -.XXXX..XXXXXX........XXXXXX..........XX...XXXXXX...XX......XX.. -XXXXXX...XX.........................XX....XXX.XX...XX.....XX... -..XX.....XX.....XX............XX...XX.....XX..XX...XX....XX.... -...............XX.............XX...........XXXX..XXXXXX.XXXXXX. -!"#$%&'()*+,-./012 diff --git a/blk/537 b/blk/537 deleted file mode 100644 index 0dba57f..0000000 --- a/blk/537 +++ /dev/null @@ -1,15 +0,0 @@ -.XXXX.....XX..XXXXXX...XXX..XXXXXX..XXXX...XXXX................ -XX..XX...XXX..XX......XX........XX.XX..XX.XX..XX............... -....XX..XXXX..XXXXX..XX........XX..XX..XX.XX..XX...XX.....XX... -..XXX..XX.XX......XX.XXXXX....XX....XXXX...XXXXX...XX.....XX... -....XX.XXXXXX.....XX.XX..XX..XX....XX..XX.....XX............... -XX..XX....XX..XX..XX.XX..XX..XX....XX..XX....XX....XX.....XX... -.XXXX.....XX...XXXX...XXXX...XX.....XXXX...XXX.....XX....XX.... -...XX.........XX......XXXX...XXXX...XXXX..XXXXX...XXXX..XXXX... -..XX...........XX....XX..XX.XX..XX.XX..XX.XX..XX.XX..XX.XX.XX.. -.XX....XXXXXX...XX......XX..XX.XXX.XX..XX.XX..XX.XX.....XX..XX. -XX...............XX....XX...XX.X.X.XXXXXX.XXXXX..XX.....XX..XX. -.XX....XXXXXX...XX.....XX...XX.XXX.XX..XX.XX..XX.XX.....XX..XX. -..XX...........XX...........XX.....XX..XX.XX..XX.XX..XX.XX.XX.. -...XX.........XX.......XX....XXXX..XX..XX.XXXXX...XXXX..XXXX... -3456789:;<=>?@ABCD diff --git a/blk/538 b/blk/538 deleted file mode 100644 index c0c8bfc..0000000 --- a/blk/538 +++ /dev/null @@ -1,15 +0,0 @@ -XXXXXX.XXXXXX..XXXX..XX..XX.XXXXXX..XXXXX.XX..XX.XX.....XX...XX -XX.....XX.....XX..XX.XX..XX...XX......XX..XX.XX..XX.....XXX.XXX -XX.....XX.....XX.....XX..XX...XX......XX..XXXX...XX.....XXXXXXX -XXXXX..XXXXX..XX.XXX.XXXXXX...XX......XX..XXX....XX.....XX.X.XX -XX.....XX.....XX..XX.XX..XX...XX......XX..XXXX...XX.....XX.X.XX -XX.....XX.....XX..XX.XX..XX...XX...XX.XX..XX.XX..XX.....XX...XX -XXXXXX.XX......XXXX..XX..XX.XXXXXX..XXX...XX..XX.XXXXXX.XX...XX -XX..XX..XXXX..XXXXX...XXXX..XXXXX...XXXX..XXXXXX.XX..XX.XX..XX. -XX..XX.XX..XX.XX..XX.XX..XX.XX..XX.XX..XX...XX...XX..XX.XX..XX. -XXX.XX.XX..XX.XX..XX.XX..XX.XX..XX.XX.......XX...XX..XX.XX..XX. -XXXXXX.XX..XX.XXXXX..XX..XX.XXXXX...XXXX....XX...XX..XX.XX..XX. -XX.XXX.XX..XX.XX.....XX.X.X.XX.XX......XX...XX...XX..XX.XX..XX. -XX..XX.XX..XX.XX.....XX.XX..XX..XX.XX..XX...XX...XX..XX..XXXX.. -XX..XX..XXXX..XX......XX.XX.XX..XX..XXXX....XX....XXXX....XX... -EFGHIJKLMNOPQRSTUVWXYZ[\]^_ diff --git a/blk/539 b/blk/539 deleted file mode 100644 index c1f2f2d..0000000 --- a/blk/539 +++ /dev/null @@ -1,15 +0,0 @@ -XX...XXXX..XX.XX..XX.XXXXXX.XXXXX.........XXXXX....XX.......... -XX...XXXX..XX.XX..XX.....XX.XX.....XX........XX...XXXX......... -XX.X.XX.XXXX..XX..XX....XX..XX......XX.......XX..XX..XX........ -XX.X.XX..XX....XXXX....XX...XX.......XX......XX..X....X........ -XXXXXXX.XXXX....XX....XX....XX........XX.....XX................ -XXX.XXXXX..XX...XX...XX.....XX.........XX....XX................ -XX...XXXX..XX...XX...XXXXXX.XXXXX.........XXXXX.........XXXXXXX -.XX...........XX................XX..........XXX.........XX..... -..XX..........XX................XX.........XX.....XXXX..XX..... -...XX...XXXX..XXXXX...XXXX...XXXXX..XXXX...XX....XX..XX.XXXXX.. -...........XX.XX..XX.XX..XX.XX..XX.XX..XX.XXXXX..XX..XX.XX..XX. -........XXXXX.XX..XX.XX.....XX..XX.XXXXXX..XX.....XXXXX.XX..XX. -.......XX..XX.XX..XX.XX..XX.XX..XX.XX......XX........XX.XX..XX. -........XXXXX.XXXXX...XXXX...XXXXX..XXXX...XX.....XXX...XX..XX. -WXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ diff --git a/blk/540 b/blk/540 deleted file mode 100644 index bd0b9be..0000000 --- a/blk/540 +++ /dev/null @@ -1,15 +0,0 @@ -..XX.....XX...XX......XXX...................................... -..............XX.......XX...................................... -.XXX....XXX...XX..XX...XX....XX.XX.XXXXX...XXXX..XXXXX...XXXXX. -..XX.....XX...XX.XX....XX...XXXXXXXXX..XX.XX..XX.XX..XX.XX..XX. -..XX.....XX...XXXX.....XX...XX.X.XXXX..XX.XX..XX.XX..XX.XX..XX. -..XX.....XX...XX.XX....XX...XX.X.XXXX..XX.XX..XX.XXXXX...XXXXX. -.XXXX..XX.....XX..XX..XXXX..XX...XXXX..XX..XXXX..XX.........XX. -...............XX.............................................. -...............XX.............................................. -XX.XX...XXXXX.XXXXX..XX..XX.XX..XX.XX...XXXX..XX.XX..XX.XXXXXX. -XXX.XX.XX......XX....XX..XX.XX..XX.XX.X.XX.XXXX..XX..XX....XX.. -XX......XXXX...XX....XX..XX.XX..XX.XX.X.XX..XX...XX..XX...XX... -XX.........XX..XX....XX..XX..XXXX..XXXXXXX.XXXX...XXXXX..XX.... -XX.....XXXXX....XXX...XXXXX...XX....XX.XX.XX..XX.....XX.XXXXXX. -ijklmnopqrstuvwxyz{|}~ diff --git a/blk/541 b/blk/541 deleted file mode 100644 index 17f11d1..0000000 --- a/blk/541 +++ /dev/null @@ -1,8 +0,0 @@ -...XX....XX...XX......XX...X -..XX.....XX....XX....XX.X.XX -..XX.....XX....XX....X...XX. -XXX......XX.....XXX......... -..XX.....XX....XX........... -..XX.....XX....XX........... -...XX....XX...XX............ -{|}~ diff --git a/cvm/Makefile b/cvm/Makefile index 3117643..d5f2473 100644 --- a/cvm/Makefile +++ b/cvm/Makefile @@ -16,7 +16,7 @@ stage: stage.c $(OBJS) blkfs $(CC) -DFBIN_PATH=\"`pwd`/stage.bin\" -DBLKFS_PATH=\"`pwd`/blkfs\" stage.c $(OBJS) -o $@ blkfs: $(BLKPACK) - $(BLKPACK) ../blk > $@ + $(BLKPACK) < ../blk.fs > $@ forth.bin: stage common.fs forth.fs blkfs cat common.fs forth.fs | ./stage > $@ @@ -39,7 +39,7 @@ pack: .PHONY: unpack unpack: - $(BLKUNPACK) ../blk < blkfs + $(BLKUNPACK) < blkfs > ../blk.fs .PHONY: clean clean: diff --git a/tools/blkpack.c b/tools/blkpack.c index 429dec7..4ca5b35 100644 --- a/tools/blkpack.c +++ b/tools/blkpack.c @@ -6,81 +6,92 @@ #include #include -static char *buf; -static int blkcnt; +static int lineno; + +static void emptylines(int n) +{ + for (int i=0; i<64*n; i++) putchar(0); +} + +static int getmarker(char *line) // returns -1 on error, blkid otherwise +{ + int blkid; + int r = sscanf(line, "( ----- %d )\n", &blkid); + if (r == 1) { + return blkid; + } else { + return -1; + } +} + +static int expectmarker(char *line) +{ + int blkid = getmarker(line); + if (blkid < 0) { // could not scan + fprintf( + stderr, "Error at line %d: expecting block marker\n", lineno); + } + return blkid; +} static void usage() { - fprintf(stderr, "Usage: blkpack dirname [dirname ...]\n"); -} - -static int spit(char *dirname) -{ - DIR *dp; - struct dirent *ep; - - dp = opendir(dirname); - if (dp == NULL) { - fprintf(stderr, "Couldn't open directory %s.\n", dirname); - return 1; - } - while ((ep = readdir(dp))) { - if ((strcmp(ep->d_name, ".") == 0) || strcmp(ep->d_name, "..") == 0) { - continue; - } - int blkid = atoi(ep->d_name); - if (blkid >= blkcnt) { - int newcnt = blkid+1; - buf = realloc(buf, newcnt*1024); - memset(buf+(blkcnt*1024), 0, (newcnt-blkcnt)*1024); - blkcnt = newcnt; - } - char *fullpath = malloc(strlen(dirname) + MAXNAMLEN + 2); - strcpy(fullpath, dirname); - strcat(fullpath, "/"); - strcat(fullpath, ep->d_name); - FILE *fp = fopen(fullpath, "r"); - free(fullpath); - if (fp == NULL) { - fprintf(stderr, "Could not open %s: %s\n", ep->d_name, strerror(errno)); - continue; - } - char *line = NULL; - size_t n = 0; - for (int i=0; i<16; i++) { - ssize_t cnt = getline(&line, &n, fp); - if (cnt < 0) break; - if (cnt > 65) { - fprintf(stderr, "Line %d too long in blk %s\n", i+1, ep->d_name); - } - strncpy(buf+(blkid*1024)+(i*64), line, cnt-1); - } - ssize_t cnt = getline(&line, &n, fp); - if (cnt > 0) { - fprintf(stderr, "blk %s has more than 16 lines\n", ep->d_name); - } - free(line); - fclose(fp); - } - closedir(dp); - return 0; + fprintf(stderr, "Usage: blkpack < blk.fs > blkfs\n"); } int main(int argc, char *argv[]) { - if (argc < 2) { + int prevblkid = -1; + int blkid; + char *line = NULL; + if (argc != 1) { usage(); return 1; } - buf = NULL; - blkcnt = 0; - for (int i=1; i 65) { + fprintf(stderr, "Line %d too long (blk %d)\n", lineno, blkid); + return 1; + } + if (getmarker(line) >= 0) break; // we have a marker early + line[cnt-1] = '\0'; // remove newline + printf("%s", line); + // pad line to 64 chars + for (int i=cnt-1; i<64; i++) putchar(0); + } + if (blkline == 16) { + lineno++; + cnt = getline(&line, &n, stdin); + } else { + // fill to 16 lines + emptylines(16-blkline); + } + if (cnt <= 0) break; // EOF + prevblkid = blkid; } - fwrite(buf, 1024, blkcnt, stdout); - free(buf); + free(line); return 0; } diff --git a/tools/blkunpack.c b/tools/blkunpack.c index 6b6bd22..a84b116 100644 --- a/tools/blkunpack.c +++ b/tools/blkunpack.c @@ -1,25 +1,21 @@ #include #include -#include -#include #include void usage() { - fprintf(stderr, "Usage: blkunpack dirname\n"); + fprintf(stderr, "Usage: blkunpack < blkfs > blk.fs\n"); } int main(int argc, char *argv[]) { char buf[1024]; int blkid = 0; - if (argc != 2) { + if (argc != 1) { usage(); return 1; } while (fread(buf, 1024, 1, stdin) == 1) { - char fullpath[0x200]; - sprintf(fullpath, "%s/%03d", argv[1], blkid); int linecnt = 0 ; for (int i=1023; i>=0; i--) { if (buf[i]) { @@ -29,7 +25,7 @@ int main(int argc, char *argv[]) } if (linecnt) { // not an empty block - FILE *fp = fopen(fullpath, "w"); + printf("( ----- %03d )\n", blkid); for (int i=0; i