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)
|
||||
L1 BSET ( used in ?br and loop )
|
||||
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,
|
||||
;CODE
|
||||
CODE (?br)
|
||||
@ -9,6 +10,6 @@ PC ORG @ 0x41 + ! ( stable ABI JP )
|
||||
HL POP,
|
||||
HLZ,
|
||||
JRZ, L1 BWR ( br + 1. False, branch )
|
||||
( True, skip next 2 bytes and don't branch )
|
||||
IY INCd, IY INCd,
|
||||
( True, skip next byte and don't branch )
|
||||
IY INCd,
|
||||
;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 )
|
||||
( don't branch )
|
||||
IX DECd, IX DECd, IX DECd, IX DECd,
|
||||
IY INCd, IY INCd,
|
||||
IY INCd,
|
||||
;CODE
|
||||
|
||||
|
||||
|
2
blk/397
2
blk/397
@ -1,7 +1,7 @@
|
||||
( Now we have "as late as possible" stuff. See B70 and B260. )
|
||||
: _bchk DUP 0x7f + 0xff > IF LIT< br-ovfl (print) ABORT THEN ;
|
||||
: 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 )
|
||||
: LITN 0x23 ( n ) , , ;
|
||||
( 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 )
|
||||
0x3f ( ?br ) , H@ 2 ALLOT ( br cell allot )
|
||||
0x3f ( ?br ) , H@ 1 ALLOT ( br cell allot )
|
||||
; IMMEDIATE
|
||||
: THEN ( a -- | a: br cell addr )
|
||||
DUP H@ -^ _bchk SWAP ( a-H a ) !
|
||||
DUP H@ -^ _bchk SWAP ( a-H a ) C!
|
||||
; IMMEDIATE
|
||||
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
||||
0x3b ( br ) ,
|
||||
2 ALLOT
|
||||
1 ALLOT
|
||||
[COMPILE] THEN
|
||||
H@ 2- ( push a. -2 for allot offset )
|
||||
H@ 1- ( push a. 1- for allot offset )
|
||||
; IMMEDIATE
|
||||
|
4
blk/399
4
blk/399
@ -1,7 +1,7 @@
|
||||
: LIT< 0x2b ( s ) , WORD DUP C@ 1+ MOVE, ; IMMEDIATE
|
||||
: BEGIN H@ ; IMMEDIATE
|
||||
: AGAIN 0x3b ( br ) , H@ - _bchk , ; IMMEDIATE
|
||||
: UNTIL 0x3f ( ?br ) , H@ - _bchk , ; IMMEDIATE
|
||||
: AGAIN 0x3b ( br ) , H@ - _bchk C, ; IMMEDIATE
|
||||
: UNTIL 0x3f ( ?br ) , H@ - _bchk C, ; IMMEDIATE
|
||||
: [ INTERPRET ; IMMEDIATE
|
||||
: ] R> DROP ;
|
||||
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||
|
2
blk/753
2
blk/753
@ -1,7 +1,7 @@
|
||||
: OP1 CREATE C, DOES> C@ A, ;
|
||||
0xc3 OP1 RETn, 0xfa OP1 CLI, 0xfb OP1 STI,
|
||||
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,
|
||||
0xad OP1 LODSW, 0xa6 OP1 CMPSB, 0xa7 OP1 CMPSW,
|
||||
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 )
|
||||
CODE (br) L1 BSET ( used in ?br )
|
||||
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 (?br)
|
||||
PC 0x43 - ORG @ 0x41 + ! ( stable abi )
|
||||
AX POPx, AX AX ORxx, JZ, L1 @ RPCs, ( False, branch )
|
||||
( True, skip next 2 bytes and don't branch )
|
||||
DX INCx, DX INCx,
|
||||
( True, skip next byte and don't branch )
|
||||
DX INCx,
|
||||
;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[]+,
|
||||
JNZ, L1 @ RPCs, ( branch )
|
||||
( don't branch )
|
||||
BP 4 SUBxi, DX INCx, DX INCx,
|
||||
BP 4 SUBxi, DX INCx,
|
||||
;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 _br_() { vm.IP += gw(vm.IP); };
|
||||
static void _cbr_() { if (!pop()) { _br_(); } else { vm.IP += 2; } };
|
||||
static void _br_() {
|
||||
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_() {
|
||||
word I = gw(vm.RS); I++; sw(vm.RS, I);
|
||||
if (I == gw(vm.RS-2)) { // don't branch
|
||||
popRS(); popRS();
|
||||
vm.IP += 2;
|
||||
vm.IP++;
|
||||
} else { // branch
|
||||
_br_();
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user