mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-26 06:38:06 +11:00
forth: replace "ROUTINE" with "JTBL"
This commit is contained in:
parent
26871be6f2
commit
409a9f87e5
@ -2,7 +2,7 @@
|
|||||||
: -^ SWAP - ;
|
: -^ SWAP - ;
|
||||||
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
|
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
|
||||||
: ] R> DROP ;
|
: ] R> DROP ;
|
||||||
: LIT [ ROUTINE S LITN ] , ;
|
: LIT [ JTBL 26 + LITN ] , ;
|
||||||
: LITS LIT SCPY ;
|
: LITS LIT SCPY ;
|
||||||
: LIT< WORD LITS ; IMMEDIATE
|
: LIT< WORD LITS ; IMMEDIATE
|
||||||
: _err LIT< word-not-found (print) ABORT ;
|
: _err LIT< word-not-found (print) ABORT ;
|
||||||
@ -50,7 +50,7 @@
|
|||||||
|
|
||||||
: CREATE
|
: CREATE
|
||||||
(entry) ( empty header with name )
|
(entry) ( empty header with name )
|
||||||
[ ROUTINE C LITN ] ( push cellWord addr )
|
[ JTBL 3 + LITN ] ( push cellWord addr )
|
||||||
, ( write it )
|
, ( write it )
|
||||||
;
|
;
|
||||||
: VARIABLE CREATE 2 ALLOT ;
|
: VARIABLE CREATE 2 ALLOT ;
|
||||||
@ -87,7 +87,7 @@
|
|||||||
|
|
||||||
: (sysv)
|
: (sysv)
|
||||||
(entry)
|
(entry)
|
||||||
[ ROUTINE Y LITN ] ,
|
[ JTBL LITN ] ,
|
||||||
SYSVNXT @ ,
|
SYSVNXT @ ,
|
||||||
2 SYSVNXT +!
|
2 SYSVNXT +!
|
||||||
;
|
;
|
||||||
|
@ -52,9 +52,6 @@ DOES> -- See description at top of file
|
|||||||
IMMED? a -- f Checks whether wordref at a is immediate.
|
IMMED? a -- f Checks whether wordref at a is immediate.
|
||||||
IMMEDIATE -- Flag the latest defined word as immediate.
|
IMMEDIATE -- Flag the latest defined word as immediate.
|
||||||
LITN n -- Write number n as a literal.
|
LITN n -- Write number n as a literal.
|
||||||
ROUTINE x -- a Push the addr of the specified core routine
|
|
||||||
C=cellWord J=JUMPTBL V=nativeWord N=next S=LIT
|
|
||||||
M=NUMBER Y=sysvarWord D=doesWord
|
|
||||||
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
||||||
|
|
||||||
Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
|
Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
|
||||||
|
@ -115,8 +115,10 @@
|
|||||||
; change bootstrap binaries have to be adjusted because they rely on them.
|
; change bootstrap binaries have to be adjusted because they rely on them.
|
||||||
; We're at 0 here
|
; We're at 0 here
|
||||||
jp forthMain
|
jp forthMain
|
||||||
.fill 0x0e-$
|
.fill 0x08-$
|
||||||
JUMPTBL:
|
JUMPTBL:
|
||||||
|
jp sysvarWord
|
||||||
|
jp cellWord
|
||||||
jp compiledWord
|
jp compiledWord
|
||||||
jp pushRS
|
jp pushRS
|
||||||
jp popRS
|
jp popRS
|
||||||
@ -734,64 +736,11 @@ WR:
|
|||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
.fill 100
|
||||||
.db "ROUTINE"
|
|
||||||
.dw $-WR
|
|
||||||
.db 7
|
|
||||||
ROUTINE:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw WORD
|
|
||||||
.dw .private
|
|
||||||
.dw EXIT
|
|
||||||
|
|
||||||
.private:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
ld a, (hl)
|
|
||||||
ld de, cellWord
|
|
||||||
cp 'C'
|
|
||||||
jr z, .end
|
|
||||||
ld de, JUMPTBL
|
|
||||||
cp 'J'
|
|
||||||
jr z, .end
|
|
||||||
ld de, JUMPTBL+9
|
|
||||||
cp 'V'
|
|
||||||
jr z, .end
|
|
||||||
ld de, JUMPTBL+12
|
|
||||||
cp 'N'
|
|
||||||
jr z, .end
|
|
||||||
ld de, sysvarWord
|
|
||||||
cp 'Y'
|
|
||||||
jr z, .end
|
|
||||||
ld de, doesWord
|
|
||||||
cp 'D'
|
|
||||||
jr z, .end
|
|
||||||
ld de, LIT
|
|
||||||
cp 'S'
|
|
||||||
jr z, .end
|
|
||||||
ld de, NUMBER
|
|
||||||
cp 'M'
|
|
||||||
jr z, .end
|
|
||||||
ld de, JUMPTBL+15
|
|
||||||
cp 'P'
|
|
||||||
jr nz, .notgood
|
|
||||||
; continue to end on match
|
|
||||||
.end:
|
|
||||||
; is our slen 1?
|
|
||||||
inc hl
|
|
||||||
ld a, (hl)
|
|
||||||
or a
|
|
||||||
jr z, .good
|
|
||||||
.notgood:
|
|
||||||
ld de, 0
|
|
||||||
.good:
|
|
||||||
push de
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; ( addr -- )
|
; ( addr -- )
|
||||||
.db "EXECUTE"
|
.db "EXECUTE"
|
||||||
.dw $-ROUTINE
|
.dw $-WR
|
||||||
.db 7
|
.db 7
|
||||||
; STABLE ABI
|
; STABLE ABI
|
||||||
; Offset: 0388
|
; Offset: 0388
|
||||||
@ -1049,13 +998,20 @@ PARSED:
|
|||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
|
||||||
.fill 107
|
.fill 96
|
||||||
|
|
||||||
|
.db "JTBL"
|
||||||
|
.dw $-PARSED
|
||||||
|
.db 4
|
||||||
|
JTBL:
|
||||||
|
.dw sysvarWord
|
||||||
|
.dw JUMPTBL
|
||||||
|
|
||||||
; STABLE ABI (every sysvars)
|
; STABLE ABI (every sysvars)
|
||||||
; Offset: 05ca
|
; Offset: 05ca
|
||||||
.out $
|
.out $
|
||||||
.db "HERE"
|
.db "HERE"
|
||||||
.dw $-PARSED
|
.dw $-JTBL
|
||||||
.db 4
|
.db 4
|
||||||
HERE_: ; Caution: conflicts with actual variable name
|
HERE_: ; Caution: conflicts with actual variable name
|
||||||
.dw sysvarWord
|
.dw sysvarWord
|
||||||
|
@ -107,8 +107,8 @@
|
|||||||
|
|
||||||
: X
|
: X
|
||||||
_c (entry)
|
_c (entry)
|
||||||
( JUMPTBL+0 == compiledWord )
|
( JTBL+6 == compiledWord )
|
||||||
[ ROUTINE J LITN ] ,
|
[ JTBL 6 + LITN ] ,
|
||||||
BEGIN
|
BEGIN
|
||||||
WORD
|
WORD
|
||||||
(find)
|
(find)
|
||||||
|
@ -222,16 +222,19 @@
|
|||||||
0x10 OPJR DJNZe,
|
0x10 OPJR DJNZe,
|
||||||
|
|
||||||
( Specials )
|
( Specials )
|
||||||
: JPNEXT, [ ROUTINE N LITN ] JPnn, ;
|
( JTBL+18 == next )
|
||||||
|
: JPNEXT, [ JTBL 18 + LITN ] JPnn, ;
|
||||||
|
|
||||||
: CODE
|
: CODE
|
||||||
( same as CREATE, but with ROUTINE V )
|
( same as CREATE, but with native word )
|
||||||
(entry)
|
(entry)
|
||||||
[ ROUTINE V LITN ] ,
|
( JTBL+15 == next )
|
||||||
|
[ JTBL 15 + LITN ] ,
|
||||||
;
|
;
|
||||||
|
|
||||||
: ;CODE JPNEXT, ;
|
: ;CODE JPNEXT, ;
|
||||||
|
|
||||||
|
|
||||||
( Routines )
|
( Routines )
|
||||||
: chkPS, [ ROUTINE P LITN ] CALLnn, ;
|
( JTBL+21 == next )
|
||||||
|
: chkPS, [ JTBL 21 + LITN ] CALLnn, ;
|
||||||
|
@ -12,8 +12,6 @@
|
|||||||
any word from our high level Forth, as long as it doesn't
|
any word from our high level Forth, as long as it doesn't
|
||||||
spit word references.
|
spit word references.
|
||||||
|
|
||||||
ROUTINE stuff is fine. It's not supposed to change.
|
|
||||||
|
|
||||||
These restrictions are temporary, I'll figure something out
|
These restrictions are temporary, I'll figure something out
|
||||||
so that we can end up fully bootstrap Forth from within
|
so that we can end up fully bootstrap Forth from within
|
||||||
itself.
|
itself.
|
||||||
@ -220,12 +218,12 @@ CODE J
|
|||||||
CODE >R
|
CODE >R
|
||||||
HL POPqq,
|
HL POPqq,
|
||||||
chkPS,
|
chkPS,
|
||||||
( JUMPTBL+3 == pushRS )
|
( JTBL+9 == pushRS )
|
||||||
ROUTINE J 3 + CALLnn,
|
JTBL 9 + CALLnn,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
CODE R>
|
CODE R>
|
||||||
( JUMPTBL+6 == popRS )
|
( JTBL+12 == popRS )
|
||||||
ROUTINE J 6 + CALLnn,
|
JTBL 12 + CALLnn,
|
||||||
HL PUSHqq,
|
HL PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
Loading…
Reference in New Issue
Block a user