mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:20:55 +11:00
Compare commits
16 Commits
05c38424c7
...
54929c2aa0
Author | SHA1 | Date | |
---|---|---|---|
|
54929c2aa0 | ||
|
e6d3638f4f | ||
|
f1171c656c | ||
|
1b6286dcfe | ||
|
66dc621919 | ||
|
0c3067ed9a | ||
|
784b109652 | ||
|
afed423530 | ||
|
6c48c1b53c | ||
|
b69ca4488e | ||
|
6f082b0b13 | ||
|
68f359d6c2 | ||
|
b5638d142a | ||
|
2a2e3a64a4 | ||
|
a7a2f3d08b | ||
|
64e441d059 |
@ -38,6 +38,8 @@ 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.
|
||||
@ -89,8 +91,6 @@ 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,6 +98,8 @@ 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
|
||||
|
@ -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/z80c.fs ../forth/icore.fs | ./forth/stage2 | tee forth/z80c.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
|
||||
|
||||
.PHONY: clean
|
||||
clean:
|
||||
|
11
emul/emul.c
11
emul/emul.c
@ -41,6 +41,9 @@ 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;
|
||||
}
|
||||
@ -102,6 +105,14 @@ 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);
|
||||
|
@ -31,4 +31,5 @@ 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.
11
emul/forth/xcomp.fs
Normal file
11
emul/forth/xcomp.fs
Normal file
@ -0,0 +1,11 @@
|
||||
: 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.
@ -102,10 +102,7 @@ int main(int argc, char *argv[])
|
||||
char c;
|
||||
if (read(fileno(stdin), &c, 1) == 1) {
|
||||
if (c == 5) {
|
||||
fprintf(stderr, "Dumping memory to memdump\n");
|
||||
FILE *fp = fopen("memdump", "w");
|
||||
fwrite(m->mem, 0x10000, 1, fp);
|
||||
fclose(fp);
|
||||
emul_memdump();
|
||||
c = 0; // don't send to RC2014
|
||||
}
|
||||
if (c == 4) { // CTRL+D
|
||||
|
@ -123,14 +123,16 @@ 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 where (HL) points to
|
||||
and sets DE to point to that entry. Z if found, NZ if not.
|
||||
( 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.
|
||||
)
|
||||
|
||||
BC PUSHqq,
|
||||
@ -154,7 +156,6 @@ 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 )
|
||||
@ -241,6 +242,7 @@ 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 )
|
||||
@ -366,7 +368,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:
|
||||
|
@ -1,5 +1,8 @@
|
||||
: H@ HERE @ ;
|
||||
: -^ SWAP - ;
|
||||
: IMMEDIATE
|
||||
CURRENT @ 1 -
|
||||
DUP C@ 128 OR SWAP C!
|
||||
;
|
||||
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
|
||||
: ] R> DROP ;
|
||||
: LIT 34 , ;
|
||||
@ -29,6 +32,7 @@
|
||||
(br)) and then call LITN on it. )
|
||||
|
||||
: +! SWAP OVER @ + SWAP ! ;
|
||||
: -^ SWAP - ;
|
||||
: ALLOT HERE +! ;
|
||||
|
||||
: IF ( -- a | a: br cell addr )
|
||||
@ -128,3 +132,7 @@
|
||||
LOOP
|
||||
2DROP
|
||||
;
|
||||
|
||||
: DELW
|
||||
1 - 0 SWAP C!
|
||||
;
|
||||
|
256
forth/icore.fs
256
forth/icore.fs
@ -19,145 +19,101 @@
|
||||
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 contain no "_c" references.
|
||||
they are *not* offsetted
|
||||
|
||||
All these rules make this unit a bit messy, but this is the
|
||||
price to pay for the awesomeness of self-bootstrapping.
|
||||
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.
|
||||
)
|
||||
|
||||
( 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 ] _c +
|
||||
[ RAMSTART LITN ] +
|
||||
;
|
||||
|
||||
: FLAGS 0x08 _c RAM+ ;
|
||||
: (parse*) 0x0a _c RAM+ ;
|
||||
: HERE 0x04 _c RAM+ ;
|
||||
: CURRENT 0x02 _c RAM+ ;
|
||||
: (mmap*) 0x51 _c RAM+ ;
|
||||
: FLAGS 0x08 RAM+ ;
|
||||
: (parse*) 0x0a RAM+ ;
|
||||
: HERE 0x04 RAM+ ;
|
||||
: CURRENT* 0x51 RAM+ ;
|
||||
: CURRENT CURRENT* @ ;
|
||||
|
||||
( 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! ;
|
||||
( w -- a f )
|
||||
: (find) CURRENT @ SWAP _find ;
|
||||
|
||||
: QUIT
|
||||
0 _c FLAGS _c ! _c (resRS)
|
||||
LIT< INTERPRET _c (find) _c DROP EXECUTE
|
||||
0 FLAGS ! (resRS)
|
||||
LIT< INTERPRET (find) DROP EXECUTE
|
||||
;
|
||||
|
||||
: ABORT _c (resSP) _c QUIT ;
|
||||
: ABORT (resSP) QUIT ;
|
||||
|
||||
: = _c CMP _c NOT ;
|
||||
: < _c CMP -1 _c = ;
|
||||
: > _c CMP 1 _c = ;
|
||||
: = CMP NOT ;
|
||||
: < CMP -1 = ;
|
||||
: > CMP 1 = ;
|
||||
|
||||
: (parsed) ( a -- n f )
|
||||
( read first char outside of the loop. it *has* to be
|
||||
nonzero. )
|
||||
_c DUP _c C@ ( a c )
|
||||
_c DUP _c NOT IF EXIT THEN ( a 0 )
|
||||
DUP C@ ( a c )
|
||||
DUP NOT IF EXIT THEN ( a 0 )
|
||||
( special case: do we have a negative? )
|
||||
_c DUP '-' _c = IF
|
||||
DUP '-' = IF
|
||||
( Oh, a negative, let's recurse and reverse )
|
||||
_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 )
|
||||
DROP 1 + ( a+1 )
|
||||
(parsed) ( n f )
|
||||
SWAP 0 SWAP ( f 0 n )
|
||||
- SWAP EXIT ( 0-n f )
|
||||
THEN
|
||||
( running result, staring at zero )
|
||||
0 _c SWAP ( a r c )
|
||||
0 SWAP ( a r c )
|
||||
( Loop over chars )
|
||||
BEGIN
|
||||
( parse char )
|
||||
'0' _c -
|
||||
'0' -
|
||||
( if bad, return "a 0" )
|
||||
_c DUP 0 _c < IF _c 2DROP 0 EXIT THEN ( bad )
|
||||
_c DUP 9 _c > IF _c 2DROP 0 EXIT THEN ( bad )
|
||||
DUP 0 < IF 2DROP 0 EXIT THEN ( bad )
|
||||
DUP 9 > IF 2DROP 0 EXIT THEN ( bad )
|
||||
( good, add to running result )
|
||||
_c SWAP 10 _c * _c + ( a r*10+n )
|
||||
_c SWAP 1 _c + _c SWAP ( a+1 r )
|
||||
SWAP 10 * + ( a r*10+n )
|
||||
SWAP 1 + SWAP ( a+1 r )
|
||||
( read next char )
|
||||
_c OVER _c C@
|
||||
_c DUP _c NOT UNTIL
|
||||
OVER C@
|
||||
DUP NOT UNTIL
|
||||
( we're done and it's a success. We have "a r c", we want
|
||||
"r 1". )
|
||||
_c DROP _c SWAP _c DROP 1
|
||||
DROP SWAP DROP 1
|
||||
;
|
||||
|
||||
( This is only the "early parser" in earlier stages. No need
|
||||
for an abort message )
|
||||
: (parse)
|
||||
_c (parsed) _c NOT IF _c ABORT THEN
|
||||
(parsed) NOT IF ABORT THEN
|
||||
;
|
||||
|
||||
: C<
|
||||
( 0c == CINPTR )
|
||||
0x0c _c RAM+ _c @ EXECUTE
|
||||
0x0c RAM+ @ EXECUTE
|
||||
;
|
||||
|
||||
: ,
|
||||
_c HERE _c @ _c !
|
||||
_c HERE _c @ 2 _c + _c HERE _c !
|
||||
HERE @ !
|
||||
HERE @ 2 + HERE !
|
||||
;
|
||||
|
||||
: C,
|
||||
_c HERE _c @ _c C!
|
||||
_c HERE _c @ 1 _c + _c HERE _c !
|
||||
HERE @ C!
|
||||
HERE @ 1 + HERE !
|
||||
;
|
||||
|
||||
( 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 _c CMP 1 _c + _c NOT ;
|
||||
: WS? 33 CMP 1 + NOT ;
|
||||
|
||||
: TOWORD
|
||||
BEGIN
|
||||
_c C< _c DUP _c WS? _c NOT IF EXIT THEN _c DROP
|
||||
C< DUP WS? NOT IF EXIT THEN DROP
|
||||
AGAIN
|
||||
;
|
||||
|
||||
@ -165,47 +121,56 @@
|
||||
return, make HL point to WORDBUF. )
|
||||
: WORD
|
||||
( 0e == WORDBUF )
|
||||
0x0e _c RAM+ ( a )
|
||||
_c TOWORD ( a c )
|
||||
0x0e RAM+ ( a )
|
||||
TOWORD ( a c )
|
||||
BEGIN
|
||||
( We take advantage of the fact that char MSB is
|
||||
always zero to pre-write our null-termination )
|
||||
_c OVER _c ! ( a )
|
||||
1 _c + ( a+1 )
|
||||
_c C< ( a c )
|
||||
_c DUP _c WS?
|
||||
OVER ! ( a )
|
||||
1 + ( a+1 )
|
||||
C< ( a c )
|
||||
DUP WS?
|
||||
UNTIL
|
||||
( a this point, PS is: a WS )
|
||||
( null-termination is already written )
|
||||
_c 2DROP
|
||||
0x0e _c RAM+
|
||||
2DROP
|
||||
0x0e RAM+
|
||||
;
|
||||
|
||||
: SCPY
|
||||
BEGIN ( a )
|
||||
DUP C@ ( a c )
|
||||
DUP C, ( a c )
|
||||
NOT IF DROP EXIT THEN
|
||||
1 + ( a+1 )
|
||||
AGAIN
|
||||
;
|
||||
|
||||
: (entry)
|
||||
_c HERE _c @ ( h )
|
||||
_c WORD ( h s )
|
||||
_c SCPY ( h )
|
||||
HERE @ ( h )
|
||||
WORD ( h s )
|
||||
SCPY ( h )
|
||||
( Adjust HERE -1 because SCPY copies the null )
|
||||
_c HERE _c @ 1 _c - ( h h' )
|
||||
_c DUP _c HERE _c ! ( h h' )
|
||||
_c SWAP _c - ( sz )
|
||||
HERE @ 1 - ( h h' )
|
||||
DUP HERE ! ( h h' )
|
||||
SWAP - ( sz )
|
||||
( write prev value )
|
||||
_c HERE _c @ _c CURRENT _c @ _c - _c ,
|
||||
HERE @ CURRENT @ - ,
|
||||
( write size )
|
||||
_c C,
|
||||
_c HERE _c @ _c CURRENT _c !
|
||||
C,
|
||||
HERE @ CURRENT !
|
||||
;
|
||||
|
||||
: INTERPRET
|
||||
BEGIN
|
||||
_c WORD
|
||||
_c (find)
|
||||
WORD
|
||||
(find)
|
||||
IF
|
||||
1 _c FLAGS _c !
|
||||
1 FLAGS !
|
||||
EXECUTE
|
||||
0 _c FLAGS _c !
|
||||
0 FLAGS !
|
||||
ELSE
|
||||
_c (parse*) _c @ EXECUTE
|
||||
(parse*) @ EXECUTE
|
||||
THEN
|
||||
AGAIN
|
||||
;
|
||||
@ -214,67 +179,58 @@
|
||||
LATEST. Convenient way to bootstrap a new system. )
|
||||
: (c<)
|
||||
( 60 == SYSTEM SCRATCHPAD )
|
||||
0x60 _c RAM+ _c @ ( a )
|
||||
_c DUP _c C@ ( a c )
|
||||
_c SWAP 1 _c + ( c a+1 )
|
||||
0x60 _c RAM+ _c ! ( c )
|
||||
0x60 RAM+ @ ( a )
|
||||
DUP C@ ( a c )
|
||||
SWAP 1 + ( c a+1 )
|
||||
0x60 RAM+ ! ( c )
|
||||
;
|
||||
|
||||
: BOOT
|
||||
0 0x51 _c RAM+ _c _!
|
||||
LIT< (parse) _c (find) _c DROP _c (parse*) _c !
|
||||
0x02 RAM+ CURRENT* !
|
||||
LIT< (parse) (find) DROP (parse*) !
|
||||
( 60 == SYSTEM SCRATCHPAD )
|
||||
_c CURRENT _c @ 0x60 _c RAM+ _c !
|
||||
CURRENT @ 0x60 RAM+ !
|
||||
( 0c == CINPTR )
|
||||
LIT< (c<) _c (find) _c DROP 0x0c _c RAM+ _c !
|
||||
LIT< INIT _c (find)
|
||||
LIT< (c<) (find) DROP 0x0c RAM+ !
|
||||
LIT< INIT (find)
|
||||
IF EXECUTE
|
||||
ELSE _c DROP _c INTERPRET THEN
|
||||
ELSE DROP INTERPRET THEN
|
||||
;
|
||||
|
||||
( LITN has to be defined after the last immediate usage of
|
||||
it to avoid bootstrapping issues )
|
||||
: LITN
|
||||
( 32 == NUMBER )
|
||||
32 _c , _c ,
|
||||
32 , ,
|
||||
;
|
||||
|
||||
( : 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.
|
||||
)
|
||||
: IMMED? 1 - C@ 0x80 AND ;
|
||||
|
||||
: X
|
||||
_c (entry)
|
||||
( ';' 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)
|
||||
( 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 ] _c ,
|
||||
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] ,
|
||||
BEGIN
|
||||
_c WORD
|
||||
_c (find)
|
||||
WORD
|
||||
(find)
|
||||
( is word )
|
||||
IF _c DUP _c IMMED? IF EXECUTE ELSE _c , THEN
|
||||
IF DUP IMMED? IF EXECUTE ELSE , THEN
|
||||
( maybe number )
|
||||
ELSE _c (parse*) _c @ EXECUTE _c LITN THEN
|
||||
ELSE (parse*) @ EXECUTE LITN THEN
|
||||
AGAIN
|
||||
;
|
||||
|
||||
: 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!
|
||||
|
||||
(xentry) _
|
||||
H@ 256 /MOD 2 PC! 2 PC!
|
||||
|
@ -80,7 +80,7 @@
|
||||
(parseb) IF EXIT THEN
|
||||
(parsed) IF EXIT THEN
|
||||
( nothing works )
|
||||
LIT< (wnf) (find) DROP EXECUTE
|
||||
LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
|
||||
;
|
||||
|
||||
' (parse) (parse*) !
|
||||
|
71
forth/xcomp.fs
Normal file
71
forth/xcomp.fs
Normal file
@ -0,0 +1,71 @@
|
||||
( 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
|
||||
;
|
@ -22,10 +22,6 @@
|
||||
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 )
|
||||
@ -232,7 +228,7 @@ L2 FSET ( skip )
|
||||
BC PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE _!
|
||||
CODE !
|
||||
HL POPqq,
|
||||
DE POPqq,
|
||||
chkPS,
|
||||
@ -241,7 +237,7 @@ CODE _!
|
||||
(HL) D LDrr,
|
||||
;CODE
|
||||
|
||||
CODE _@
|
||||
CODE @
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
E (HL) LDrr,
|
||||
@ -250,14 +246,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,
|
||||
@ -311,25 +307,6 @@ 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
|
||||
@ -373,8 +350,10 @@ CODE CMP
|
||||
BC PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE (find)
|
||||
HL POPqq,
|
||||
( cur w -- a f )
|
||||
CODE _find
|
||||
HL POPqq, ( w )
|
||||
DE POPqq, ( cur )
|
||||
chkPS,
|
||||
( 3 == find )
|
||||
3 CALLnn,
|
||||
@ -390,24 +369,6 @@ 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,
|
||||
|
34
notes.txt
34
notes.txt
@ -88,7 +88,7 @@ RAMSTART INITIAL_SP
|
||||
+0e WORDBUF
|
||||
+2e SYSVNXT
|
||||
+4e INTJUMP
|
||||
+51 MMAPPTR
|
||||
+51 CURRENTPTR
|
||||
+53 RESERVED
|
||||
+60 SYSTEM SCRATCHPAD
|
||||
+80 RAMEND
|
||||
@ -117,8 +117,10 @@ 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.
|
||||
|
||||
MMAPPTR: Address behind (mmap), which is called before every !/C!/@/C@ world
|
||||
to give the opportunity to change the address of the call.
|
||||
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.
|
||||
|
||||
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
|
||||
@ -158,29 +160,3 @@ 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.....
|
||||
>
|
||||
|
Loading…
Reference in New Issue
Block a user