\ ************************************************************************

\ a direct threading composite code interpreter. has a number of small
\ differences to standard forth. (the idea is this will run a version
\ of forth without parsing control words, but using quoted code instead).


\ *** CONTINUE will resume the execution of the VM, more specificly
\ the program pointed to by IP. a program is an array of primitive
\ instructions. primitive instructions are primitive code (word)
\ addresses + a continuation discard bit (EXIT bit). IP is implemented
\ by TBLPTR. (f register)

\ *** i want to express iteration using TAIL RECURSION. this means the
\ caller needs to pass the proper continuation to the callee on the
\ RETURN STACK, discarding the current thread if necessary. for this
\ purpose, one 'EXIT' bit will be reserved in the instruction field,
\ and the interpreter loop will pop the stack before calling the next
\ primitive.

\ *** a continuation can be invoked by RUN, so there is no distinction
\ between programs and continuations. a continuation takes a data
\ stack as argument, just like ordinary programs. (RUN is the dual of
\ forth's EXECUTE, which is used here to invoke primitives).

\ *** the machine return stack is reserved for the underlying STC
\ forth / machine code. the VM uses the STC aux stack x as return
\ stack, to limit interference.

\ *** to treat composite code as a primitive, an array of primtiive
\ instructions needs to be prefixed by a machine code element 'CALL
\ enter', which will save the current continuation (IP) and invoke a
\ new one. 'enter' needs to be duplicated if a large address space is
\ spanned, so a short branch can be used.

\ *** the interpreter is explicit: this is done so that primitives do
\ not need to end in NEXT, as is done traditionally. an explicit
\ interpreter loop enables the use of STC primitives, allowing better
\ interoperability with STC a and foreighn code. also, instead of
\ using real name spaces, all primitives are prefixed with '_'
\ (underscore) so they are easily mapped and debugged in STC forth.



\ TODO: some modifications.
\ - all data sizes used (literals, primitives, composite) fixed at 14bit
\ - interpreter runs on top of memory model: composite code in ram possible


\ ************************************************************************

\ IP + RS
\ instruction pointer manipulation. only the ones that affect the
\ machine return stack and machine flags need to be macros. the rest
\ can be functions for ease of debugging.

macro
: @IP+  @f+ ;  \ read bytes from the instruction stream
forth

: _IP!
    _<< fh ! fl ! ;   \ store to IP
  
: enter \ asm (rcall ENTER) wraps composite code in prim
    _IP>r
    TOSL fl @!  \ TOS cannot be movff dst, but src is ok       
    TOSH fh @!
    pop ;   
  
: _>r    >x >x ;
: _r>    x> x> ;    
: _rdrop xdrop xdrop ;


\ These 2 govern the format in which threaded addresses are stored on
\ the return stack. For return stack tricks to work, this is taken to
\ be word addresses.
    
: _IP>r              \ save current IP to VM RS
    clc
    fh @ rot>>c +x !
    fl @ rot>>c +x ! ;
    
: _r>IP              \ pop IP from VM RS
    clc
    x- @ rot<<c fl !
    x- @ rot<<c fh ! ;


\ INSTRUCTION FORMAT + INTERPRETER / COMPILER

macro

\ in flash, code is stored as [EXIT | LIT | DATA]. the shift left when
\ reading will move EXIT->carry and LIT->negative flags.

: exit?    c? ;
: literal? n? ;
: prim@/flags         \ fetch next primitive from composition
    \ clc             \ low bit is ignored by PIC
    @IP+ rot<<c        \ this sets c and n flags
    @IP+ rot<<c  ;

  
\ compilation macros. DTC is compiled by mapping it to native forth in
\ symbolic form. these macros implement the encoding.
  
: pow2      1 swap <<< ;
: set       pow2 or ;
: mask      pow2 1 - and ;
    
: exitbit   15 set ;
: litbit    14 set ;    
: mask14    14 mask ;

: _compile ,, ;                  \ word.addr --
: _exit    dw> exitbit  ,, ;
: _literal mask14 litbit   ,, ;  \ 
: _;       _exit ;

    
\ utility macros
: _c>>     rot>>c 2nd rot>>c! ;
: _<<c     2nd rot<<c! rot<<c ; 
    
forth
  
\ inner interpreter loop
: continue
    prim@/flags                 \ fetch next primitive + set type flags
    exit? if _r>IP then         \ c -> perform exit
    literal? if 14bit ; then    \ n -> unpack literal
    execute/b continue ;        \ execute primitive

\ interpret doubleword [ 1 | 14 | x ] as a signed value.
: 14bit
    _c>>                 \ [ x | 1 | 14 ]
    #x3F and             \ high bits -> 0  
    1st 5 high?
    if #xC0 or then      \ high bits -> 1
    continue ;    



: _execute  _<<              \ execute STC primitive, word address
: execute/b push TOSH ! TOSL ! ; \ ( lo hi -- ) execute STC primitive, byte address
    
: _bye      pop              \ quit the inner interpreter
: _nop      ;


    
\ trampoline entry. 'execute' will run a dtc primitive or primitive
\ wrapped program. not again that: PRIMITIVE = pointer to native code
\ (execution token passed to 'execute') , COMPOSITE = pointer to array
\ of execution tokens (program token passed to 'run')
    
: bye>x      enter ' _bye _compile _exit
: dtc           \ ( lo hi -- )
    bye>x       \ install continuation into dtc code "bye ;"
    execute/b   \ invoke the primitive (might be enter = wrapped program)
    continue ;  \ invoke threaded continuation
    

\ CONTROL FLOW WORDS

\ 'run' is the dual of 'execute'. it takes threaded code addresses. in
\ combination with the exit bit, this can be used to implement
\ conditional jumps.
    
: _run \ addr --
    _IP>r
    _IP! ;

\ : _0=run \ flag addr -- 
\     _run
\     or nz? if _r>IP then
\     drop ;


\ "go" = "run ;"    

\ i don't want to use the word 'jump', but conditional jump is not the
\ same as conditional run.
    
: _0=go  \ ? program --
    _>r
    or nz? if
	_rdrop
    else
	_r>IP
    then drop ;

    
macro

\ note: XT need to be word addresses, since i have only 14 bit
\ literals. return stack still contains byte addresses though, so for
\ now it's kept abstract.


: _m>literal   m> _literal ;
: _m>compile   m> _compile ;

\ create a jump label symbol and duplicate it (for to and from)
: _2sym>m      sym >m m-dup ;
    


\ jumps are implemented as literal + primitive (instead of reading
\ from instruction stream)
    
: _m>jmp    _m>literal ' _run   _compile _exit ;
: _m>0=jmp  _m>literal ' _0=go  _compile  ;    
    
: _begin    _2sym>m m> label ;   \ back label
: _again    _m>jmp ;             \ back jump
: _until    _m>0=jmp _space ;    \ conditional back jump
    
: _if     _2sym>m _m>0=jmp ;                  \ c: -- label1
: _else   _2sym>m _m>jmp m-swap m> label ;   \ c: label1 -- label2
: _then   m> label _space ;        \ c: label --

: _space  ' _nop _compile ; \ necessary when 'return' needs to be isolated.
    
\ : _for    _2sym>m m> label ' do-for _compile ; \ c: -- label
\ : _next   _m>literal ' do-next _compile _space ;

: _for
    ' _>r _compile
    _begin ;
: _next
    ' do-next _compile  _m>0=jmp
    ' _rdrop _compile
    _space ;
    
forth
: do-next \ -- ?
    _r> _1- _dup
    _>r _0= ;
