mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 05:18:06 +11:00
forth: Forth-ify "HERE", "CURRENT" and "JTBL"
This commit is contained in:
parent
a9cf861cfd
commit
61195a987d
Binary file not shown.
@ -131,6 +131,8 @@ LIT:
|
||||
.dw FLAGS
|
||||
; 46
|
||||
.dw PARSEPTR
|
||||
.dw HERE
|
||||
.dw CURRENT
|
||||
|
||||
; *** Code ***
|
||||
forthMain:
|
||||
@ -161,7 +163,7 @@ forthMain:
|
||||
.bootName:
|
||||
.db "BOOT", 0
|
||||
|
||||
.fill 105
|
||||
.fill 101
|
||||
|
||||
; STABLE ABI
|
||||
; Offset: 00cd
|
||||
@ -784,36 +786,10 @@ PARSED:
|
||||
jp next
|
||||
|
||||
|
||||
.fill 96
|
||||
|
||||
.db "JTBL"
|
||||
.dw $-PARSED
|
||||
.db 4
|
||||
JTBL:
|
||||
.dw sysvarWord
|
||||
.dw JUMPTBL
|
||||
|
||||
; STABLE ABI (every sysvars)
|
||||
; Offset: 05ca
|
||||
.out $
|
||||
.db "HERE"
|
||||
.dw $-JTBL
|
||||
.db 4
|
||||
HERE_: ; Caution: conflicts with actual variable name
|
||||
.dw sysvarWord
|
||||
.dw HERE
|
||||
|
||||
.db "CURRENT"
|
||||
.dw $-HERE_
|
||||
.db 7
|
||||
CURRENT_:
|
||||
.dw sysvarWord
|
||||
.dw CURRENT
|
||||
|
||||
.fill 92
|
||||
.fill 224
|
||||
|
||||
.db "_bend"
|
||||
.dw $-CURRENT_
|
||||
.dw $-PARSED
|
||||
.db 5
|
||||
; Offset: 0647
|
||||
.out $
|
||||
|
@ -55,6 +55,8 @@
|
||||
, ( write! )
|
||||
; IMMEDIATE
|
||||
|
||||
: JTBL 0x08 ;
|
||||
|
||||
: FLAGS
|
||||
( JTBL+44 == FLAGS )
|
||||
[ JTBL 44 + @ LITN ]
|
||||
@ -65,6 +67,16 @@
|
||||
[ JTBL 46 + @ LITN ]
|
||||
;
|
||||
|
||||
: HERE
|
||||
( JTBL+48 == HERE )
|
||||
[ JTBL 48 + @ LITN ]
|
||||
;
|
||||
|
||||
: CURRENT
|
||||
( JTBL+50 == CURRENT )
|
||||
[ JTBL 50 + @ LITN ]
|
||||
;
|
||||
|
||||
: QUIT
|
||||
0 _c FLAGS _c ! _c (resRS)
|
||||
LIT< INTERPRET (find) _c DROP EXECUTE
|
||||
@ -100,8 +112,8 @@
|
||||
;
|
||||
|
||||
: C,
|
||||
HERE _c @ _c C!
|
||||
HERE _c @ 1 _c + HERE _c !
|
||||
_c HERE _c @ _c C!
|
||||
_c HERE _c @ 1 _c + _c HERE _c !
|
||||
;
|
||||
|
||||
( The NOT is to normalize the negative/positive numbers to 1
|
||||
@ -136,18 +148,18 @@
|
||||
;
|
||||
|
||||
: (entry)
|
||||
HERE _c @ ( h )
|
||||
_c HERE _c @ ( h )
|
||||
_c WORD ( h s )
|
||||
SCPY ( h )
|
||||
( Adjust HERE -1 because SCPY copies the null )
|
||||
HERE _c @ 1 _c - ( h h' )
|
||||
_c DUP HERE _c ! ( h h' )
|
||||
_c HERE _c @ 1 _c - ( h h' )
|
||||
_c DUP _c HERE _c ! ( h h' )
|
||||
_c SWAP _c - ( sz )
|
||||
( write prev value )
|
||||
HERE _c @ CURRENT _c @ _c - ,
|
||||
_c HERE _c @ _c CURRENT _c @ _c - ,
|
||||
( write size )
|
||||
_c C,
|
||||
HERE _c @ CURRENT _c !
|
||||
_c HERE _c @ _c CURRENT _c !
|
||||
;
|
||||
|
||||
: INTERPRET
|
||||
@ -177,7 +189,7 @@
|
||||
it to avoid bootstrapping issues )
|
||||
: LITN
|
||||
( JTBL+24 == NUMBER )
|
||||
JTBL 24 _c + ,
|
||||
_c JTBL 24 _c + ,
|
||||
,
|
||||
;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user