mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 18:20:55 +11:00
Compare commits
No commits in common. "839021e0f8e3523b0916c8a57215f3c651ecd793" and "cb3e6469b825d64dbb5f82363ef12565808b305c" have entirely different histories.
839021e0f8
...
cb3e6469b8
@ -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/icore.fs ../forth/dummy.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
|
cat ../forth/dummy.fs ../forth/z80c.fs forth/emul.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 J=JUMPTBL V=nativeWord N=next S=LIT
|
C=cellWord L=compiledWord 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,14 +10,6 @@
|
|||||||
; 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
|
||||||
@ -66,8 +58,6 @@
|
|||||||
.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
|
||||||
@ -115,17 +105,11 @@
|
|||||||
; 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 0x11-$
|
.fill 0x17-$
|
||||||
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:
|
||||||
@ -153,10 +137,6 @@ 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
|
||||||
@ -180,8 +160,6 @@ 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
|
||||||
|
|
||||||
@ -197,13 +175,31 @@ BEGIN:
|
|||||||
|
|
||||||
INTERPRET:
|
INTERPRET:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw LIT
|
; BBR mark
|
||||||
.db "INTERPRET", 0
|
.dw WORD
|
||||||
.dw FIND_
|
.dw FIND_
|
||||||
.dw DROP
|
.dw CSKIP
|
||||||
|
.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
|
||||||
.fill 13
|
.dw 0
|
||||||
|
.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
|
||||||
@ -629,6 +625,9 @@ 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
|
||||||
@ -640,6 +639,9 @@ 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"
|
||||||
@ -689,11 +691,8 @@ abortUnderflow:
|
|||||||
.word:
|
.word:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw LIT
|
.dw LIT
|
||||||
.db "stack underfl", 0
|
.db "stack underflow", 0
|
||||||
.dw NUMBER
|
.dw PRINT
|
||||||
.dw PRINTPTR
|
|
||||||
.dw FETCH
|
|
||||||
.dw EXECUTE
|
|
||||||
.dw ABORT
|
.dw ABORT
|
||||||
|
|
||||||
.db "BYE"
|
.db "BYE"
|
||||||
@ -703,9 +702,6 @@ BYE:
|
|||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
halt
|
halt
|
||||||
|
|
||||||
; STABLE ABI
|
|
||||||
; Offset: 02aa
|
|
||||||
.out $
|
|
||||||
; ( c -- )
|
; ( c -- )
|
||||||
.db "EMIT"
|
.db "EMIT"
|
||||||
.dw $-BYE
|
.dw $-BYE
|
||||||
@ -719,10 +715,43 @@ EMIT:
|
|||||||
.dw EXIT
|
.dw EXIT
|
||||||
|
|
||||||
|
|
||||||
.fill 49
|
.db "(print)"
|
||||||
|
.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 $-EMIT
|
.dw $-PRINT
|
||||||
.db 2
|
.db 2
|
||||||
CWR:
|
CWR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -765,13 +794,13 @@ ROUTINE:
|
|||||||
ld de, cellWord
|
ld de, cellWord
|
||||||
cp 'C'
|
cp 'C'
|
||||||
jr z, .end
|
jr z, .end
|
||||||
ld de, JUMPTBL
|
ld de, compiledWord
|
||||||
cp 'J'
|
cp 'L'
|
||||||
jr z, .end
|
jr z, .end
|
||||||
ld de, JUMPTBL+6
|
ld de, JUMPTBL
|
||||||
cp 'V'
|
cp 'V'
|
||||||
jr z, .end
|
jr z, .end
|
||||||
ld de, JUMPTBL+9
|
ld de, JUMPTBL+3
|
||||||
cp 'N'
|
cp 'N'
|
||||||
jr z, .end
|
jr z, .end
|
||||||
ld de, sysvarWord
|
ld de, sysvarWord
|
||||||
@ -786,7 +815,7 @@ ROUTINE:
|
|||||||
ld de, NUMBER
|
ld de, NUMBER
|
||||||
cp 'M'
|
cp 'M'
|
||||||
jr z, .end
|
jr z, .end
|
||||||
ld de, JUMPTBL+12
|
ld de, JUMPTBL+6
|
||||||
cp 'P'
|
cp 'P'
|
||||||
jr nz, .notgood
|
jr nz, .notgood
|
||||||
; continue to end on match
|
; continue to end on match
|
||||||
@ -806,9 +835,6 @@ 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
|
||||||
@ -822,10 +848,23 @@ EXECUTE:
|
|||||||
jp (hl) ; go!
|
jp (hl) ; go!
|
||||||
|
|
||||||
|
|
||||||
.fill 22
|
.db ";"
|
||||||
.db ":"
|
|
||||||
.dw $-EXECUTE
|
.dw $-EXECUTE
|
||||||
.db 0x81 ; IMMEDIATE
|
.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 ":"
|
||||||
|
.dw $-ENDDEF
|
||||||
|
.db 0x81 ; IMMEDIATE
|
||||||
DEFINE:
|
DEFINE:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw ENTRYHEAD
|
.dw ENTRYHEAD
|
||||||
@ -944,9 +983,6 @@ 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
|
||||||
@ -1034,9 +1070,6 @@ 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 )
|
||||||
@ -1104,7 +1137,23 @@ PARSED:
|
|||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
|
||||||
.fill 41
|
.db "(parse)"
|
||||||
|
.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
|
||||||
@ -1119,7 +1168,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 $-PARSED
|
.dw $-PARSE
|
||||||
.db 7
|
.db 7
|
||||||
ENTRYHEAD:
|
ENTRYHEAD:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
@ -1153,9 +1202,6 @@ ENTRYHEAD:
|
|||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
|
||||||
; STABLE ABI (every sysvars)
|
|
||||||
; Offset: 05ca
|
|
||||||
.out $
|
|
||||||
.db "HERE"
|
.db "HERE"
|
||||||
.dw $-ENTRYHEAD
|
.dw $-ENTRYHEAD
|
||||||
.db 4
|
.db 4
|
||||||
@ -1195,9 +1241,6 @@ 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
|
||||||
@ -1223,7 +1266,6 @@ 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
|
||||||
@ -1267,12 +1309,28 @@ 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
|
||||||
|
|
||||||
.fill 31
|
.db "R>"
|
||||||
|
.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 $-OVER
|
.dw $-R2P
|
||||||
.db 1
|
.db 1
|
||||||
PLUS:
|
PLUS:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -1283,11 +1341,23 @@ PLUS:
|
|||||||
push hl
|
push hl
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
.fill 18
|
; ( a b -- c ) A - B
|
||||||
|
.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 $-PLUS
|
.dw $-MINUS
|
||||||
.db 4
|
.db 4
|
||||||
SCMP:
|
SCMP:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -1320,9 +1390,6 @@ 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
|
||||||
@ -1380,9 +1447,6 @@ 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
|
||||||
@ -1396,9 +1460,6 @@ 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)
|
||||||
@ -1412,6 +1473,5 @@ 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 5
|
.db 0
|
||||||
|
@ -1,85 +0,0 @@
|
|||||||
( 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,15 +113,6 @@ 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,
|
||||||
@ -216,16 +207,3 @@ 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