mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 04:58:05 +11:00
forth: Add word "("
Also, fix "RECURSE" in IMMEDIATE contexts.
This commit is contained in:
parent
d60ea4cb30
commit
5b1ca474d4
@ -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 ;
|
||||
|
@ -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.
|
||||
|
@ -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:
|
||||
|
Loading…
Reference in New Issue
Block a user