1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-24 14:38:05 +11:00

forth: Forth-ify "R>" and ">R"

This commit is contained in:
Virgil Dupras 2020-03-27 11:27:40 -04:00
parent 1e7e696e4a
commit 005dd98fc2
5 changed files with 35 additions and 34 deletions

Binary file not shown.

View File

@ -54,7 +54,7 @@ IMMEDIATE -- Flag the latest defined word as immediate.
LITN n -- Write number n as a literal.
[LITN] n -- *I* Immediate version of LITN.
ROUTINE x -- a Push the addr of the specified core routine
C=cellWord L=compiledWord V=nativeWord N=next S=LIT
C=cellWord J=JUMPTBL V=nativeWord N=next S=LIT
M=NUMBER Y=sysvarWord D=doesWord
VARIABLE c -- Creates cell x with 2 bytes allocation.

View File

@ -113,8 +113,10 @@
; change bootstrap binaries have to be adjusted because they rely on them.
; We're at 0 here
jp forthMain
.fill 0x17-$
.fill 0x11-$
JUMPTBL:
jp pushRS
jp popRS
jp nativeWord
jp next
jp chkPS
@ -782,13 +784,13 @@ ROUTINE:
ld de, cellWord
cp 'C'
jr z, .end
ld de, compiledWord
cp 'L'
jr z, .end
ld de, JUMPTBL
cp 'J'
jr z, .end
ld de, JUMPTBL+6
cp 'V'
jr z, .end
ld de, JUMPTBL+3
ld de, JUMPTBL+9
cp 'N'
jr z, .end
ld de, sysvarWord
@ -803,7 +805,7 @@ ROUTINE:
ld de, NUMBER
cp 'M'
jr z, .end
ld de, JUMPTBL+6
ld de, JUMPTBL+12
cp 'P'
jr nz, .notgood
; continue to end on match
@ -1300,28 +1302,12 @@ OVER:
push de
jp next
.db ">R"
.dw $-OVER
.db 2
P2R:
.dw nativeWord
pop hl
call chkPS
call pushRS
jp next
.db "R>"
.dw $-P2R
.db 2
R2P:
.dw nativeWord
call popRS
push hl
jp next
.fill 31
; ( a b -- c ) A + B
.db "+"
.dw $-R2P
.dw $-OVER
.db 1
PLUS:
.dw nativeWord

View File

@ -41,15 +41,6 @@
, ( write! )
; IMMEDIATE
: X ( can't have its real name now )
['] EXIT ,
R> DROP ( exit COMPILE )
R> DROP ( exit : )
; IMMEDIATE
( Give ";" its real name )
';' CURRENT @ 4 - C!
: INTERPRET
BEGIN
WORD
@ -63,3 +54,14 @@
THEN
AGAIN
;
( ; has to be defined last because it can't be executed now )
: X ( can't have its real name now )
['] EXIT ,
_c R> DROP ( exit COMPILE )
_c R> DROP ( exit : )
; IMMEDIATE
( Give ";" its real name )
';' CURRENT @ 4 - C!

View File

@ -207,3 +207,16 @@ CODE J
H 3 IX- LDrIXY,
HL PUSHqq,
;CODE
CODE >R
HL POPqq,
chkPS,
( JUMPTBL+0 == pushRS )
ROUTINE J CALLnn,
;CODE
CODE R>
( JUMPTBL+3 == popRS )
ROUTINE J 3 + CALLnn,
HL PUSHqq,
;CODE