mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 14:20:56 +11:00
Compare commits
6 Commits
cb3e6469b8
...
839021e0f8
Author | SHA1 | Date | |
---|---|---|---|
|
839021e0f8 | ||
|
edcd80e3a6 | ||
|
941224be94 | ||
|
005dd98fc2 | ||
|
1e7e696e4a | ||
|
dad0081123 |
@ -103,7 +103,7 @@ updatebootstrap: $(ZASMBIN)
|
|||||||
# words and they write to HERE at initialization.
|
# words and they write to HERE at initialization.
|
||||||
.PHONY: fbootstrap
|
.PHONY: fbootstrap
|
||||||
fbootstrap: forth/stage2
|
fbootstrap: forth/stage2
|
||||||
cat ../forth/dummy.fs ../forth/z80c.fs forth/emul.fs ../forth/dummy.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
|
cat ../forth/dummy.fs ../forth/z80c.fs forth/emul.fs ../forth/icore.fs ../forth/dummy.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
|
||||||
|
|
||||||
.PHONY: clean
|
.PHONY: clean
|
||||||
clean:
|
clean:
|
||||||
|
Binary file not shown.
@ -54,7 +54,7 @@ IMMEDIATE -- Flag the latest defined word as immediate.
|
|||||||
LITN n -- Write number n as a literal.
|
LITN n -- Write number n as a literal.
|
||||||
[LITN] n -- *I* Immediate version of LITN.
|
[LITN] n -- *I* Immediate version of LITN.
|
||||||
ROUTINE x -- a Push the addr of the specified core routine
|
ROUTINE x -- a Push the addr of the specified core routine
|
||||||
C=cellWord L=compiledWord V=nativeWord N=next S=LIT
|
C=cellWord J=JUMPTBL V=nativeWord N=next S=LIT
|
||||||
M=NUMBER Y=sysvarWord D=doesWord
|
M=NUMBER Y=sysvarWord D=doesWord
|
||||||
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
||||||
|
|
||||||
|
216
forth/forth.asm
216
forth/forth.asm
@ -10,6 +10,14 @@
|
|||||||
; self-hosts in a more compact manner. File include is a big part of the
|
; self-hosts in a more compact manner. File include is a big part of the
|
||||||
; complexity in zasm. If we can get rid of it, we'll be more compact.
|
; complexity in zasm. If we can get rid of it, we'll be more compact.
|
||||||
|
|
||||||
|
; *** ABI STABILITY ***
|
||||||
|
;
|
||||||
|
; This unit needs to have some of its entry points stay at a stable offset.
|
||||||
|
; These have a comment over them indicating the expected offset. These should
|
||||||
|
; not move until the Grand Bootstrapping operation has been completed.
|
||||||
|
;
|
||||||
|
; When you see random ".fill" here and there, it's to ensure that stability.
|
||||||
|
|
||||||
; *** Defines ***
|
; *** Defines ***
|
||||||
; GETC: address of a GetC routine
|
; GETC: address of a GetC routine
|
||||||
; PUTC: address of a PutC routine
|
; PUTC: address of a PutC routine
|
||||||
@ -58,6 +66,8 @@
|
|||||||
.equ CINPTR @+2
|
.equ CINPTR @+2
|
||||||
; Pointer to (emit) word
|
; Pointer to (emit) word
|
||||||
.equ EMITPTR @+2
|
.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
|
||||||
@ -105,11 +115,17 @@
|
|||||||
; 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 0x17-$
|
.fill 0x11-$
|
||||||
JUMPTBL:
|
JUMPTBL:
|
||||||
|
jp pushRS
|
||||||
|
jp popRS
|
||||||
jp nativeWord
|
jp nativeWord
|
||||||
jp next
|
jp next
|
||||||
jp chkPS
|
jp chkPS
|
||||||
|
NUMBER:
|
||||||
|
.dw numberWord
|
||||||
|
LIT:
|
||||||
|
.dw litWord
|
||||||
|
|
||||||
; *** Code ***
|
; *** Code ***
|
||||||
forthMain:
|
forthMain:
|
||||||
@ -137,6 +153,10 @@ forthMain:
|
|||||||
ld hl, .emitName
|
ld hl, .emitName
|
||||||
call find
|
call find
|
||||||
ld (EMITPTR), de
|
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
|
||||||
@ -160,6 +180,8 @@ forthMain:
|
|||||||
.db "(c<)", 0
|
.db "(c<)", 0
|
||||||
.emitName:
|
.emitName:
|
||||||
.db "(emit)", 0
|
.db "(emit)", 0
|
||||||
|
.printName:
|
||||||
|
.db "(print)", 0
|
||||||
.keyName:
|
.keyName:
|
||||||
.db "KEY", 0
|
.db "KEY", 0
|
||||||
|
|
||||||
@ -175,31 +197,13 @@ BEGIN:
|
|||||||
|
|
||||||
INTERPRET:
|
INTERPRET:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
; BBR mark
|
.dw LIT
|
||||||
.dw WORD
|
.db "INTERPRET", 0
|
||||||
.dw FIND_
|
.dw FIND_
|
||||||
.dw CSKIP
|
.dw DROP
|
||||||
.dw FBR
|
|
||||||
.db 22
|
|
||||||
; It's a word, execute it
|
|
||||||
; For now, we only have one flag, let's take advantage of
|
|
||||||
; this to keep code simple.
|
|
||||||
.dw NUMBER ; Bit 0 on
|
|
||||||
.dw 1
|
|
||||||
.dw FLAGS_
|
|
||||||
.dw STORE
|
|
||||||
.dw EXECUTE
|
.dw EXECUTE
|
||||||
.dw NUMBER ; Bit 0 off
|
|
||||||
.dw 0
|
.fill 13
|
||||||
.dw FLAGS_
|
|
||||||
.dw STORE
|
|
||||||
.dw BBR
|
|
||||||
.db 29
|
|
||||||
; FBR mark, try number
|
|
||||||
.dw PARSEI
|
|
||||||
.dw BBR
|
|
||||||
.db 34
|
|
||||||
; infinite loop
|
|
||||||
|
|
||||||
; *** 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
|
||||||
@ -625,9 +629,6 @@ numberWord:
|
|||||||
push de
|
push de
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
NUMBER:
|
|
||||||
.dw numberWord
|
|
||||||
|
|
||||||
; Similarly to numberWord, this is not a real word, but a string literal.
|
; Similarly to numberWord, this is not a real word, but a string literal.
|
||||||
; Instead of being followed by a 2 bytes number, it's followed by a
|
; Instead of being followed by a 2 bytes number, it's followed by a
|
||||||
; null-terminated string. When called, puts the string's address on PS
|
; null-terminated string. When called, puts the string's address on PS
|
||||||
@ -639,9 +640,6 @@ litWord:
|
|||||||
ld (IP), hl
|
ld (IP), hl
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
LIT:
|
|
||||||
.dw litWord
|
|
||||||
|
|
||||||
; Pop previous IP from Return stack and execute it.
|
; Pop previous IP from Return stack and execute it.
|
||||||
; ( R:I -- )
|
; ( R:I -- )
|
||||||
.db "EXIT"
|
.db "EXIT"
|
||||||
@ -691,8 +689,11 @@ abortUnderflow:
|
|||||||
.word:
|
.word:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw LIT
|
.dw LIT
|
||||||
.db "stack underflow", 0
|
.db "stack underfl", 0
|
||||||
.dw PRINT
|
.dw NUMBER
|
||||||
|
.dw PRINTPTR
|
||||||
|
.dw FETCH
|
||||||
|
.dw EXECUTE
|
||||||
.dw ABORT
|
.dw ABORT
|
||||||
|
|
||||||
.db "BYE"
|
.db "BYE"
|
||||||
@ -702,6 +703,9 @@ BYE:
|
|||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
halt
|
halt
|
||||||
|
|
||||||
|
; STABLE ABI
|
||||||
|
; Offset: 02aa
|
||||||
|
.out $
|
||||||
; ( c -- )
|
; ( c -- )
|
||||||
.db "EMIT"
|
.db "EMIT"
|
||||||
.dw $-BYE
|
.dw $-BYE
|
||||||
@ -715,43 +719,10 @@ EMIT:
|
|||||||
.dw EXIT
|
.dw EXIT
|
||||||
|
|
||||||
|
|
||||||
.db "(print)"
|
.fill 49
|
||||||
.dw $-EMIT
|
|
||||||
.db 7
|
|
||||||
PRINT:
|
|
||||||
.dw compiledWord ; a
|
|
||||||
; BBR mark
|
|
||||||
.dw DUP ; a a
|
|
||||||
.dw .getc ; a c
|
|
||||||
.dw DUP ; a c f
|
|
||||||
.dw CSKIP ; a c
|
|
||||||
; zero, end of string
|
|
||||||
.dw FBR
|
|
||||||
.db 12
|
|
||||||
.dw EMIT ; a
|
|
||||||
.dw NUMBER ; a 1
|
|
||||||
.dw 1
|
|
||||||
.dw PLUS ; a+1
|
|
||||||
.dw BBR
|
|
||||||
.db 21
|
|
||||||
; FBR mark
|
|
||||||
.dw DROP
|
|
||||||
.dw DROP
|
|
||||||
.dw EXIT
|
|
||||||
|
|
||||||
; Yes, very much like C@, but it has already been Forth-ified...
|
|
||||||
.getc:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
ld l, (hl)
|
|
||||||
ld h, 0
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
|
|
||||||
.db "C,"
|
.db "C,"
|
||||||
.dw $-PRINT
|
.dw $-EMIT
|
||||||
.db 2
|
.db 2
|
||||||
CWR:
|
CWR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -794,13 +765,13 @@ ROUTINE:
|
|||||||
ld de, cellWord
|
ld de, cellWord
|
||||||
cp 'C'
|
cp 'C'
|
||||||
jr z, .end
|
jr z, .end
|
||||||
ld de, compiledWord
|
|
||||||
cp 'L'
|
|
||||||
jr z, .end
|
|
||||||
ld de, JUMPTBL
|
ld de, JUMPTBL
|
||||||
|
cp 'J'
|
||||||
|
jr z, .end
|
||||||
|
ld de, JUMPTBL+6
|
||||||
cp 'V'
|
cp 'V'
|
||||||
jr z, .end
|
jr z, .end
|
||||||
ld de, JUMPTBL+3
|
ld de, JUMPTBL+9
|
||||||
cp 'N'
|
cp 'N'
|
||||||
jr z, .end
|
jr z, .end
|
||||||
ld de, sysvarWord
|
ld de, sysvarWord
|
||||||
@ -815,7 +786,7 @@ ROUTINE:
|
|||||||
ld de, NUMBER
|
ld de, NUMBER
|
||||||
cp 'M'
|
cp 'M'
|
||||||
jr z, .end
|
jr z, .end
|
||||||
ld de, JUMPTBL+6
|
ld de, JUMPTBL+12
|
||||||
cp 'P'
|
cp 'P'
|
||||||
jr nz, .notgood
|
jr nz, .notgood
|
||||||
; continue to end on match
|
; continue to end on match
|
||||||
@ -835,6 +806,9 @@ ROUTINE:
|
|||||||
.db "EXECUTE"
|
.db "EXECUTE"
|
||||||
.dw $-ROUTINE
|
.dw $-ROUTINE
|
||||||
.db 7
|
.db 7
|
||||||
|
; STABLE ABI
|
||||||
|
; Offset: 0388
|
||||||
|
.out $
|
||||||
EXECUTE:
|
EXECUTE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop iy ; is a wordref
|
pop iy ; is a wordref
|
||||||
@ -848,22 +822,9 @@ EXECUTE:
|
|||||||
jp (hl) ; go!
|
jp (hl) ; go!
|
||||||
|
|
||||||
|
|
||||||
.db ";"
|
.fill 22
|
||||||
.dw $-EXECUTE
|
|
||||||
.db 0x81 ; IMMEDIATE
|
|
||||||
ENDDEF:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw NUMBER
|
|
||||||
.dw EXIT
|
|
||||||
.dw WR
|
|
||||||
.dw R2P ; exit COMPILE
|
|
||||||
.dw DROP
|
|
||||||
.dw R2P ; exit DEFINE
|
|
||||||
.dw DROP
|
|
||||||
.dw EXIT
|
|
||||||
|
|
||||||
.db ":"
|
.db ":"
|
||||||
.dw $-ENDDEF
|
.dw $-EXECUTE
|
||||||
.db 0x81 ; IMMEDIATE
|
.db 0x81 ; IMMEDIATE
|
||||||
DEFINE:
|
DEFINE:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
@ -983,6 +944,9 @@ SCPY:
|
|||||||
.db "(find)"
|
.db "(find)"
|
||||||
.dw $-SCPY
|
.dw $-SCPY
|
||||||
.db 6
|
.db 6
|
||||||
|
; STABLE ABI
|
||||||
|
; Offset: 047c
|
||||||
|
.out $
|
||||||
FIND_:
|
FIND_:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
@ -1070,6 +1034,9 @@ TOWORD:
|
|||||||
.db "WORD"
|
.db "WORD"
|
||||||
.dw $-TOWORD
|
.dw $-TOWORD
|
||||||
.db 4
|
.db 4
|
||||||
|
; STABLE ABI
|
||||||
|
; Offset: 04f7
|
||||||
|
.out $
|
||||||
WORD:
|
WORD:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw NUMBER ; ( a )
|
.dw NUMBER ; ( a )
|
||||||
@ -1137,23 +1104,7 @@ PARSED:
|
|||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
|
||||||
.db "(parse)"
|
.fill 41
|
||||||
.dw $-PARSED
|
|
||||||
.db 7
|
|
||||||
PARSE:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw PARSED
|
|
||||||
.dw CSKIP
|
|
||||||
.dw .error
|
|
||||||
; success, stack is already good, we can exit
|
|
||||||
.dw EXIT
|
|
||||||
|
|
||||||
.error:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw LIT
|
|
||||||
.db "unknown word", 0
|
|
||||||
.dw PRINT
|
|
||||||
.dw ABORT
|
|
||||||
|
|
||||||
|
|
||||||
; Indirect parse caller. Reads PARSEPTR and calls
|
; Indirect parse caller. Reads PARSEPTR and calls
|
||||||
@ -1168,7 +1119,7 @@ PARSEI:
|
|||||||
; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
|
; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
|
||||||
; HL points to new (HERE)
|
; HL points to new (HERE)
|
||||||
.db "(entry)"
|
.db "(entry)"
|
||||||
.dw $-PARSE
|
.dw $-PARSED
|
||||||
.db 7
|
.db 7
|
||||||
ENTRYHEAD:
|
ENTRYHEAD:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
@ -1202,6 +1153,9 @@ ENTRYHEAD:
|
|||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
|
||||||
|
; STABLE ABI (every sysvars)
|
||||||
|
; Offset: 05ca
|
||||||
|
.out $
|
||||||
.db "HERE"
|
.db "HERE"
|
||||||
.dw $-ENTRYHEAD
|
.dw $-ENTRYHEAD
|
||||||
.db 4
|
.db 4
|
||||||
@ -1241,6 +1195,9 @@ SYSVNXT_:
|
|||||||
.db "!"
|
.db "!"
|
||||||
.dw $-SYSVNXT_
|
.dw $-SYSVNXT_
|
||||||
.db 1
|
.db 1
|
||||||
|
; STABLE ABI
|
||||||
|
; Offset: 0610
|
||||||
|
.out $
|
||||||
STORE:
|
STORE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop iy
|
pop iy
|
||||||
@ -1266,6 +1223,7 @@ FETCH:
|
|||||||
.db "DROP"
|
.db "DROP"
|
||||||
.dw $-FETCH
|
.dw $-FETCH
|
||||||
.db 4
|
.db 4
|
||||||
|
; STABLE ABI
|
||||||
DROP:
|
DROP:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
@ -1309,28 +1267,12 @@ OVER:
|
|||||||
push de
|
push de
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
.db ">R"
|
|
||||||
.dw $-OVER
|
|
||||||
.db 2
|
|
||||||
P2R:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
call pushRS
|
|
||||||
jp next
|
|
||||||
|
|
||||||
.db "R>"
|
.fill 31
|
||||||
.dw $-P2R
|
|
||||||
.db 2
|
|
||||||
R2P:
|
|
||||||
.dw nativeWord
|
|
||||||
call popRS
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; ( a b -- c ) A + B
|
; ( a b -- c ) A + B
|
||||||
.db "+"
|
.db "+"
|
||||||
.dw $-R2P
|
.dw $-OVER
|
||||||
.db 1
|
.db 1
|
||||||
PLUS:
|
PLUS:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -1341,23 +1283,11 @@ PLUS:
|
|||||||
push hl
|
push hl
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; ( a b -- c ) A - B
|
.fill 18
|
||||||
.db "-"
|
|
||||||
.dw $-PLUS
|
|
||||||
.db 1
|
|
||||||
MINUS:
|
|
||||||
.dw nativeWord
|
|
||||||
pop de ; B
|
|
||||||
pop hl ; A
|
|
||||||
call chkPS
|
|
||||||
or a ; reset carry
|
|
||||||
sbc hl, de
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; ( a1 a2 -- b )
|
; ( a1 a2 -- b )
|
||||||
.db "SCMP"
|
.db "SCMP"
|
||||||
.dw $-MINUS
|
.dw $-PLUS
|
||||||
.db 4
|
.db 4
|
||||||
SCMP:
|
SCMP:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -1390,6 +1320,9 @@ CMP:
|
|||||||
.db "SKIP?"
|
.db "SKIP?"
|
||||||
.dw $-CMP
|
.dw $-CMP
|
||||||
.db 5
|
.db 5
|
||||||
|
; STABLE ABI
|
||||||
|
; Offset: 06ee
|
||||||
|
.out $
|
||||||
CSKIP:
|
CSKIP:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
@ -1447,6 +1380,9 @@ CSKIP:
|
|||||||
.db "(fbr)"
|
.db "(fbr)"
|
||||||
.dw $-CSKIP
|
.dw $-CSKIP
|
||||||
.db 5
|
.db 5
|
||||||
|
; STABLE ABI
|
||||||
|
; Offset: 073e
|
||||||
|
.out $
|
||||||
FBR:
|
FBR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
push de
|
push de
|
||||||
@ -1460,6 +1396,9 @@ FBR:
|
|||||||
.db "(bbr)"
|
.db "(bbr)"
|
||||||
.dw $-FBR
|
.dw $-FBR
|
||||||
.db 5
|
.db 5
|
||||||
|
; STABLE ABI
|
||||||
|
; Offset: 0757
|
||||||
|
.out $
|
||||||
BBR:
|
BBR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
ld hl, (IP)
|
ld hl, (IP)
|
||||||
@ -1473,5 +1412,6 @@ BBR:
|
|||||||
; To allow dict binaries to "hook themselves up", we always end such binary
|
; 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
|
; with a dummy, *empty* entry. Therefore, we can have a predictable place for
|
||||||
; getting a prev label.
|
; getting a prev label.
|
||||||
|
.db "_bend"
|
||||||
.dw $-BBR
|
.dw $-BBR
|
||||||
.db 0
|
.db 5
|
||||||
|
85
forth/icore.fs
Normal file
85
forth/icore.fs
Normal file
@ -0,0 +1,85 @@
|
|||||||
|
( Inner core. This unit represents core definitions that
|
||||||
|
happen right after native definitions. Before core.fs.
|
||||||
|
|
||||||
|
Unlike core.fs and its followers, this unit isn't self-
|
||||||
|
sustained. Like native defs it uses the machinery of a
|
||||||
|
full Forth interpreter, notably for flow structures.
|
||||||
|
|
||||||
|
Because of that, it has to obey specific rules:
|
||||||
|
|
||||||
|
1. It cannot compile a word from higher layers. Using
|
||||||
|
immediates is fine though.
|
||||||
|
2. If it references a word from this unit or from native
|
||||||
|
definitions, these need to be properly offsetted
|
||||||
|
because their offset at compile time are not the same
|
||||||
|
as their runtime offsets.
|
||||||
|
3. Anything they refer to in the boot binary has to be
|
||||||
|
properly stabilized.
|
||||||
|
4. Make sure that the words you compile are not overridden
|
||||||
|
by the full interpreter.
|
||||||
|
)
|
||||||
|
|
||||||
|
( When referencing words from native defs or this very unit,
|
||||||
|
use this compiling word, which subtract the proper offset
|
||||||
|
from the compiled word. That proper offset is:
|
||||||
|
1. Take ROT-header addr, the first native def.
|
||||||
|
2. Subtract _bend, boot's last word.
|
||||||
|
3. That will give us the offset to subtract to get the addr
|
||||||
|
of our word at runtime.
|
||||||
|
|
||||||
|
This means, of course, that any word compiling a _c word
|
||||||
|
can't be executed immediately.
|
||||||
|
)
|
||||||
|
|
||||||
|
: _c
|
||||||
|
['] ROT
|
||||||
|
6 - ( header )
|
||||||
|
['] _bend
|
||||||
|
- ( our offset )
|
||||||
|
' ( get word )
|
||||||
|
-^ ( apply offset )
|
||||||
|
, ( write! )
|
||||||
|
; IMMEDIATE
|
||||||
|
|
||||||
|
: 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
|
||||||
|
for an abort message )
|
||||||
|
: (parse)
|
||||||
|
(parsed) SKIP? ABORT
|
||||||
|
;
|
||||||
|
|
||||||
|
( a -- )
|
||||||
|
: (print)
|
||||||
|
BEGIN
|
||||||
|
DUP ( a a )
|
||||||
|
_c C@ ( a c )
|
||||||
|
( exit if null )
|
||||||
|
DUP NOT IF DROP DROP EXIT THEN
|
||||||
|
EMIT ( a )
|
||||||
|
1 + ( a+1 )
|
||||||
|
AGAIN
|
||||||
|
;
|
||||||
|
|
||||||
|
( ; has to be defined last because it can't be executed now )
|
||||||
|
: X ( can't have its real name now )
|
||||||
|
['] EXIT ,
|
||||||
|
_c R> DROP ( exit COMPILE )
|
||||||
|
_c R> DROP ( exit : )
|
||||||
|
; IMMEDIATE
|
||||||
|
|
||||||
|
( Give ";" its real name )
|
||||||
|
';' CURRENT @ 4 - C!
|
||||||
|
|
@ -113,6 +113,15 @@ CODE XOR
|
|||||||
HL PUSHqq,
|
HL PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
CODE -
|
||||||
|
DE POPqq,
|
||||||
|
HL POPqq,
|
||||||
|
chkPS,
|
||||||
|
A ORr,
|
||||||
|
DE SBCHLss,
|
||||||
|
HL PUSHqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
CODE *
|
CODE *
|
||||||
DE POPqq,
|
DE POPqq,
|
||||||
BC POPqq,
|
BC POPqq,
|
||||||
@ -207,3 +216,16 @@ CODE J
|
|||||||
H 3 IX- LDrIXY,
|
H 3 IX- LDrIXY,
|
||||||
HL PUSHqq,
|
HL PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
CODE >R
|
||||||
|
HL POPqq,
|
||||||
|
chkPS,
|
||||||
|
( JUMPTBL+0 == pushRS )
|
||||||
|
ROUTINE J CALLnn,
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
CODE R>
|
||||||
|
( JUMPTBL+3 == popRS )
|
||||||
|
ROUTINE J 3 + CALLnn,
|
||||||
|
HL PUSHqq,
|
||||||
|
;CODE
|
||||||
|
Loading…
Reference in New Issue
Block a user