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

forth: Forth-ify ","

This commit is contained in:
Virgil Dupras 2020-03-31 15:26:43 -04:00
parent 7d5b1f5cea
commit 1e85d60d89
3 changed files with 12 additions and 20 deletions

Binary file not shown.

View File

@ -126,24 +126,11 @@ CBR:
ld (IP), hl ld (IP), hl
jp next jp next
.db "," .fill 23
.dw $-CBR
.db 1
WR:
.dw nativeWord
pop de
call chkPS
ld hl, (HERE)
ld (hl), e
inc hl
ld (hl), d
inc hl
ld (HERE), hl
jp next
; ( addr -- ) ; ( addr -- )
.db "EXECUTE" .db "EXECUTE"
.dw $-WR .dw $-CBR
.db 7 .db 7
EXECUTE: EXECUTE:
.dw nativeWord .dw nativeWord

View File

@ -146,6 +146,11 @@
[ 48 @ LITN ] _c @ EXECUTE [ 48 @ LITN ] _c @ EXECUTE
; ;
: ,
_c HERE _c @ _c !
_c HERE _c @ 2 _c + _c HERE _c !
;
: C, : C,
_c HERE _c @ _c C! _c HERE _c @ _c C!
_c HERE _c @ 1 _c + _c HERE _c ! _c HERE _c @ 1 _c + _c HERE _c !
@ -191,7 +196,7 @@
_c DUP _c HERE _c ! ( h h' ) _c DUP _c HERE _c ! ( h h' )
_c SWAP _c - ( sz ) _c SWAP _c - ( sz )
( write prev value ) ( write prev value )
_c HERE _c @ _c CURRENT _c @ _c - , _c HERE _c @ _c CURRENT _c @ _c - _c ,
( write size ) ( write size )
_c C, _c C,
_c HERE _c @ _c CURRENT _c ! _c HERE _c @ _c CURRENT _c !
@ -225,7 +230,7 @@
it to avoid bootstrapping issues ) it to avoid bootstrapping issues )
: LITN : LITN
( 32 == NUMBER ) ( 32 == NUMBER )
32 , , 32 _c , _c ,
; ;
( : and ; have to be defined last because it can't be ( : and ; have to be defined last because it can't be
@ -236,19 +241,19 @@
_c (entry) _c (entry)
( We cannot use LITN as IMMEDIATE because of bootstrapping ( We cannot use LITN as IMMEDIATE because of bootstrapping
issues. 32 == NUMBER 14 == compiledWord ) issues. 32 == NUMBER 14 == compiledWord )
[ 32 , 14 , ] , [ 32 , 14 , ] _c ,
BEGIN BEGIN
_c WORD _c WORD
_c (find) _c (find)
( is word ) ( is word )
IF _c DUP _c IMMED? IF EXECUTE ELSE , THEN IF _c DUP _c IMMED? IF EXECUTE ELSE _c , THEN
( maybe number ) ( maybe number )
ELSE _c (parse*) _c @ EXECUTE _c LITN THEN ELSE _c (parse*) _c @ EXECUTE _c LITN THEN
AGAIN AGAIN
; IMMEDIATE ; IMMEDIATE
: Y : Y
['] EXIT , ['] EXIT _c ,
_c R> _c DROP ( exit : ) _c R> _c DROP ( exit : )
; IMMEDIATE ; IMMEDIATE