mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-24 02:58:06 +11:00
forth: replace (fbr?) by SKIP?
This will allow us to support backward branching with just one new (bbr) word. Also, this allow us to have "(" word sooned in core.fth and thus allow for earlier commenting.
This commit is contained in:
parent
94166186eb
commit
764b2222c7
@ -4,20 +4,24 @@
|
|||||||
: ALLOT HERE +! ;
|
: ALLOT HERE +! ;
|
||||||
: , H ! 2 ALLOT ;
|
: , H ! 2 ALLOT ;
|
||||||
: C, H C! 1 ALLOT ;
|
: C, H C! 1 ALLOT ;
|
||||||
: IF ['] (fbr?) , H 1 ALLOT ; IMMEDIATE
|
: NOT 1 SWAP SKIP? EXIT 0 * ;
|
||||||
: THEN DUP H -^ SWAP C! ; IMMEDIATE
|
|
||||||
: ELSE ['] (fbr) , 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE
|
|
||||||
: RECURSE R> R> 2 - >R >R EXIT ;
|
: RECURSE R> R> 2 - >R >R EXIT ;
|
||||||
: ( LIT@ ) WORD SCMP IF RECURSE THEN ; IMMEDIATE
|
: ( LIT@ ) WORD SCMP NOT SKIP? RECURSE ; 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 )
|
||||||
( IF: write (fbr?) addr, push HERE, create cell )
|
( BTW: Forth lines limited to 64 cols because of default )
|
||||||
( THEN: Subtract TOS from H to get offset to write to cell )
|
( input buffer size in Collapse OS )
|
||||||
( in that same TOS's addr )
|
( NOT: a bit convulted because we don't have IF yet )
|
||||||
( ELSE: write (fbr) addr, allot, then same as THEN )
|
|
||||||
( RECURSE: RS TOS is for RECURSE itself, then we have to dig )
|
( RECURSE: RS TOS is for RECURSE itself, then we have to dig )
|
||||||
( one more level to get to RECURSE's parent's caller. )
|
( one more level to get to RECURSE's parent's caller. )
|
||||||
: NOT IF 0 ELSE 1 THEN ;
|
( IF true, skip following (fbr). Also, push br cell ref H, )
|
||||||
|
( to PS )
|
||||||
|
: IF ['] SKIP? , ['] (fbr) , H 1 ALLOT ; IMMEDIATE
|
||||||
|
( Subtract TOS from H to get offset to write to IF or ELSE's )
|
||||||
|
( br cell )
|
||||||
|
: THEN DUP H -^ SWAP C! ; IMMEDIATE
|
||||||
|
( write (fbr) addr, allot, then same as THEN )
|
||||||
|
: ELSE ['] (fbr) , 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE
|
||||||
: ? @ . ;
|
: ? @ . ;
|
||||||
: VARIABLE CREATE 2 ALLOT ;
|
: VARIABLE CREATE 2 ALLOT ;
|
||||||
: CONSTANT CREATE H ! DOES> @ ;
|
: CONSTANT CREATE H ! DOES> @ ;
|
||||||
|
@ -711,12 +711,27 @@ CMP:
|
|||||||
push bc
|
push bc
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
.db "SKIP?"
|
||||||
|
.fill 2
|
||||||
|
.dw CMP
|
||||||
|
.db 0
|
||||||
|
CSKIP:
|
||||||
|
.dw nativeWord
|
||||||
|
pop hl
|
||||||
|
ld a, h
|
||||||
|
or l
|
||||||
|
jp z, next ; False, do nothing.
|
||||||
|
ld hl, (IP)
|
||||||
|
call compSkip
|
||||||
|
ld (IP), hl
|
||||||
|
jp next
|
||||||
|
|
||||||
; 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)"
|
||||||
.fill 2
|
.fill 2
|
||||||
.dw CMP
|
.dw CSKIP
|
||||||
.db 0
|
.db 0
|
||||||
FBR:
|
FBR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -728,23 +743,6 @@ FBR:
|
|||||||
pop de
|
pop de
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; Conditional branch, only branch if TOS is zero
|
|
||||||
.db "(fbr?)"
|
|
||||||
.fill 1
|
|
||||||
.dw FBR
|
|
||||||
.db 0
|
|
||||||
FBRC:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
ld a, h
|
|
||||||
or l
|
|
||||||
jr z, FBR+2
|
|
||||||
; skip next byte in RS
|
|
||||||
ld hl, (IP)
|
|
||||||
inc hl
|
|
||||||
ld (IP), hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
LATEST:
|
LATEST:
|
||||||
.dw FBRC
|
.dw FBR
|
||||||
|
|
||||||
|
@ -49,8 +49,6 @@ LITERAL n -- *I* Inserts number from TOS as a literal
|
|||||||
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
||||||
|
|
||||||
*** Flow ***
|
*** Flow ***
|
||||||
(fbr?) f -- Conditionally branches forward by the number
|
|
||||||
specified in its atom's cell.
|
|
||||||
(fbr) -- Branches forward by the number specified in its
|
(fbr) -- Branches forward by the number specified in its
|
||||||
atom's cell.
|
atom's cell.
|
||||||
ELSE I:a -- *I* Compiles a (fbr) and set branching cell at a.
|
ELSE I:a -- *I* Compiles a (fbr) and set branching cell at a.
|
||||||
@ -60,6 +58,9 @@ 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 promp immediately
|
QUIT R:drop -- Return to interpreter promp 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.
|
||||||
|
|
||||||
*** Parameter Stack ***
|
*** Parameter Stack ***
|
||||||
|
@ -73,10 +73,6 @@ HLPointsBR:
|
|||||||
push de
|
push de
|
||||||
ld de, FBR
|
ld de, FBR
|
||||||
call HLPointsDE
|
call HLPointsDE
|
||||||
jr z, .end
|
|
||||||
ld de, FBRC
|
|
||||||
call HLPointsDE
|
|
||||||
.end:
|
|
||||||
pop de
|
pop de
|
||||||
ret
|
ret
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user