mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:30:55 +11:00
Compare commits
11 Commits
839021e0f8
...
408d93bd23
Author | SHA1 | Date | |
---|---|---|---|
|
408d93bd23 | ||
|
8f990ff954 | ||
|
41cd8086d4 | ||
|
409a9f87e5 | ||
|
26871be6f2 | ||
|
29dcddb8cd | ||
|
49101915fb | ||
|
799ea72974 | ||
|
7967c654e0 | ||
|
f40c14715e | ||
|
684cb028ff |
Binary file not shown.
@ -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 +!
|
||||
;
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
209
forth/forth.asm
209
forth/forth.asm
@ -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
|
||||
|
@ -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!
|
||||
|
||||
|
@ -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, ;
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user