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

Compare commits

...

16 Commits

Author SHA1 Message Date
Virgil Dupras
54929c2aa0 xcomp: simplify further 2020-04-09 12:10:43 -04:00
Virgil Dupras
e6d3638f4f Add CURRENT* and simplify xcomp 2020-04-09 12:01:08 -04:00
Virgil Dupras
f1171c656c xcomp: make (xfind) use _find instead of (find) 2020-04-09 11:24:43 -04:00
Virgil Dupras
1b6286dcfe Make (find) 2-layered, the lower layer having CURRENT as a param 2020-04-09 11:20:54 -04:00
Virgil Dupras
66dc621919 xcomp: don't automatically shadow core words 2020-04-09 09:43:48 -04:00
Virgil Dupras
0c3067ed9a icore: simplify definition of ":" and ";" 2020-04-09 09:38:59 -04:00
Virgil Dupras
784b109652 So, why was ":" an immediate again? 2020-04-09 09:27:51 -04:00
Virgil Dupras
afed423530 Remove memory maps
It was a dead end. my new tentative solution is xcomp.
2020-04-09 09:21:55 -04:00
Virgil Dupras
6c48c1b53c parse: be a bit more graceful on parsing meta-failure 2020-04-09 08:27:14 -04:00
Virgil Dupras
b69ca4488e Add emul_memdump() and stop automatically on ROM write 2020-04-09 08:26:41 -04:00
Virgil Dupras
6f082b0b13 Change DELW signature 2020-04-09 08:26:27 -04:00
Virgil Dupras
68f359d6c2 Add xcomp unit for cross compilation
Memory mapping is a dead end too, solution has to be at a higher
level. xcomp is my new approach.
2020-04-09 08:23:53 -04:00
Virgil Dupras
b5638d142a Add word "DELW" 2020-04-08 20:40:23 -04:00
Virgil Dupras
2a2e3a64a4 Move IMMED? from z80c to icore 2020-04-08 20:09:32 -04:00
Virgil Dupras
a7a2f3d08b Move IMMEDIATE from z80c to core
This makes IMMEDIATE affected by memory mappings.
2020-04-08 19:43:44 -04:00
Virgil Dupras
64e441d059 Move SCPY from z80c to icore
This way, it can be affected by memory mappers.
2020-04-08 16:12:34 -04:00
15 changed files with 235 additions and 239 deletions

View File

@ -38,6 +38,8 @@ CREATE x -- Create cell named x. Doesn't allocate a PF.
words are *not* executed. words are *not* executed.
COMPILE x -- Meta compiles. Kind of blows the mind. See below. COMPILE x -- Meta compiles. Kind of blows the mind. See below.
CONSTANT x n -- Creates cell x that when called pushes its value 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 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.
@ -89,8 +91,6 @@ I' -- n Copy RS second item to PS
J -- n Copy RS third item to PS J -- n Copy RS third item to PS
*** Memory *** *** 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 @ a -- n Set n to value at address a
! n a -- Store n in address a ! n a -- Store n in address a
? a -- Print value of addr 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@ a -- c Set c to byte at address a
C! c a -- Store byte c in address a C! c a -- Store byte c in address a
CURRENT -- a Set a to wordref of last added entry. 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 HERE -- a Push HERE's address
H@ -- a HERE @ H@ -- a HERE @
MOVE a1 a2 u -- Copy u bytes from a1 to a2, starting with a1, going 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 .PHONY: updatebootstrap
updatebootstrap: forth/stage2 updatebootstrap: forth/stage2
cat ./forth/conf.fs ../forth/boot.fs | ./forth/stage2 | tee forth/boot.bin > /dev/null 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 .PHONY: clean
clean: clean:

View File

