~vdupras/collapseos

a7dcb522c2ee85686ab1ff88dcc47a49addf5caf — Virgil Dupras a month ago bf4ab0f
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.
10 files changed, 25 insertions(+), 19 deletions(-)

M blk/297
M blk/298
M blk/397
M blk/398
M blk/399
M blk/753
M blk/806
M blk/807
M cvm/forth.bin
M cvm/vm.c
M blk/297 => blk/297 +4 -3
@@ 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

M blk/298 => blk/298 +1 -1
@@ 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



M blk/397 => blk/397 +1 -1
@@ 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 )

M blk/398 => blk/398 +4 -4
@@ 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

M blk/399 => blk/399 +2 -2
@@ 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

M blk/753 => blk/753 +1 -1
@@ 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,

M blk/806 => blk/806 +4 -3
@@ 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

M blk/807 => blk/807 +1 -1
@@ 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

M cvm/forth.bin => cvm/forth.bin +0 -0

M cvm/vm.c => cvm/vm.c +7 -3
@@ 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_();
    }