1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 18:10:55 +11:00

Compare commits

..

No commits in common. "408d93bd230219a71a4c1077446e772cd63d65d1" and "839021e0f8e3523b0916c8a57215f3c651ecd793" have entirely different histories.

8 changed files with 223 additions and 120 deletions

Binary file not shown.

View File

@ -1,8 +1,7 @@
: H@ HERE @ ; : H@ HERE @ ;
: -^ SWAP - ; : -^ SWAP - ;
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE : [LITN] LITN ; IMMEDIATE
: ] R> DROP ; : LIT ROUTINE S [LITN] , ;
: LIT [ JTBL 26 + LITN ] , ;
: LITS LIT SCPY ; : LITS LIT SCPY ;
: LIT< WORD LITS ; IMMEDIATE : LIT< WORD LITS ; IMMEDIATE
: _err LIT< word-not-found (print) ABORT ; : _err LIT< word-not-found (print) ABORT ;
@ -50,7 +49,7 @@
: CREATE : CREATE
(entry) ( empty header with name ) (entry) ( empty header with name )
[ JTBL 3 + LITN ] ( push cellWord addr ) ROUTINE C [LITN] ( push cellWord addr )
, ( write it ) , ( write it )
; ;
: VARIABLE CREATE 2 ALLOT ; : VARIABLE CREATE 2 ALLOT ;
@ -87,7 +86,7 @@
: (sysv) : (sysv)
(entry) (entry)
[ JTBL LITN ] , ROUTINE Y [LITN] ,
SYSVNXT @ , SYSVNXT @ ,
2 SYSVNXT +! 2 SYSVNXT +!
; ;

View File

@ -52,6 +52,10 @@ DOES> -- See description at top of file
IMMED? a -- f Checks whether wordref at a is immediate. IMMED? a -- f Checks whether wordref at a is immediate.
IMMEDIATE -- Flag the latest defined word as immediate. 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.
ROUTINE x -- a Push the addr of the specified core routine
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. VARIABLE c -- Creates cell x with 2 bytes allocation.
Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo", Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
@ -77,10 +81,6 @@ input stream is executed immediately. In this context, branching doesn't work.
atom's cell. atom's cell.
(bbr) -- Branches backward by the number specified in its (bbr) -- Branches backward by the number specified in its
atom's cell. atom's cell.
[ -- Begin interetative mode. In a definition, words
between here and "]" will be executed instead of
compiled.
] -- End interpretative mode.
ABORT -- Resets PS and RS and returns to interpreter ABORT -- Resets PS and RS and returns to interpreter
ABORT" x" -- *I* Compiles a ." followed by a ABORT. ABORT" x" -- *I* Compiles a ." followed by a ABORT.
AGAIN I:a -- *I* Jump backwards to preceeding BEGIN. AGAIN I:a -- *I* Jump backwards to preceeding BEGIN.

View File

