\ Generic Target Compiler.

0 [if]
Copyright (C) 2004 by Charles Shattuck.

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

For LGPL information:   http://www.gnu.org/copyleft/lesser.txt

[then]

only forth also definitions
vocabulary target

nowarn
: ] only forth also target also definitions ; immediate
: [ only target also forth also definitions ; immediate [
warn

: :m postpone ] : ;
: m; postpone ; [ ; immediate

\ 0 constant start  \ Reset vector.
\ 8192 constant target-size
create target-image target-size allot
target-image target-size $ff fill  \ ROM erased.
: there   ( a1 - a2)   target-image + ( start +) ;
: c!-t   ( c a - )   there c! ;
: c@-t   ( a - c)   there c@ ;
: !-t  ( n a - )   there over 8 rshift over c! 1 + c! ;
: @-t  ( a - n)  there count 8 lshift swap c@ + ;

variable tdp  \ Rom pointer.
:m HERE   (  - a)   tdp @ m;
:m ORG   ( a - )   tdp ! m;
:m ALLOT   ( n - )   tdp +! m;
:m ,   ( c - )   HERE c!-t 1 tdp +! m;

variable trp  \ Ram pointer.
: cpuHERE  (  - a)   trp @ ;
: cpuORG  ( a - )  trp ! ; 8 cpuORG
: cpuALLOT  ( n - )  trp +! ;
: report cr ." HERE=" ] HERE [ u. cr ;

\ ----- Optimization ----- /
variable 'edge
: hide target-size 1 - 'edge ! ; hide \ Contains a nop.
: hint ] here [ 'edge ! ;
: edge 'edge @ ;

\ ----- Labels ----- /
nowarn
variable labels 0 labels !
warn
: label  (  - )
	[ labels @ here labels ! , ] HERE [ , BL word count here
	over char+ allot place align ;
: show  ( a - ) ( >red) 2 cells + count type ( >black) ;
: label?  ( a - 0|a)
	>r labels begin @ dup while  dup cell+ @ r@ = if
	r> drop exit  then  repeat  r> drop ;
nowarn
: (words  words ;
: .words  labels begin  @ dup while  dup cell+ @ u. dup show 2
   spaces  repeat  drop ;
: words  labels begin  @ dup while  dup show space  repeat  drop ;
warn

\ ----- Headers on the target ----- /
variable thp
create target-heads target-size allot
create end-of-heads
: headsize end-of-heads thp @ - ;
target-heads target-size + 3 - thp !
0 value heads
nowarn
: header  (  - )
	-6 thp +! labels @ cell+ dup cell+ thp @ over c@  1 + 4 min move
	@ dup 8 rshift thp @ 4 + c! thp @ 5 + c! ;
warn
\ Tack headers onto end of code.
\ ***** Why does the string "end-of-heads" get tacked on? ***** /
: headers  (  - )
	target-size ] here [ headsize + - 0<
	abort" Target memory overflow"
	thp @ ] here [ dup to heads there headsize move
	headsize tdp +! ;

