mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-26 04:28:05 +11:00
forth: Word-ify "[COMPILE]"
This commit is contained in:
parent
b72901175e
commit
707f1dbae1
@ -2,7 +2,6 @@
|
|||||||
: -^ SWAP - ;
|
: -^ SWAP - ;
|
||||||
: +! SWAP OVER @ + SWAP ! ;
|
: +! SWAP OVER @ + SWAP ! ;
|
||||||
: ALLOT HERE +! ;
|
: ALLOT HERE +! ;
|
||||||
: , H ! 2 ALLOT ;
|
|
||||||
: C, H C! 1 ALLOT ;
|
: C, H C! 1 ALLOT ;
|
||||||
: BEGIN H ; IMMEDIATE
|
: BEGIN H ; IMMEDIATE
|
||||||
: COMPILE ' ['] LITN EXECUTE ['] , , ; IMMEDIATE
|
: COMPILE ' ['] LITN EXECUTE ['] , , ; IMMEDIATE
|
||||||
|
@ -119,8 +119,7 @@ LIT:
|
|||||||
.db 0
|
.db 0
|
||||||
EXIT:
|
EXIT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call popRS
|
call popRSIP
|
||||||
ld (IP), hl
|
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; ( R:I -- )
|
; ( R:I -- )
|
||||||
@ -130,7 +129,6 @@ EXIT:
|
|||||||
.db 0
|
.db 0
|
||||||
QUIT:
|
QUIT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
quit:
|
|
||||||
jp forthRdLine
|
jp forthRdLine
|
||||||
|
|
||||||
.db "ABORT"
|
.db "ABORT"
|
||||||
@ -283,9 +281,23 @@ PFETCH:
|
|||||||
push hl
|
push hl
|
||||||
jp next
|
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 -- )
|
; ( addr -- )
|
||||||
.db "EXECUTE"
|
.db "EXECUTE"
|
||||||
.dw PFETCH
|
.dw WR
|
||||||
.db 0
|
.db 0
|
||||||
EXECUTE:
|
EXECUTE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -304,41 +316,50 @@ EXECUTE:
|
|||||||
.dw EXECUTE
|
.dw EXECUTE
|
||||||
.db 1 ; IMMEDIATE
|
.db 1 ; IMMEDIATE
|
||||||
COMPILE:
|
COMPILE:
|
||||||
.dw nativeWord
|
.dw compiledWord
|
||||||
call readword
|
.dw FIND_
|
||||||
call find
|
.dw CSKIP
|
||||||
jr nz, .maybeNum
|
.dw .maybeNum
|
||||||
ex de, hl
|
.dw DUP
|
||||||
call HLisIMMED
|
.dw ISIMMED
|
||||||
jr z, .immed
|
.dw CSKIP
|
||||||
ex de, hl
|
.dw .word
|
||||||
call .writeDE
|
; is immediate. just execute.
|
||||||
jp next
|
.dw EXECUTE
|
||||||
|
.dw EXIT
|
||||||
|
|
||||||
|
.db 0b10 ; UNWORD
|
||||||
|
.word:
|
||||||
|
.dw compiledWord
|
||||||
|
.dw WR
|
||||||
|
.dw R2P ; exit COMPILE
|
||||||
|
.dw DROP
|
||||||
|
.dw EXIT
|
||||||
|
|
||||||
|
.db 0b10 ; UNWORD
|
||||||
.maybeNum:
|
.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
|
push hl ; --> lvl 1. save string addr
|
||||||
call parseLiteral
|
call parseLiteral
|
||||||
pop hl ; <-- lvl 1
|
pop hl ; <-- lvl 1
|
||||||
jr nz, .undef
|
jr nz, .undef
|
||||||
; a valid number in DE!
|
; a valid number in DE!
|
||||||
ex de, hl
|
push de
|
||||||
ld de, NUMBER
|
|
||||||
call .writeDE
|
|
||||||
ex de, hl ; number in DE
|
|
||||||
call .writeDE
|
|
||||||
jp next
|
jp next
|
||||||
.undef:
|
.undef:
|
||||||
call printstr
|
call printstr
|
||||||
jp abortUnknownWord
|
jp abortUnknownWord
|
||||||
.immed:
|
|
||||||
push hl
|
|
||||||
jp EXECUTE+2
|
|
||||||
.writeDE:
|
|
||||||
push hl
|
|
||||||
ld hl, (HERE)
|
|
||||||
call DEinHL
|
|
||||||
ld (HERE), hl
|
|
||||||
pop hl
|
|
||||||
ret
|
|
||||||
|
|
||||||
|
|
||||||
.db ":"
|
.db ":"
|
||||||
@ -381,8 +402,7 @@ DEFINE:
|
|||||||
.retRef:
|
.retRef:
|
||||||
.dw $+2
|
.dw $+2
|
||||||
.dw $+2
|
.dw $+2
|
||||||
call popRS
|
call popRSIP
|
||||||
ld (IP), hl
|
|
||||||
jr .loop
|
jr .loop
|
||||||
|
|
||||||
|
|
||||||
@ -418,10 +438,28 @@ IMMEDIATE:
|
|||||||
set FLAG_IMMED, (hl)
|
set FLAG_IMMED, (hl)
|
||||||
jp next
|
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 -- )
|
; ( n -- )
|
||||||
.db "LITN"
|
.db "LITN"
|
||||||
.fill 3
|
.fill 3
|
||||||
.dw IMMEDIATE
|
.dw ISIMMED
|
||||||
.db 1 ; IMMEDIATE
|
.db 1 ; IMMEDIATE
|
||||||
LITN:
|
LITN:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
|
@ -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.
|
COMPILE x -- Meta compiles. Kind of blows the mind. See below.
|
||||||
CONSTANT x n -- Creates cell x that when called pushes its value
|
CONSTANT x n -- Creates cell x that when called pushes its value
|
||||||
DOES> -- See description at top of file
|
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.
|
IMMEDIATE -- Flag the latest defined word as immediate.
|
||||||
LITN n -- *I* Inserts number from TOS as a literal
|
LITN 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.
|
||||||
|
@ -25,6 +25,11 @@ popRS:
|
|||||||
dec ix
|
dec ix
|
||||||
ret
|
ret
|
||||||
|
|
||||||
|
popRSIP:
|
||||||
|
call popRS
|
||||||
|
ld (IP), hl
|
||||||
|
ret
|
||||||
|
|
||||||
; Skip the next two bytes in RS' TOS
|
; Skip the next two bytes in RS' TOS
|
||||||
skipRS:
|
skipRS:
|
||||||
push hl
|
push hl
|
||||||
|
@ -519,14 +519,6 @@ HLisIMMED:
|
|||||||
; We need an invert flag. We want to Z to be set when flag is non-zero.
|
; We need an invert flag. We want to Z to be set when flag is non-zero.
|
||||||
jp toggleZ
|
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
|
; Sets Z if wordref at HL is of the UNWORD type
|
||||||
HLisUNWORD:
|
HLisUNWORD:
|
||||||
dec hl
|
dec hl
|
||||||
|
Loading…
Reference in New Issue
Block a user