forth: Add word "("

Also, fix "RECURSE" in IMMEDIATE contexts.
This commit is contained in:
Virgil Dupras 2020-03-13 19:33:16 -04:00
parent d60ea4cb30
commit 5b1ca474d4
3 changed files with 32 additions and 17 deletions

View File

@ -1,17 +1,26 @@
: H HERE @ ;
: -^ SWAP - ;
: ? @ . ;
: +! SWAP OVER @ + SWAP ! ;
: ALLOT HERE +! ;
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE H ! DOES> @ ;
: , H ! 2 ALLOT ;
: C, H C! 1 ALLOT ;
: IF ['] (fbr?) , H 0 C, ; IMMEDIATE
: IF ['] (fbr?) , H 1 ALLOT ; IMMEDIATE
: THEN DUP H -^ SWAP C! ; IMMEDIATE
: ELSE ['] (fbr) , 0 C, DUP H -^ SWAP C! H 1 - ; IMMEDIATE
: ELSE ['] (fbr) , 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE
: RECURSE R> R> 2 - >R >R EXIT ;
: ( LIT@ ) WORD SCMP IF RECURSE THEN ; IMMEDIATE
( Hello, hello, krkrkrkr... do you hear me? )
( Ah, voice at last! Some lines above need comments )
( IF: write (fbr?) addr, push HERE, create cell )
( THEN: Subtract TOS from H to get offset to write to cell )
( in that same TOS's addr )
( ELSE: write (fbr) addr, allot, then same as THEN )
( RECURSE: RS TOS is for RECURSE itself, then we have to dig )
( one more level to get to RECURSE's parent's caller. )
: NOT IF 0 ELSE 1 THEN ;
: ? @ . ;
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE H ! DOES> @ ;
: = CMP NOT ;
: < CMP 0 1 - = ;
: > CMP 1 = ;
: RECURSE R> R> 2 - >R >R EXIT ;

View File

@ -36,7 +36,9 @@ directly, but as part of another word.
; R:I -- Exit a colon definition
, n -- Write n in HERE and advance it.
' x -- a Push addr of word x to a.
['] x -- *I* Like "'", but spits the addr as a number literal.
['] x -- *I* Like "'", but spits the addr as a number
literal.
( -- *I* Comment. Ignore rest of line until ")" is read.
ALLOT n -- Move HERE by n bytes
C, b -- Write byte b in HERE and advance it.
CREATE x -- Create cell named x. Doesn't allocate a PF.

View File

@ -155,16 +155,25 @@ forthInterpret:
ld (HERE), de
jr forthInterpret
.immed:
push hl ; --> For EXECUTE
ld hl, .retRef
ld (IP), hl
jp EXECUTE+2
; For this IMMEDIATE word to be compatible with regular execution model,
; it needs to be compiled as an atom list. We need a temporary space for
; this, let's use (OLDHERE) while it isn't used.
ex de, hl ; atom to write in DE
ld hl, (OLDHERE)
call DEinHL
; Now, let's write the .retRef
ld de, .retRef
call DEinHL
ld iy, (OLDHERE)
jr .execIY
.execute:
ld de, QUIT
call .writeDE
; Compilation done, let's restore (HERE) and execute!
ld hl, (OLDHERE)
ld (HERE), hl
ld iy, COMPBUF
.execIY:
; before we execute, let's play with our RS a bit: compiledWord is
; going to push (IP) on the RS, but we don't expect our compiled words
; to ever return: it ends with QUIT. Let's set (IP) to ABORTREF and
@ -172,21 +181,16 @@ forthInterpret:
ld hl, ABORTREF
ld (IP), hl
ld ix, RS_ADDR-2
ld iy, COMPBUF
jp compiledWord
.writeDE:
push hl
ld hl, (HERE)
ld (hl), e
inc hl
ld (hl), d
inc hl
call DEinHL
ld (HERE), hl
pop hl
ret
.retRef:
.dw $+2
.dw forthInterpret
msgOk: