1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-25 17:18:06 +11:00

forth: Word-ify "[COMPILE]"

This commit is contained in:
Virgil Dupras 2020-03-17 17:29:03 -04:00
parent b72901175e
commit 707f1dbae1
5 changed files with 76 additions and 41 deletions

View File

@ -2,7 +2,6 @@
: -^ SWAP - ;
: +! SWAP OVER @ + SWAP ! ;
: ALLOT HERE +! ;
: , H ! 2 ALLOT ;
: C, H C! 1 ALLOT ;
: BEGIN H ; IMMEDIATE
: COMPILE ' ['] LITN EXECUTE ['] , , ; IMMEDIATE

View File

@ -119,8 +119,7 @@ LIT:
.db 0
EXIT:
.dw nativeWord
call popRS
ld (IP), hl
call popRSIP
jp next
; ( R:I -- )
@ -130,7 +129,6 @@ EXIT:
.db 0
QUIT:
.dw nativeWord
quit:
jp forthRdLine
.db "ABORT"
@ -283,9 +281,23 @@ PFETCH:
push hl
jp next
.db ","
.fill 6
.dw PFETCH
.db 0
WR:
.dw nativeWord
pop de
call chkPS
ld hl, (HERE)
call DEinHL
ld (HERE), hl
jp next
; ( addr -- )
.db "EXECUTE"
.dw PFETCH
.dw WR
.db 0
EXECUTE:
.dw nativeWord
@ -304,41 +316,50 @@ EXECUTE:
.dw EXECUTE
.db 1 ; IMMEDIATE
COMPILE:
.dw nativeWord
call readword
call find
jr nz, .maybeNum
ex de, hl
call HLisIMMED
jr z, .immed
ex de, hl
call .writeDE
jp next
.dw compiledWord
.dw FIND_
.dw CSKIP
.dw .maybeNum
.dw DUP
.dw ISIMMED
.dw CSKIP
.dw .word
; is immediate. just execute.
.dw EXECUTE
.dw EXIT
.db 0b10 ; UNWORD
.word:
.dw compiledWord
.dw WR
.dw R2P ; exit COMPILE
.dw DROP
.dw EXIT
.db 0b10 ; UNWORD
.maybeNum:
.dw compiledWord
.dw .parseNum
.dw LITN
.dw R2P ; exit COMPILE
.dw DROP
.dw EXIT
.db 0b10 ; UNWORD
.parseNum:
.dw nativeWord
pop hl ; string addr
push hl ; --> lvl 1. save string addr
call parseLiteral
pop hl ; <-- lvl 1
jr nz, .undef
; a valid number in DE!
ex de, hl
ld de, NUMBER
call .writeDE
ex de, hl ; number in DE
call .writeDE
push de
jp next
.undef:
call printstr
jp abortUnknownWord
.immed:
push hl
jp EXECUTE+2
.writeDE:
push hl
ld hl, (HERE)
call DEinHL
ld (HERE), hl
pop hl
ret
.db ":"
@ -381,8 +402,7 @@ DEFINE:
.retRef:
.dw $+2
.dw $+2
call popRS
ld (IP), hl
call popRSIP
jr .loop
@ -418,10 +438,28 @@ IMMEDIATE:
set FLAG_IMMED, (hl)
jp next
.db "IMMED?"
.fill 1
.dw IMMEDIATE
.db 0
ISIMMED:
.dw nativeWord
pop hl
call chkPS
dec hl
ld de, 0
bit FLAG_IMMED, (hl)
jr z, .notset
inc de
.notset:
push de
jp next
; ( n -- )
.db "LITN"
.fill 3
.dw IMMEDIATE
.dw ISIMMED
.db 1 ; IMMEDIATE
LITN:
.dw nativeWord

View File

@ -48,6 +48,7 @@ CREATE x -- Create cell named x. Doesn't allocate a PF.
COMPILE x -- Meta compiles. Kind of blows the mind. See below.
CONSTANT x n -- Creates cell x that when called pushes its value
DOES> -- See description at top of file
IMMED? a -- f Checks whether wordref at a is immediate.
IMMEDIATE -- Flag the latest defined word as immediate.
LITN n -- *I* Inserts number from TOS as a literal
VARIABLE c -- Creates cell x with 2 bytes allocation.

View File

@ -25,6 +25,11 @@ popRS:
dec ix
ret
popRSIP:
call popRS
ld (IP), hl
ret
; Skip the next two bytes in RS' TOS
skipRS:
push hl

View File

@ -519,14 +519,6 @@ HLisIMMED:
; We need an invert flag. We want to Z to be set when flag is non-zero.
jp toggleZ
; Sets Z if wordref at (HL) is of the IMMEDIATE type
HLPointsIMMED:
push hl
call intoHL
call HLisIMMED
pop hl
ret
; Sets Z if wordref at HL is of the UNWORD type
HLisUNWORD:
dec hl