Interrupts

I'm reasonably happy with my little interrupt dispatcher which has an interface like this:

\ interrupt service routine for TIMER1 interrupt
: ticker ." tick " TIMER1 clear-timer-interrupt ;

['] ticker int$TIMER1 isr!
int$TIMER1 enable-interrupt

\
\ VIC: Vectored Interrupt Controller
\

VARIABLE isr-table 32 cells ALLOT

: isr-entry ( n -- ) cells isr-table + ;
: isr! ( cfa int# -- ) isr-entry ! ;
: isr@ ( int# -- cfa ) isr-entry @ ;

: service-interrupt ( n -- )
    dup isr@   ( n isr|0 )
    ?dup 0<> IF
        execute
        drop
    ELSE
        ." Unhandled interrupt #" . cr
    THEN
;

: ack-IRQs ( -- ) $0 VICVectAddr ! ;

\ Call the ISR for each enabled and asserted IRQ.
: isr-dispatch ( -- )
    VICIRQStatus @
    32 0 DO ( IRQs )
        dup i bit-set? IF
            i service-interrupt
        THEN
    LOOP
    drop
    ack-IRQs
    EXIT-ISR
;

\ Setup generic interrupt dispatching.
: init-VIC
    32 0 DO  0 i isr!  LOOP
    ['] isr-dispatch forth-isr !
    c-isr @ VICDefVectAddr !  \ default non-vectored IRQ handler
;

\ Utilities for ISRs

: clear-timer-interrupt ( TIMER -- )
    $FF swap T-IR + !   ( clear all interrupt flags )
;

: enable-interrupt ( int# -- ) bit VICIntEnable ! ;

To communicate between I/O interrupt handlers and "normal" code I spent most of the day writing a simple ring (bounded buffer) data structure. I'm not thrilled at how much stack-munging code this turned out to be. I reckon that either I didn't write it very well, or I could have taken a much simpler approach in general, or both.

\ Ring data structure to use as a bounded-buffer.
\ The ring is initialized with two parameters:
\   MAX: The most items that the ring can contain.
\   ITEM-SIZE: The number of words per item in the ring.
\ The basic operations are RING-EMPTY? RING-FULL? >RING RING@ RING>
\ Each add/remove from the queue moves ITEM-SIZE words between the
\ queue and the stack.
\ 
\ For example if ITEM-SIZE is 3 then the stack effect of
\ >RING is ( a b c ring -- ) and RING@ or RING> is ( ring -- a b c ).
\
\ The idea is to have an interrupt handler like:
\ : can-send   ( dB dA len id ) can-tx-ring >ring ;
\ : can-tx-ISR ( -- ) can-tx-ring ring> ( dB dA len id ) can-tx
\ where this ring has four words per item.

\ Data structure layout:
\ MAX is the most items that the ring can hold.
: ring-max          ( ring -- addr ) ;
\ FIRST is the index (0..MAX-1) of the first item i.e. next to be taken.
: ring-first        ( ring -- addr ) cell+ ;
\ LENGTH is the number of items currently in the ring.
: ring-length       ( ring -- addr ) 2 cells + ;
\ ITEM-SIZE is the number of words per item.
: ring-item-size    ( ring -- addr ) 3 cells + ;
\ DATA is the start address of the real data area.
: ring-data         ( ring -- addr ) 4 cells + ;
\ See the example down below for how to initialize a ring.

: ring-empty? ( ring -- flag )
    ring-length @ 0=
;

: ring-full? ( ring -- flag )
    dup ring-length @ ( ring len )
    swap ring-max @   ( len max )
    =
;

\ Return the address of the first (next) data element.
: ring-first-addr ( ring -- addr )
    dup ring-first @          ( ring n )
    over ring-item-size @ cells ( ring n size )
    *                         ( ring offset )
    swap ring-data +          ( element-addr )
;

\ Return the address of the last data element. 
: ring-last-addr ( ring -- addr )
    dup ring-first @          ( ring n )
    over ring-length @ +      ( ring n )
    over ring-max @ mod       ( ring n )
    over ring-item-size @ cells ( ring n size )
    *                         ( ring offset )
    swap ring-data +          ( element-addr )
;

\ Copy the elements of the next data element onto the stack.
: ring@ ( ring -- ... )
    dup ring-first-addr swap ( addr ring )
    ring-item-size @         ( addr size )
    0 DO                     ( addr )
        dup @ swap           ( ... v addr )
\        ." fetched " over . ." from " dup . cr
        cell+
    LOOP                     ( v1 .. vn addr )
    drop                     ( v1 .. vn )
;

\ Drop the next element from the ring.
: ring-drop ( ring -- )
    dup ring-length --
    dup ring-first @ 1+  ( ring first' )
    over ring-max @ mod  ( ring first'' )
    swap ring-first !
;

\ Move the next element of the ring onto the stack.
: ring> ( ring -- ... )
    dup >r
    ring@
    r> ring-drop
;

\ Move a data element from the stack onto the ring.
: >ring ( v1 .. vn ring -- )
    dup ring-last-addr            ( ... ring addr )
    over ring-length ++           ( ... ring addr )
    \ insert the elements backwards so that they'll be taken out forwards
    over ring-item-size @         ( ... ring addr elem-size )
    1- cells +                    ( ... ring addr )
    swap ring-item-size @ 0 DO    ( ... addr )
\        cr ." store " over . ." at " dup .
        swap over                 ( v1 ... addr vn addr )
        !                         ( v1 ... vn-1 addr )
        cell-
    LOOP
    drop
;

: .ring ( ring -- )
    cr
    ." max:    " dup ring-max @ . cr
    ." first:  " dup ring-first @ . cr
    ." length: " dup ring-length @ . cr
    ." esize:  " ring-item-size @ .
;

\
\ Test/example code
\

\ Ring for testing
VARIABLE r 4 3 * ( four 3-word items ) 4 + ( and 4 words of header ) cells ALLOT

: init-r ( ) 
    \ Configure the ring
    4 r ring-max !
    0 r ring-first !
    0 r ring-length !
    3 r ring-item-size !
    \ Then you can do e.g.
    \ 1 2 3 r >ring   s:
    \ 4 5 6 r >ring   s:
    \ r ring>         s: 1 2 3
    \ r ring>         s: 1 2 3 4 5 6
    \ etc..
;