#lang planet zwizwa/staapl/pic18 \ -*- forth -*-
provide-all

staapl pic18/vector
staapl pic18/prom
staapl pic18/route

2variable v-rx
2variable v-tx
: receive  v-rx invoke ;
: transmit v-tx invoke ;   



\ --- INTERPRETER ---

\ control xts
: jsr     push receive2 TOSH ! TOSL ! ;
: header  #xFF transmit transmit ;  \ reply packet (address + length)
    
: ack     0 header ;  \ zero length message to host

\ Apart from single character replies in the interpreter, this behaves
\ as Forth "emit": it sends single characters to the host console
\ encapsulated as length=1 messages, while it is waiting for an ack
\ (lenth=0 message).
: emit   1 header transmit ;

    


\ NOTE: console-on/off is disabled. fix this somewhere else.    
: ferase   flash erase   ack ;
: fprog    flash program ack ;


\ token 0 is nop, so a stream of zeros can be used as soft interrupt

\ Except for nop and reset, all tokens return at least one byte result
\ to synchronize on. The protocol has Remote Procedure Call (RPC)
\ semantics, but implements it without the need for simultaneous
\ buffering and handling.
    
\ token --
: interpret-cmd
    #x0F and route
     ack    . receive/ack . emit    . jsr/ack .
     lda    . ldf         . ack     . reset
     n@a+   . n@f+        . n!a+    . n!f+    .    
     chkblk . stackptr    . ferase  . fprog   ;


: receive2    receive receive ;   
: receive/ack receive ack ;
: jsr/ack     jsr ack ;   

\ Bytecode interpreter main loop.  The zero length message is ignored,
\ all other messages are interpreted and assumed to be of correct
\ length.  ( This is debug: target doesn't need to second-guess the host. )

macro
: 0=  #xFF + drop nc? ;        \ n -- ?
: 0?  -1 addlw 1 addlw z? ;    \ n -- n ?  : sets machine flags
forth

: interpret-msg
    receive 0= not if receive interpret-cmd then ;
: forward-msg \ id --
    transmit
    receive dup transmit
    0? if drop ; then
    for receive transmit next ;
    
: interpreter
    receive 1 - nc? if
        \ 0 = us
        drop interpret-msg
    else
        \ other 
        forward-msg
    then
    interpreter ;

\ Block transfer. These take the size from the command input to make
\ the host -> target protocol context-free, and send out message
\ length to do the same for target -> host protocol.

: receive-dup-header receive dup header ;
    
: n@f+ receive-dup-header for @f+ transmit next ;
: n@a+ receive-dup-header for @a+ transmit next ;
    
: n!f+ receive for receive !f+ next ack ;
: n!a+ receive for receive !a+ next ack ;

\ pointer initialization
: lda  receive2 a!! ack ;
: ldf  receive2 f!! ack ;
    
\ program block memory check
: chkblk 255 64 for @f+ and next emit ;

\ Dump data stack size.  Since the data stack is a real stack to the
\ host, the target needs to provide information about the bottom.  The
\ easiest way to do this is to just return the size, and let the host
\ pull out the data.
: stackptr FSR0L @ emit ;