mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:20:55 +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.
|
||||
.PHONY: fbootstrap
|
||||
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
|
||||
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 -- *I* Immediate version of LITN.
|
||||
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
|
||||
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
|
||||
; 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 ***
|
||||
; GETC: address of a GetC routine
|
||||
; PUTC: address of a PutC routine
|
||||
@ -58,6 +66,8 @@
|
||||
.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
|
||||
@ -105,11 +115,17 @@
|
||||
; change bootstrap binaries have to be adjusted because they rely on them.
|
||||
; We're at 0 here
|
||||
jp forthMain
|
||||
.fill 0x17-$
|
||||
.fill 0x11-$
|
||||
JUMPTBL:
|
||||
jp pushRS
|
||||
jp popRS
|
||||
jp nativeWord
|
||||
jp next
|
||||
jp chkPS
|
||||
NUMBER:
|
||||
.dw numberWord
|
||||
LIT:
|
||||
.dw litWord
|
||||
|
||||
; *** Code ***
|
||||
forthMain:
|
||||
@ -137,6 +153,10 @@ forthMain:
|
||||
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
|
||||
@ -160,6 +180,8 @@ forthMain:
|
||||
.db "(c<)", 0
|
||||
.emitName:
|
||||
.db "(emit)", 0
|
||||
.printName:
|
||||
.db "(print)", 0
|
||||
.keyName:
|
||||
.db "KEY", 0
|
||||
|
||||
@ -175,31 +197,13 @@ BEGIN:
|
||||
|
||||
INTERPRET:
|
||||
.dw compiledWord
|
||||
; BBR mark
|
||||
.dw WORD
|
||||
.dw LIT
|
||||
.db "INTERPRET", 0
|
||||
.dw FIND_
|
||||
.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 DROP
|
||||
.dw EXECUTE
|
||||
.dw NUMBER ; Bit 0 off
|
||||
.dw 0
|
||||
.dw FLAGS_
|
||||
.dw STORE
|
||||
.dw BBR
|
||||
.db 29
|
||||
; FBR mark, try number
|
||||
.dw PARSEI
|
||||
.dw BBR
|
||||
.db 34
|
||||
; infinite loop
|
||||
|
||||
.fill 13
|
||||
|
||||
; *** Collapse OS lib copy ***
|
||||
; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
|
||||
@ -625,9 +629,6 @@ numberWord:
|
||||
push de
|
||||
jp next
|
||||
|
||||
NUMBER:
|
||||
.dw numberWord
|
||||
|
||||
; 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
|
||||
; null-terminated string. When called, puts the string's address on PS
|
||||
@ -639,9 +640,6 @@ litWord:
|
||||
ld (IP), hl
|
||||
jp next
|
||||
|
||||
LIT:
|
||||
.dw litWord
|
||||
|
||||
; Pop previous IP from Return stack and execute it.
|
||||
; ( R:I -- )
|
||||
.db "EXIT"
|
||||
@ -691,8 +689,11 @@ abortUnderflow:
|
||||
.word:
|
||||
.dw compiledWord
|
||||
.dw LIT
|
||||
.db "stack underflow", 0
|
||||
.dw PRINT
|
||||
.db "stack underfl", 0
|
||||
.dw NUMBER
|
||||
.dw PRINTPTR
|
||||
.dw FETCH
|
||||
.dw EXECUTE
|
||||
.dw ABORT
|
||||
|
||||
.db "BYE"
|
||||
@ -702,6 +703,9 @@ BYE:
|
||||
.dw nativeWord
|
||||
halt
|
||||
|
||||
; STABLE ABI
|
||||
; Offset: 02aa
|
||||
.out $
|
||||
; ( c -- )
|
||||
.db "EMIT"
|
||||
.dw $-BYE
|
||||
@ -715,43 +719,10 @@ EMIT:
|
||||
.dw EXIT
|
||||
|
||||
|
||||
.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
|
||||
|
||||
.fill 49
|
||||
|
||||
.db "C,"
|
||||
.dw $-PRINT
|
||||
.dw $-EMIT
|
||||
.db 2
|
||||
CWR:
|
||||
.dw nativeWord
|
||||
@ -794,13 +765,13 @@ ROUTINE:
|
||||
ld de, cellWord
|
||||
cp 'C'
|
||||
jr z, .end
|
||||
ld de, compiledWord
|
||||
cp 'L'
|
||||
jr z, .end
|
||||
ld de, JUMPTBL
|
||||
cp 'J'
|
||||
jr z, .end
|
||||
ld de, JUMPTBL+6
|
||||
cp 'V'
|
||||
jr z, .end
|
||||
ld de, JUMPTBL+3
|
||||
ld de, JUMPTBL+9
|
||||
cp 'N'
|
||||
jr z, .end
|
||||
ld de, sysvarWord
|
||||
@ -815,7 +786,7 @@ ROUTINE:
|
||||
ld de, NUMBER
|
||||
cp 'M'
|
||||
jr z, .end
|
||||
ld de, JUMPTBL+6
|
||||
ld de, JUMPTBL+12
|
||||
cp 'P'
|
||||
jr nz, .notgood
|
||||
; continue to end on match
|
||||
@ -835,6 +806,9 @@ ROUTINE:
|
||||
.db "EXECUTE"
|
||||
.dw $-ROUTINE
|
||||
.db 7
|
||||
; STABLE ABI
|
||||
; Offset: 0388
|
||||
.out $
|
||||
EXECUTE:
|
||||
.dw nativeWord
|
||||
pop iy ; is a wordref
|
||||
@ -848,22 +822,9 @@ EXECUTE:
|
||||
jp (hl) ; go!
|
||||
|
||||
|
||||
.db ";"
|
||||
.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
|
||||
|
||||
.fill 22
|
||||
.db ":"
|
||||
.dw $-ENDDEF
|
||||
.dw $-EXECUTE
|
||||
.db 0x81 ; IMMEDIATE
|
||||
DEFINE:
|
||||
.dw compiledWord
|
||||
@ -983,6 +944,9 @@ SCPY:
|
||||
.db "(find)"
|
||||
.dw $-SCPY
|
||||
.db 6
|
||||
; STABLE ABI
|
||||
; Offset: 047c
|
||||
.out $
|
||||
FIND_:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -1070,6 +1034,9 @@ TOWORD:
|
||||
.db "WORD"
|
||||
.dw $-TOWORD
|
||||
.db 4
|
||||
; STABLE ABI
|
||||
; Offset: 04f7
|
||||
.out $
|
||||
WORD:
|
||||
.dw compiledWord
|
||||
.dw NUMBER ; ( a )
|
||||
@ -1137,23 +1104,7 @@ PARSED:
|
||||
jp next
|
||||
|
||||
|
||||
.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
|
||||
.fill 41
|
||||
|
||||
|
||||
; Indirect parse caller. Reads PARSEPTR and calls
|
||||
@ -1168,7 +1119,7 @@ PARSEI:
|
||||
; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
|
||||
; HL points to new (HERE)
|
||||
.db "(entry)"
|
||||
.dw $-PARSE
|
||||
.dw $-PARSED
|
||||
.db 7
|
||||
ENTRYHEAD:
|
||||
.dw compiledWord
|
||||
@ -1202,6 +1153,9 @@ ENTRYHEAD:
|
||||
jp next
|
||||
|
||||
|
||||
; STABLE ABI (every sysvars)
|
||||
; Offset: 05ca
|
||||
.out $
|
||||
.db "HERE"
|
||||
.dw $-ENTRYHEAD
|
||||
.db 4
|
||||
@ -1241,6 +1195,9 @@ SYSVNXT_:
|
||||
.db "!"
|
||||
.dw $-SYSVNXT_
|
||||
.db 1
|
||||
; STABLE ABI
|
||||
; Offset: 0610
|
||||
.out $
|
||||
STORE:
|
||||
.dw nativeWord
|
||||
pop iy
|
||||
@ -1266,6 +1223,7 @@ FETCH:
|
||||
.db "DROP"
|
||||
.dw $-FETCH
|
||||
.db 4
|
||||
; STABLE ABI
|
||||
DROP:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -1309,28 +1267,12 @@ OVER:
|
||||
push de
|
||||
jp next
|
||||
|
||||
.db ">R"
|
||||
.dw $-OVER
|
||||
.db 2
|
||||
P2R:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
call chkPS
|
||||
call pushRS
|
||||
jp next
|
||||
|
||||
.db "R>"
|
||||
.dw $-P2R
|
||||
.db 2
|
||||
R2P:
|
||||
.dw nativeWord
|
||||
call popRS
|
||||
push hl
|
||||
jp next
|
||||
.fill 31
|
||||
|
||||
; ( a b -- c ) A + B
|
||||
.db "+"
|
||||
.dw $-R2P
|
||||
.dw $-OVER
|
||||
.db 1
|
||||
PLUS:
|
||||
.dw nativeWord
|
||||
@ -1341,23 +1283,11 @@ PLUS:
|
||||
push hl
|
||||
jp next
|
||||
|
||||
; ( 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
|
||||
.fill 18
|
||||
|
||||
; ( a1 a2 -- b )
|
||||
.db "SCMP"
|
||||
.dw $-MINUS
|
||||
.dw $-PLUS
|
||||
.db 4
|
||||
SCMP:
|
||||
.dw nativeWord
|
||||
@ -1390,6 +1320,9 @@ CMP:
|
||||
.db "SKIP?"
|
||||
.dw $-CMP
|
||||
.db 5
|
||||
; STABLE ABI
|
||||
; Offset: 06ee
|
||||
.out $
|
||||
CSKIP:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -1447,6 +1380,9 @@ CSKIP:
|
||||
.db "(fbr)"
|
||||
.dw $-CSKIP
|
||||
.db 5
|
||||
; STABLE ABI
|
||||
; Offset: 073e
|
||||
.out $
|
||||
FBR:
|
||||
.dw nativeWord
|
||||
push de
|
||||
@ -1460,6 +1396,9 @@ FBR:
|
||||
.db "(bbr)"
|
||||
.dw $-FBR
|
||||
.db 5
|
||||
; STABLE ABI
|
||||
; Offset: 0757
|
||||
.out $
|
||||
BBR:
|
||||
.dw nativeWord
|
||||
ld hl, (IP)
|
||||
@ -1473,5 +1412,6 @@ BBR:
|
||||
; 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 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,
|
||||
;CODE
|
||||
|
||||
CODE -
|
||||
DE POPqq,
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
A ORr,
|
||||
DE SBCHLss,
|
||||
HL PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE *
|
||||
DE POPqq,
|
||||
BC POPqq,
|
||||
@ -207,3 +216,16 @@ CODE J
|
||||
H 3 IX- LDrIXY,
|
||||
HL PUSHqq,
|
||||
;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