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:
parent
758ec025dc
commit
6e3b47f4a4
Binary file not shown.
@ -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
|
||||||
|
|
||||||
|
146
forth/forth.asm
146
forth/forth.asm
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user