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

Compare commits

..

No commits in common. "54929c2aa0d84db7d29a5c504fdfc14d0c203225" and "05c38424c7639cd245699804c9de57cf2dd1c761" have entirely different histories.

15 changed files with 239 additions and 235 deletions

View File

@ -38,8 +38,6 @@ CREATE x -- Create cell named x. Doesn't allocate a PF.
words are *not* executed.
COMPILE x -- Meta compiles. Kind of blows the mind. See below.
CONSTANT x n -- Creates cell x that when called pushes its value
DELW a -- Delete wordref at a. If it shadows another
definition, that definition is unshadowed.
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.
@ -91,6 +89,8 @@ I' -- n Copy RS second item to PS
J -- n Copy RS third item to PS
*** Memory ***
(mmap*) -- a Address of active memory mapper. 0 for none. See
"Memory maps" in notes.txt.
@ a -- n Set n to value at address a
! n a -- Store n in address a
? a -- Print value of addr a
@ -98,8 +98,6 @@ J -- n Copy RS third item to PS
C@ a -- c Set c to byte at address a
C! c a -- Store byte c in address a
CURRENT -- a Set a to wordref of last added entry.
CURRENT* -- a A pointer to active CURRENT*. Useful when we have
multiple active dicts.
HERE -- a Push HERE's address
H@ -- a HERE @
MOVE a1 a2 u -- Copy u bytes from a1 to a2, starting with a1, going

View File

@ -63,7 +63,7 @@ emul.o: emul.c
.PHONY: updatebootstrap
updatebootstrap: forth/stage2
cat ./forth/conf.fs ../forth/boot.fs | ./forth/stage2 | tee forth/boot.bin > /dev/null
cat ./forth/conf.fs ../forth/xcomp.fs ./forth/xcomp.fs ../forth/z80c.fs ../forth/icore.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
cat ./forth/conf.fs ../forth/z80c.fs ../forth/icore.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
.PHONY: clean
clean:

View File

