1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-26 07:18:05 +11:00

Compare commits

...

11 Commits

Author SHA1 Message Date
Virgil Dupras
408d93bd23 forth: Forth-ify "IMMED?" 2020-03-27 21:58:24 -04:00
Virgil Dupras
8f990ff954 forth: Forth-ify "IMMEDIATE" 2020-03-27 21:36:05 -04:00
Virgil Dupras
41cd8086d4 forth: don't use "(entry)" in dummy.fs
Because icore.fs defines it in a "not-for-runtime" manner, dummy.fs
executing it had ill effects. We use a workaround instead.
2020-03-27 21:15:16 -04:00
Virgil Dupras
409a9f87e5 forth: replace "ROUTINE" with "JTBL" 2020-03-27 19:53:28 -04:00
Virgil Dupras
26871be6f2 forth: Forth-ify "C," 2020-03-27 19:12:46 -04:00
Virgil Dupras
29dcddb8cd forth: improve assembler a bit 2020-03-27 18:38:42 -04:00
Virgil Dupras
49101915fb forth: Forth-ify "(entry)" 2020-03-27 16:52:42 -04:00
Virgil Dupras
799ea72974 forth: Forth-ify ":"!!!
Lifting ourselves by the bootstraps!
2020-03-27 16:21:34 -04:00
Virgil Dupras
7967c654e0 forth: Un-IMMEDIATE "ROUTINE"
It's not needed anymore
2020-03-27 15:51:28 -04:00
Virgil Dupras
f40c14715e forth: take advantage of the new [] mode 2020-03-27 15:35:58 -04:00
Virgil Dupras
684cb028ff forth: add words "[" and "]" 2020-03-27 15:25:20 -04:00
8 changed files with 120 additions and 223 deletions

Binary file not shown.

View File

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

View File

@ -52,10 +52,6 @@ DOES> -- See description at top of file
IMMED? a -- f Checks whether wordref at a is immediate.
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 J=JUMPTBL V=nativeWord N=next S=LIT
M=NUMBER Y=sysvarWord D=doesWord
VARIABLE c -- Creates cell x with 2 bytes allocation.
Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
@ -81,6 +77,10 @@ input stream is executed immediately. In this context, branching doesn't work.
atom's cell.
(bbr) -- Branches backward by the number specified in its
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" x" -- *I* Compiles a ." followed by a ABORT.
AGAIN I:a -- *I* Jump backwards to preceeding BEGIN.

View File

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

View File

@ -115,8 +115,11 @@
; change bootstrap binaries have to be adjusted because they rely on them.
; We're at 0 here
jp forthMain
.fill 0x11-$
.fill 0x08-$
JUMPTBL:
jp sysvarWord
jp cellWord
jp compiledWord
jp pushRS
jp popRS
jp nativeWord
@ -719,24 +722,10 @@ EMIT:
.dw EXIT
.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
.fill 71
.db ","
.dw $-CWR
.dw $-EMIT
.db 1
WR:
.dw nativeWord
@ -747,64 +736,11 @@ WR:
ld (HERE), hl
jp next
.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
.fill 100
; ( addr -- )
.db "EXECUTE"
.dw $-ROUTINE
.dw $-WR
.db 7
; STABLE ABI
; Offset: 0388
@ -822,52 +758,10 @@ EXECUTE:
jp (hl) ; go!
.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
.fill 77
.db "DOES>"
.dw $-DEFINE
.dw $-EXECUTE
.db 5
DOES:
.dw nativeWord
@ -887,36 +781,11 @@ DOES:
jp EXIT+2
.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
.fill 51
; ( n -- )
.db "LITN"
.dw $-ISIMMED
.dw $-DOES
.db 4
LITN:
.dw nativeWord
@ -1104,60 +973,20 @@ PARSED:
jp next
.fill 41
.fill 96
; 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)"
.db "JTBL"
.dw $-PARSED
.db 7
ENTRYHEAD:
.dw compiledWord
.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
.db 4
JTBL:
.dw sysvarWord
.dw JUMPTBL
; STABLE ABI (every sysvars)
; Offset: 05ca
.out $
.db "HERE"
.dw $-ENTRYHEAD
.dw $-JTBL
.db 4
HERE_: ; Caution: conflicts with actual variable name
.dw sysvarWord

View File

@ -29,13 +29,21 @@
This means, of course, that any word compiling a _c word
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
['] ROT
[
' ROT
6 - ( header )
['] _bend
' _bend
- ( our offset )
LITN
]
' ( get word )
-^ ( apply offset )
, ( write! )
@ -73,13 +81,50 @@
AGAIN
;
( ; has to be defined last because it can't be executed now )
: X ( can't have its real name now )
: C,
HERE @ _c C!
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 ,
_c R> DROP ( exit COMPILE )
_c R> DROP ( exit : )
; IMMEDIATE
( Give ";" its real name )
';' CURRENT @ 4 - C!
( Give ":" and ";" their real name )
':' ' X 4 - C!
';' ' Y 4 - C!

View File

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

View File

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