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

forth: Forth-ify "WORD"

This commit is contained in:
Virgil Dupras 2020-03-28 12:55:22 -04:00
parent 6e3b47f4a4
commit 8b7947bc6a
3 changed files with 45 additions and 79 deletions

Binary file not shown.

View File

@ -121,6 +121,7 @@ NUMBER:
LIT:
.dw litWord
.dw INITIAL_SP
.dw WORDBUF
; *** Code ***
forthMain:
@ -179,7 +180,7 @@ INTERPRET:
.dw DROP
.dw EXECUTE
.fill 58
.fill 56
; STABLE ABI
; Offset: 00cd
@ -890,65 +891,10 @@ TOWORD:
.dw TOWORD
.dw EXIT
; Read word from C<, copy to WORDBUF, null-terminate, and return, make
; HL point to WORDBUF.
.db "WORD"
.dw $-TOWORD
.db 4
; STABLE ABI
; Offset: 04f7
.out $
WORD:
.dw compiledWord
.dw NUMBER ; ( a )
.dw WORDBUF
.dw TOWORD ; ( a c )
; branch mark
.dw OVER ; ( a c a )
.dw STORE ; ( a )
.dw NUMBER ; ( a 1 )
.dw 1
.dw PLUS ; ( a+1 )
.dw CIN ; ( a c )
.dw DUP ; ( a c c )
.dw ISWS ; ( a c f )
.dw CSKIP ; ( a c )
; I'm not sure why, I can't seem to successfully change this into
; a (br). I'll get rid of the (fbr) and (bbr) words when I'm done
; Forth-ifying "WORD"
.dw BBR
.db 20 ; here - mark
; at this point, we have ( a WS )
.dw DROP
.dw NUMBER
.dw 0
.dw SWAP ; ( 0 a )
.dw STORE ; ()
.dw NUMBER
.dw WORDBUF
.dw EXIT
.wcpy:
.dw nativeWord
ld de, WORDBUF
push de ; we already have our result
.loop:
ld a, (hl)
cp ' '+1
jr c, .loopend
ld (de), a
inc hl
inc de
jr .loop
.loopend:
; null-terminate the string.
xor a
ld (de), a
jp next
.fill 73
.db "(parsed)"
.dw $-WORD
.dw $-TOWORD
.db 8
PARSED:
.dw nativeWord

View File

@ -51,25 +51,6 @@
: ABORT _c (resSP) QUIT ;
: INTERPRET
BEGIN
WORD
(find)
IF
1 FLAGS !
EXECUTE
0 FLAGS !
ELSE
(parse*) @ EXECUTE
THEN
AGAIN
;
: BOOT
LIT< (c<$) (find) IF EXECUTE ELSE DROP THEN
_c INTERPRET
;
( This is only the "early parser" in earlier stages. No need
for an abort message )
: (parse)
@ -97,6 +78,26 @@
HERE @ 1 + HERE !
;
( Read word from C<, copy to WORDBUF, null-terminate, and
return, make HL point to WORDBUF. )
: WORD
( JTBL+30 == WORDBUF )
[ JTBL 30 + @ LITN ] ( a )
TOWORD ( a c )
BEGIN
( We take advantage of the fact that char MSB is
always zero to pre-write our null-termination )
OVER ! ( a )
1 + ( a+1 )
C< ( a c )
DUP WS?
UNTIL
( a this point, PS is: a WS )
( null-termination is already written )
DROP DROP
[ JTBL 30 + @ LITN ]
;
: LITN
( JTBL+24 == NUMBER )
JTBL 24 + ,
@ -105,7 +106,7 @@
: (entry)
HERE @ ( h )
WORD ( h s )
_c WORD ( h s )
SCPY ( h )
( Adjust HERE -1 because SCPY copies the null )
HERE @ 1 _c - ( h h' )
@ -118,6 +119,25 @@
HERE @ CURRENT !
;
: INTERPRET
BEGIN
_c WORD
(find)
IF
1 FLAGS !
EXECUTE
0 FLAGS !
ELSE
(parse*) @ EXECUTE
THEN
AGAIN
;
: BOOT
LIT< (c<$) (find) IF EXECUTE ELSE DROP THEN
_c INTERPRET
;
( : and ; have to be defined last because it can't be
executed now also, they can't have their real name
right away )
@ -128,7 +148,7 @@
issues. JTBL+24 == NUMBER JTBL+6 == compiledWord )
[ JTBL 24 + , JTBL 6 + , ] ,
BEGIN
WORD
_c WORD
(find)
( is word )
IF DUP _c IMMED? IF EXECUTE ELSE , THEN