1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-27 13:38:05 +11:00

forth: Replace "(fbr)" and "(bbr)" words by "(br)"

I can't get rid of "(fbr)" and "(bbr)" just yet, but soon...
This commit is contained in:
Virgil Dupras 2020-03-28 11:03:04 -04:00
parent 758ec025dc
commit 6e3b47f4a4
3 changed files with 94 additions and 76 deletions

Binary file not shown.

View File

@ -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 : AGAIN COMPILE (br) H@ - , ; IMMEDIATE
: UNTIL COMPILE SKIP? COMPILE (bbr) H@ -^ C, ; 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) COMPILE (br)
1 ALLOT 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) COMPILE I' COMPILE = COMPILE SKIP? COMPILE (br)
H@ -^ C, H@ - ,
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
; IMMEDIATE ; IMMEDIATE

View File

@ -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, .fill 80
; 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
; 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