mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:20:55 +11:00
Compare commits
12 Commits
408d93bd23
...
9fcfebd84c
Author | SHA1 | Date | |
---|---|---|---|
|
9fcfebd84c | ||
|
a17da42021 | ||
|
c1693c6256 | ||
|
8b7947bc6a | ||
|
6e3b47f4a4 | ||
|
758ec025dc | ||
|
1227ee7155 | ||
|
2db6ebc247 | ||
|
e0eaa8ba63 | ||
|
8d8e1d93da | ||
|
ab98e9bcd1 | ||
|
5471ef02a7 |
@ -2,7 +2,7 @@
|
||||
stdio port is 0
|
||||
)
|
||||
|
||||
CODE (emit)
|
||||
CODE EMIT
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
A L LDrr,
|
||||
|
Binary file not shown.
@ -11,8 +11,8 @@
|
||||
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||
: [COMPILE] ' , ; IMMEDIATE
|
||||
: BEGIN H@ ; IMMEDIATE
|
||||
: AGAIN COMPILE (bbr) H@ -^ C, ; IMMEDIATE
|
||||
: UNTIL COMPILE SKIP? COMPILE (bbr) H@ -^ C, ; IMMEDIATE
|
||||
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
|
||||
: UNTIL COMPILE SKIP? COMPILE (br) H@ - , ; IMMEDIATE
|
||||
: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
|
||||
( Hello, hello, krkrkrkr... do you hear me?
|
||||
Ah, voice at last! Some lines above need comments
|
||||
@ -23,29 +23,29 @@
|
||||
that is, only used by their immediate surrondings.
|
||||
|
||||
COMPILE: Tough one. Get addr of caller word (example above
|
||||
(bbr)) and then call LITN on it. )
|
||||
(br)) and then call LITN on it. )
|
||||
|
||||
: +! SWAP OVER @ + SWAP ! ;
|
||||
: ALLOT HERE +! ;
|
||||
|
||||
: IF ( -- a | a: br cell addr )
|
||||
COMPILE SKIP? ( if true, don't branch )
|
||||
COMPILE (fbr)
|
||||
COMPILE (br)
|
||||
H@ ( push a )
|
||||
1 ALLOT ( br cell allot )
|
||||
2 ALLOT ( br cell allot )
|
||||
; IMMEDIATE
|
||||
|
||||
: THEN ( a -- | a: br cell addr )
|
||||
DUP H@ -^ SWAP ( a-H a )
|
||||
C!
|
||||
!
|
||||
; IMMEDIATE
|
||||
|
||||
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
||||
COMPILE (fbr)
|
||||
1 ALLOT
|
||||
COMPILE (br)
|
||||
2 ALLOT
|
||||
DUP H@ -^ SWAP ( a-H a )
|
||||
C!
|
||||
H@ 1 - ( push a. -1 for allot offset )
|
||||
!
|
||||
H@ 2 - ( push a. -2 for allot offset )
|
||||
; IMMEDIATE
|
||||
|
||||
: CREATE
|
||||
@ -73,8 +73,8 @@
|
||||
the RS )
|
||||
: LOOP
|
||||
COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R
|
||||
COMPILE I' COMPILE = COMPILE SKIP? COMPILE (bbr)
|
||||
H@ -^ C,
|
||||
COMPILE I' COMPILE = COMPILE SKIP? COMPILE (br)
|
||||
H@ - ,
|
||||
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
|
||||
; IMMEDIATE
|
||||
|
||||
|
374
forth/forth.asm
374
forth/forth.asm
@ -32,17 +32,11 @@
|
||||
; *** Const ***
|
||||
; Base of the Return Stack
|
||||
.equ RS_ADDR 0xf000
|
||||
; Number of bytes we keep as a padding between HERE and the scratchpad
|
||||
.equ PADDING 0x20
|
||||
; Buffer where WORD copies its read word to.
|
||||
.equ WORD_BUFSIZE 0x20
|
||||
; Allocated space for sysvars (see comment above SYSVCNT)
|
||||
.equ SYSV_BUFSIZE 0x10
|
||||
|
||||
; Flags for the "flag field" of the word structure
|
||||
; IMMEDIATE word
|
||||
.equ FLAG_IMMED 7
|
||||
|
||||
; *** Variables ***
|
||||
.equ INITIAL_SP RAMSTART
|
||||
; wordref of the last entry of the dict.
|
||||
@ -64,10 +58,6 @@
|
||||
; interface in Forth, which we plug in during init. If "(c<)" exists in the
|
||||
; dict, CINPTR is set to it. Otherwise, we set KEY
|
||||
.equ CINPTR @+2
|
||||
; Pointer to (emit) word
|
||||
.equ EMITPTR @+2
|
||||
; Pointer to (print) word
|
||||
.equ PRINTPTR @+2
|
||||
.equ WORDBUF @+2
|
||||
; Sys Vars are variables with their value living in the system RAM segment. We
|
||||
; need this mechanisms for core Forth source needing variables. Because core
|
||||
@ -125,10 +115,13 @@ JUMPTBL:
|
||||
jp nativeWord
|
||||
jp next
|
||||
jp chkPS
|
||||
; 24
|
||||
NUMBER:
|
||||
.dw numberWord
|
||||
LIT:
|
||||
.dw litWord
|
||||
.dw INITIAL_SP
|
||||
.dw WORDBUF
|
||||
|
||||
; *** Code ***
|
||||
forthMain:
|
||||
@ -138,7 +131,7 @@ forthMain:
|
||||
; ourselves a nice 6 bytes buffer. 6 bytes because we seldom have words
|
||||
; requiring more than 3 items from the stack. Then, at each "exit" call
|
||||
; we check for stack underflow.
|
||||
push af \ push af \ push af
|
||||
ld sp, 0xfffa
|
||||
ld (INITIAL_SP), sp
|
||||
ld ix, RS_ADDR
|
||||
; LATEST is a label to the latest entry of the dict. This can be
|
||||
@ -152,14 +145,6 @@ forthMain:
|
||||
ld hl, .parseName
|
||||
call find
|
||||
ld (PARSEPTR), de
|
||||
; Set up EMITPTR
|
||||
ld hl, .emitName
|
||||
call find
|
||||
ld (EMITPTR), de
|
||||
; Set up PRINTPTR
|
||||
ld hl, .printName
|
||||
call find
|
||||
ld (PRINTPTR), de
|
||||
; Set up CINPTR
|
||||
; do we have a (c<) impl?
|
||||
ld hl, .cinName
|
||||
@ -173,30 +158,19 @@ forthMain:
|
||||
; Set up SYSVNXT
|
||||
ld hl, SYSVBUF
|
||||
ld (SYSVNXT), hl
|
||||
ld hl, BEGIN
|
||||
push hl
|
||||
ld hl, .bootName
|
||||
call find
|
||||
push de
|
||||
jp EXECUTE+2
|
||||
|
||||
.parseName:
|
||||
.db "(parse)", 0
|
||||
.cinName:
|
||||
.db "(c<)", 0
|
||||
.emitName:
|
||||
.db "(emit)", 0
|
||||
.printName:
|
||||
.db "(print)", 0
|
||||
.keyName:
|
||||
.db "KEY", 0
|
||||
|
||||
BEGIN:
|
||||
.dw compiledWord
|
||||
.dw LIT
|
||||
.db "(c<$)", 0
|
||||
.dw FIND_
|
||||
.dw NOT
|
||||
.dw CSKIP
|
||||
.dw EXECUTE
|
||||
.dw INTERPRET
|
||||
.bootName:
|
||||
.db "BOOT", 0
|
||||
|
||||
INTERPRET:
|
||||
.dw compiledWord
|
||||
@ -206,8 +180,11 @@ INTERPRET:
|
||||
.dw DROP
|
||||
.dw EXECUTE
|
||||
|
||||
.fill 13
|
||||
.fill 56
|
||||
|
||||
; STABLE ABI
|
||||
; Offset: 00cd
|
||||
.out $
|
||||
; *** Collapse OS lib copy ***
|
||||
; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
|
||||
; Forth and the concept of ASM libs will become obsolete. To facilitate this
|
||||
@ -671,61 +648,83 @@ QUIT:
|
||||
ld ix, RS_ADDR
|
||||
jp next
|
||||
|
||||
.db "ABORT"
|
||||
.dw $-QUIT
|
||||
.db 5
|
||||
ABORT:
|
||||
.dw compiledWord
|
||||
.dw .private
|
||||
.dw QUIT
|
||||
abortUnderflow:
|
||||
ld hl, .name
|
||||
call find
|
||||
push de
|
||||
jp EXECUTE+2
|
||||
.name:
|
||||
.db "(uflw)", 0
|
||||
|
||||
.private:
|
||||
.db "(br)"
|
||||
.dw $-QUIT
|
||||
.db 4
|
||||
BR:
|
||||
.dw nativeWord
|
||||
; Reinitialize PS
|
||||
ld sp, (INITIAL_SP)
|
||||
ld hl, (IP)
|
||||
ld e, (hl)
|
||||
inc hl
|
||||
ld d, (hl)
|
||||
dec hl
|
||||
add hl, de
|
||||
ld (IP), hl
|
||||
jp next
|
||||
|
||||
abortUnderflow:
|
||||
ld hl, .word
|
||||
push hl
|
||||
jp EXECUTE+2
|
||||
.word:
|
||||
.dw compiledWord
|
||||
.dw LIT
|
||||
.db "stack underfl", 0
|
||||
.dw NUMBER
|
||||
.dw PRINTPTR
|
||||
.dw FETCH
|
||||
.dw EXECUTE
|
||||
.dw ABORT
|
||||
|
||||
.db "BYE"
|
||||
.dw $-ABORT
|
||||
.db 3
|
||||
BYE:
|
||||
; Skip the compword where HL is currently pointing. If it's a regular word,
|
||||
; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
|
||||
; to after null-termination.
|
||||
.db "SKIP?"
|
||||
.dw $-BR
|
||||
.db 5
|
||||
CSKIP:
|
||||
.dw nativeWord
|
||||
halt
|
||||
pop hl
|
||||
call chkPS
|
||||
ld a, h
|
||||
or l
|
||||
jp z, next ; False, do nothing.
|
||||
ld hl, (IP)
|
||||
ld de, NUMBER
|
||||
call .HLPointsDE
|
||||
jr z, .isNum
|
||||
ld de, BR
|
||||
call .HLPointsDE
|
||||
jr z, .isNum
|
||||
ld de, LIT
|
||||
call .HLPointsDE
|
||||
jr nz, .isWord
|
||||
; We have a literal
|
||||
inc hl \ inc hl
|
||||
call strskip
|
||||
inc hl ; byte after word termination
|
||||
jr .end
|
||||
.isNum:
|
||||
; skip by 4
|
||||
inc hl
|
||||
inc hl
|
||||
; continue to isWord
|
||||
.isWord:
|
||||
; skip by 2
|
||||
inc hl \ inc hl
|
||||
.end:
|
||||
ld (IP), hl
|
||||
jp next
|
||||
|
||||
; STABLE ABI
|
||||
; Offset: 02aa
|
||||
.out $
|
||||
; ( c -- )
|
||||
.db "EMIT"
|
||||
.dw $-BYE
|
||||
.db 4
|
||||
EMIT:
|
||||
.dw compiledWord
|
||||
.dw NUMBER
|
||||
.dw EMITPTR
|
||||
.dw FETCH
|
||||
.dw EXECUTE
|
||||
.dw EXIT
|
||||
; Sets Z if (HL) == E and (HL+1) == D
|
||||
.HLPointsDE:
|
||||
ld a, (hl)
|
||||
cp e
|
||||
ret nz ; no
|
||||
inc hl
|
||||
ld a, (hl)
|
||||
dec hl
|
||||
cp d ; Z has our answer
|
||||
ret
|
||||
|
||||
|
||||
.fill 71
|
||||
.fill 45
|
||||
|
||||
.db ","
|
||||
.dw $-EMIT
|
||||
.dw $-CSKIP
|
||||
.db 1
|
||||
WR:
|
||||
.dw nativeWord
|
||||
@ -781,25 +780,10 @@ DOES:
|
||||
jp EXIT+2
|
||||
|
||||
|
||||
.fill 51
|
||||
|
||||
; ( n -- )
|
||||
.db "LITN"
|
||||
.dw $-DOES
|
||||
.db 4
|
||||
LITN:
|
||||
.dw nativeWord
|
||||
ld hl, (HERE)
|
||||
ld de, NUMBER
|
||||
call DEinHL
|
||||
pop de ; number from stack
|
||||
call chkPS
|
||||
call DEinHL
|
||||
ld (HERE), hl
|
||||
jp next
|
||||
.fill 82
|
||||
|
||||
.db "SCPY"
|
||||
.dw $-LITN
|
||||
.dw $-DOES
|
||||
.db 4
|
||||
SCPY:
|
||||
.dw nativeWord
|
||||
@ -846,27 +830,10 @@ CIN:
|
||||
.dw EXIT
|
||||
|
||||
|
||||
; ( c -- f )
|
||||
; 33 CMP 1 + NOT
|
||||
; The NOT is to normalize the negative/positive numbers to 1 or 0.
|
||||
; Hadn't we wanted to normalize, we'd have written:
|
||||
; 32 CMP 1 -
|
||||
.db "WS?"
|
||||
.dw $-CIN
|
||||
.db 3
|
||||
ISWS:
|
||||
.dw compiledWord
|
||||
.dw NUMBER
|
||||
.dw 33
|
||||
.dw CMP
|
||||
.dw NUMBER
|
||||
.dw 1
|
||||
.dw PLUS
|
||||
.dw NOT
|
||||
.dw EXIT
|
||||
.fill 24
|
||||
|
||||
.db "NOT"
|
||||
.dw $-ISWS
|
||||
.dw $-CIN
|
||||
.db 3
|
||||
NOT:
|
||||
.dw nativeWord
|
||||
@ -882,78 +849,11 @@ NOT:
|
||||
push hl
|
||||
jp next
|
||||
|
||||
; ( -- c )
|
||||
; C< DUP 32 CMP 1 - SKIP? EXIT DROP TOWORD
|
||||
.db "TOWORD"
|
||||
.dw $-NOT
|
||||
.db 6
|
||||
TOWORD:
|
||||
.dw compiledWord
|
||||
.dw CIN
|
||||
.dw DUP
|
||||
.dw ISWS
|
||||
.dw CSKIP
|
||||
.dw EXIT
|
||||
.dw DROP
|
||||
.dw TOWORD
|
||||
.dw EXIT
|
||||
|
||||
; Read word from C<, copy to WORDBUF, null-terminate, and return, make
|
||||
; HL point to WORDBUF.
|
||||
.db "WORD"
|
||||
.dw $-TOWORD
|
||||
.db 4
|
||||
; STABLE ABI
|
||||
; Offset: 04f7
|
||||
.out $
|
||||
WORD:
|
||||
.dw compiledWord
|
||||
.dw NUMBER ; ( a )
|
||||
.dw WORDBUF
|
||||
.dw TOWORD ; ( a c )
|
||||
; branch mark
|
||||
.dw OVER ; ( a c a )
|
||||
.dw STORE ; ( a )
|
||||
.dw NUMBER ; ( a 1 )
|
||||
.dw 1
|
||||
.dw PLUS ; ( a+1 )
|
||||
.dw CIN ; ( a c )
|
||||
.dw DUP ; ( a c c )
|
||||
.dw ISWS ; ( a c f )
|
||||
.dw CSKIP ; ( a c )
|
||||
.dw BBR
|
||||
.db 20 ; here - mark
|
||||
; at this point, we have ( a WS )
|
||||
.dw DROP
|
||||
.dw NUMBER
|
||||
.dw 0
|
||||
.dw SWAP ; ( 0 a )
|
||||
.dw STORE ; ()
|
||||
.dw NUMBER
|
||||
.dw WORDBUF
|
||||
.dw EXIT
|
||||
|
||||
.wcpy:
|
||||
.dw nativeWord
|
||||
ld de, WORDBUF
|
||||
push de ; we already have our result
|
||||
.loop:
|
||||
ld a, (hl)
|
||||
cp ' '+1
|
||||
jr c, .loopend
|
||||
ld (de), a
|
||||
inc hl
|
||||
inc de
|
||||
jr .loop
|
||||
.loopend:
|
||||
; null-terminate the string.
|
||||
xor a
|
||||
ld (de), a
|
||||
jp next
|
||||
|
||||
.fill 100
|
||||
|
||||
.db "(parsed)"
|
||||
.dw $-WORD
|
||||
.dw $-NOT
|
||||
.db 8
|
||||
PARSED:
|
||||
.dw nativeWord
|
||||
@ -1143,104 +1043,6 @@ CMP:
|
||||
push bc
|
||||
jp next
|
||||
|
||||
; Skip the compword where HL is currently pointing. If it's a regular word,
|
||||
; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
|
||||
; to after null-termination.
|
||||
.db "SKIP?"
|
||||
.db "_bend"
|
||||
.dw $-CMP
|
||||
.db 5
|
||||
; STABLE ABI
|
||||
; Offset: 06ee
|
||||
.out $
|
||||
CSKIP:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
call chkPS
|
||||
ld a, h
|
||||
or l
|
||||
jp z, next ; False, do nothing.
|
||||
ld hl, (IP)
|
||||
ld de, NUMBER
|
||||
call .HLPointsDE
|
||||
jr z, .isNum
|
||||
ld de, FBR
|
||||
call .HLPointsDE
|
||||
jr z, .isBranch
|
||||
ld de, BBR
|
||||
call .HLPointsDE
|
||||
jr z, .isBranch
|
||||
ld de, LIT
|
||||
call .HLPointsDE
|
||||
jr nz, .isWord
|
||||
; We have a literal
|
||||
inc hl \ inc hl
|
||||
call strskip
|
||||
inc hl ; byte after word termination
|
||||
jr .end
|
||||
.isNum:
|
||||
; skip by 4
|
||||
inc hl
|
||||
; continue to isBranch
|
||||
.isBranch:
|
||||
; skip by 3
|
||||
inc hl
|
||||
; continue to isWord
|
||||
.isWord:
|
||||
; skip by 2
|
||||
inc hl \ inc hl
|
||||
.end:
|
||||
ld (IP), hl
|
||||
jp next
|
||||
|
||||
; Sets Z if (HL) == E and (HL+1) == D
|
||||
.HLPointsDE:
|
||||
ld a, (hl)
|
||||
cp e
|
||||
ret nz ; no
|
||||
inc hl
|
||||
ld a, (hl)
|
||||
dec hl
|
||||
cp d ; Z has our answer
|
||||
ret
|
||||
|
||||
; This word's atom is followed by 1b *relative* offset (to the cell's addr) to
|
||||
; where to branch to. For example, The branching cell of "IF THEN" would
|
||||
; contain 3. Add this value to RS.
|
||||
.db "(fbr)"
|
||||
.dw $-CSKIP
|
||||
.db 5
|
||||
; STABLE ABI
|
||||
; Offset: 073e
|
||||
.out $
|
||||
FBR:
|
||||
.dw nativeWord
|
||||
push de
|
||||
ld hl, (IP)
|
||||
ld a, (hl)
|
||||
call addHL
|
||||
ld (IP), hl
|
||||
pop de
|
||||
jp next
|
||||
|
||||
.db "(bbr)"
|
||||
.dw $-FBR
|
||||
.db 5
|
||||
; STABLE ABI
|
||||
; Offset: 0757
|
||||
.out $
|
||||
BBR:
|
||||
.dw nativeWord
|
||||
ld hl, (IP)
|
||||
ld d, 0
|
||||
ld e, (hl)
|
||||
or a ; clear carry
|
||||
sbc hl, de
|
||||
ld (IP), hl
|
||||
jp next
|
||||
|
||||
; To allow dict binaries to "hook themselves up", we always end such binary
|
||||
; with a dummy, *empty* entry. Therefore, we can have a predictable place for
|
||||
; getting a prev label.
|
||||
.db "_bend"
|
||||
.dw $-BBR
|
||||
.db 5
|
||||
|
@ -49,24 +49,12 @@
|
||||
, ( write! )
|
||||
; IMMEDIATE
|
||||
|
||||
: INTERPRET
|
||||
BEGIN
|
||||
WORD
|
||||
(find)
|
||||
IF
|
||||
1 FLAGS !
|
||||
EXECUTE
|
||||
0 FLAGS !
|
||||
ELSE
|
||||
(parse*) @ EXECUTE
|
||||
THEN
|
||||
AGAIN
|
||||
;
|
||||
: ABORT _c (resSP) QUIT ;
|
||||
|
||||
( This is only the "early parser" in earlier stages. No need
|
||||
for an abort message )
|
||||
: (parse)
|
||||
(parsed) SKIP? ABORT
|
||||
(parsed) SKIP? _c ABORT
|
||||
;
|
||||
|
||||
( a -- )
|
||||
@ -76,19 +64,60 @@
|
||||
_c C@ ( a c )
|
||||
( exit if null )
|
||||
DUP NOT IF DROP DROP EXIT THEN
|
||||
EMIT ( a )
|
||||
_c EMIT ( a )
|
||||
1 + ( a+1 )
|
||||
AGAIN
|
||||
;
|
||||
|
||||
: (uflw)
|
||||
LIT< stack-underflow _c (print) _c ABORT
|
||||
;
|
||||
|
||||
: C,
|
||||
HERE @ _c C!
|
||||
HERE @ 1 + HERE !
|
||||
;
|
||||
|
||||
( The NOT is to normalize the negative/positive numbers to 1
|
||||
or 0. Hadn't we wanted to normalize, we'd have written:
|
||||
32 CMP 1 - )
|
||||
: WS? 33 CMP 1 + NOT ;
|
||||
|
||||
: TOWORD
|
||||
BEGIN
|
||||
C< DUP _c WS? NOT IF EXIT THEN DROP
|
||||
AGAIN
|
||||
;
|
||||
|
||||
( Read word from C<, copy to WORDBUF, null-terminate, and
|
||||
return, make HL point to WORDBUF. )
|
||||
: WORD
|
||||
( JTBL+30 == WORDBUF )
|
||||
[ JTBL 30 + @ LITN ] ( a )
|
||||
_c TOWORD ( a c )
|
||||
BEGIN
|
||||
( We take advantage of the fact that char MSB is
|
||||
always zero to pre-write our null-termination )
|
||||
OVER ! ( a )
|
||||
1 + ( a+1 )
|
||||
C< ( a c )
|
||||
DUP _c WS?
|
||||
UNTIL
|
||||
( a this point, PS is: a WS )
|
||||
( null-termination is already written )
|
||||
DROP DROP
|
||||
[ JTBL 30 + @ LITN ]
|
||||
;
|
||||
|
||||
: LITN
|
||||
( JTBL+24 == NUMBER )
|
||||
JTBL 24 + ,
|
||||
,
|
||||
;
|
||||
|
||||
: (entry)
|
||||
HERE @ ( h )
|
||||
WORD ( h s )
|
||||
_c WORD ( h s )
|
||||
SCPY ( h )
|
||||
( Adjust HERE -1 because SCPY copies the null )
|
||||
HERE @ 1 _c - ( h h' )
|
||||
@ -101,21 +130,41 @@
|
||||
HERE @ CURRENT !
|
||||
;
|
||||
|
||||
: INTERPRET
|
||||
BEGIN
|
||||
_c WORD
|
||||
(find)
|
||||
IF
|
||||
1 FLAGS !
|
||||
EXECUTE
|
||||
0 FLAGS !
|
||||
ELSE
|
||||
(parse*) @ EXECUTE
|
||||
THEN
|
||||
AGAIN
|
||||
;
|
||||
|
||||
: BOOT
|
||||
LIT< (c<$) (find) IF EXECUTE ELSE DROP THEN
|
||||
_c INTERPRET
|
||||
;
|
||||
|
||||
( : and ; have to be defined last because it can't be
|
||||
executed now also, they can't have their real name
|
||||
right away )
|
||||
|
||||
: X
|
||||
_c (entry)
|
||||
( JTBL+6 == compiledWord )
|
||||
[ JTBL 6 + LITN ] ,
|
||||
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
||||
issues. JTBL+24 == NUMBER JTBL+6 == compiledWord )
|
||||
[ JTBL 24 + , JTBL 6 + , ] ,
|
||||
BEGIN
|
||||
WORD
|
||||
_c WORD
|
||||
(find)
|
||||
( is word )
|
||||
IF DUP _c IMMED? IF EXECUTE ELSE , THEN
|
||||
( maybe number )
|
||||
ELSE (parse*) @ EXECUTE LITN THEN
|
||||
ELSE (parse*) @ EXECUTE _c LITN THEN
|
||||
AGAIN
|
||||
; IMMEDIATE
|
||||
|
||||
|
@ -2,8 +2,7 @@
|
||||
|
||||
( Splits word into msb/lsb, lsb being on TOS )
|
||||
: SPLITB
|
||||
DUP 0x100 /
|
||||
SWAP 0xff AND
|
||||
256 /MOD SWAP
|
||||
;
|
||||
|
||||
( To debug, change C, to .X )
|
||||
@ -33,6 +32,9 @@
|
||||
: IY+ _iy+- ;
|
||||
: IY- 0 -^ _iy+- ;
|
||||
|
||||
: <<3 8 * ;
|
||||
: <<4 16 * ;
|
||||
|
||||
( -- )
|
||||
: OP1 CREATE C, DOES> C@ A, ;
|
||||
0x76 OP1 HALT,
|
||||
@ -49,7 +51,7 @@
|
||||
DOES>
|
||||
C@ ( r op )
|
||||
SWAP ( op r )
|
||||
8 * ( op r<<3 )
|
||||
<<3 ( op r<<3 )
|
||||
OR A,
|
||||
;
|
||||
0x04 OP1r INCr,
|
||||
@ -73,7 +75,7 @@
|
||||
DOES>
|
||||
C@ ( qq op )
|
||||
SWAP ( op qq )
|
||||
16 * ( op qq<<4 )
|
||||
<<4 ( op qq<<4 )
|
||||
OR A,
|
||||
;
|
||||
0xc5 OP1qq PUSHqq,
|
||||
@ -85,7 +87,7 @@
|
||||
: _1rr
|
||||
C@ ( rd rr op )
|
||||
ROT ( rr op rd )
|
||||
8 * ( rr op rd<<3 )
|
||||
<<3 ( rr op rd<<3 )
|
||||
OR OR A,
|
||||
;
|
||||
|
||||
@ -126,7 +128,7 @@
|
||||
DOES>
|
||||
C@ ( r n op )
|
||||
ROT ( n op r )
|
||||
8 * ( n op r<<3 )
|
||||
<<3 ( n op r<<3 )
|
||||
OR A, A,
|
||||
;
|
||||
0x06 OP2rn LDrn,
|
||||
@ -138,7 +140,7 @@
|
||||
0xcb A,
|
||||
C@ ( b r op )
|
||||
ROT ( r op b )
|
||||
8 * ( r op b<<3 )
|
||||
<<3 ( r op b<<3 )
|
||||
OR OR A,
|
||||
;
|
||||
0xc0 OP2br SETbr,
|
||||
@ -166,9 +168,9 @@
|
||||
: OP2r
|
||||
CREATE ,
|
||||
DOES>
|
||||
@ 256 /MOD ( r lsb msb )
|
||||
@ SPLITB SWAP ( r lsb msb )
|
||||
A, ( r lsb )
|
||||
SWAP 8 * ( lsb r<<3 )
|
||||
SWAP <<3 ( lsb r<<3 )
|
||||
OR A,
|
||||
;
|
||||
0xed41 OP2r OUT(C)r,
|
||||
@ -180,7 +182,7 @@
|
||||
DOES>
|
||||
0xed A,
|
||||
C@ SWAP ( op ss )
|
||||
16 * ( op ss<< 4 )
|
||||
<<4 ( op ss<< 4 )
|
||||
OR A,
|
||||
;
|
||||
0x4a OP2ss ADCHLss,
|
||||
@ -192,7 +194,7 @@
|
||||
DOES>
|
||||
C@ ( dd nn op )
|
||||
ROT ( nn op dd )
|
||||
16 * ( nn op dd<<4 )
|
||||
<<4 ( nn op dd<<4 )
|
||||
OR A,
|
||||
SPLITB A, A,
|
||||
;
|
||||
@ -223,6 +225,21 @@
|
||||
0x10 OPJR DJNZe,
|
||||
|
||||
( Specials )
|
||||
|
||||
( dd nn -- )
|
||||
: LDdd(nn),
|
||||
0xed A,
|
||||
SWAP <<4 0x4b OR A,
|
||||
SPLITB A, A,
|
||||
;
|
||||
|
||||
( nn dd -- )
|
||||
: LD(nn)dd,
|
||||
0xed A,
|
||||
<<4 0x43 OR A,
|
||||
SPLITB A, A,
|
||||
;
|
||||
|
||||
( JTBL+18 == next )
|
||||
: JPNEXT, [ JTBL 18 + LITN ] JPnn, ;
|
||||
|
||||
|
@ -245,3 +245,12 @@ CODE IMMED?
|
||||
( notset )
|
||||
DE PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE BYE
|
||||
HALT,
|
||||
;CODE
|
||||
|
||||
CODE (resSP)
|
||||
( INITIAL_SP == JTBL+28 )
|
||||
SP JTBL 28 + @ LDdd(nn),
|
||||
;CODE
|
||||
|
Loading…
Reference in New Issue
Block a user