mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-27 11:28:05 +11:00
forth: Replace "SKIP?" with "(?br)"
There is an alternate git history where I continued the Forth-ification of words, including "SKIP?", but that was a bad idea: because that word was written by flow control immediates, I stepped into quicksands where stability became necessary in z80c.fs and I couldn't gracefully get out of it. I'm stepping back and take this opportunity to replace the shoddy SKIP? algo with a more straightforward (?br) implementation. (br) and (?br) will always stay in boot code where it's easier manage a stable ABI.
This commit is contained in:
parent
9fcfebd84c
commit
48078d9c9c
Binary file not shown.
@ -2,17 +2,17 @@
|
|||||||
: -^ SWAP - ;
|
: -^ SWAP - ;
|
||||||
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
|
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
|
||||||
: ] R> DROP ;
|
: ] R> DROP ;
|
||||||
: LIT [ JTBL 26 + LITN ] , ;
|
: LIT JTBL 26 + , ;
|
||||||
: LITS LIT SCPY ;
|
: LITS LIT SCPY ;
|
||||||
: LIT< WORD LITS ; IMMEDIATE
|
: LIT< WORD LITS ; IMMEDIATE
|
||||||
: _err LIT< word-not-found (print) ABORT ;
|
: _err LIT< word-not-found (print) ABORT ;
|
||||||
: ' WORD (find) SKIP? _err ;
|
: ' WORD (find) NOT (?br) [ 4 , ] _err ;
|
||||||
: ['] WORD (find) SKIP? _err LITN ; IMMEDIATE
|
: ['] ' LITN ; IMMEDIATE
|
||||||
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||||
: [COMPILE] ' , ; IMMEDIATE
|
: [COMPILE] ' , ; IMMEDIATE
|
||||||
: BEGIN H@ ; IMMEDIATE
|
: BEGIN H@ ; IMMEDIATE
|
||||||
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
|
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
|
||||||
: UNTIL COMPILE SKIP? COMPILE (br) H@ - , ; IMMEDIATE
|
: UNTIL 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
|
||||||
@ -29,8 +29,7 @@
|
|||||||
: ALLOT HERE +! ;
|
: ALLOT HERE +! ;
|
||||||
|
|
||||||
: IF ( -- a | a: br cell addr )
|
: IF ( -- a | a: br cell addr )
|
||||||
COMPILE SKIP? ( if true, don't branch )
|
COMPILE (?br)
|
||||||
COMPILE (br)
|
|
||||||
H@ ( push a )
|
H@ ( push a )
|
||||||
2 ALLOT ( br cell allot )
|
2 ALLOT ( br cell allot )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
@ -73,7 +72,7 @@
|
|||||||
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 (br)
|
COMPILE I' COMPILE = COMPILE (?br)
|
||||||
H@ - ,
|
H@ - ,
|
||||||
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
|
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
@ -73,10 +73,9 @@ Note about flow words: flow words can only be used in definitions. In the
|
|||||||
INTERPRET loop, they don't have the desired effect because each word from the
|
INTERPRET loop, they don't have the desired effect because each word from the
|
||||||
input stream is executed immediately. In this context, branching doesn't work.
|
input stream is executed immediately. In this context, branching doesn't work.
|
||||||
|
|
||||||
(fbr) -- Branches forward by the number specified in its
|
(br) -- Branches by the number specified in the 2 following
|
||||||
atom's cell.
|
bytes. Can be negative.
|
||||||
(bbr) -- Branches backward by the number specified in its
|
(?br) f -- Branch if f is false.
|
||||||
atom's cell.
|
|
||||||
[ -- Begin interetative mode. In a definition, words
|
[ -- Begin interetative mode. In a definition, words
|
||||||
between here and "]" will be executed instead of
|
between here and "]" will be executed instead of
|
||||||
compiled.
|
compiled.
|
||||||
@ -92,9 +91,6 @@ INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
|||||||
then execute the compiled contents.
|
then execute the compiled contents.
|
||||||
QUIT R:drop -- Return to interpreter prompt immediately
|
QUIT R:drop -- Return to interpreter prompt immediately
|
||||||
RECURSE R:I -- R:I-2 Run the current word again.
|
RECURSE R:I -- R:I-2 Run the current word again.
|
||||||
SKIP? f -- If f is true, skip the execution of the next atom.
|
|
||||||
Use this right before ";" and you're gonna have a
|
|
||||||
bad time.
|
|
||||||
THEN I:a -- *I* Set branching cell at a.
|
THEN I:a -- *I* Set branching cell at a.
|
||||||
UNTIL f -- *I* Jump backwards to BEGIN if f is *false*.
|
UNTIL f -- *I* Jump backwards to BEGIN if f is *false*.
|
||||||
|
|
||||||
|
@ -670,61 +670,28 @@ BR:
|
|||||||
ld (IP), hl
|
ld (IP), hl
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; Skip the compword where HL is currently pointing. If it's a regular word,
|
.fill 72
|
||||||
; 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 "(?br)"
|
||||||
.db "SKIP?"
|
|
||||||
.dw $-BR
|
.dw $-BR
|
||||||
.db 5
|
.db 5
|
||||||
CSKIP:
|
CBR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
call chkPS
|
call chkPS
|
||||||
ld a, h
|
ld a, h
|
||||||
or l
|
or l
|
||||||
jp z, next ; False, do nothing.
|
jp z, BR+2 ; False, branch
|
||||||
ld hl, (IP)
|
; True, skip next 2 bytes and don't branch
|
||||||
ld de, NUMBER
|
ld hl, IP
|
||||||
call .HLPointsDE
|
inc (hl)
|
||||||
jr z, .isNum
|
inc (hl)
|
||||||
ld de, BR
|
|
||||||
call .HLPointsDE
|
|
||||||
jr z, .isNum
|
|
||||||
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
|
|
||||||
inc hl
|
|
||||||
; continue to isWord
|
|
||||||
.isWord:
|
|
||||||
; skip by 2
|
|
||||||
inc hl \ inc hl
|
|
||||||
.end:
|
|
||||||
ld (IP), hl
|
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; Sets Z if (HL) == E and (HL+1) == D
|
.fill 18
|
||||||
.HLPointsDE:
|
|
||||||
ld a, (hl)
|
|
||||||
cp e
|
|
||||||
ret nz ; no
|
|
||||||
inc hl
|
|
||||||
ld a, (hl)
|
|
||||||
dec hl
|
|
||||||
cp d ; Z has our answer
|
|
||||||
ret
|
|
||||||
|
|
||||||
.fill 45
|
|
||||||
|
|
||||||
.db ","
|
.db ","
|
||||||
.dw $-CSKIP
|
.dw $-CBR
|
||||||
.db 1
|
.db 1
|
||||||
WR:
|
WR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -1046,3 +1013,5 @@ CMP:
|
|||||||
.db "_bend"
|
.db "_bend"
|
||||||
.dw $-CMP
|
.dw $-CMP
|
||||||
.db 5
|
.db 5
|
||||||
|
; Offset: 06ee
|
||||||
|
.out $
|
||||||
|
@ -54,7 +54,7 @@
|
|||||||
( This is only the "early parser" in earlier stages. No need
|
( This is only the "early parser" in earlier stages. No need
|
||||||
for an abort message )
|
for an abort message )
|
||||||
: (parse)
|
: (parse)
|
||||||
(parsed) SKIP? _c ABORT
|
(parsed) NOT IF _c ABORT THEN
|
||||||
;
|
;
|
||||||
|
|
||||||
( a -- )
|
( a -- )
|
||||||
|
@ -75,10 +75,10 @@
|
|||||||
;
|
;
|
||||||
|
|
||||||
: (parse) ( a -- n )
|
: (parse) ( a -- n )
|
||||||
(parsec) NOT SKIP? EXIT
|
(parsec) IF EXIT THEN
|
||||||
(parseh) NOT SKIP? EXIT
|
(parseh) IF EXIT THEN
|
||||||
(parseb) NOT SKIP? EXIT
|
(parseb) IF EXIT THEN
|
||||||
(parsed) NOT SKIP? EXIT
|
(parsed) IF EXIT THEN
|
||||||
( nothing works )
|
( nothing works )
|
||||||
ABORT" unknown word! "
|
ABORT" unknown word! "
|
||||||
;
|
;
|
||||||
|
@ -4,6 +4,6 @@
|
|||||||
|
|
||||||
: fail SPC ." failed" LF 1 1 PC! BYE ;
|
: fail SPC ." failed" LF 1 1 PC! BYE ;
|
||||||
|
|
||||||
: # SKIP? fail SPC ." pass" LF ;
|
: # IF SPC ." pass" LF ELSE fail THEN ;
|
||||||
|
|
||||||
: #eq 2DUP SWAP . SPC '=' EMIT SPC . '?' EMIT = # ;
|
: #eq 2DUP SWAP . SPC '=' EMIT SPC . '?' EMIT = # ;
|
||||||
|
Loading…
Reference in New Issue
Block a user