staapl pic18/shift
\ staapl pic18/interpreter
staapl pic18/route


\ usb device state
variable   state
variable   endpoint        \ current endpoint
variable   device-address  \ current usb device address

macro
: POWERED 0 ;
: DEFAULT 1 ;
: ADDRESS 2 ;
: CONFIG 3 ;
forth



  







  
: init-usb
    0 UIE !   \ mask all USB interrupts
    0 UIR !   \ clear all interrupt flags
    
    \ #x10 UCFG ! \ int pullup + transceiver, low speed, no pingpong
    #x14 UCFG ! \ int pullup + transceiver, full speed, no pingpong
    #x08 UCON ! \ USBEN high: needs to be done last [PIC,164]
 
    POWERED state !

    begin UCON SE0 high? until \ wait for single ended zero on bus
    
    \ something with config i dont get
;

: debug 65 + emit ;

: service-usb
    \ UIR @ trace drop
    \ [PIC,178]
    UIR UERRIF  high? if error       ; then
    UIR SOFIF   high? if soframe     ; then  \ 1kHz bus heartbeat
    UIR IDLEIF  high? if idle        ; then
    UIR ACTVIF  high? if activity    ; then
    UIR STALLIF high? if stall       ; then
    UIR URSTIF  high? if usbreset    ; then
    UIR TRNIF   high? if transaction ; then
;


\ layer 0
: error    0 UEIR ! ;                           \ usb error
: soframe  UIR SOFIF low ;                      \ START-OF-FRAME token received
: idle     UIR IDLEIF low UCON SUSPND high ;    \ idle condition detected
: activity UIR ACTVIF low UCON SUSPND low ;     \ bus activity detected
: stall    UIR STALLIF low ;                    \ STALL handshake sent


macro
\ Implemented as macros so we can use the fast LFSR instruction.  

\ These will load the address of the endpoint register window into the
\ a register.

: EPn-OUT    3 <<< ;
: EPn-IN     EPn-OUT 4 + ;    

\ ( reladdr -- ) set object to buffer descriptor in bank 4
: BD:        4 a!! ;

\ Convenient aliases (ColorForth-style)    
: !+         !a+ ;
: @+         @a+ ;
    
: buf-page 4 ;    \ first bank of dual-port USB ram (4-7)
: buf-OUT0 #x80 ; \ 64 bytes
: buf-IN0  #xC0 ; \ 64 bytes
forth


\ Follow pointer.  Note this needs to load on stack and then update
\ `a' reg.  The full sequence is 8 instructions so let's make it a
\ word, not a macro.
: NEXT:      @a+ @a+ a!! ; 
  

\ Words that end in ':' set the current object pointer (the `a'
\ register) to a particular address.  The data can then be streamed
\ into/out-of the memory using !+ or @+.
    
\ Load buffer address into `a'.  
: OUT0:          buf-OUT0 buf-page a!! ;
: IN0:           buf-IN0  buf-page a!! ;

\ Load buffer descriptor (BD) into `a'.  
: BD-OUT0:       0 EPn-OUT BD: ;
: BD-IN0:        0 EPn-IN  BD: ;

forth

    
  
\ valid usb reset occured
: usbreset

    POWERED state !
    
    4 for UIR TRNIF low next        \ clear out the USTAT FIFO
    UEP0 #x0F a!! 16 for 0 !a+ next \ clear EP control regs

    BD-OUT0:
      #x08     !+  \ clear UOWN, MCU can write
      64       !+  \ buffer size
      buf-OUT0 !+  \ addrl
      buf-page !+  \ addrh

    BD-IN0:
      #x08     !+  \ clear UOWN, MCU can write
      64       !+  \ buffer size
      buf-IN0  !+  \ addrl
      buf-page !+  \ addrh

    0 UADDR !              \ set USB address to 0
    0 UIR !                \ clear all usb interrupt flags    
    #x16 UEP0 !            \ control: in, out, setup + handshake enabled + stall off
    #xff UEIE !            \ enable all error interrupts

    DEFAULT state !

    BD-OUT0:
      #x88 !+ \ set UOWN: USB can write
    ;


\ Request parsing.  The general approach we use is to read the buffer
\ from left to right using @+, storing any useful data in variables.
variable endpoint
variable bmRequestType
  

macro    
: BD-LAST:
    USTAT @ #x7C and      \ mask out bits to get BD register offset
    dup >>3 endpoint !    \ save endpoint (WHY?)
    BD: ;                 \ current object = BD of last transaction

: STAT-PID >>2 #x0F and ; \ convert STAT to PID.  
forth
    
    
: transaction

    BD-LAST:        \ current object = BD of last transaction
      @+ STAT-PID   \ get packet ID from STAT register
      @+ drop       \ ignore size
    NEXT:           \ follow pointer to current buffer

    \ usb core gives only IN OUT STATUS,
    \ so use only top 2 bits to route:
    
    \ 0001 OUT    pos0
    \ 1001 IN     pos2
    \ 1101 SETUP  pos3

    >>2 route
        transaction.OUT   . .
        transaction.IN    .
        transaction.SETUP ;    

\ These have current object set to packet buffer.        
: transaction.OUT   \ -- : a->packet
    ;
: transaction.IN    \ -- : a->packet
    ;

: transaction.SETUP \ -- : a->packet
    @+  bmRequestType !
    @+  \ bRequest
    
    #x0F and route
        GET_STATUS        . \  0
        CLEAR_FEATURE     . \  1
                          . \  2
        SET_FEATURE       . \  3
                          . \  4
        SET_ADDRESS       . \  5
        GET_DESCRIPTOR    . \  6
        SET_DESCRIPTOR    . \  7
        GET_CONFIGURATION . \  8
        SET_CONFIGURATION . \  9
        GET_INTERFACE     . \ 10
        SET_INTERFACE     ; \ 11

\ These have current object pointing at byte 2 of SETUP request buffer.
: GET_STATUS ;
: CLEAR_FEATURE ;
: SET_FEATURE ;
: SET_ADDRESS ;
: GET_DESCRIPTOR ;
: SET_DESCRIPTOR ;
: GET_CONFIGURATION ;
: SET_CONFIGURATION ;
: GET_INTERFACE ;
: SET_INTERFACE ;

        
        
: test
    init-usb
    begin service-usb again



load debug.f

: out0 OUT0: 4 for 16 nadump+ next ;
: in0  IN0:  4 for 16 nadump+ next ;        
