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

Add words |M and |L

Browse Source 
Splitting a word into MSB/LSB pairs happens often and is worth, I
think, native words. Also, I'm going to need it in the upcoming
commits.
This commit is contained in:
Virgil Dupras 2020-12-07 20:08:45 -05:00
parent 55a7726f70
commit 80d1b59050
19 changed files with 86 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
arch/8086/pcat/Makefile
View File

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

2
arch/8086/pcat/blk.fs
View File

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

4
arch/8086/pcat/mbr.fs
View File

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

4
arch/8086/pcat/xcomp.fs
View File

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

4
arch/z80/rc2014/xcomp.fs
View File

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

4
arch/z80/sms/xcomp.fs
View File

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

4
arch/z80/sms/xcompkbd.fs
View File

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

4
arch/z80/sms/xcompsdc.fs
View File

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

4
arch/z80/sms/xcomptextmode.fs
View File

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

13
arch/z80/ti84/xcomp.fs
View File

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

4
arch/z80/trs80/xcomp.fs
View File

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

4
arch/z80/z80mbc2/xcomp.fs
View File

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

100
blk.fs
View File

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

10
cvm/common.fs
View File

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

4
cvm/forth.fs
View File

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

BIN
cvm/stage.bin
View File

Binary file not shown.

4
cvm/stage.fs
View File

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

6
cvm/vm.c
View File

@ -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()<<u); }
static void TICKS() { usleep(pop()); }
static void SPLITL() {
word n = pop(); push(n>>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

2
doc/dict.txt
View File

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