mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 19:08:05 +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
|
.dw FLAGS
|
||||||
; 46
|
; 46
|
||||||
.dw PARSEPTR
|
.dw PARSEPTR
|
||||||
|
.dw HERE
|
||||||
|
.dw CURRENT
|
||||||
|
|
||||||
; *** Code ***
|
; *** Code ***
|
||||||
forthMain:
|
forthMain:
|
||||||
@ -161,7 +163,7 @@ forthMain:
|
|||||||
.bootName:
|
.bootName:
|
||||||
.db "BOOT", 0
|
.db "BOOT", 0
|
||||||
|
|
||||||
.fill 105
|
.fill 101
|
||||||
|
|
||||||
; STABLE ABI
|
; STABLE ABI
|
||||||
; Offset: 00cd
|
; Offset: 00cd
|
||||||
@ -784,36 +786,10 @@ PARSED:
|
|||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
|
||||||
.fill 96
|
.fill 224
|
||||||
|
|
||||||
.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
|
|
||||||
|
|
||||||
.db "_bend"
|
.db "_bend"
|
||||||
.dw $-CURRENT_
|
.dw $-PARSED
|
||||||
.db 5
|
.db 5
|
||||||
; Offset: 0647
|
; Offset: 0647
|
||||||
.out $
|
.out $
|
||||||
|
@ -55,6 +55,8 @@
|
|||||||
, ( write! )
|
, ( write! )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
|
: JTBL 0x08 ;
|
||||||
|
|
||||||
: FLAGS
|
: FLAGS
|
||||||
( JTBL+44 == FLAGS )
|
( JTBL+44 == FLAGS )
|
||||||
[ JTBL 44 + @ LITN ]
|
[ JTBL 44 + @ LITN ]
|
||||||
@ -65,6 +67,16 @@
|
|||||||
[ JTBL 46 + @ LITN ]
|
[ JTBL 46 + @ LITN ]
|
||||||
;
|
;
|
||||||
|
|
||||||
|
: HERE
|
||||||
|
( JTBL+48 == HERE )
|
||||||
|
[ JTBL 48 + @ LITN ]
|
||||||
|
;
|
||||||
|
|
||||||
|
: CURRENT
|
||||||
|
( JTBL+50 == CURRENT )
|
||||||
|
[ JTBL 50 + @ LITN ]
|
||||||
|
;
|
||||||
|
|
||||||
: QUIT
|
: QUIT
|
||||||
0 _c FLAGS _c ! _c (resRS)
|
0 _c FLAGS _c ! _c (resRS)
|
||||||
LIT< INTERPRET (find) _c DROP EXECUTE
|
LIT< INTERPRET (find) _c DROP EXECUTE
|
||||||
@ -100,8 +112,8 @@
|
|||||||
;
|
;
|
||||||
|
|
||||||
: C,
|
: C,
|
||||||
HERE _c @ _c C!
|
_c HERE _c @ _c C!
|
||||||
HERE _c @ 1 _c + HERE _c !
|
_c HERE _c @ 1 _c + _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
|
||||||
@ -136,18 +148,18 @@
|
|||||||
;
|
;
|
||||||
|
|
||||||
: (entry)
|
: (entry)
|
||||||
HERE _c @ ( h )
|
_c HERE _c @ ( h )
|
||||||
_c WORD ( h s )
|
_c WORD ( h s )
|
||||||
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' )
|
_c HERE _c @ 1 _c - ( h h' )
|
||||||
_c DUP 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 )
|
||||||
HERE _c @ CURRENT _c @ _c - ,
|
_c HERE _c @ _c CURRENT _c @ _c - ,
|
||||||
( write size )
|
( write size )
|
||||||
_c C,
|
_c C,
|
||||||
HERE _c @ CURRENT _c !
|
_c HERE _c @ _c CURRENT _c !
|
||||||
;
|
;
|
||||||
|
|
||||||
: INTERPRET
|
: INTERPRET
|
||||||
@ -177,7 +189,7 @@
|
|||||||
it to avoid bootstrapping issues )
|
it to avoid bootstrapping issues )
|
||||||
: LITN
|
: LITN
|
||||||
( JTBL+24 == NUMBER )
|
( JTBL+24 == NUMBER )
|
||||||
JTBL 24 _c + ,
|
_c JTBL 24 _c + ,
|
||||||
,
|
,
|
||||||
;
|
;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user