diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index 288f8fc..fb4b5f1 100644 Binary files a/emul/forth/z80c.bin and b/emul/forth/z80c.bin differ diff --git a/forth/core.fs b/forth/core.fs index 5018b59..ff79970 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -11,8 +11,8 @@ : COMPILE ' LITN ['] , , ; IMMEDIATE : [COMPILE] ' , ; IMMEDIATE : BEGIN H@ ; IMMEDIATE -: AGAIN COMPILE (bbr) H@ -^ C, ; IMMEDIATE -: UNTIL COMPILE SKIP? COMPILE (bbr) H@ -^ C, ; IMMEDIATE +: AGAIN COMPILE (br) H@ - , ; IMMEDIATE +: UNTIL COMPILE SKIP? COMPILE (br) H@ - , ; IMMEDIATE : ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE ( Hello, hello, krkrkrkr... do you hear me? Ah, voice at last! Some lines above need comments @@ -23,29 +23,29 @@ that is, only used by their immediate surrondings. COMPILE: Tough one. Get addr of caller word (example above - (bbr)) and then call LITN on it. ) + (br)) and then call LITN on it. ) : +! SWAP OVER @ + SWAP ! ; : ALLOT HERE +! ; : IF ( -- a | a: br cell addr ) COMPILE SKIP? ( if true, don't branch ) - COMPILE (fbr) + COMPILE (br) H@ ( push a ) - 1 ALLOT ( br cell allot ) + 2 ALLOT ( br cell allot ) ; IMMEDIATE : THEN ( a -- | a: br cell addr ) DUP H@ -^ SWAP ( a-H a ) - C! + ! ; IMMEDIATE : ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) - COMPILE (fbr) - 1 ALLOT + COMPILE (br) + 2 ALLOT DUP H@ -^ SWAP ( a-H a ) - C! - H@ 1 - ( push a. -1 for allot offset ) + ! + H@ 2 - ( push a. -2 for allot offset ) ; IMMEDIATE : CREATE @@ -73,8 +73,8 @@ the RS ) : LOOP COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R - COMPILE I' COMPILE = COMPILE SKIP? COMPILE (bbr) - H@ -^ C, + COMPILE I' COMPILE = COMPILE SKIP? COMPILE (br) + H@ - , COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP ; IMMEDIATE diff --git a/forth/forth.asm b/forth/forth.asm index 24da0b8..fb87e49 100644 --- a/forth/forth.asm +++ b/forth/forth.asm @@ -655,10 +655,84 @@ abortUnderflow: .name: .db "(uflw)", 0 -.fill 140 + .db "(br)" + .dw $-QUIT + .db 4 +BR: + .dw nativeWord + ld hl, (IP) + ld e, (hl) + inc hl + ld d, (hl) + dec hl + add hl, de + ld (IP), hl + jp next + +; Skip the compword where HL is currently pointing. If it's a regular word, +; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip +; to after null-termination. + .db "SKIP?" + .dw $-BR + .db 5 +CSKIP: + .dw nativeWord + pop hl + call chkPS + ld a, h + or l + jp z, next ; False, do nothing. + ld hl, (IP) + ld de, NUMBER + call .HLPointsDE + jr z, .isNum + ld de, BR + call .HLPointsDE + jr z, .isNum + ld de, FBR + call .HLPointsDE + jr z, .isBranch + ld de, BBR + call .HLPointsDE + jr z, .isBranch + ld de, LIT + call .HLPointsDE + jr nz, .isWord + ; We have a literal + inc hl \ inc hl + call strskip + inc hl ; byte after word termination + jr .end +.isNum: + ; skip by 4 + inc hl + ; continue to isBranch +.isBranch: + ; skip by 3 + inc hl + ; continue to isWord +.isWord: + ; skip by 2 + inc hl \ inc hl +.end: + ld (IP), hl + jp next + +; Sets Z if (HL) == E and (HL+1) == D +.HLPointsDE: + ld a, (hl) + cp e + ret nz ; no + inc hl + ld a, (hl) + dec hl + cp d ; Z has our answer + ret + +.fill 29 .db "," - .dw $-QUIT + .dw $-CSKIP .db 1 WR: .dw nativeWord @@ -839,6 +913,9 @@ WORD: .dw DUP ; ( a c c ) .dw ISWS ; ( a c f ) .dw CSKIP ; ( a c ) + ; I'm not sure why, I can't seem to successfully change this into + ; a (br). I'll get rid of the (fbr) and (bbr) words when I'm done + ; Forth-ifying "WORD" .dw BBR .db 20 ; here - mark ; at this point, we have ( a WS ) @@ -1061,71 +1138,12 @@ CMP: push bc jp next -; Skip the compword where HL is currently pointing. If it's a regular word, -; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip -; to after null-termination. - .db "SKIP?" - .dw $-CMP - .db 5 -; STABLE ABI -; Offset: 06ee -.out $ -CSKIP: - .dw nativeWord - pop hl - call chkPS - ld a, h - or l - jp z, next ; False, do nothing. - ld hl, (IP) - ld de, NUMBER - call .HLPointsDE - jr z, .isNum - ld de, FBR - call .HLPointsDE - jr z, .isBranch - ld de, BBR - call .HLPointsDE - jr z, .isBranch - ld de, LIT - call .HLPointsDE - jr nz, .isWord - ; We have a literal - inc hl \ inc hl - call strskip - inc hl ; byte after word termination - jr .end -.isNum: - ; skip by 4 - inc hl - ; continue to isBranch -.isBranch: - ; skip by 3 - inc hl - ; continue to isWord -.isWord: - ; skip by 2 - inc hl \ inc hl -.end: - ld (IP), hl - jp next - -; Sets Z if (HL) == E and (HL+1) == D -.HLPointsDE: - ld a, (hl) - cp e - ret nz ; no - inc hl - ld a, (hl) - dec hl - cp d ; Z has our answer - ret - +.fill 80 ; This word's atom is followed by 1b *relative* offset (to the cell's addr) to ; where to branch to. For example, The branching cell of "IF THEN" would ; contain 3. Add this value to RS. .db "(fbr)" - .dw $-CSKIP + .dw $-CMP .db 5 ; STABLE ABI ; Offset: 073e @@ -1160,5 +1178,5 @@ BBR: ; with a dummy, *empty* entry. Therefore, we can have a predictable place for ; getting a prev label. .db "_bend" - .dw $-BBR + .dw $-CMP .db 5