@ -41,9 +41,6 @@ static void mem_write(int unused, uint16_t addr, uint8_t val)
{
if (addr < m.ramstart) {
fprintf(stderr, "Writing to ROM (%d)!\n", addr);
emul_memdump();
fprintf(stderr, "Press any key to continue...\n");
while (getchar() > 0x100);
}
m.mem[addr] = val;
}
@ -105,14 +102,6 @@ void emul_trace(ushort addr)
}
}
void emul_memdump()
{
fprintf(stderr, "Dumping memory to memdump. PC %04x\n", m.cpu.PC);
FILE *fp = fopen("memdump", "w");
fwrite(m.mem, 0x10000, 1, fp);
fclose(fp);
}
void emul_printdebug()
{
fprintf(stderr, "Min SP: %04x\n", m.minsp);

View File

@ -31,5 +31,4 @@ bool emul_step();
bool emul_steps(unsigned int steps);
void emul_loop();
void emul_trace(ushort addr);
void emul_memdump();
void emul_printdebug();

Binary file not shown.

View File

@ -1,11 +0,0 @@
: CODE XCODE ;
: IMMEDIATE XIMM ;
: : [ ' X: , ] ;
CURRENT @ XCURRENT !
H@ ' _bend - 4 + XOFF !
( dummy entry for dict hook )
(xentry) _
H@ 256 /MOD 2 PC! 2 PC!

Binary file not shown.

View File

@ -102,7 +102,10 @@ int main(int argc, char *argv[])
char c;
if (read(fileno(stdin), &c, 1) == 1) {
if (c == 5) {
emul_memdump();
fprintf(stderr, "Dumping memory to memdump\n");
FILE *fp = fopen("memdump", "w");
fwrite(m->mem, 0x10000, 1, fp);
fclose(fp);
c = 0; // don't send to RC2014
}
if (c == 4) { // CTRL+D

View File

@ -123,16 +123,14 @@ PC ORG @ 1 + ! ( main )
0x08 LDHL(nn),
RAMSTART 0x02 + LD(nn)HL, ( RAM+02 == CURRENT )
RAMSTART 0x04 + LD(nn)HL, ( RAM+04 == HERE )
EXDEHL,
HL L1 @ LDddnn,
0x03 CALLnn, ( 03 == find )
DE PUSHqq,
L2 @ 2 + JPnn,
PC ORG @ 4 + ! ( find )
( Find the entry corresponding to word name where (HL) points
to in dictionary having its tip at DE and sets DE to point
to that entry. Z if found, NZ if not.
( Find the entry corresponding to word where (HL) points to
and sets DE to point to that entry. Z if found, NZ if not.
)
BC PUSHqq,
@ -156,6 +154,7 @@ PC ORG @ 4 + ! ( find )
adjust. Because the compare loop pre-decrements, instead
of DECing HL twice, we DEC it once. )
HL DECss,
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
L3 BSET ( inner )
( DE is a wordref, first step, do our len correspond? )
HL PUSHqq, ( --> lvl 1 )
@ -242,7 +241,6 @@ PC ORG @ 0x15 + ! ( popRS )
'(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, 0 A,
L1 BSET ( abortUnderflow )
HL PC 7 - LDddnn,
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
0x03 CALLnn, ( find )
DE PUSHqq,
L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
@ -368,7 +366,7 @@ PC ORG @ 0x22 + ! ( litWord )
JPNEXT,
( filler )
NOP, NOP, NOP, NOP, NOP,
NOP, NOP, NOP, NOP, NOP, NOP,
( DICT HOOK )
( This dummy dictionary entry serves two purposes:

View File

@ -1,8 +1,5 @@
: H@ HERE @ ;
: IMMEDIATE
CURRENT @ 1 -
DUP C@ 128 OR SWAP C!
;
: -^ SWAP - ;
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
: ] R> DROP ;
: LIT 34 , ;
@ -32,7 +29,6 @@
(br)) and then call LITN on it. )
: +! SWAP OVER @ + SWAP ! ;
: -^ SWAP - ;
: ALLOT HERE +! ;
: IF ( -- a | a: br cell addr )
@ -132,7 +128,3 @@
LOOP
2DROP
;
: DELW
1 - 0 SWAP C!
;

View File

@ -19,101 +19,145 @@
by the full interpreter.
5. When using words as immediates, make sure that they're
not defined in icore or, if they are, make sure that
they are *not* offsetted
they contain no "_c" references.
Those rules are mostly met by the "xcomp" unit, which is
expected to have been loaded prior to icore and redefines
":" and other defining words. So, in other words, when
compiling icore, ":" doesn't means what you think it means,
go look in xcomp.
All these rules make this unit a bit messy, but this is the
price to pay for the awesomeness of self-bootstrapping.
)
( 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.
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
6 - ( header )
' _bend
- ( our offset )
LITN
]
' ( get word )
-^ ( apply offset )
, ( write! )
;
( We can't use IMMEDIATE because the one we've just compiled
in z80c target's the *target*'s RAM addr, not the host's.
manually set namelen field. )
0x82 CURRENT @ 1 - C!
: RAM+
[ RAMSTART LITN ] +
[ RAMSTART LITN ] _c +
;
: FLAGS 0x08 RAM+ ;
: (parse*) 0x0a RAM+ ;
: HERE 0x04 RAM+ ;
: CURRENT* 0x51 RAM+ ;
: CURRENT CURRENT* @ ;
: FLAGS 0x08 _c RAM+ ;
: (parse*) 0x0a _c RAM+ ;
: HERE 0x04 _c RAM+ ;
: CURRENT 0x02 _c RAM+ ;
: (mmap*) 0x51 _c RAM+ ;
( w -- a f )
: (find) CURRENT @ SWAP _find ;
( The goal here is to be as fast as possible *when there is
no mmap*, which is the most frequent situation. That is why
we don't DUP and we rather refetch. That is also why we
use direct literal instead of RAM+ or (mmap*). )
: (mmap)
[ RAMSTART 0x51 + LITN ] _c _@
IF
[ RAMSTART 0x51 + LITN ] _c _@ EXECUTE
THEN
;
: @ _c (mmap) _c _@ ;
: C@ _c (mmap) _c _C@ ;
: ! _c (mmap) _c _! ;
: C! _c (mmap) _c _C! ;
: QUIT
0 FLAGS ! (resRS)
LIT< INTERPRET (find) DROP EXECUTE
0 _c FLAGS _c ! _c (resRS)
LIT< INTERPRET _c (find) _c DROP EXECUTE
;
: ABORT (resSP) QUIT ;
: ABORT _c (resSP) _c QUIT ;
: = CMP NOT ;
: < CMP -1 = ;
: > CMP 1 = ;
: = _c CMP _c NOT ;
: < _c CMP -1 _c = ;
: > _c CMP 1 _c = ;
: (parsed) ( a -- n f )
( read first char outside of the loop. it *has* to be
nonzero. )
DUP C@ ( a c )
DUP NOT IF EXIT THEN ( a 0 )
_c DUP _c C@ ( a c )
_c DUP _c NOT IF EXIT THEN ( a 0 )
( special case: do we have a negative? )
DUP '-' = IF
_c DUP '-' _c = IF
( Oh, a negative, let's recurse and reverse )
DROP 1 + ( a+1 )
(parsed) ( n f )
SWAP 0 SWAP ( f 0 n )
- SWAP EXIT ( 0-n f )
_c DROP 1 _c + ( a+1 )
_c (parsed) ( n f )
_c SWAP 0 _c SWAP ( f 0 n )
_c - _c SWAP EXIT ( 0-n f )
THEN
( running result, staring at zero )
0 SWAP ( a r c )
0 _c SWAP ( a r c )
( Loop over chars )
BEGIN
( parse char )
'0' -
'0' _c -
( if bad, return "a 0" )
DUP 0 < IF 2DROP 0 EXIT THEN ( bad )
DUP 9 > IF 2DROP 0 EXIT THEN ( bad )
_c DUP 0 _c < IF _c 2DROP 0 EXIT THEN ( bad )
_c DUP 9 _c > IF _c 2DROP 0 EXIT THEN ( bad )
( good, add to running result )
SWAP 10 * + ( a r*10+n )
SWAP 1 + SWAP ( a+1 r )
_c SWAP 10 _c * _c + ( a r*10+n )
_c SWAP 1 _c + _c SWAP ( a+1 r )
( read next char )
OVER C@
DUP NOT UNTIL
_c OVER _c C@
_c DUP _c NOT UNTIL
( we're done and it's a success. We have "a r c", we want
"r 1". )
DROP SWAP DROP 1
_c DROP _c SWAP _c DROP 1
;
( This is only the "early parser" in earlier stages. No need
for an abort message )
: (parse)
(parsed) NOT IF ABORT THEN
_c (parsed) _c NOT IF _c ABORT THEN
;
: C<
( 0c == CINPTR )
0x0c RAM+ @ EXECUTE
0x0c _c RAM+ _c @ EXECUTE
;
: ,
HERE @ !
HERE @ 2 + HERE !
_c HERE _c @ _c !
_c HERE _c @ 2 _c + _c HERE _c !
;
: C,
HERE @ C!
HERE @ 1 + HERE !
_c HERE _c @ _c C!
_c HERE _c @ 1 _c + _c HERE _c !
;
( The NOT is to normalize the negative/positive numbers to 1
or 0. Hadn't we wanted to normalize, we'd have written:
32 CMP 1 - )
: WS? 33 CMP 1 + NOT ;
: WS? 33 _c CMP 1 _c + _c NOT ;
: TOWORD
BEGIN
C< DUP WS? NOT IF EXIT THEN DROP
_c C< _c DUP _c WS? _c NOT IF EXIT THEN _c DROP
AGAIN
;
@ -121,56 +165,47 @@
return, make HL point to WORDBUF. )
: WORD
( 0e == WORDBUF )
0x0e RAM+ ( a )
TOWORD ( a c )
0x0e _c RAM+ ( a )
_c TOWORD ( a c )
BEGIN
( We take advantage of the fact that char MSB is
always zero to pre-write our null-termination )
OVER ! ( a )
1 + ( a+1 )
C< ( a c )
DUP WS?
_c OVER _c ! ( a )
1 _c + ( a+1 )
_c C< ( a c )
_c DUP _c WS?
UNTIL
( a this point, PS is: a WS )
( null-termination is already written )
2DROP
0x0e RAM+
;
: SCPY
BEGIN ( a )
DUP C@ ( a c )
DUP C, ( a c )
NOT IF DROP EXIT THEN
1 + ( a+1 )
AGAIN
_c 2DROP
0x0e _c RAM+
;
: (entry)
HERE @ ( h )
WORD ( h s )
SCPY ( h )
_c HERE _c @ ( h )
_c WORD ( h s )
_c SCPY ( h )
( Adjust HERE -1 because SCPY copies the null )
HERE @ 1 - ( h h' )
DUP HERE ! ( h h' )
SWAP - ( sz )
_c HERE _c @ 1 _c - ( h h' )
_c DUP _c HERE _c ! ( h h' )
_c SWAP _c - ( sz )
( write prev value )
HERE @ CURRENT @ - ,
_c HERE _c @ _c CURRENT _c @ _c - _c ,
( write size )
C,
HERE @ CURRENT !
_c C,
_c HERE _c @ _c CURRENT _c !
;
: INTERPRET
BEGIN
WORD
(find)
_c WORD
_c (find)
IF
1 FLAGS !
1 _c FLAGS _c !
EXECUTE
0 FLAGS !
0 _c FLAGS _c !
ELSE
(parse*) @ EXECUTE
_c (parse*) _c @ EXECUTE
THEN
AGAIN
;
@ -179,58 +214,67 @@
LATEST. Convenient way to bootstrap a new system. )
: (c<)
( 60 == SYSTEM SCRATCHPAD )
0x60 RAM+ @ ( a )
DUP C@ ( a c )
SWAP 1 + ( c a+1 )
0x60 RAM+ ! ( c )
0x60 _c RAM+ _c @ ( a )
_c DUP _c C@ ( a c )
_c SWAP 1 _c + ( c a+1 )
0x60 _c RAM+ _c ! ( c )
;
: BOOT
0x02 RAM+ CURRENT* !
LIT< (parse) (find) DROP (parse*) !
0 0x51 _c RAM+ _c _!
LIT< (parse) _c (find) _c DROP _c (parse*) _c !
( 60 == SYSTEM SCRATCHPAD )
CURRENT @ 0x60 RAM+ !
_c CURRENT _c @ 0x60 _c RAM+ _c !
( 0c == CINPTR )
LIT< (c<) (find) DROP 0x0c RAM+ !
LIT< INIT (find)
LIT< (c<) _c (find) _c DROP 0x0c _c RAM+ _c !
LIT< INIT _c (find)
IF EXECUTE
ELSE DROP INTERPRET THEN
ELSE _c DROP _c INTERPRET THEN
;
( LITN has to be defined after the last immediate usage of
it to avoid bootstrapping issues )
: LITN
( 32 == NUMBER )
32 , ,
32 _c , _c ,
;
: IMMED? 1 - C@ 0x80 AND ;
( : and ; have to be defined last because it can't be
executed now also, they can't have their real name
right away. We also can't use IMMEDIATE because the offset
used for CURRENT is the *target*'s RAM offset. we're still
on the host.
)
( ';' can't have its name right away because, when created, it
is not an IMMEDIATE yet and will not be treated properly by
xcomp. )
: _
['] EXIT ,
R> DROP ( exit : )
; IMMEDIATE
';' XCURRENT @ 4 - C!
: :
(entry)
: X
_c (entry)
( We cannot use LITN as IMMEDIATE because of bootstrapping
issues. Same thing for ",".
32 == NUMBER 14 == compiledWord )
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] ,
[ 32 H@ _! 2 ALLOT 14 H@ _! 2 ALLOT ] _c ,
BEGIN
WORD
(find)
_c WORD
_c (find)
( is word )
IF DUP IMMED? IF EXECUTE ELSE , THEN
IF _c DUP _c IMMED? IF EXECUTE ELSE _c , THEN
( maybe number )
ELSE (parse*) @ EXECUTE LITN THEN
ELSE _c (parse*) _c @ EXECUTE _c LITN THEN
AGAIN
;
(xentry) _
H@ 256 /MOD 2 PC! 2 PC!
: Y
['] EXIT _c ,
_c R> _c DROP ( exit : )
;
( Give ":" and ";" their real name and make them IMMEDIATE )
0x81 ' X 1 - _C!
':' ' X 4 - _C!
0x81 ' Y 1 - _C!
';' ' Y 4 - _C!
( Add dummy entry. we use CREATE because (entry) is, at this
point, broken. Adjust H@ durint port 2 ping. )
CREATE _
H@ 2 - 256 /MOD 2 PC! 2 PC!

View File

@ -80,7 +80,7 @@
(parseb) IF EXIT THEN
(parsed) IF EXIT THEN
( nothing works )
LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
LIT< (wnf) (find) DROP EXECUTE
;
' (parse) (parse*) !

View File

@ -1,71 +0,0 @@
( Do dictionary cross compilation.
Include this file right before your cross compilation, then
set XCURRENT to CURRENT and XOFF to H@ - your target hook.
Example: H@ ' _bend - XOFF !
This redefines defining words to achieve cross compilation.
The goal is two-fold:
1. Add an offset to all word references in definitions.
2. Don't shadow important words we need right now.
New defining words establish a new XCURRENT, a copy of
CURRENT. From now on, CURRENT doesn't move. This means that
"'" and friends will *not* find words you're about to
define. Only (xfind) will.
Words ":", "IMMEDIATE" and "CODE" are not automatically
shadowed to allow the harmless inclusion of this unit. This
shadowing has to take place in your xcomp configuration.
See example in /emul/forth/xcomp.fs
)
VARIABLE XCURRENT
VARIABLE XOFF
: XCON XCURRENT CURRENT* ! ;
: XCOFF CURRENT CURRENT* ! ;
: (xentry) XCON (entry) XCOFF ;
: XCODE XCON CODE XCOFF ;
: XIMM XCON IMMEDIATE XCOFF ;
: X:
XCON
(entry)
( 0e == compiledWord )
[ 0x0e LITN ] ,
BEGIN
( DUP is because we need a copy in case it's IMMED )
WORD DUP
(find) ( w a f )
IF
( is word )
DUP IMMED?
IF ( w a )
( When encountering IMMEDIATE, we exec the *host*
word. )
DROP ( w )
( hardcoded system CURRENT )
0x02 RAM+ @ SWAP ( cur w )
_find ( a f )
NOT IF ABORT THEN ( a )
EXECUTE
ELSE
( not an immed. drop backup w and write, with
offset. )
SWAP DROP ( a )
DUP 0x100 > IF XOFF @ - THEN
,
THEN
ELSE ( w a )
( maybe number )
DROP ( w )
(parse*) @ EXECUTE LITN
THEN
AGAIN
XCOFF
;

View File

@ -22,6 +22,10 @@
This unit expects the same conf as boot.fs.
)
( dummy entry for dict hook )
(entry) _
H@ 256 /MOD 2 PC! 2 PC!
( a b c -- b c a )
CODE ROT
HL POPqq, ( C )
@ -228,7 +232,7 @@ L2 FSET ( skip )
BC PUSHqq,
;CODE
CODE !
CODE _!
HL POPqq,
DE POPqq,
chkPS,
@ -237,7 +241,7 @@ CODE !
(HL) D LDrr,
;CODE
CODE @
CODE _@
HL POPqq,
chkPS,
E (HL) LDrr,
@ -246,14 +250,14 @@ CODE @
DE PUSHqq,
;CODE
CODE C!
CODE _C!
HL POPqq,
DE POPqq,
chkPS,
(HL) E LDrr,
;CODE
CODE C@
CODE _C@
HL POPqq,
chkPS,
L (HL) LDrr,
@ -307,6 +311,25 @@ CODE R>
HL PUSHqq,
;CODE
CODE IMMEDIATE
( CURRENT == RAM+2 )
RAMSTART 0x02 + LDHL(nn),
HL DECss,
7 (HL) SETbr,
;CODE
CODE IMMED?
HL POPqq,
chkPS,
HL DECss,
DE 0 LDddnn,
7 (HL) BITbr,
JRZ, L1 FWR ( notset )
DE INCss,
L1 FSET ( notset )
DE PUSHqq,
;CODE
CODE BYE
HALT,
;CODE
@ -350,10 +373,8 @@ CODE CMP
BC PUSHqq,
;CODE
( cur w -- a f )
CODE _find
HL POPqq, ( w )
DE POPqq, ( cur )
CODE (find)
HL POPqq,
chkPS,
( 3 == find )
3 CALLnn,
@ -369,6 +390,24 @@ L1 FSET ( found )
DE PUSHqq,
;CODE
CODE SCPY
HL POPqq,
chkPS,
( HERE == RAM+4 )
DE RAMSTART 0x04 + LDdd(nn),
B 0 LDrn,
L1 BSET ( loop )
A (HL) LDrr,
LD(DE)A,
HL INCss,
DE INCss,
B INCr,
A ORr,
JRNZ, L1 BWR ( loop )
DE A LD(dd)r
RAMSTART 0x04 + DE LD(nn)dd,
;CODE
CODE (im1)
IM1,
EI,

View File

@ -88,7 +88,7 @@ RAMSTART INITIAL_SP
+0e WORDBUF
+2e SYSVNXT
+4e INTJUMP
+51 CURRENTPTR
+51 MMAPPTR
+53 RESERVED
+60 SYSTEM SCRATCHPAD
+80 RAMEND
@ -117,10 +117,8 @@ those slots...) in boot binaries are made to jump to this address. If you use
one of those slots for an interrupt, write a jump to the appropriate offset in
that RAM location.
CURRENTPTR points to current CURRENT. The Forth CURRENT word doesn't return
RAM+2 directly, but rather the value at this address. Most of the time, it
points to RAM+2, but sometimes, when maintaining alternative dicts (during
cross compilation for example), it can point elsewhere.
MMAPPTR: Address behind (mmap), which is called before every !/C!/@/C@ world
to give the opportunity to change the address of the call.
SYSTEM SCRATCHPAD is reserved for temporary system storage or can be reserved
by low-level drivers. These are the current usages of this space throughout the
@ -160,3 +158,29 @@ can't have comments. This leads to peculiar code in this area. If you see weird
whitespace usage, it's probably because not using those whitespace would result
in dict entry creation overwriting the code before it has the chance to be
interpreted.
*** Memory maps
We have a mechanism to map memory ranges to something else. We call this memory
maps. There is a reserved address in memory for a memory mapping routine. The
word (mmap*) returns that address. By default, it's zero which means no mapping.
Each call to @, C@, ! or C! call that word, if nonzero, before executing. This
allows you to do pretty much anything. Try to be efficient in your programming,
however, because those words are called *very* often.
Here's a toy example of memory map usage:
> 8 0x8000 DUMP
:00 0000 0000 0000 0000 ........
> : foo DUP 0x8000 = IF 2 + THEN ;
> ' foo (mmap*) !
> 8 0x8000 DUMP
:00 0000 0000 0000 0000 ........
> 0x1234 0x8000 !
> 8 0x8000 DUMP
:00 3412 3412 0000 0000 4.4.....
> 0 (mmap*) !
> 8 0x8000 DUMP
:00 0000 3412 0000 0000 ..4.....
>