mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-26 05:38:06 +11:00
forth: add "DUP", "OVER", "SWAP", "?", "+!", "ALLOT"
This commit is contained in:
parent
f0cf10ab7c
commit
53024d88f5
@ -268,11 +268,46 @@ FETCH:
|
|||||||
push hl
|
push hl
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
|
; ( a b -- b a )
|
||||||
|
SWAP:
|
||||||
|
.db "SWAP"
|
||||||
|
.fill 4
|
||||||
|
.dw FETCH
|
||||||
|
.dw nativeWord
|
||||||
|
pop hl
|
||||||
|
ex (sp), hl
|
||||||
|
push hl
|
||||||
|
jp exit
|
||||||
|
|
||||||
|
; ( a -- a a )
|
||||||
|
DUP:
|
||||||
|
.db "DUP"
|
||||||
|
.fill 5
|
||||||
|
.dw SWAP
|
||||||
|
.dw nativeWord
|
||||||
|
pop hl
|
||||||
|
push hl
|
||||||
|
push hl
|
||||||
|
jp exit
|
||||||
|
|
||||||
|
; ( a b -- a b a )
|
||||||
|
OVER:
|
||||||
|
.db "OVER"
|
||||||
|
.fill 4
|
||||||
|
.dw DUP
|
||||||
|
.dw nativeWord
|
||||||
|
pop hl ; B
|
||||||
|
pop de ; A
|
||||||
|
push de
|
||||||
|
push hl
|
||||||
|
push de
|
||||||
|
jp exit
|
||||||
|
|
||||||
; ( a b -- c ) A + B
|
; ( a b -- c ) A + B
|
||||||
PLUS:
|
PLUS:
|
||||||
.db "+"
|
.db "+"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw FETCH
|
.dw OVER
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
pop de
|
pop de
|
||||||
@ -317,3 +352,40 @@ DIV:
|
|||||||
push bc
|
push bc
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
|
; End of native words
|
||||||
|
|
||||||
|
; ( a -- )
|
||||||
|
; @ .
|
||||||
|
FETCHDOT:
|
||||||
|
.db "?"
|
||||||
|
.fill 7
|
||||||
|
.dw DIV
|
||||||
|
.dw compiledWord
|
||||||
|
.dw FETCH+CODELINK_OFFSET
|
||||||
|
.dw DOT+CODELINK_OFFSET
|
||||||
|
.dw EXIT+CODELINK_OFFSET
|
||||||
|
|
||||||
|
; ( n a -- )
|
||||||
|
; SWAP OVER @ + SWAP !
|
||||||
|
STOREINC:
|
||||||
|
.db "+!"
|
||||||
|
.fill 6
|
||||||
|
.dw FETCHDOT
|
||||||
|
.dw compiledWord
|
||||||
|
.dw SWAP+CODELINK_OFFSET
|
||||||
|
.dw OVER+CODELINK_OFFSET
|
||||||
|
.dw FETCH+CODELINK_OFFSET
|
||||||
|
.dw PLUS+CODELINK_OFFSET
|
||||||
|
.dw SWAP+CODELINK_OFFSET
|
||||||
|
.dw STORE+CODELINK_OFFSET
|
||||||
|
.dw EXIT+CODELINK_OFFSET
|
||||||
|
|
||||||
|
; ( n -- )
|
||||||
|
; HERE +!
|
||||||
|
ALLOT:
|
||||||
|
.db "ALLOT", 0, 0, 0
|
||||||
|
.dw STOREINC
|
||||||
|
.dw compiledWord
|
||||||
|
.dw HERE_+CODELINK_OFFSET
|
||||||
|
.dw STOREINC+CODELINK_OFFSET
|
||||||
|
.dw EXIT+CODELINK_OFFSET
|
||||||
|
@ -2,6 +2,8 @@ Stack notation: "<stack before> -- <stack after>". Rightmost is top of stack
|
|||||||
(TOS). For example, in "a b -- c d", b is TOS before, d is TOS
|
(TOS). For example, in "a b -- c d", b is TOS before, d is TOS
|
||||||
after. "R:" means that the Return Stack is modified.
|
after. "R:" means that the Return Stack is modified.
|
||||||
|
|
||||||
|
*** Native Words ***
|
||||||
|
|
||||||
: x ... ; -- Define a new word
|
: x ... ; -- Define a new word
|
||||||
. n -- Print n in its decimal form
|
. n -- Print n in its decimal form
|
||||||
@ a -- n Set n to value at address a
|
@ a -- n Set n to value at address a
|
||||||
@ -11,6 +13,7 @@ Stack notation: "<stack before> -- <stack after>". Rightmost is top of stack
|
|||||||
* a b -- c a * b -> c
|
* a b -- c a * b -> c
|
||||||
/ a b -- c a / b -> c
|
/ a b -- c a / b -> c
|
||||||
CREATE x -- Create cell named x
|
CREATE x -- Create cell named x
|
||||||
|
DUP a -- a a
|
||||||
EMIT c -- Spit char c to stdout
|
EMIT c -- Spit char c to stdout
|
||||||
EXECUTE a -- Execute word at addr a
|
EXECUTE a -- Execute word at addr a
|
||||||
EXIT R:I -- Exit a colon definition
|
EXIT R:I -- Exit a colon definition
|
||||||
@ -19,3 +22,11 @@ QUIT R:drop -- Return to interpreter promp immediately
|
|||||||
KEY -- c Get char c from stdin
|
KEY -- c Get char c from stdin
|
||||||
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
||||||
then execute the compiled contents.
|
then execute the compiled contents.
|
||||||
|
OVER a b -- a b a
|
||||||
|
SWAP a b -- b a
|
||||||
|
|
||||||
|
*** Core-but-Forth Words ***
|
||||||
|
|
||||||
|
? a -- Print value of addr a
|
||||||
|
+! n a -- Increase value of addr a by n
|
||||||
|
ALLOT n -- Move HERE by n bytes
|
||||||
|
@ -57,7 +57,7 @@ forthMain:
|
|||||||
; we check for stack underflow.
|
; we check for stack underflow.
|
||||||
push af \ push af \ push af
|
push af \ push af \ push af
|
||||||
ld (INITIAL_SP), sp
|
ld (INITIAL_SP), sp
|
||||||
ld hl, DIV ; last entry in hardcoded dict
|
ld hl, ALLOT ; last entry in hardcoded dict
|
||||||
ld (CURRENT), hl
|
ld (CURRENT), hl
|
||||||
ld hl, FORTH_RAMEND
|
ld hl, FORTH_RAMEND
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
|
Loading…
Reference in New Issue
Block a user