izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-27 15:08:05 +11:00
Code Issues Releases Wiki Activity

forth: Forth-ify "!"

Browse Source
This commit is contained in:
Virgil Dupras 2020-03-30 14:09:39 -04:00
parent 8ef9e7d0da
commit 162ff2c5cb
4 changed files with 19 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
emul/forth/z80c.bin
View File

Binary file not shown.

19
forth/forth.asm
View File

@ -841,26 +841,11 @@ SYSVNXT_:
.dw sysvarWord .dw sysvarWord
.dw SYSVNXT .dw SYSVNXT
; ( n a -- )
.db "!"
.dw $-SYSVNXT_
.db 1
; STABLE ABI
; Offset: 0610
.out $
STORE:
.dw nativeWord
pop iy
pop hl
call chkPS
ld (iy), l
ld (iy+1), h
jp next
.fill 30 .fill 51
.db "_bend" .db "_bend"
.dw $-STORE .dw $-SYSVNXT_
.db 5 .db 5
; Offset: 0647 ; Offset: 0647
.out $ .out $

16
forth/icore.fs
View File

@ -56,7 +56,7 @@
; IMMEDIATE ; IMMEDIATE
: QUIT : QUIT
0 FLAGS ! _c (resRS) 0 FLAGS _c ! _c (resRS)
LIT< INTERPRET (find) _c DROP EXECUTE LIT< INTERPRET (find) _c DROP EXECUTE
; ;
@ -91,7 +91,7 @@
: C, : C,
HERE _c @ _c C! HERE _c @ _c C!
HERE _c @ 1 _c + HERE ! HERE _c @ 1 _c + HERE _c !
; ;
( The NOT is to normalize the negative/positive numbers to 1 ( The NOT is to normalize the negative/positive numbers to 1
@ -114,7 +114,7 @@
BEGIN BEGIN
( We take advantage of the fact that char MSB is ( We take advantage of the fact that char MSB is
always zero to pre-write our null-termination ) always zero to pre-write our null-termination )
_c OVER ! ( a ) _c OVER _c ! ( a )
1 _c + ( a+1 ) 1 _c + ( a+1 )
_c C< ( a c ) _c C< ( a c )
_c DUP _c WS? _c DUP _c WS?
@ -131,13 +131,13 @@
SCPY ( h ) SCPY ( h )
( Adjust HERE -1 because SCPY copies the null ) ( Adjust HERE -1 because SCPY copies the null )
HERE _c @ 1 _c - ( h h' ) HERE _c @ 1 _c - ( h h' )
_c DUP HERE ! ( h h' ) _c DUP HERE _c ! ( h h' )
_c SWAP _c - ( sz ) _c SWAP _c - ( sz )
( write prev value ) ( write prev value )
HERE _c @ CURRENT _c @ _c - , HERE _c @ CURRENT _c @ _c - ,
( write size ) ( write size )
_c C, _c C,
HERE _c @ CURRENT ! HERE _c @ CURRENT _c !
; ;
: INTERPRET : INTERPRET
@ -145,9 +145,9 @@
_c WORD _c WORD
(find) (find)
IF IF
1 FLAGS ! 1 FLAGS _c !
EXECUTE EXECUTE
0 FLAGS ! 0 FLAGS _c !
ELSE ELSE
(parse*) _c @ EXECUTE (parse*) _c @ EXECUTE
THEN THEN
@ -157,7 +157,7 @@
: BOOT : BOOT
LIT< (c<) (find) NOT IF LIT< KEY (find) _c DROP THEN LIT< (c<) (find) NOT IF LIT< KEY (find) _c DROP THEN
( JTBL+40 == CINPTR ) ( JTBL+40 == CINPTR )
[ JTBL 40 + @ LITN ] ! [ JTBL 40 + @ LITN ] _c !
LIT< (c<$) (find) IF EXECUTE ELSE _c DROP THEN LIT< (c<$) (find) IF EXECUTE ELSE _c DROP THEN
_c INTERPRET _c INTERPRET
; ;

9
forth/z80c.fs
View File

@ -213,6 +213,15 @@ CODE /MOD
BC PUSHqq, BC PUSHqq,
;CODE ;CODE
CODE !
HL POPqq,
DE POPqq,
chkPS,
(HL) E LDrr,
HL INCss,
(HL) D LDrr,
;CODE
CODE @ CODE @
HL POPqq, HL POPqq,
chkPS, chkPS,