forth: Forth-ify "(entry)"
This commit is contained in:
parent
799ea72974
commit
49101915fb
Binary file not shown.
@ -1063,50 +1063,13 @@ PARSED:
|
|||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
|
||||||
.fill 51
|
.fill 107
|
||||||
|
|
||||||
; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
|
|
||||||
; HL points to new (HERE)
|
|
||||||
.db "(entry)"
|
|
||||||
.dw $-PARSED
|
|
||||||
.db 7
|
|
||||||
ENTRYHEAD:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw WORD
|
|
||||||
.dw .private
|
|
||||||
.dw EXIT
|
|
||||||
|
|
||||||
.private:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
ld de, (HERE)
|
|
||||||
call strcpy
|
|
||||||
; DE point to char after null, rewind.
|
|
||||||
dec de
|
|
||||||
; B counts the null, adjust
|
|
||||||
dec b
|
|
||||||
ld a, b
|
|
||||||
ex de, hl ; HL points to new HERE
|
|
||||||
ld de, (CURRENT)
|
|
||||||
push hl ; --> lvl 1
|
|
||||||
or a ; clear carry
|
|
||||||
sbc hl, de
|
|
||||||
ex de, hl
|
|
||||||
pop hl ; <-- lvl 1
|
|
||||||
call DEinHL
|
|
||||||
; Save size
|
|
||||||
ld (hl), b
|
|
||||||
inc hl
|
|
||||||
ld (CURRENT), hl
|
|
||||||
ld (HERE), hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
|
|
||||||
; STABLE ABI (every sysvars)
|
; STABLE ABI (every sysvars)
|
||||||
; Offset: 05ca
|
; Offset: 05ca
|
||||||
.out $
|
.out $
|
||||||
.db "HERE"
|
.db "HERE"
|
||||||
.dw $-ENTRYHEAD
|
.dw $-PARSED
|
||||||
.db 4
|
.db 4
|
||||||
HERE_: ; Caution: conflicts with actual variable name
|
HERE_: ; Caution: conflicts with actual variable name
|
||||||
.dw sysvarWord
|
.dw sysvarWord
|
||||||
|
@ -81,12 +81,27 @@
|
|||||||
AGAIN
|
AGAIN
|
||||||
;
|
;
|
||||||
|
|
||||||
|
: (entry)
|
||||||
|
HERE @ ( h )
|
||||||
|
WORD ( h s )
|
||||||
|
SCPY ( h )
|
||||||
|
( Adjust HERE -1 because SCPY copies the null )
|
||||||
|
HERE @ 1 _c - ( h h' )
|
||||||
|
DUP HERE ! ( h h' )
|
||||||
|
SWAP _c - ( sz )
|
||||||
|
( write prev value )
|
||||||
|
HERE @ CURRENT @ _c - ,
|
||||||
|
( write size )
|
||||||
|
C,
|
||||||
|
HERE @ CURRENT !
|
||||||
|
;
|
||||||
|
|
||||||
( : and ; have to be defined last because it can't be
|
( : and ; have to be defined last because it can't be
|
||||||
executed now also, they can't have their real name
|
executed now also, they can't have their real name
|
||||||
right away )
|
right away )
|
||||||
|
|
||||||
: X
|
: X
|
||||||
(entry)
|
_c (entry)
|
||||||
( JUMPTBL+0 == compiledWord )
|
( JUMPTBL+0 == compiledWord )
|
||||||
[ ROUTINE J LITN ] ,
|
[ ROUTINE J LITN ] ,
|
||||||
BEGIN
|
BEGIN
|
||||||
|
Loading…
Reference in New Issue
Block a user