I can't get rid of "(fbr)" and "(bbr)" just yet, but soon...pull/95/head
@@ -11,8 +11,8 @@ | |||||
: COMPILE ' LITN ['] , , ; IMMEDIATE | : COMPILE ' LITN ['] , , ; IMMEDIATE | ||||
: [COMPILE] ' , ; IMMEDIATE | : [COMPILE] ' , ; IMMEDIATE | ||||
: BEGIN H@ ; 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 | : ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE | ||||
( Hello, hello, krkrkrkr... do you hear me? | ( Hello, hello, krkrkrkr... do you hear me? | ||||
Ah, voice at last! Some lines above need comments | Ah, voice at last! Some lines above need comments | ||||
@@ -23,29 +23,29 @@ | |||||
that is, only used by their immediate surrondings. | that is, only used by their immediate surrondings. | ||||
COMPILE: Tough one. Get addr of caller word (example above | 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 ! ; | : +! SWAP OVER @ + SWAP ! ; | ||||
: ALLOT HERE +! ; | : ALLOT HERE +! ; | ||||
: IF ( -- a | a: br cell addr ) | : IF ( -- a | a: br cell addr ) | ||||
COMPILE SKIP? ( if true, don't branch ) | COMPILE SKIP? ( if true, don't branch ) | ||||
COMPILE (fbr) | |||||
COMPILE (br) | |||||
H@ ( push a ) | H@ ( push a ) | ||||
1 ALLOT ( br cell allot ) | |||||
2 ALLOT ( br cell allot ) | |||||
; IMMEDIATE | ; IMMEDIATE | ||||
: THEN ( a -- | a: br cell addr ) | : THEN ( a -- | a: br cell addr ) | ||||
DUP H@ -^ SWAP ( a-H a ) | DUP H@ -^ 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 ) | ||||
COMPILE (fbr) | |||||
1 ALLOT | |||||
COMPILE (br) | |||||
2 ALLOT | |||||
DUP H@ -^ SWAP ( a-H a ) | DUP H@ -^ SWAP ( a-H a ) | ||||
C! | |||||
H@ 1 - ( push a. -1 for allot offset ) | |||||
! | |||||
H@ 2 - ( push a. -2 for allot offset ) | |||||
; IMMEDIATE | ; IMMEDIATE | ||||
: CREATE | : CREATE | ||||
@@ -73,8 +73,8 @@ | |||||
the RS ) | the RS ) | ||||
: LOOP | : LOOP | ||||
COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R | 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 | COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP | ||||
; IMMEDIATE | ; IMMEDIATE | ||||
@@ -655,10 +655,84 @@ abortUnderflow: | |||||
.name: | .name: | ||||
.db "(uflw)", 0 | .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 "," | .db "," | ||||
.dw $-QUIT | |||||
.dw $-CSKIP | |||||
.db 1 | .db 1 | ||||
WR: | WR: | ||||
.dw nativeWord | .dw nativeWord | ||||
@@ -839,6 +913,9 @@ WORD: | |||||
.dw DUP ; ( a c c ) | .dw DUP ; ( a c c ) | ||||
.dw ISWS ; ( a c f ) | .dw ISWS ; ( a c f ) | ||||
.dw CSKIP ; ( a c ) | .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 | .dw BBR | ||||
.db 20 ; here - mark | .db 20 ; here - mark | ||||
; at this point, we have ( a WS ) | ; at this point, we have ( a WS ) | ||||
@@ -1061,71 +1138,12 @@ CMP: | |||||
push bc | push bc | ||||
jp next | 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 | ; 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 | ; where to branch to. For example, The branching cell of "IF THEN" would | ||||
; contain 3. Add this value to RS. | ; contain 3. Add this value to RS. | ||||
.db "(fbr)" | .db "(fbr)" | ||||
.dw $-CSKIP | |||||
.dw $-CMP | |||||
.db 5 | .db 5 | ||||
; STABLE ABI | ; STABLE ABI | ||||
; Offset: 073e | ; Offset: 073e | ||||
@@ -1160,5 +1178,5 @@ BBR: | |||||
; with a dummy, *empty* entry. Therefore, we can have a predictable place for | ; with a dummy, *empty* entry. Therefore, we can have a predictable place for | ||||
; getting a prev label. | ; getting a prev label. | ||||
.db "_bend" | .db "_bend" | ||||
.dw $-BBR | |||||
.dw $-CMP | |||||
.db 5 | .db 5 |