Browse Source

forth: Forth-ify "HERE", "CURRENT" and "JTBL"

pull/95/head
Virgil Dupras 4 years ago
parent
commit
61195a987d
3 changed files with 25 additions and 37 deletions
  1. BIN
      emul/forth/z80c.bin
  2. +5
    -29
      forth/forth.asm
  3. +20
    -8
      forth/icore.fs

BIN
emul/forth/z80c.bin View File


+ 5
- 29
forth/forth.asm View File

@@ -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 $

+ 20
- 8
forth/icore.fs View File

@@ -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…
Cancel
Save