1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-26 18:08:05 +11:00

forth: add "DUP", "OVER", "SWAP", "?", "+!", "ALLOT"

This commit is contained in:
Virgil Dupras 2020-03-07 21:12:30 -05:00
parent f0cf10ab7c
commit 53024d88f5
3 changed files with 85 additions and 2 deletions

View File

@ -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

View File

@ -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

View File

@ -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