mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 16:28:05 +11:00
Make br cells 1 byte wide
The 1 byte limitation has been effective for a while now, but I hadn't made the move yet, I wanted to see if the limitation would cause me problems. It doesn't. Doing this now slightly facilitates the IY->BC move in z80. Bootstrapping: if you try to recreate the CVM binary from the previous commit with this code, you'll have bootstrapping problems. The first bootstrap will compile a binary with 2-bytes wide cells but branching conditionals that yields 1-byte cells. That's bad. I got around the issue by temporarily inserting a "397 399 LOADR" instruction in cvm/xcomp.fs, right before the xcomp overrides. This way, I force 1-byte cells everywhere on the first compiliation, which then allows me to apply the logic change in cvm/vm.c and have a properly running binary.
This commit is contained in:
parent
bf4ab0f1b4
commit
a7dcb522c2
7
blk/297
7
blk/297
@ -1,7 +1,8 @@
|
|||||||
CODE (br)
|
CODE (br)
|
||||||
L1 BSET ( used in ?br and loop )
|
L1 BSET ( used in ?br and loop )
|
||||||
PC ORG @ 0x3d + ! ( stable ABI JP )
|
PC ORG @ 0x3d + ! ( stable ABI JP )
|
||||||
E 0 IY+ LDrIXY, D 1 IY+ LDrIXY,
|
E 0 IY+ LDrIXY, D 0 LDri,
|
||||||
|
7 E BIT, IFNZ, D DECr, THEN,
|
||||||
DE ADDIYd,
|
DE ADDIYd,
|
||||||
;CODE
|
;CODE
|
||||||
CODE (?br)
|
CODE (?br)
|
||||||
@ -9,6 +10,6 @@ PC ORG @ 0x41 + ! ( stable ABI JP )
|
|||||||
HL POP,
|
HL POP,
|
||||||
HLZ,
|
HLZ,
|
||||||
JRZ, L1 BWR ( br + 1. False, branch )
|
JRZ, L1 BWR ( br + 1. False, branch )
|
||||||
( True, skip next 2 bytes and don't branch )
|
( True, skip next byte and don't branch )
|
||||||
IY INCd, IY INCd,
|
IY INCd,
|
||||||
;CODE
|
;CODE
|
||||||
|
2
blk/298
2
blk/298
@ -6,7 +6,7 @@ PC ORG @ 0x45 + ! ( stable ABI JP )
|
|||||||
A 1 IX+ LDrIXY, 1 IX- CP(IXY+), JRNZ, L1 BWR ( branch )
|
A 1 IX+ LDrIXY, 1 IX- CP(IXY+), JRNZ, L1 BWR ( branch )
|
||||||
( don't branch )
|
( don't branch )
|
||||||
IX DECd, IX DECd, IX DECd, IX DECd,
|
IX DECd, IX DECd, IX DECd, IX DECd,
|
||||||
IY INCd, IY INCd,
|
IY INCd,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
|
||||||
|
2
blk/397
2
blk/397
@ -1,7 +1,7 @@
|
|||||||
( Now we have "as late as possible" stuff. See B70 and B260. )
|
( Now we have "as late as possible" stuff. See B70 and B260. )
|
||||||
: _bchk DUP 0x7f + 0xff > IF LIT< br-ovfl (print) ABORT THEN ;
|
: _bchk DUP 0x7f + 0xff > IF LIT< br-ovfl (print) ABORT THEN ;
|
||||||
: DO 0x33 ( 2>R ) , H@ ; IMMEDIATE
|
: DO 0x33 ( 2>R ) , H@ ; IMMEDIATE
|
||||||
: LOOP 0x43 ( loop ) , H@ - _bchk , ; IMMEDIATE
|
: LOOP 0x43 ( loop ) , H@ - _bchk C, ; IMMEDIATE
|
||||||
( LEAVE is implemented in low xcomp )
|
( LEAVE is implemented in low xcomp )
|
||||||
: LITN 0x23 ( n ) , , ;
|
: LITN 0x23 ( n ) , , ;
|
||||||
( gets its name at the very end. can't comment afterwards )
|
( gets its name at the very end. can't comment afterwards )
|
||||||
|
8
blk/398
8
blk/398
@ -1,12 +1,12 @@
|
|||||||
: IF ( -- a | a: br cell addr )
|
: IF ( -- a | a: br cell addr )
|
||||||
0x3f ( ?br ) , H@ 2 ALLOT ( br cell allot )
|
0x3f ( ?br ) , H@ 1 ALLOT ( br cell allot )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
: THEN ( a -- | a: br cell addr )
|
: THEN ( a -- | a: br cell addr )
|
||||||
DUP H@ -^ _bchk SWAP ( a-H a ) !
|
DUP H@ -^ _bchk SWAP ( a-H a ) C!
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
||||||
0x3b ( br ) ,
|
0x3b ( br ) ,
|
||||||
2 ALLOT
|
1 ALLOT
|
||||||
[COMPILE] THEN
|
[COMPILE] THEN
|
||||||
H@ 2- ( push a. -2 for allot offset )
|
H@ 1- ( push a. 1- for allot offset )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
4
blk/399
4
blk/399
@ -1,7 +1,7 @@
|
|||||||
: LIT< 0x2b ( s ) , WORD DUP C@ 1+ MOVE, ; IMMEDIATE
|
: LIT< 0x2b ( s ) , WORD DUP C@ 1+ MOVE, ; IMMEDIATE
|
||||||
: BEGIN H@ ; IMMEDIATE
|
: BEGIN H@ ; IMMEDIATE
|
||||||
: AGAIN 0x3b ( br ) , H@ - _bchk , ; IMMEDIATE
|
: AGAIN 0x3b ( br ) , H@ - _bchk C, ; IMMEDIATE
|
||||||
: UNTIL 0x3f ( ?br ) , H@ - _bchk , ; IMMEDIATE
|
: UNTIL 0x3f ( ?br ) , H@ - _bchk C, ; IMMEDIATE
|
||||||
: [ INTERPRET ; IMMEDIATE
|
: [ INTERPRET ; IMMEDIATE
|
||||||
: ] R> DROP ;
|
: ] R> DROP ;
|
||||||
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||||
|
2
blk/753
2
blk/753
@ -1,7 +1,7 @@
|
|||||||
: OP1 CREATE C, DOES> C@ A, ;
|
: OP1 CREATE C, DOES> C@ A, ;
|
||||||
0xc3 OP1 RETn, 0xfa OP1 CLI, 0xfb OP1 STI,
|
0xc3 OP1 RETn, 0xfa OP1 CLI, 0xfb OP1 STI,
|
||||||
0xf4 OP1 HLT, 0xfc OP1 CLD, 0xfd OP1 STD,
|
0xf4 OP1 HLT, 0xfc OP1 CLD, 0xfd OP1 STD,
|
||||||
0x90 OP1 NOP,
|
0x90 OP1 NOP, 0x98 OP1 CBW,
|
||||||
0xf3 OP1 REPZ, 0xf2 OP1 REPNZ, 0xac OP1 LODSB,
|
0xf3 OP1 REPZ, 0xf2 OP1 REPNZ, 0xac OP1 LODSB,
|
||||||
0xad OP1 LODSW, 0xa6 OP1 CMPSB, 0xa7 OP1 CMPSW,
|
0xad OP1 LODSW, 0xa6 OP1 CMPSB, 0xa7 OP1 CMPSW,
|
||||||
0xa4 OP1 MOVSB, 0xa5 OP1 MOVSW, 0xae OP1 SCASB,
|
0xa4 OP1 MOVSB, 0xa5 OP1 MOVSW, 0xae OP1 SCASB,
|
||||||
|
7
blk/806
7
blk/806
@ -2,11 +2,12 @@
|
|||||||
H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
|
H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
|
||||||
CODE (br) L1 BSET ( used in ?br )
|
CODE (br) L1 BSET ( used in ?br )
|
||||||
PC 0x3f - ORG @ 0x3d + ! ( stable abi )
|
PC 0x3f - ORG @ 0x3d + ! ( stable abi )
|
||||||
DI DX MOVxx, DI [DI] MOVx[], DX DI ADDxx,
|
DI DX MOVxx, AL [DI] MOVr[], AH AH XORrr, CBW,
|
||||||
|
DX AX ADDxx,
|
||||||
;CODE
|
;CODE
|
||||||
CODE (?br)
|
CODE (?br)
|
||||||
PC 0x43 - ORG @ 0x41 + ! ( stable abi )
|
PC 0x43 - ORG @ 0x41 + ! ( stable abi )
|
||||||
AX POPx, AX AX ORxx, JZ, L1 @ RPCs, ( False, branch )
|
AX POPx, AX AX ORxx, JZ, L1 @ RPCs, ( False, branch )
|
||||||
( True, skip next 2 bytes and don't branch )
|
( True, skip next byte and don't branch )
|
||||||
DX INCx, DX INCx,
|
DX INCx,
|
||||||
;CODE
|
;CODE
|
||||||
|
2
blk/807
2
blk/807
@ -5,5 +5,5 @@ PC 0x47 - ORG @ 0x45 + ! ( stable abi )
|
|||||||
AX [BP] 0 MOVx[]+, AX [BP] -2 CMPx[]+,
|
AX [BP] 0 MOVx[]+, AX [BP] -2 CMPx[]+,
|
||||||
JNZ, L1 @ RPCs, ( branch )
|
JNZ, L1 @ RPCs, ( branch )
|
||||||
( don't branch )
|
( don't branch )
|
||||||
BP 4 SUBxi, DX INCx, DX INCx,
|
BP 4 SUBxi, DX INCx,
|
||||||
;CODE
|
;CODE
|
||||||
|
BIN
cvm/forth.bin
BIN
cvm/forth.bin
Binary file not shown.
10
cvm/vm.c
10
cvm/vm.c
@ -119,13 +119,17 @@ static word find(word daddr, word waddr) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void EXIT() { vm.IP = popRS(); }
|
static void EXIT() { vm.IP = popRS(); }
|
||||||
static void _br_() { vm.IP += gw(vm.IP); };
|
static void _br_() {
|
||||||
static void _cbr_() { if (!pop()) { _br_(); } else { vm.IP += 2; } };
|
word off = vm.mem[vm.IP];
|
||||||
|
if (off > 0x7f ) { off -= 0x100; }
|
||||||
|
vm.IP += off;
|
||||||
|
}
|
||||||
|
static void _cbr_() { if (!pop()) { _br_(); } else { vm.IP++; } }
|
||||||
static void _loop_() {
|
static void _loop_() {
|
||||||
word I = gw(vm.RS); I++; sw(vm.RS, I);
|
word I = gw(vm.RS); I++; sw(vm.RS, I);
|
||||||
if (I == gw(vm.RS-2)) { // don't branch
|
if (I == gw(vm.RS-2)) { // don't branch
|
||||||
popRS(); popRS();
|
popRS(); popRS();
|
||||||
vm.IP += 2;
|
vm.IP++;
|
||||||
} else { // branch
|
} else { // branch
|
||||||
_br_();
|
_br_();
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user