@ -41,6 +41,9 @@ static void mem_write(int unused, uint16_t addr, uint8_t val)
{ {
if (addr < m.ramstart) { if (addr < m.ramstart) {
fprintf(stderr, "Writing to ROM (%d)!\n", addr); 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; 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() void emul_printdebug()
{ {
fprintf(stderr, "Min SP: %04x\n", m.minsp); fprintf(stderr, "Min SP: %04x\n", m.minsp);

View File

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

Binary file not shown.

11
emul/forth/xcomp.fs Normal file
View 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.

View File

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

View File

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

View File

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

View File

@ -19,145 +19,101 @@
by the full interpreter. by the full interpreter.
5. When using words as immediates, make sure that they're 5. When using words as immediates, make sure that they're
not defined in icore or, if they are, make sure that 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 Those rules are mostly met by the "xcomp" unit, which is
price to pay for the awesomeness of self-bootstrapping. 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+ : RAM+
[ RAMSTART LITN ] _c + [ RAMSTART LITN ] +
; ;
: FLAGS 0x08 _c RAM+ ; : FLAGS 0x08 RAM+ ;
: (parse*) 0x0a _c RAM+ ; : (parse*) 0x0a RAM+ ;
: HERE 0x04 _c RAM+ ; : HERE 0x04 RAM+ ;
: CURRENT 0x02 _c RAM+ ; : CURRENT* 0x51 RAM+ ;
: (mmap*) 0x51 _c RAM+ ; : CURRENT CURRENT* @ ;
( The goal here is to be as fast as possible *when there is ( w -- a f )
no mmap*, which is the most frequent situation. That is why : (find) CURRENT @ SWAP _find ;
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 : QUIT
0 _c FLAGS _c ! _c (resRS) 0 FLAGS ! (resRS)
LIT< INTERPRET _c (find) _c DROP EXECUTE LIT< INTERPRET (find) DROP EXECUTE
; ;
: ABORT _c (resSP) _c QUIT ; : ABORT (resSP) QUIT ;
: = _c CMP _c NOT ; : = CMP NOT ;
: < _c CMP -1 _c = ; : < CMP -1 = ;
: > _c CMP 1 _c = ; : > CMP 1 = ;
: (parsed) ( a -- n f ) : (parsed) ( a -- n f )
( read first char outside of the loop. it *has* to be ( read first char outside of the loop. it *has* to be
nonzero. ) nonzero. )
_c DUP _c C@ ( a c ) DUP C@ ( a c )
_c DUP _c NOT IF EXIT THEN ( a 0 ) DUP NOT IF EXIT THEN ( a 0 )
( special case: do we have a negative? ) ( special case: do we have a negative? )
_c DUP '-' _c = IF DUP '-' = IF
( Oh, a negative, let's recurse and reverse ) ( Oh, a negative, let's recurse and reverse )
_c DROP 1 _c + ( a+1 ) DROP 1 + ( a+1 )
_c (parsed) ( n f ) (parsed) ( n f )
_c SWAP 0 _c SWAP ( f 0 n ) SWAP 0 SWAP ( f 0 n )
_c - _c SWAP EXIT ( 0-n f ) - SWAP EXIT ( 0-n f )
THEN THEN
( running result, staring at zero ) ( running result, staring at zero )
0 _c SWAP ( a r c ) 0 SWAP ( a r c )
( Loop over chars ) ( Loop over chars )
BEGIN BEGIN
( parse char ) ( parse char )
'0' _c - '0' -
( if bad, return "a 0" ) ( if bad, return "a 0" )
_c DUP 0 _c < IF _c 2DROP 0 EXIT THEN ( bad ) DUP 0 < IF 2DROP 0 EXIT THEN ( bad )
_c DUP 9 _c > IF _c 2DROP 0 EXIT THEN ( bad ) DUP 9 > IF 2DROP 0 EXIT THEN ( bad )
( good, add to running result ) ( good, add to running result )
_c SWAP 10 _c * _c + ( a r*10+n ) SWAP 10 * + ( a r*10+n )
_c SWAP 1 _c + _c SWAP ( a+1 r ) SWAP 1 + SWAP ( a+1 r )
( read next char ) ( read next char )
_c OVER _c C@ OVER C@
_c DUP _c NOT UNTIL DUP NOT UNTIL
( we're done and it's a success. We have "a r c", we want ( we're done and it's a success. We have "a r c", we want
"r 1". ) "r 1". )
_c DROP _c SWAP _c DROP 1 DROP SWAP DROP 1
; ;
( This is only the "early parser" in earlier stages. No need ( This is only the "early parser" in earlier stages. No need
for an abort message ) for an abort message )
: (parse) : (parse)
_c (parsed) _c NOT IF _c ABORT THEN (parsed) NOT IF ABORT THEN
; ;
: C< : C<
( 0c == CINPTR ) ( 0c == CINPTR )
0x0c _c RAM+ _c @ EXECUTE 0x0c RAM+ @ EXECUTE
; ;
: , : ,
_c HERE _c @ _c ! HERE @ !
_c HERE _c @ 2 _c + _c HERE _c ! HERE @ 2 + HERE !
; ;
: C, : C,
_c HERE _c @ _c C! HERE @ C!
_c HERE _c @ 1 _c + _c HERE _c ! HERE @ 1 + HERE !
; ;
( The NOT is to normalize the negative/positive numbers to 1 ( The NOT is to normalize the negative/positive numbers to 1
or 0. Hadn't we wanted to normalize, we'd have written: or 0. Hadn't we wanted to normalize, we'd have written:
32 CMP 1 - ) 32 CMP 1 - )
: WS? 33 _c CMP 1 _c + _c NOT ; : WS? 33 CMP 1 + NOT ;
: TOWORD : TOWORD
BEGIN BEGIN
_c C< _c DUP _c WS? _c NOT IF EXIT THEN _c DROP C< DUP WS? NOT IF EXIT THEN DROP
AGAIN AGAIN
; ;
@ -165,47 +121,56 @@
return, make HL point to WORDBUF. ) return, make HL point to WORDBUF. )
: WORD : WORD
( 0e == WORDBUF ) ( 0e == WORDBUF )
0x0e _c RAM+ ( a ) 0x0e RAM+ ( a )
_c TOWORD ( a c ) TOWORD ( a c )
BEGIN BEGIN
( We take advantage of the fact that char MSB is ( We take advantage of the fact that char MSB is
always zero to pre-write our null-termination ) always zero to pre-write our null-termination )
_c OVER _c ! ( a ) OVER ! ( a )
1 _c + ( a+1 ) 1 + ( a+1 )
_c C< ( a c ) C< ( a c )
_c DUP _c WS? DUP WS?
UNTIL UNTIL
( a this point, PS is: a WS ) ( a this point, PS is: a WS )
( null-termination is already written ) ( null-termination is already written )
_c 2DROP 2DROP
0x0e _c RAM+ 0x0e RAM+
;
: SCPY
BEGIN ( a )
DUP C@ ( a c )
DUP C, ( a c )
NOT IF DROP EXIT THEN
1 + ( a+1 )
AGAIN
; ;
: (entry) : (entry)
_c HERE _c @ ( h ) HERE @ ( h )
_c WORD ( h s ) WORD ( h s )
_c SCPY ( h ) SCPY ( h )
( Adjust HERE -1 because SCPY copies the null ) ( Adjust HERE -1 because SCPY copies the null )
_c HERE _c @ 1 _c - ( h h' ) HERE @ 1 - ( h h' )
_c DUP _c HERE _c ! ( h h' ) DUP HERE ! ( h h' )
_c SWAP _c - ( sz ) SWAP - ( sz )
( write prev value ) ( write prev value )
_c HERE _c @ _c CURRENT _c @ _c - _c , HERE @ CURRENT @ - ,
( write size ) ( write size )
_c C, C,
_c HERE _c @ _c CURRENT _c ! HERE @ CURRENT !
; ;
: INTERPRET : INTERPRET
BEGIN BEGIN
_c WORD WORD
_c (find) (find)
IF IF
1 _c FLAGS _c ! 1 FLAGS !
EXECUTE EXECUTE
0 _c FLAGS _c ! 0 FLAGS !
ELSE ELSE
_c (parse*) _c @ EXECUTE (parse*) @ EXECUTE
THEN THEN
AGAIN AGAIN
; ;
@ -214,67 +179,58 @@
LATEST. Convenient way to bootstrap a new system. ) LATEST. Convenient way to bootstrap a new system. )
: (c<) : (c<)
( 60 == SYSTEM SCRATCHPAD ) ( 60 == SYSTEM SCRATCHPAD )
0x60 _c RAM+ _c @ ( a ) 0x60 RAM+ @ ( a )
_c DUP _c C@ ( a c ) DUP C@ ( a c )
_c SWAP 1 _c + ( c a+1 ) SWAP 1 + ( c a+1 )
0x60 _c RAM+ _c ! ( c ) 0x60 RAM+ ! ( c )
; ;
: BOOT : BOOT
0 0x51 _c RAM+ _c _! 0x02 RAM+ CURRENT* !
LIT< (parse) _c (find) _c DROP _c (parse*) _c ! LIT< (parse) (find) DROP (parse*) !
( 60 == SYSTEM SCRATCHPAD ) ( 60 == SYSTEM SCRATCHPAD )
_c CURRENT _c @ 0x60 _c RAM+ _c ! CURRENT @ 0x60 RAM+ !
( 0c == CINPTR ) ( 0c == CINPTR )
LIT< (c<) _c (find) _c DROP 0x0c _c RAM+ _c ! LIT< (c<) (find) DROP 0x0c RAM+ !
LIT< INIT _c (find) LIT< INIT (find)
IF EXECUTE IF EXECUTE
ELSE _c DROP _c INTERPRET THEN ELSE DROP INTERPRET THEN
; ;
( LITN has to be defined after the last immediate usage of ( LITN has to be defined after the last immediate usage of
it to avoid bootstrapping issues ) it to avoid bootstrapping issues )
: LITN : LITN
( 32 == NUMBER ) ( 32 == NUMBER )
32 _c , _c , 32 , ,
; ;
( : and ; have to be defined last because it can't be : IMMED? 1 - C@ 0x80 AND ;
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.
)
: X ( ';' can't have its name right away because, when created, it
_c (entry) 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 ( We cannot use LITN as IMMEDIATE because of bootstrapping
issues. Same thing for ",". issues. Same thing for ",".
32 == NUMBER 14 == compiledWord ) 32 == NUMBER 14 == compiledWord )
[ 32 H@ _! 2 ALLOT 14 H@ _! 2 ALLOT ] _c , [ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] ,
BEGIN BEGIN
_c WORD WORD
_c (find) (find)
( is word ) ( is word )
IF _c DUP _c IMMED? IF EXECUTE ELSE _c , THEN IF DUP IMMED? IF EXECUTE ELSE , THEN
( maybe number ) ( maybe number )
ELSE _c (parse*) _c @ EXECUTE _c LITN THEN ELSE (parse*) @ EXECUTE LITN THEN
AGAIN AGAIN
; ;
: Y (xentry) _
['] EXIT _c , H@ 256 /MOD 2 PC! 2 PC!
_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 (parseb) IF EXIT THEN
(parsed) IF EXIT THEN (parsed) IF EXIT THEN
( nothing works ) ( nothing works )
LIT< (wnf) (find) DROP EXECUTE LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
; ;
' (parse) (parse*) ! ' (parse) (parse*) !

71
forth/xcomp.fs Normal file
View 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
;

View File

@ -22,10 +22,6 @@
This unit expects the same conf as boot.fs. 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 ) ( a b c -- b c a )
CODE ROT CODE ROT
HL POPqq, ( C ) HL POPqq, ( C )
@ -232,7 +228,7 @@ L2 FSET ( skip )
BC PUSHqq, BC PUSHqq,
;CODE ;CODE
CODE _! CODE !
HL POPqq, HL POPqq,
DE POPqq, DE POPqq,
chkPS, chkPS,
@ -241,7 +237,7 @@ CODE _!
(HL) D LDrr, (HL) D LDrr,
;CODE ;CODE
CODE _@ CODE @
HL POPqq, HL POPqq,
chkPS, chkPS,
E (HL) LDrr, E (HL) LDrr,
@ -250,14 +246,14 @@ CODE _@
DE PUSHqq, DE PUSHqq,
;CODE ;CODE
CODE _C! CODE C!
HL POPqq, HL POPqq,
DE POPqq, DE POPqq,
chkPS, chkPS,
(HL) E LDrr, (HL) E LDrr,
;CODE ;CODE
CODE _C@ CODE C@
HL POPqq, HL POPqq,
chkPS, chkPS,
L (HL) LDrr, L (HL) LDrr,
@ -311,25 +307,6 @@ CODE R>
HL PUSHqq, HL PUSHqq,
;CODE ;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 CODE BYE
HALT, HALT,
;CODE ;CODE
@ -373,8 +350,10 @@ CODE CMP
BC PUSHqq, BC PUSHqq,
;CODE ;CODE
CODE (find) ( cur w -- a f )
HL POPqq, CODE _find
HL POPqq, ( w )
DE POPqq, ( cur )
chkPS, chkPS,
( 3 == find ) ( 3 == find )
3 CALLnn, 3 CALLnn,
@ -390,24 +369,6 @@ L1 FSET ( found )
DE PUSHqq, DE PUSHqq,
;CODE ;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) CODE (im1)
IM1, IM1,
EI, EI,

View File

@ -88,7 +88,7 @@ RAMSTART INITIAL_SP
+0e WORDBUF +0e WORDBUF
+2e SYSVNXT +2e SYSVNXT
+4e INTJUMP +4e INTJUMP
+51 MMAPPTR +51 CURRENTPTR
+53 RESERVED +53 RESERVED
+60 SYSTEM SCRATCHPAD +60 SYSTEM SCRATCHPAD
+80 RAMEND +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 one of those slots for an interrupt, write a jump to the appropriate offset in
that RAM location. that RAM location.
MMAPPTR: Address behind (mmap), which is called before every !/C!/@/C@ world CURRENTPTR points to current CURRENT. The Forth CURRENT word doesn't return
to give the opportunity to change the address of the call. 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 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 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 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 in dict entry creation overwriting the code before it has the chance to be
interpreted. 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.....
>