From 68f359d6c297140c5dead25da1d1da5b35fea861 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Thu, 9 Apr 2020 08:23:53 -0400 Subject: [PATCH] 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. --- emul/Makefile | 2 +- emul/forth/xcomp.fs | 2 + emul/forth/z80c.bin | Bin 1817 -> 1798 bytes forth/icore.fs | 228 +++++++++++++++++++++++----------------------------- forth/xcomp.fs | 91 +++++++++++++++++++++ forth/z80c.fs | 2 +- 6 files changed, 195 insertions(+), 130 deletions(-) create mode 100644 emul/forth/xcomp.fs create mode 100644 forth/xcomp.fs diff --git a/emul/Makefile b/emul/Makefile index 631afe8..204c747 100644 --- a/emul/Makefile +++ b/emul/Makefile @@ -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: diff --git a/emul/forth/xcomp.fs b/emul/forth/xcomp.fs new file mode 100644 index 0000000..a901220 --- /dev/null +++ b/emul/forth/xcomp.fs @@ -0,0 +1,2 @@ +CURRENT @ XCURRENT ! +H@ ' _bend - 4 + XOFF ! diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index 0076be7361ad468b0907dd48952d5a422833ed10..7832185b274a24dd55ebe967461e23ea285928ff 100644 GIT binary patch delta 783 zcmXw1O=}ZT6g}_FdoxK$ry8|L1er7p8o_Z`jL8XB=yclQQgMo{p%-l! zg-S+m7%tpfDM%X`{hWea5`y1VPUNPEZ3@p()l;)YkfFe)xm&Fg{KzUqV%5piw{xr#ZDH+Y_ z^ZJ=N6#eL`K6|;Rewp*qqh`)ea5Kc;BW7h!Zn^HRZkG5Gv8=u5tU+U5k~Uyb5fh$1>_Ec#T)L}pEt-KxZ?_>P`lBv!S6 zszX}3ixy1s=#%B*UM*sPqXAve3`KVvLhJRn#91Ix0WsQ>@~ delta 828 zcmXw1OK1~O6g_Y9X7ZsE*Q;UfXcc zo_Q0!8T)Q2xHoF&slnw;g)>Q9hPcqfMsG5E8!|;irBFn)A3i6S}klq42#$J$< zsZ-wwi{Y~20OPnQwu2R!7S-UbOttn*UE?D)P=({n+Q9?~ESejXke_4@`($}0|5^Nw zu`fLi&nG#Y;r7_ceaRX8k>^_Pt-k14M+}F;!|y|dI}NvVT5Gnc%Yij%cvO`Wb%IY} zOqab1i)wx;&*56{R`AqJuXD#lcrL672@H(BU`l_*fVvmWfAkHEuC--pi^*2%&9Xc1 zmYYRHZ6v}S>0_Ft3LZR3<@xZ-Lj*m_-++f*;+t73WG`yIE2F9O#Zr|zY03^5oR4_bz?82|tP diff --git a/forth/icore.fs b/forth/icore.fs index 8ef35c8..83a7b16 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -19,141 +19,114 @@ 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! ) -; IMMEDIATE - : 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 0x02 RAM+ ; +: (mmap*) 0x51 RAM+ ; ( 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 _@ + [ RAMSTART 0x51 + LITN ] _@ IF - [ RAMSTART 0x51 + LITN ] _c _@ EXECUTE + [ RAMSTART 0x51 + LITN ] _@ EXECUTE THEN ; -: @ _c (mmap) _c _@ ; -: C@ _c (mmap) _c _C@ ; -: ! _c (mmap) _c _! ; -: C! _c (mmap) _c _C! ; +: @ (mmap) _@ ; +: C@ (mmap) _C@ ; +: ! (mmap) _! ; +: C! (mmap) _C! ; : 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 ; @@ -161,56 +134,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 ) - _c DUP _c C@ ( a c ) - _c DUP _c C, ( a c ) - _c NOT IF _c DROP EXIT THEN - 1 _c + ( a+1 ) + 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 ; @@ -219,32 +192,32 @@ 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 ! + 0 0x51 RAM+ _! + 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 , , ; -: IMMED? 1 _c - _c C@ 0x80 _c AND ; +: 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 @@ -252,32 +225,31 @@ ) : X - _c (entry) + (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 ; IMMEDIATE +XCURRENT @ ( to PSP ) + : Y - ['] EXIT _c , - _c R> _c DROP ( exit : ) + ['] EXIT , + R> DROP ( exit : ) ; IMMEDIATE ( Give ":" and ";" their real name ) -':' ' X 4 - _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! +';' XCURRENT @ 4 - _C! +':' SWAP ( from PSP ) 4 - _C! +(xentry) _ +H@ 256 /MOD 2 PC! 2 PC! diff --git a/forth/xcomp.fs b/forth/xcomp.fs new file mode 100644 index 0000000..619210b --- /dev/null +++ b/forth/xcomp.fs @@ -0,0 +1,91 @@ +( 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. + + See example in /emul/forth/xcomp.fs +) + +VARIABLE XCURRENT +VARIABLE XOFF + +: (xentry) + H@ ( h ) + WORD ( h s ) + SCPY ( h ) + ( Adjust HERE -1 because SCPY copies the null ) + H@ 1 - ( h h' ) + DUP HERE ! ( h h' ) + -^ ( sz ) + ( write prev value ) + H@ XCURRENT @ - , + ( write size ) + C, + H@ XCURRENT ! +; + +( Finds in *both* CURRENT and XCURRENT ) +( w -- a f xa xf ) +: (xfind) + DUP ( w w ) + (find) ( w a f ) + ROT ( a f w ) + CURRENT @ ( a f w cur ) + XCURRENT @ CURRENT ! + SWAP ( a f cur w ) + (find) ( a f cur xa xf ) + ROT ( a f xa xf cur ) + CURRENT ! ( a f xa xf ) +; + +: CODE + (xentry) 23 , +; + +: _IMM IMMEDIATE ; + +: IMMEDIATE + XCURRENT @ 1 - + DUP C@ 128 OR SWAP C! +; + +: : + (xentry) + ( 0e == compiledWord ) + [ 0x0e LITN ] , + BEGIN + WORD + (xfind) + IF ( a f xa ) + ( is word ) + DUP IMMED? + IF ( a f xa ) + ( When encountering IMMEDIATE, we exec the *host* + word. ) + DROP ( a f ) + NOT IF ABORT THEN ( a ) + EXECUTE + ELSE + ( when compiling, we don't care about the host + find. ) + DUP 0x100 > IF XOFF @ - THEN + , 2DROP + THEN + ELSE ( w f xa ) + ( maybe number ) + 2DROP ( w ) + (parse*) @ EXECUTE LITN + THEN + AGAIN +; _IMM diff --git a/forth/z80c.fs b/forth/z80c.fs index d7cc056..762067d 100644 --- a/forth/z80c.fs +++ b/forth/z80c.fs @@ -23,7 +23,7 @@ ) ( dummy entry for dict hook ) -(entry) _ +(xentry) _ H@ 256 /MOD 2 PC! 2 PC! ( a b c -- b c a )