mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 16:20:55 +11:00
Compare commits
No commits in common. "9fcfebd84c883d7b61944c2aaf8a2388200ec383" and "408d93bd230219a71a4c1077446e772cd63d65d1" have entirely different histories.
9fcfebd84c
...
408d93bd23
@ -2,7 +2,7 @@
|
|||||||
stdio port is 0
|
stdio port is 0
|
||||||
)
|
)
|
||||||
|
|
||||||
CODE EMIT
|
CODE (emit)
|
||||||
HL POPqq,
|
HL POPqq,
|
||||||
chkPS,
|
chkPS,
|
||||||
A L LDrr,
|
A L LDrr,
|
||||||
|
Binary file not shown.
@ -11,8 +11,8 @@
|
|||||||
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||||
: [COMPILE] ' , ; IMMEDIATE
|
: [COMPILE] ' , ; IMMEDIATE
|
||||||
: BEGIN H@ ; IMMEDIATE
|
: BEGIN H@ ; IMMEDIATE
|
||||||
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
|
: AGAIN COMPILE (bbr) H@ -^ C, ; IMMEDIATE
|
||||||
: UNTIL COMPILE SKIP? COMPILE (br) H@ - , ; IMMEDIATE
|
: UNTIL COMPILE SKIP? COMPILE (bbr) H@ -^ C, ; IMMEDIATE
|
||||||
: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
|
: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
|
||||||
( Hello, hello, krkrkrkr... do you hear me?
|
( Hello, hello, krkrkrkr... do you hear me?
|
||||||
Ah, voice at last! Some lines above need comments
|
Ah, voice at last! Some lines above need comments
|
||||||
@ -23,29 +23,29 @@
|
|||||||
that is, only used by their immediate surrondings.
|
that is, only used by their immediate surrondings.
|
||||||
|
|
||||||
COMPILE: Tough one. Get addr of caller word (example above
|
COMPILE: Tough one. Get addr of caller word (example above
|
||||||
(br)) and then call LITN on it. )
|
(bbr)) and then call LITN on it. )
|
||||||
|
|
||||||
: +! SWAP OVER @ + SWAP ! ;
|
: +! SWAP OVER @ + SWAP ! ;
|
||||||
: ALLOT HERE +! ;
|
: ALLOT HERE +! ;
|
||||||
|
|
||||||
: IF ( -- a | a: br cell addr )
|
: IF ( -- a | a: br cell addr )
|
||||||
COMPILE SKIP? ( if true, don't branch )
|
COMPILE SKIP? ( if true, don't branch )
|
||||||
COMPILE (br)
|
COMPILE (fbr)
|
||||||
H@ ( push a )
|
H@ ( push a )
|
||||||
2 ALLOT ( br cell allot )
|
1 ALLOT ( br cell allot )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
: THEN ( a -- | a: br cell addr )
|
: THEN ( a -- | a: br cell addr )
|
||||||
DUP H@ -^ SWAP ( a-H a )
|
DUP H@ -^ SWAP ( a-H a )
|
||||||
!
|
C!
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
||||||
COMPILE (br)
|
COMPILE (fbr)
|
||||||
2 ALLOT
|
1 ALLOT
|
||||||
DUP H@ -^ SWAP ( a-H a )
|
DUP H@ -^ SWAP ( a-H a )
|
||||||
!
|
C!
|
||||||
H@ 2 - ( push a. -2 for allot offset )
|
H@ 1 - ( push a. -1 for allot offset )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
: CREATE
|
: CREATE
|
||||||
@ -73,8 +73,8 @@
|
|||||||
the RS )
|
the RS )
|
||||||
: LOOP
|
: LOOP
|
||||||
COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R
|
COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R
|
||||||
COMPILE I' COMPILE = COMPILE SKIP? COMPILE (br)
|
COMPILE I' COMPILE = COMPILE SKIP? COMPILE (bbr)
|
||||||
H@ - ,
|
H@ -^ C,
|
||||||
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
|
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
|
376
forth/forth.asm
376
forth/forth.asm
@ -32,11 +32,17 @@
|
|||||||
; *** Const ***
|
; *** Const ***
|
||||||
; Base of the Return Stack
|
; Base of the Return Stack
|
||||||
.equ RS_ADDR 0xf000
|
.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.
|
; Buffer where WORD copies its read word to.
|
||||||
.equ WORD_BUFSIZE 0x20
|
.equ WORD_BUFSIZE 0x20
|
||||||
; Allocated space for sysvars (see comment above SYSVCNT)
|
; Allocated space for sysvars (see comment above SYSVCNT)
|
||||||
.equ SYSV_BUFSIZE 0x10
|
.equ SYSV_BUFSIZE 0x10
|
||||||
|
|
||||||
|
; Flags for the "flag field" of the word structure
|
||||||
|
; IMMEDIATE word
|
||||||
|
.equ FLAG_IMMED 7
|
||||||
|
|
||||||
; *** Variables ***
|
; *** Variables ***
|
||||||
.equ INITIAL_SP RAMSTART
|
.equ INITIAL_SP RAMSTART
|
||||||
; wordref of the last entry of the dict.
|
; wordref of the last entry of the dict.
|
||||||
@ -58,6 +64,10 @@
|
|||||||
; interface in Forth, which we plug in during init. If "(c<)" exists in the
|
; interface in Forth, which we plug in during init. If "(c<)" exists in the
|
||||||
; dict, CINPTR is set to it. Otherwise, we set KEY
|
; dict, CINPTR is set to it. Otherwise, we set KEY
|
||||||
.equ CINPTR @+2
|
.equ CINPTR @+2
|
||||||
|
; Pointer to (emit) word
|
||||||
|
.equ EMITPTR @+2
|
||||||
|
; Pointer to (print) word
|
||||||
|
.equ PRINTPTR @+2
|
||||||
.equ WORDBUF @+2
|
.equ WORDBUF @+2
|
||||||
; Sys Vars are variables with their value living in the system RAM segment. We
|
; 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
|
; need this mechanisms for core Forth source needing variables. Because core
|
||||||
@ -115,13 +125,10 @@ JUMPTBL:
|
|||||||
jp nativeWord
|
jp nativeWord
|
||||||
jp next
|
jp next
|
||||||
jp chkPS
|
jp chkPS
|
||||||
; 24
|
|
||||||
NUMBER:
|
NUMBER:
|
||||||
.dw numberWord
|
.dw numberWord
|
||||||
LIT:
|
LIT:
|
||||||
.dw litWord
|
.dw litWord
|
||||||
.dw INITIAL_SP
|
|
||||||
.dw WORDBUF
|
|
||||||
|
|
||||||
; *** Code ***
|
; *** Code ***
|
||||||
forthMain:
|
forthMain:
|
||||||
@ -131,7 +138,7 @@ forthMain:
|
|||||||
; ourselves a nice 6 bytes buffer. 6 bytes because we seldom have words
|
; 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
|
; requiring more than 3 items from the stack. Then, at each "exit" call
|
||||||
; we check for stack underflow.
|
; we check for stack underflow.
|
||||||
ld sp, 0xfffa
|
push af \ push af \ push af
|
||||||
ld (INITIAL_SP), sp
|
ld (INITIAL_SP), sp
|
||||||
ld ix, RS_ADDR
|
ld ix, RS_ADDR
|
||||||
; LATEST is a label to the latest entry of the dict. This can be
|
; LATEST is a label to the latest entry of the dict. This can be
|
||||||
@ -145,6 +152,14 @@ forthMain:
|
|||||||
ld hl, .parseName
|
ld hl, .parseName
|
||||||
call find
|
call find
|
||||||
ld (PARSEPTR), de
|
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
|
; Set up CINPTR
|
||||||
; do we have a (c<) impl?
|
; do we have a (c<) impl?
|
||||||
ld hl, .cinName
|
ld hl, .cinName
|
||||||
@ -158,19 +173,30 @@ forthMain:
|
|||||||
; Set up SYSVNXT
|
; Set up SYSVNXT
|
||||||
ld hl, SYSVBUF
|
ld hl, SYSVBUF
|
||||||
ld (SYSVNXT), hl
|
ld (SYSVNXT), hl
|
||||||
ld hl, .bootName
|
ld hl, BEGIN
|
||||||
call find
|
push hl
|
||||||
push de
|
|
||||||
jp EXECUTE+2
|
jp EXECUTE+2
|
||||||
|
|
||||||
.parseName:
|
.parseName:
|
||||||
.db "(parse)", 0
|
.db "(parse)", 0
|
||||||
.cinName:
|
.cinName:
|
||||||
.db "(c<)", 0
|
.db "(c<)", 0
|
||||||
|
.emitName:
|
||||||
|
.db "(emit)", 0
|
||||||
|
.printName:
|
||||||
|
.db "(print)", 0
|
||||||
.keyName:
|
.keyName:
|
||||||
.db "KEY", 0
|
.db "KEY", 0
|
||||||
.bootName:
|
|
||||||
.db "BOOT", 0
|
BEGIN:
|
||||||
|
.dw compiledWord
|
||||||
|
.dw LIT
|
||||||
|
.db "(c<$)", 0
|
||||||
|
.dw FIND_
|
||||||
|
.dw NOT
|
||||||
|
.dw CSKIP
|
||||||
|
.dw EXECUTE
|
||||||
|
.dw INTERPRET
|
||||||
|
|
||||||
INTERPRET:
|
INTERPRET:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
@ -180,11 +206,8 @@ INTERPRET:
|
|||||||
.dw DROP
|
.dw DROP
|
||||||
.dw EXECUTE
|
.dw EXECUTE
|
||||||
|
|
||||||
.fill 56
|
.fill 13
|
||||||
|
|
||||||
; STABLE ABI
|
|
||||||
; Offset: 00cd
|
|
||||||
.out $
|
|
||||||
; *** Collapse OS lib copy ***
|
; *** Collapse OS lib copy ***
|
||||||
; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
|
; 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
|
; Forth and the concept of ASM libs will become obsolete. To facilitate this
|
||||||
@ -648,83 +671,61 @@ QUIT:
|
|||||||
ld ix, RS_ADDR
|
ld ix, RS_ADDR
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
.db "ABORT"
|
||||||
|
.dw $-QUIT
|
||||||
|
.db 5
|
||||||
|
ABORT:
|
||||||
|
.dw compiledWord
|
||||||
|
.dw .private
|
||||||
|
.dw QUIT
|
||||||
|
|
||||||
|
.private:
|
||||||
|
.dw nativeWord
|
||||||
|
; Reinitialize PS
|
||||||
|
ld sp, (INITIAL_SP)
|
||||||
|
jp next
|
||||||
|
|
||||||
abortUnderflow:
|
abortUnderflow:
|
||||||
ld hl, .name
|
ld hl, .word
|
||||||
call find
|
push hl
|
||||||
push de
|
|
||||||
jp EXECUTE+2
|
jp EXECUTE+2
|
||||||
.name:
|
.word:
|
||||||
.db "(uflw)", 0
|
.dw compiledWord
|
||||||
|
.dw LIT
|
||||||
|
.db "stack underfl", 0
|
||||||
|
.dw NUMBER
|
||||||
|
.dw PRINTPTR
|
||||||
|
.dw FETCH
|
||||||
|
.dw EXECUTE
|
||||||
|
.dw ABORT
|
||||||
|
|
||||||
.db "(br)"
|
.db "BYE"
|
||||||
.dw $-QUIT
|
.dw $-ABORT
|
||||||
.db 4
|
.db 3
|
||||||
BR:
|
BYE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
ld hl, (IP)
|
halt
|
||||||
ld e, (hl)
|
|
||||||
inc hl
|
|
||||||
ld d, (hl)
|
|
||||||
dec hl
|
|
||||||
add hl, de
|
|
||||||
ld (IP), hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; Skip the compword where HL is currently pointing. If it's a regular word,
|
; STABLE ABI
|
||||||
; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
|
; Offset: 02aa
|
||||||
; to after null-termination.
|
.out $
|
||||||
.db "SKIP?"
|
; ( c -- )
|
||||||
.dw $-BR
|
.db "EMIT"
|
||||||
.db 5
|
.dw $-BYE
|
||||||
CSKIP:
|
.db 4
|
||||||
.dw nativeWord
|
EMIT:
|
||||||
pop hl
|
.dw compiledWord
|
||||||
call chkPS
|
.dw NUMBER
|
||||||
ld a, h
|
.dw EMITPTR
|
||||||
or l
|
.dw FETCH
|
||||||
jp z, next ; False, do nothing.
|
.dw EXECUTE
|
||||||
ld hl, (IP)
|
.dw EXIT
|
||||||
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
|
|
||||||
|
|
||||||
; 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 45
|
.fill 71
|
||||||
|
|
||||||
.db ","
|
.db ","
|
||||||
.dw $-CSKIP
|
.dw $-EMIT
|
||||||
.db 1
|
.db 1
|
||||||
WR:
|
WR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -780,10 +781,25 @@ DOES:
|
|||||||
jp EXIT+2
|
jp EXIT+2
|
||||||
|
|
||||||
|
|
||||||
.fill 82
|
.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
|
||||||
|
|
||||||
.db "SCPY"
|
.db "SCPY"
|
||||||
.dw $-DOES
|
.dw $-LITN
|
||||||
.db 4
|
.db 4
|
||||||
SCPY:
|
SCPY:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -830,10 +846,27 @@ CIN:
|
|||||||
.dw EXIT
|
.dw EXIT
|
||||||
|
|
||||||
|
|
||||||
.fill 24
|
; ( 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
|
||||||
|
|
||||||
.db "NOT"
|
.db "NOT"
|
||||||
.dw $-CIN
|
.dw $-ISWS
|
||||||
.db 3
|
.db 3
|
||||||
NOT:
|
NOT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -849,11 +882,78 @@ NOT:
|
|||||||
push hl
|
push hl
|
||||||
jp next
|
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)"
|
.db "(parsed)"
|
||||||
.dw $-NOT
|
.dw $-WORD
|
||||||
.db 8
|
.db 8
|
||||||
PARSED:
|
PARSED:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -1043,6 +1143,104 @@ CMP:
|
|||||||
push bc
|
push bc
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
.db "_bend"
|
; 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 $-CMP
|
.dw $-CMP
|
||||||
.db 5
|
.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,12 +49,24 @@
|
|||||||
, ( write! )
|
, ( write! )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
: ABORT _c (resSP) QUIT ;
|
: INTERPRET
|
||||||
|
BEGIN
|
||||||
|
WORD
|
||||||
|
(find)
|
||||||
|
IF
|
||||||
|
1 FLAGS !
|
||||||
|
EXECUTE
|
||||||
|
0 FLAGS !
|
||||||
|
ELSE
|
||||||
|
(parse*) @ EXECUTE
|
||||||
|
THEN
|
||||||
|
AGAIN
|
||||||
|
;
|
||||||
|
|
||||||
( This is only the "early parser" in earlier stages. No need
|
( This is only the "early parser" in earlier stages. No need
|
||||||
for an abort message )
|
for an abort message )
|
||||||
: (parse)
|
: (parse)
|
||||||
(parsed) SKIP? _c ABORT
|
(parsed) SKIP? ABORT
|
||||||
;
|
;
|
||||||
|
|
||||||
( a -- )
|
( a -- )
|
||||||
@ -64,60 +76,19 @@
|
|||||||
_c C@ ( a c )
|
_c C@ ( a c )
|
||||||
( exit if null )
|
( exit if null )
|
||||||
DUP NOT IF DROP DROP EXIT THEN
|
DUP NOT IF DROP DROP EXIT THEN
|
||||||
_c EMIT ( a )
|
EMIT ( a )
|
||||||
1 + ( a+1 )
|
1 + ( a+1 )
|
||||||
AGAIN
|
AGAIN
|
||||||
;
|
;
|
||||||
|
|
||||||
: (uflw)
|
|
||||||
LIT< stack-underflow _c (print) _c ABORT
|
|
||||||
;
|
|
||||||
|
|
||||||
: C,
|
: C,
|
||||||
HERE @ _c C!
|
HERE @ _c C!
|
||||||
HERE @ 1 + HERE !
|
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)
|
: (entry)
|
||||||
HERE @ ( h )
|
HERE @ ( h )
|
||||||
_c WORD ( h s )
|
WORD ( h s )
|
||||||
SCPY ( h )
|
SCPY ( h )
|
||||||
( Adjust HERE -1 because SCPY copies the null )
|
( Adjust HERE -1 because SCPY copies the null )
|
||||||
HERE @ 1 _c - ( h h' )
|
HERE @ 1 _c - ( h h' )
|
||||||
@ -130,41 +101,21 @@
|
|||||||
HERE @ CURRENT !
|
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
|
( : 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
|
||||||
_c (entry)
|
_c (entry)
|
||||||
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
( JTBL+6 == compiledWord )
|
||||||
issues. JTBL+24 == NUMBER JTBL+6 == compiledWord )
|
[ JTBL 6 + LITN ] ,
|
||||||
[ JTBL 24 + , JTBL 6 + , ] ,
|
|
||||||
BEGIN
|
BEGIN
|
||||||
_c WORD
|
WORD
|
||||||
(find)
|
(find)
|
||||||
( is word )
|
( is word )
|
||||||
IF DUP _c IMMED? IF EXECUTE ELSE , THEN
|
IF DUP _c IMMED? IF EXECUTE ELSE , THEN
|
||||||
( maybe number )
|
( maybe number )
|
||||||
ELSE (parse*) @ EXECUTE _c LITN THEN
|
ELSE (parse*) @ EXECUTE LITN THEN
|
||||||
AGAIN
|
AGAIN
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
|
@ -2,7 +2,8 @@
|
|||||||
|
|
||||||
( Splits word into msb/lsb, lsb being on TOS )
|
( Splits word into msb/lsb, lsb being on TOS )
|
||||||
: SPLITB
|
: SPLITB
|
||||||
256 /MOD SWAP
|
DUP 0x100 /
|
||||||
|
SWAP 0xff AND
|
||||||
;
|
;
|
||||||
|
|
||||||
( To debug, change C, to .X )
|
( To debug, change C, to .X )
|
||||||
@ -32,9 +33,6 @@
|
|||||||
: IY+ _iy+- ;
|
: IY+ _iy+- ;
|
||||||
: IY- 0 -^ _iy+- ;
|
: IY- 0 -^ _iy+- ;
|
||||||
|
|
||||||
: <<3 8 * ;
|
|
||||||
: <<4 16 * ;
|
|
||||||
|
|
||||||
( -- )
|
( -- )
|
||||||
: OP1 CREATE C, DOES> C@ A, ;
|
: OP1 CREATE C, DOES> C@ A, ;
|
||||||
0x76 OP1 HALT,
|
0x76 OP1 HALT,
|
||||||
@ -51,7 +49,7 @@
|
|||||||
DOES>
|
DOES>
|
||||||
C@ ( r op )
|
C@ ( r op )
|
||||||
SWAP ( op r )
|
SWAP ( op r )
|
||||||
<<3 ( op r<<3 )
|
8 * ( op r<<3 )
|
||||||
OR A,
|
OR A,
|
||||||
;
|
;
|
||||||
0x04 OP1r INCr,
|
0x04 OP1r INCr,
|
||||||
@ -75,7 +73,7 @@
|
|||||||
DOES>
|
DOES>
|
||||||
C@ ( qq op )
|
C@ ( qq op )
|
||||||
SWAP ( op qq )
|
SWAP ( op qq )
|
||||||
<<4 ( op qq<<4 )
|
16 * ( op qq<<4 )
|
||||||
OR A,
|
OR A,
|
||||||
;
|
;
|
||||||
0xc5 OP1qq PUSHqq,
|
0xc5 OP1qq PUSHqq,
|
||||||
@ -87,7 +85,7 @@
|
|||||||
: _1rr
|
: _1rr
|
||||||
C@ ( rd rr op )
|
C@ ( rd rr op )
|
||||||
ROT ( rr op rd )
|
ROT ( rr op rd )
|
||||||
<<3 ( rr op rd<<3 )
|
8 * ( rr op rd<<3 )
|
||||||
OR OR A,
|
OR OR A,
|
||||||
;
|
;
|
||||||
|
|
||||||
@ -128,7 +126,7 @@
|
|||||||
DOES>
|
DOES>
|
||||||
C@ ( r n op )
|
C@ ( r n op )
|
||||||
ROT ( n op r )
|
ROT ( n op r )
|
||||||
<<3 ( n op r<<3 )
|
8 * ( n op r<<3 )
|
||||||
OR A, A,
|
OR A, A,
|
||||||
;
|
;
|
||||||
0x06 OP2rn LDrn,
|
0x06 OP2rn LDrn,
|
||||||
@ -140,7 +138,7 @@
|
|||||||
0xcb A,
|
0xcb A,
|
||||||
C@ ( b r op )
|
C@ ( b r op )
|
||||||
ROT ( r op b )
|
ROT ( r op b )
|
||||||
<<3 ( r op b<<3 )
|
8 * ( r op b<<3 )
|
||||||
OR OR A,
|
OR OR A,
|
||||||
;
|
;
|
||||||
0xc0 OP2br SETbr,
|
0xc0 OP2br SETbr,
|
||||||
@ -168,9 +166,9 @@
|
|||||||
: OP2r
|
: OP2r
|
||||||
CREATE ,
|
CREATE ,
|
||||||
DOES>
|
DOES>
|
||||||
@ SPLITB SWAP ( r lsb msb )
|
@ 256 /MOD ( r lsb msb )
|
||||||
A, ( r lsb )
|
A, ( r lsb )
|
||||||
SWAP <<3 ( lsb r<<3 )
|
SWAP 8 * ( lsb r<<3 )
|
||||||
OR A,
|
OR A,
|
||||||
;
|
;
|
||||||
0xed41 OP2r OUT(C)r,
|
0xed41 OP2r OUT(C)r,
|
||||||
@ -182,7 +180,7 @@
|
|||||||
DOES>
|
DOES>
|
||||||
0xed A,
|
0xed A,
|
||||||
C@ SWAP ( op ss )
|
C@ SWAP ( op ss )
|
||||||
<<4 ( op ss<< 4 )
|
16 * ( op ss<< 4 )
|
||||||
OR A,
|
OR A,
|
||||||
;
|
;
|
||||||
0x4a OP2ss ADCHLss,
|
0x4a OP2ss ADCHLss,
|
||||||
@ -194,7 +192,7 @@
|
|||||||
DOES>
|
DOES>
|
||||||
C@ ( dd nn op )
|
C@ ( dd nn op )
|
||||||
ROT ( nn op dd )
|
ROT ( nn op dd )
|
||||||
<<4 ( nn op dd<<4 )
|
16 * ( nn op dd<<4 )
|
||||||
OR A,
|
OR A,
|
||||||
SPLITB A, A,
|
SPLITB A, A,
|
||||||
;
|
;
|
||||||
@ -225,21 +223,6 @@
|
|||||||
0x10 OPJR DJNZe,
|
0x10 OPJR DJNZe,
|
||||||
|
|
||||||
( Specials )
|
( 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 )
|
( JTBL+18 == next )
|
||||||
: JPNEXT, [ JTBL 18 + LITN ] JPnn, ;
|
: JPNEXT, [ JTBL 18 + LITN ] JPnn, ;
|
||||||
|
|
||||||
|
@ -245,12 +245,3 @@ CODE IMMED?
|
|||||||
( notset )
|
( notset )
|
||||||
DE PUSHqq,
|
DE PUSHqq,
|
||||||
;CODE
|
;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