mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 17:48: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
|
||||
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
|
||||
PLUS:
|
||||
.db "+"
|
||||
.fill 7
|
||||
.dw FETCH
|
||||
.dw OVER
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
pop de
|
||||
@ -317,3 +352,40 @@ DIV:
|
||||
push bc
|
||||
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
|
||||
after. "R:" means that the Return Stack is modified.
|
||||
|
||||
*** Native Words ***
|
||||
|
||||
: x ... ; -- Define a new word
|
||||
. n -- Print n in its decimal form
|
||||
@ 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
|
||||
CREATE x -- Create cell named x
|
||||
DUP a -- a a
|
||||
EMIT c -- Spit char c to stdout
|
||||
EXECUTE a -- Execute word at addr a
|
||||
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
|
||||
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
||||
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.
|
||||
push af \ push af \ push af
|
||||
ld (INITIAL_SP), sp
|
||||
ld hl, DIV ; last entry in hardcoded dict
|
||||
ld hl, ALLOT ; last entry in hardcoded dict
|
||||
ld (CURRENT), hl
|
||||
ld hl, FORTH_RAMEND
|
||||
ld (HERE), hl
|
||||
|
Loading…
Reference in New Issue
Block a user