@ -1,9 +1,7 @@
( When building a compiled dict, always include this unit at ( When building a compiled dict, always include this unit at
the end of it so that Forth knows how to hook LATEST into the end of it so that Forth knows how to hook LATEST into
it. We don't use the word "(entry)" to avoid messing up it )
with icore setup. ) (entry) _
CREATE _
H@ 2 - HERE !
( After each dummy word like this, we poke IO port 2 with our ( After each dummy word like this, we poke IO port 2 with our
current HERE value. The staging executable needs it to know current HERE value. The staging executable needs it to know

View File

@ -115,11 +115,8 @@
; 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 0x08-$ .fill 0x11-$
JUMPTBL: JUMPTBL:
jp sysvarWord
jp cellWord
jp compiledWord
jp pushRS jp pushRS
jp popRS jp popRS
jp nativeWord jp nativeWord
@ -722,10 +719,24 @@ EMIT:
.dw EXIT .dw EXIT
.fill 71 .fill 49
.db "C,"
.dw $-EMIT
.db 2
CWR:
.dw nativeWord
pop de
call chkPS
ld hl, (HERE)
ld (hl), e
inc hl
ld (HERE), hl
jp next
.db "," .db ","
.dw $-EMIT .dw $-CWR
.db 1 .db 1
WR: WR:
.dw nativeWord .dw nativeWord
@ -736,11 +747,64 @@ WR:
ld (HERE), hl ld (HERE), hl
jp next jp next
.fill 100
.db "ROUTINE"
.dw $-WR
.db 0x87 ; IMMEDIATE
ROUTINE:
.dw compiledWord
.dw WORD
.dw .private
.dw EXIT
.private:
.dw nativeWord
pop hl
call chkPS
ld a, (hl)
ld de, cellWord
cp 'C'
jr z, .end
ld de, JUMPTBL
cp 'J'
jr z, .end
ld de, JUMPTBL+6
cp 'V'
jr z, .end
ld de, JUMPTBL+9
cp 'N'
jr z, .end
ld de, sysvarWord
cp 'Y'
jr z, .end
ld de, doesWord
cp 'D'
jr z, .end
ld de, LIT
cp 'S'
jr z, .end
ld de, NUMBER
cp 'M'
jr z, .end
ld de, JUMPTBL+12
cp 'P'
jr nz, .notgood
; continue to end on match
.end:
; is our slen 1?
inc hl
ld a, (hl)
or a
jr z, .good
.notgood:
ld de, 0
.good:
push de
jp next
; ( addr -- ) ; ( addr -- )
.db "EXECUTE" .db "EXECUTE"
.dw $-WR .dw $-ROUTINE
.db 7 .db 7
; STABLE ABI ; STABLE ABI
; Offset: 0388 ; Offset: 0388
@ -758,10 +822,52 @@ EXECUTE:
jp (hl) ; go! jp (hl) ; go!
.fill 77 .fill 22
.db ":"
.dw $-EXECUTE
.db 0x81 ; IMMEDIATE
DEFINE:
.dw compiledWord
.dw ENTRYHEAD
.dw NUMBER
.dw compiledWord
.dw WR
; BBR branch mark
.dw .compile
.dw BBR
.db 4
; no need for EXIT, ENDDEF takes care of taking us out
.compile:
.dw compiledWord
.dw WORD
.dw FIND_
.dw NOT
.dw CSKIP
.dw FBR
.db 7
; Maybe number
.dw PARSEI
.dw LITN
.dw EXIT
; FBR mark
.dw DUP
.dw ISIMMED
.dw CSKIP
.dw FBR
.db 5
; is immediate. just execute.
.dw EXECUTE
.dw EXIT
; FBR mark
; just a word, write
.dw WR
.dw EXIT
.db "DOES>" .db "DOES>"
.dw $-EXECUTE .dw $-DEFINE
.db 5 .db 5
DOES: DOES:
.dw nativeWord .dw nativeWord
@ -781,11 +887,36 @@ DOES:
jp EXIT+2 jp EXIT+2
.fill 51 .db "IMMEDIATE"
.dw $-DOES
.db 9
IMMEDIATE:
.dw nativeWord
ld hl, (CURRENT)
dec hl
set FLAG_IMMED, (hl)
jp next
.db "IMMED?"
.dw $-IMMEDIATE
.db 6
ISIMMED:
.dw nativeWord
pop hl
call chkPS
dec hl
ld de, 0
bit FLAG_IMMED, (hl)
jr z, .notset
inc de
.notset:
push de
jp next
; ( n -- ) ; ( n -- )
.db "LITN" .db "LITN"
.dw $-DOES .dw $-ISIMMED
.db 4 .db 4
LITN: LITN:
.dw nativeWord .dw nativeWord
@ -973,20 +1104,60 @@ PARSED:
jp next jp next
.fill 96 .fill 41
.db "JTBL"
; Indirect parse caller. Reads PARSEPTR and calls
PARSEI:
.dw compiledWord
.dw PARSEPTR_
.dw FETCH
.dw EXECUTE
.dw EXIT
; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
; HL points to new (HERE)
.db "(entry)"
.dw $-PARSED .dw $-PARSED
.db 4 .db 7
JTBL: ENTRYHEAD:
.dw sysvarWord .dw compiledWord
.dw JUMPTBL .dw WORD
.dw .private
.dw EXIT
.private:
.dw nativeWord
pop hl
ld de, (HERE)
call strcpy
; DE point to char after null, rewind.
dec de
; B counts the null, adjust
dec b
ld a, b
ex de, hl ; HL points to new HERE
ld de, (CURRENT)
push hl ; --> lvl 1
or a ; clear carry
sbc hl, de
ex de, hl
pop hl ; <-- lvl 1
call DEinHL
; Save size
ld (hl), b
inc hl
ld (CURRENT), hl
ld (HERE), hl
jp next
; STABLE ABI (every sysvars) ; STABLE ABI (every sysvars)
; Offset: 05ca ; Offset: 05ca
.out $ .out $
.db "HERE" .db "HERE"
.dw $-JTBL .dw $-ENTRYHEAD
.db 4 .db 4
HERE_: ; Caution: conflicts with actual variable name HERE_: ; Caution: conflicts with actual variable name
.dw sysvarWord .dw sysvarWord

View File

@ -29,21 +29,13 @@
This means, of course, that any word compiling a _c word This means, of course, that any word compiling a _c word
can't be executed immediately. can't be executed immediately.
Also note that because of that "_c" mechanism, it might
take two rounds of bootstrapping before the compiled
z80c.bin file is "stabilized". That's because the 2nd time
around, the recorded offset will have changed.
) )
: _c : _c
[ ['] ROT
' ROT
6 - ( header ) 6 - ( header )
' _bend ['] _bend
- ( our offset ) - ( our offset )
LITN
]
' ( get word ) ' ( get word )
-^ ( apply offset ) -^ ( apply offset )
, ( write! ) , ( write! )
@ -81,50 +73,13 @@
AGAIN AGAIN
; ;
: C, ( ; has to be defined last because it can't be executed now )
HERE @ _c C! : X ( can't have its real name now )
HERE @ 1 + HERE !
;
: (entry)
HERE @ ( h )
WORD ( h s )
SCPY ( h )
( Adjust HERE -1 because SCPY copies the null )
HERE @ 1 _c - ( h h' )
DUP HERE ! ( h h' )
SWAP _c - ( sz )
( write prev value )
HERE @ CURRENT @ _c - ,
( write size )
_c C,
HERE @ CURRENT !
;
( : 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 ] ,
BEGIN
WORD
(find)
( is word )
IF DUP _c IMMED? IF EXECUTE ELSE , THEN
( maybe number )
ELSE (parse*) @ EXECUTE LITN THEN
AGAIN
; IMMEDIATE
: Y
['] EXIT , ['] EXIT ,
_c R> DROP ( exit COMPILE )
_c R> DROP ( exit : ) _c R> DROP ( exit : )
; IMMEDIATE ; IMMEDIATE
( Give ":" and ";" their real name ) ( Give ";" its real name )
':' ' X 4 - C! ';' CURRENT @ 4 - C!
';' ' Y 4 - C!

View File

@ -54,6 +54,7 @@
; ;
0x04 OP1r INCr, 0x04 OP1r INCr,
0x05 OP1r DECr, 0x05 OP1r DECr,
0x46 OP1r LDr(HL),
( r -- ) ( r -- )
: OP1r0 : OP1r0
@ -62,6 +63,7 @@
C@ ( r op ) C@ ( r op )
OR A, OR A,
; ;
0x70 OP1r0 LD(HL)r,
0xa0 OP1r0 ANDr, 0xa0 OP1r0 ANDr,
0xb0 OP1r0 ORr, 0xb0 OP1r0 ORr,
0xa8 OP1r0 XORr, 0xa8 OP1r0 XORr,
@ -79,7 +81,6 @@
0xc5 OP1qq PUSHqq, 0xc5 OP1qq PUSHqq,
0xc1 OP1qq POPqq, 0xc1 OP1qq POPqq,
0x03 OP1qq INCss, 0x03 OP1qq INCss,
0x0b OP1qq DECss,
0x09 OP1qq ADDHLss, 0x09 OP1qq ADDHLss,
: _1rr : _1rr
@ -207,8 +208,6 @@
; ;
0xcd OP3nn CALLnn, 0xcd OP3nn CALLnn,
0xc3 OP3nn JPnn, 0xc3 OP3nn JPnn,
0x22 OP3nn LD(nn)HL,
0x2a OP3nn LDHL(nn),
: OPJR : OPJR
CREATE C, CREATE C,
@ -223,19 +222,16 @@
0x10 OPJR DJNZe, 0x10 OPJR DJNZe,
( Specials ) ( Specials )
( JTBL+18 == next ) : JPNEXT, ROUTINE N [LITN] JPnn, ;
: JPNEXT, [ JTBL 18 + LITN ] JPnn, ;
: CODE : CODE
( same as CREATE, but with native word ) ( same as CREATE, but with ROUTINE V )
(entry) (entry)
( JTBL+15 == next ) ROUTINE V [LITN] ,
[ JTBL 15 + LITN ] ,
; ;
: ;CODE JPNEXT, ; : ;CODE JPNEXT, ;
( Routines ) ( Routines )
( JTBL+21 == next ) : chkPS, ROUTINE P [LITN] CALLnn, ;
: chkPS, [ JTBL 21 + LITN ] CALLnn, ;

View File

@ -12,6 +12,8 @@
any word from our high level Forth, as long as it doesn't any word from our high level Forth, as long as it doesn't
spit word references. spit word references.
ROUTINE stuff is fine. It's not supposed to change.
These restrictions are temporary, I'll figure something out These restrictions are temporary, I'll figure something out
so that we can end up fully bootstrap Forth from within so that we can end up fully bootstrap Forth from within
itself. itself.
@ -171,13 +173,13 @@ CODE C!
HL POPqq, HL POPqq,
DE POPqq, DE POPqq,
chkPS, chkPS,
(HL) E LDrr, E LD(HL)r,
;CODE ;CODE
CODE C@ CODE C@
HL POPqq, HL POPqq,
chkPS, chkPS,
L (HL) LDrr, L LDr(HL),
H 0 LDrn, H 0 LDrn,
HL PUSHqq, HL PUSHqq,
;CODE ;CODE
@ -218,30 +220,12 @@ CODE J
CODE >R CODE >R
HL POPqq, HL POPqq,
chkPS, chkPS,
( JTBL+9 == pushRS ) ( JUMPTBL+0 == pushRS )
JTBL 9 + CALLnn, ROUTINE J CALLnn,
;CODE ;CODE
CODE R> CODE R>
( JTBL+12 == popRS ) ( JUMPTBL+3 == popRS )
JTBL 12 + CALLnn, ROUTINE J 3 + CALLnn,
HL PUSHqq, HL PUSHqq,
;CODE ;CODE
CODE IMMEDIATE
CURRENT LDHL(nn),
HL DECss,
7 (HL) SETbr,
;CODE
CODE IMMED?
HL POPqq,
chkPS,
HL DECss,
DE 0 LDddnn,
7 (HL) BITbr,
3 JRZe, ( notset )
DE INCss,
( notset )
DE PUSHqq,
;CODE