diff --git a/arch/8086/pcat/Makefile b/arch/8086/pcat/Makefile index 5fbd6c9..edaaa88 100644 --- a/arch/8086/pcat/Makefile +++ b/arch/8086/pcat/Makefile @@ -14,7 +14,7 @@ os.bin: xcomp.fs $(STAGE) blkfs $(BLKPACK): $(MAKE) -C $(BASE)/tools -blkfs: $(BLKPACK) +blkfs: $(BLKPACK) blk.fs cat $(BASE)/blk.fs blk.fs | $(BLKPACK) > $@ $(STAGE): diff --git a/arch/8086/pcat/blk.fs b/arch/8086/pcat/blk.fs index e724513..6fdb4c6 100644 --- a/arch/8086/pcat/blk.fs +++ b/arch/8086/pcat/blk.fs @@ -16,7 +16,7 @@ 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, +ORG @ 0x1fe + HERE ! 0x55 C,* 0xaa C,* ( ----- 604 ) CODE (emit) 1 chkPS, AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT, diff --git a/arch/8086/pcat/mbr.fs b/arch/8086/pcat/mbr.fs index 6feec20..c3f87ca 100644 --- a/arch/8086/pcat/mbr.fs +++ b/arch/8086/pcat/mbr.fs @@ -1,4 +1,4 @@ 30 LOAD 602 LOAD -ORG @ 256 /MOD 2 PC! 2 PC! -H@ 256 /MOD 2 PC! 2 PC! +ORG @ |M 2 PC! 2 PC! +H@ |M 2 PC! 2 PC! diff --git a/arch/8086/pcat/xcomp.fs b/arch/8086/pcat/xcomp.fs index 541918e..45cd9c8 100644 --- a/arch/8086/pcat/xcomp.fs +++ b/arch/8086/pcat/xcomp.fs @@ -1,3 +1,3 @@ 612 LOAD ( PC/AT xcomp ) -ORG @ 256 /MOD 2 PC! 2 PC! -H@ 256 /MOD 2 PC! 2 PC! +ORG @ |M 2 PC! 2 PC! +H@ |M 2 PC! 2 PC! diff --git a/arch/z80/rc2014/xcomp.fs b/arch/z80/rc2014/xcomp.fs index 026cc27..a09d3e8 100644 --- a/arch/z80/rc2014/xcomp.fs +++ b/arch/z80/rc2014/xcomp.fs @@ -1,3 +1,3 @@ 619 LOAD -ORG @ 256 /MOD 2 PC! 2 PC! -H@ 256 /MOD 2 PC! 2 PC! +ORG @ |M 2 PC! 2 PC! +H@ |M 2 PC! 2 PC! diff --git a/arch/z80/sms/xcomp.fs b/arch/z80/sms/xcomp.fs index d00b24f..2a6e769 100644 --- a/arch/z80/sms/xcomp.fs +++ b/arch/z80/sms/xcomp.fs @@ -37,6 +37,6 @@ CREATE ~FNT CPFNT7x7 ( Update LATEST ) PC ORG @ 8 + ! ," VDP$ GRID$ PAD$ (im1) " EOT, -ORG @ 0x100 - DUP 256 /MOD 2 PC! 2 PC! +ORG @ 0x100 - DUP |M 2 PC! 2 PC! DUP 1 ( 16K ) segasig -0x4000 + 256 /MOD 2 PC! 2 PC! +0x4000 + |M 2 PC! 2 PC! diff --git a/arch/z80/sms/xcompkbd.fs b/arch/z80/sms/xcompkbd.fs index e8ae877..ea0bc08 100644 --- a/arch/z80/sms/xcompkbd.fs +++ b/arch/z80/sms/xcompkbd.fs @@ -38,6 +38,6 @@ CREATE ~FNT CPFNT7x7 ( Update LATEST ) PC ORG @ 8 + ! ," VDP$ GRID$ PS2$ (im1) " EOT, -ORG @ 0x100 - DUP 256 /MOD 2 PC! 2 PC! +ORG @ 0x100 - DUP |M 2 PC! 2 PC! DUP 1 ( 16K ) segasig -0x4000 + 256 /MOD 2 PC! 2 PC! +0x4000 + |M 2 PC! 2 PC! diff --git a/arch/z80/sms/xcompsdc.fs b/arch/z80/sms/xcompsdc.fs index ce9bb3f..f0f69f3 100644 --- a/arch/z80/sms/xcompsdc.fs +++ b/arch/z80/sms/xcompsdc.fs @@ -41,6 +41,6 @@ CREATE ~FNT CPFNT7x7 ( Update LATEST ) PC ORG @ 8 + ! ," VDP$ GRID$ PS2$ BLK$ (im1) " EOT, -ORG @ 0x100 - DUP 256 /MOD 2 PC! 2 PC! +ORG @ 0x100 - DUP |M 2 PC! 2 PC! DUP 1 ( 16K ) segasig -0x4000 + 256 /MOD 2 PC! 2 PC! +0x4000 + |M 2 PC! 2 PC! diff --git a/arch/z80/sms/xcomptextmode.fs b/arch/z80/sms/xcomptextmode.fs index ae8141d..a436312 100644 --- a/arch/z80/sms/xcomptextmode.fs +++ b/arch/z80/sms/xcomptextmode.fs @@ -40,6 +40,6 @@ CREATE ~FNT CPFNT5x7 ( Update LATEST ) PC ORG @ 8 + ! ," TMS$ GRID$ PS2$ BLK$ ' SDC@ BLK@* ! (im1) " EOT, -ORG @ 0x100 - DUP 256 /MOD 2 PC! 2 PC! +ORG @ 0x100 - DUP |M 2 PC! 2 PC! DUP 1 ( 16K ) segasig -0x4000 + 256 /MOD 2 PC! 2 PC! +0x4000 + |M 2 PC! 2 PC! diff --git a/arch/z80/ti84/xcomp.fs b/arch/z80/ti84/xcomp.fs index fe4cb26..1bd2c82 100644 --- a/arch/z80/ti84/xcomp.fs +++ b/arch/z80/ti84/xcomp.fs @@ -7,7 +7,6 @@ SYSVARS 0x72 + CONSTANT GRID_MEM SYSVARS 0x75 + CONSTANT KBD_MEM 0x01 CONSTANT KBD_PORT 5 LOAD ( z80 assembler ) -: ZFILL, ( u ) 0 DO 0 A, LOOP ; 262 LOAD ( xcomp ) 522 LOAD ( font compiler ) 282 LOAD ( boot.z80.decl ) @@ -18,8 +17,8 @@ SYSVARS 0x75 + CONSTANT KBD_MEM offset the binary by 0x100, which is our minimum possible increment and fill the TI stuff with the code below. ) -0x5a JP, 0x15 ZFILL, ( 0x18 ) -0x5a JP, ( reboot ) 0x1d ZFILL, ( 0x38 ) +0x5a JP, 0x15 ALLOT0 ( 0x18 ) +0x5a JP, ( reboot ) 0x1d ALLOT0 ( 0x38 ) ( handleInterrupt ) DI, AF PUSH, @@ -39,7 +38,7 @@ AF POP, EI, RETI, -0x03 ZFILL, ( 0x53 ) +0x03 ALLOT0 ( 0x53 ) 0x5a JP, ( 0x56 ) 0xff A, 0xa5 A, 0xff A, ( 0x5a ) ( boot ) DI, @@ -56,7 +55,7 @@ A 0x02 ( LCD_CMD_DISABLE ) LDri, 0x10 ( LCD_PORT_CMD ) OUTiA, HALT, -0x95 ZFILL, ( 0x100 ) +0x95 ALLOT0 ( 0x100 ) ( All set, carry on! ) CURRENT @ XCURRENT ! @@ -73,5 +72,5 @@ CREATE ~FNT CPFNT3x5 ( Update LATEST ) PC ORG @ 8 + ! ," LCD$ KBD$ GRID$ " EOT, -ORG @ 0x100 - 256 /MOD 2 PC! 2 PC! -H@ 256 /MOD 2 PC! 2 PC! +ORG @ 0x100 - |M 2 PC! 2 PC! +H@ |M 2 PC! 2 PC! diff --git a/arch/z80/trs80/xcomp.fs b/arch/z80/trs80/xcomp.fs index 24d434b..9839c2e 100644 --- a/arch/z80/trs80/xcomp.fs +++ b/arch/z80/trs80/xcomp.fs @@ -16,5 +16,5 @@ RS_ADDR 0x80 - CONSTANT SYSVARS PC ORG @ 8 + ! ( TRS-80 wants CR-only newlines ) ," ' CR ' NL **! BLK$ FD$ " EOT, -ORG @ 256 /MOD 2 PC! 2 PC! -H@ 256 /MOD 2 PC! 2 PC! +ORG @ |M 2 PC! 2 PC! +H@ |M 2 PC! 2 PC! diff --git a/arch/z80/z80mbc2/xcomp.fs b/arch/z80/z80mbc2/xcomp.fs index ec648a3..762dddc 100644 --- a/arch/z80/z80mbc2/xcomp.fs +++ b/arch/z80/z80mbc2/xcomp.fs @@ -39,5 +39,5 @@ CODE (key) ( Update LATEST ) PC ORG @ 8 + ! ," BLK$ FD$ ' FD@ BLK@* ! ' FD! BLK!* ! " EOT, -ORG @ 256 /MOD 2 PC! 2 PC! -H@ 256 /MOD 2 PC! 2 PC! +ORG @ |M 2 PC! 2 PC! +H@ |M 2 PC! 2 PC! diff --git a/blk.fs b/blk.fs index aa199da..fe3ec3e 100644 --- a/blk.fs +++ b/blk.fs @@ -53,14 +53,10 @@ VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4 : 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( @ + ; ( C,* spits an assembled byte, A,, spits an assembled word Both increase PC. ) -: A,, SPLITB C,* C,* ; +: A,, |L C,* C,* ; : <<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 ) @@ -160,7 +156,7 @@ VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4 LDIXYr, ; ( ----- 015 ) -: OP2 CREATE , DOES> @ 256 /MOD C,* C,* ; +: OP2 CREATE , DOES> @ |M C,* C,* ; 0xeda1 OP2 CPI, 0xedb1 OP2 CPIR, 0xeda9 OP2 CPD, 0xedb9 OP2 CPDR, 0xed46 OP2 IM0, 0xed56 OP2 IM1, @@ -229,9 +225,9 @@ VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4 : OP2r CREATE , DOES> - @ SPLITB SWAP ( r lsb msb ) - C,* ( r lsb ) - SWAP <<3 ( lsb r<<3 ) + @ |M ( r lsb msb ) + C,* ( r lsb ) + SWAP <<3 ( lsb r<<3 ) OR C,* ; 0xed41 OP2r OUT(C)r, @@ -354,12 +350,8 @@ VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4 : [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 C,* C,* ; +: A,, |L C,* C,* ; ( ----- 033 ) : OP1 CREATE C, DOES> C@ C,* ; 0xc3 OP1 RET, 0xfa OP1 CLI, 0xfb OP1 STI, @@ -440,7 +432,7 @@ VARIABLE L1 VARIABLE L2 VARIABLE L3 VARIABLE L4 : SUBxi, 0x83 C,* SWAP 0xe8 OR C,* C,* ; : ADDxi, 0x83 C,* SWAP 0xc0 OR C,* C,* ; : JMPr, 0xff C,* 7 AND 0xe0 OR C,* ; -: JMPf, ( seg off ) 0xea C,* SPLITB C,* C,* A,, ; +: JMPf, ( seg off ) 0xea C,* |L C,* C,* A,, ; ( ----- 041 ) ( Place BEGIN, where you want to jump back and AGAIN after a relative jump operator. Just like BSET and BWR. ) @@ -480,14 +472,11 @@ VARIABLE lblchkPS ( ----- 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 ; ( C,* spits an assembled byte, A,, spits an assembled word Both increase PC. ) -: A,, SPLITB C,* C,* ; +: A,, |L C,* C,* ; ( ----- 052 ) : _oor ." arg out of range: " .X SPC ." PC: " PC .X NL ABORT ; : _r8c DUP 7 > IF _oor THEN ; @@ -935,24 +924,24 @@ VARIABLE aspprevx : 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 ) + SWAP |L ( a hi lo ) 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 ) + 0 SWAP aspfpgsz @ * |M ( 0 lsb msb ) 0x4c _cmd DROP asprdy ; : aspf@ ( page a -- n, read word from flash ) - SWAP aspfpgsz @ * OR ( addr ) 256 /MOD ( lsb msb ) + SWAP aspfpgsz @ * OR ( addr ) |M ( 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 + 0 SWAP |L ( 0 msb lsb ) 0xa0 ( 0 msb lsb 0xa0 ) _cmd ; : aspe! ( byte addr --, write to EEPROM ) - 256 /MOD ( b lsb msb ) SWAP + |L ( b msb lsb ) 0xc0 ( b msb lsb 0xc0 ) _cmd DROP asprdy ; ( ----- 165 ) ( Sega ROM signer. See doc/sega.txt ) @@ -1636,32 +1625,28 @@ CODE 2- ;CODE ( ----- 334 ) CODE RSHIFT ( n u -- n ) - DE POP, ( u ) - HL POP, ( n ) - chkPS, + DE POP, ( u ) HL POP, ( n ) chkPS, A E LDrr, A ORr, IFNZ, - BEGIN, - H SRL, L RR, - A DECr, - JRNZ, AGAIN, + BEGIN, H SRL, L RR, A DECr, JRNZ, AGAIN, THEN, - HL PUSH, -;CODE -( ----- 335 ) + HL PUSH, ;CODE CODE LSHIFT ( n u -- n ) - DE POP, ( u ) - HL POP, ( n ) - chkPS, + DE POP, ( u ) HL POP, ( n ) chkPS, A E LDrr, A ORr, IFNZ, - BEGIN, - L SLA, H RL, - A DECr, - JRNZ, AGAIN, + BEGIN, L SLA, H RL, A DECr, JRNZ, AGAIN, THEN, - HL PUSH, -;CODE + HL PUSH, ;CODE +( ----- 335 ) +CODE |L ( n -- msb lsb ) + HL POP, chkPS, + D 0 LDri, E H LDrr, DE PUSH, + E L LDrr, DE PUSH, ;CODE +CODE |M ( n -- lsb msb ) + HL POP, chkPS, + D 0 LDri, E L LDrr, DE PUSH, + E H LDrr, DE PUSH, ;CODE ( ----- 350 ) Core words @@ -1999,24 +1984,17 @@ SYSVARS 0x0c + :** C<* : ? @ . ; : _ DUP 9 > IF 10 - 'a' + - ELSE '0' + THEN -; + 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 -; + 0xff AND 16 /MOD ( l h ) + _ EMIT _ EMIT ; +: .X |M .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 + 4 0 DO DUP @ |L .x .x SPC 2+ LOOP DROP ( a ) 8 0 DO C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT @@ -2417,9 +2395,9 @@ EXX, ( unprotect BC ) ;CODE : _cmd _wait DROP ROT ( a1 a2 cmd ) 0 _s+crc ( a1 a2 crc ) - ROT 256 /MOD ROT ( a2 h l crc ) + ROT |M ROT ( a2 h l crc ) _s+crc _s+crc ( a2 crc ) - SWAP 256 /MOD ROT ( h l crc ) + SWAP |M ROT ( h l crc ) _s+crc _s+crc ( crc ) 1 OR ( ensure stop bit ) (spix) DROP ( send CRC ) @@ -2511,7 +2489,7 @@ EXX, ( unprotect BC ) ;CODE (spix) DROP ( a crc ) SWAP ( crc a ) LOOP - DROP ( crc ) 256 /MOD ( lsb msb ) + DROP ( crc ) |M ( lsb msb ) (spix) DROP (spix) DROP _wait DROP 0 (spie) ; ( ----- 435 ) @@ -2775,6 +2753,12 @@ CODE TICKS 1 chkPS, ( n=100us ) AX 0x8600 MOVxI, ( 86h, WAIT ) 0x15 INT, DX SI MOVxx, ( restore IP ) ;CODE +CODE |M ( n -- lsb msb ) 1 chkPS, + CX POPx, AH 0 MOVri, + AL CL MOVrr, AX PUSHx, AL CH MOVrr, AX PUSHx, ;CODE +CODE |L ( n -- msb lsb ) 1 chkPS, + CX POPx, AH 0 MOVri, + AL CH MOVrr, AX PUSHx, AL CL MOVrr, AX PUSHx, ;CODE ( ----- 470 ) ( Z80 driver for TMS9918. Implements grid protocol. Requires TMS_CTLPORT, TMS_DATAPORT and ~FNT from the Font compiler at diff --git a/cvm/common.fs b/cvm/common.fs index 8d46f2d..ee362d6 100644 --- a/cvm/common.fs +++ b/cvm/common.fs @@ -72,16 +72,18 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) 0x36 CODE LSHIFT 0x37 CODE TICKS 0x38 CODE ROT> +0x39 CODE |L +0x3a CODE |M 353 LOAD ( xcomp core ) : (key) 0 PC@ ; : EFS@ 1 3 PC! ( read ) - 256 /MOD 3 PC! 3 PC! ( blkid ) - BLK( 256 /MOD 3 PC! 3 PC! ( dest ) + |M 3 PC! 3 PC! ( blkid ) + BLK( |M 3 PC! 3 PC! ( dest ) ; : EFS! 2 3 PC! ( write ) - 256 /MOD 3 PC! 3 PC! ( blkid ) - BLK( 256 /MOD 3 PC! 3 PC! ( dest ) + |M 3 PC! 3 PC! ( blkid ) + BLK( |M 3 PC! 3 PC! ( dest ) ; ( fork between stage and forth begins here ) diff --git a/cvm/forth.fs b/cvm/forth.fs index ef7b325..11b9e70 100644 --- a/cvm/forth.fs +++ b/cvm/forth.fs @@ -10,6 +10,6 @@ SYSVARS 0x70 + CONSTANT GRID_MEM ( Update LATEST ) PC ORG @ 8 + ! ," BLK$ ' EFS@ BLK@* ! ' EFS! BLK!* ! GRID$ " EOT, -ORG @ 256 /MOD 2 PC! 2 PC! -H@ 256 /MOD 2 PC! 2 PC! +ORG @ |M 2 PC! 2 PC! +H@ |M 2 PC! 2 PC! diff --git a/cvm/stage.bin b/cvm/stage.bin index eaa77f4..e5bf9a9 100644 Binary files a/cvm/stage.bin and b/cvm/stage.bin differ diff --git a/cvm/stage.fs b/cvm/stage.fs index 1c84fe1..294c00a 100644 --- a/cvm/stage.fs +++ b/cvm/stage.fs @@ -7,5 +7,5 @@ PC ORG @ 8 + ! ," ' EFS@ BLK@* ! " ," ' EFS! BLK!* ! " EOT, -ORG @ 256 /MOD 2 PC! 2 PC! -H@ 256 /MOD 2 PC! 2 PC! +ORG @ |M 2 PC! 2 PC! +H@ |M 2 PC! 2 PC! diff --git a/cvm/vm.c b/cvm/vm.c index c07ed0f..15fe3ae 100644 --- a/cvm/vm.c +++ b/cvm/vm.c @@ -286,6 +286,10 @@ static void PLUS2() { push(pop()+2); } static void RSHIFT() { word u = pop(); push(pop()>>u); } static void LSHIFT() { word u = pop(); push(pop()<>8); push(n&0xff); } +static void SPLITM() { + word n = pop(); push(n&0xff); push(n>>8); } static void native(NativeWord func) { vm.nativew[vm.nativew_count++] = func; @@ -393,6 +397,8 @@ VM* VM_init(char *bin_path, char *blkfs_path) native(LSHIFT); native(TICKS); native(ROTR); + native(SPLITL); + native(SPLITM); vm.IP = gw(0x04) + 1; // BOOT sw(SYSVARS+0x02, gw(0x08)); // CURRENT sw(SYSVARS+0x04, gw(0x08)); // HERE diff --git a/doc/dict.txt b/doc/dict.txt index f4cb348..3ae12dc 100644 --- a/doc/dict.txt +++ b/doc/dict.txt @@ -194,6 +194,8 @@ results. Use it with C!* ialias pointing to a word-based target. -^ a b -- c b - a -> c * a b -- c a * b -> c / a b -- c a / b -> c +|L n -- msb lsb Split n word in 2 bytes, LSB on TOS +|M n -- lsb msb Split n word in 2 bytes, MSB on TOS MOD a b -- c a % b -> c /MOD a b -- r q r:remainder q:quotient AND a b -- c a & b -> c