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.
|
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
|
||||||
|
@ -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:
|
||||||
|
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) {
|
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);
|
||||||
|
@ -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
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;
|
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
|
||||||
|
@ -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:
|
||||||
|
@ -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!
|
||||||
|
;
|
||||||
|
256
forth/icore.fs
256
forth/icore.fs
@ -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!
|
|
||||||
|
|
||||||
|
@ -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
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.
|
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,
|
||||||
|
34
notes.txt
34
notes.txt
@ -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.....
|
|
||||||
>
|
|
||||||
|
Loading…
Reference in New Issue
Block a user