class: [I2C]

$00 hfield: ~revl
$04 hfield: ~revh
$10 hfield: ~sysconfig
$24 hfield: ~irq-set
$28 hfield: ~irq-clr
$28 hfield: ~irq
$2c hfield: ~irq-en
$30 hfield: ~irq-dis
$38 hfield: ~rx-dma-en
$3c hfield: ~tx-dma-en
$40 hfield: ~rx-dma-dis
$44 hfield: ~tx-dma-dis
$90 hfield: ~sysstatus
$94 bfield: ~tx-conf
$95 bfield: ~rx-conf
$98 hfield: ~count      \ 0 means $10000
$9c bfield: ~data
$a4 hfield: ~control
$a8 hfield: ~myaddr0
$ac hfield: ~addr
$b0 bfield: ~prescaler
$b4 bfield: ~scl-low
$b5 bfield: ~scl-low-hs
$b8 bfield: ~scl-high
$b9 bfield: ~scl-high-hs
$bc hfield: ~test
$c0 bfield: ~tx-stat
$c1 bfield: ~rx-stat
$c4 hfield: ~myaddr1
$c8 hfield: ~myaddr2
$cc hfield: ~myaddr3
$d0 hfield: ~aas-addr
$d4 hfield: ~aas-stall

: ~fifo-size ( -- bytes ) 8 ~rx-stat 6 lsr lsl ;
: ~rx-stat ~rx-stat $3f and ;

\ control
 0 exp2  equ: start#
 1 exp2  equ: stop#
 9 exp2  equ: write#
10 exp2  equ: master#
11 exp2  equ: stbyte#
12 exp2  equ: hs#
13 exp2  equ: sccb#
15 exp2  equ: enabled#

\ events
 0 exp2  equ: al#       \ E arbitration lost
 1 exp2  equ: nack#     \ E nack received
 2 exp2  equ: ardy#     \ E ready for new transaction
 3 exp2  equ: rrdy#     \ E receive data ready
 4 exp2  equ: xrdy#     \ E transmit data ready (uses RRDY-wakeup)
 5 exp2  equ: gcall#    \ E general call detected
 6 exp2  equ: stc#      \ E start condition detected while clock was gated
 7 exp2  equ: aerr#     \ E unexpected access to data register
 8 exp2  equ: bf#       \ E bus free
 9 exp2  equ: aas#      \ E addressed as slave
10 exp2  equ: xudf#     \ L transmit underflow (i2c clock is being stalled)
11 exp2  equ: rovr#     \ L receive overrun (i2c clock is being stalled)
12 exp2  equ: bb#       \ L bus is busy (set at start, cleared at stop)
13 exp2  equ: rdr#      \ E receive draining
14 exp2  equ: xdr#      \ E transmit draining



: kHz 1000 * ;
: MHz 1000000 * ;

48 MHz equ: fclk-rate#
 4 MHz equ: sample-rate#
10 kHz equ: bit-rate#

fclk-rate# sample-rate# u/ 1-  equ: prescaler#
sample-rate# bit-rate# u/ 12 -  \ -- period
dup 2u/ 1+ equ: scl-high#
scl-high# - equ: scl-low#

prescaler# $100 u>= abort" prescale divider out of range"
scl-low#   $100 u>= abort" scl low time out of range"
scl-high#  $100 u>= abort" scl high time out of range"

: ~suspend ( -- )
   enabled# bic-to ~control
   1 to ~sysconfig
;

: -irq ( mask -- ) dup to ~irq-dis to ~irq-clr ;
: +irq ( -- ) $63ff to ~irq-en ;

: ~init ( -- )
   0 to ~control
   2 to ~sysconfig
   ~sysconfig drop
   prescaler# to ~prescaler
   scl-low# to ~scl-low
   scl-high# to ~scl-high
   %me to ~myaddr0
   %me 1- to ~myaddr1
   enabled# to ~control
   1 [addr] ~sysstatus wait-all-set
   +irq
   $11 to ~sysconfig
;

enabled# master# or start# or equ: rcon#
rcon# write# or equ: wcon#

rcon# stop# or equ: rcons#
wcon# stop# or equ: wcons#

: ~tx ( byte -- )
   to ~data
   xrdy# to ~irq-clr
   xrdy# ardy# or [addr] ~irq-set wait-any-set
;

: ~rx ( -- byte )
   rrdy# [addr] ~irq-set wait-any-set
   ~data
   rrdy# to ~irq-clr
;

: ~rdy ( -- )
   ardy# [addr] ~irq-set wait-any-set
   ardy# to ~irq-clr
   +irq
;

: ~write ( xn .. x0 n sa -- )
   ardy# xrdy# or -irq
   to ~addr
   1+ dup to ~count
   wcons# to ~control
   xudf# [addr] ~irq-set wait-any-set
   0 do ~tx loop
   ~rdy
;

: ~read ( n sa -- x0 .. xn )
   ardy# rrdy# or -irq
   to ~addr
   1+ dup to ~count
   rcons# to ~control
   0 do ~rx loop
   ~rdy
;

: ~dump ( n sa -- )
   ardy# rrdy# or -irq
   to ~addr
   1+ dup to ~count
   rcons# to ~control
   0 do ~rx b. loop
   ~rdy
;

done

meta: i2c0  postpone &i2c0  postpone [I2C]  ;

: i2c0-init ( -- )
   &clk-l3s-alwon &mod-i2c02 do-cm
   i2c0 ~init
   ctrl ~unlock-pad
   1  263 pinmux  h!    \ ball AC04 - I2C0_SCL (IO_SCL)
   1  264 pinmux  h!    \ ball AB06 - I2C0_SDA (IO_SDA)
   ctrl ~lock
;



to [I2C]

: ~info ( -- )
   ~irq-set
   ~control $0603 and to <16:>
   ~aas-addr to <20:25>
;

: list-info ( info prefix -- info )
   >r
   <0:8> if
    <0> if r@ emit ." AL " then
    <1> if r@ emit ." NACK " then
    <2> if r@ emit ." ARDY " then
    <3> if r@ emit ." RRDY " then
    <4> if r@ emit ." XRDY " then
    <5> if r@ emit ." GCALL " then
    <6> if r@ emit ." STC " then
    <7> if r@ emit ." AERR " then
   then
   <8:16> if
    <8> if r@ emit ." BF " then
    <9> if r@ emit ." AAS " then
   <10> if r@ emit ." XUDF " then
   <11> if r@ emit ." ROVR " then
   <12> if r@ emit ." BB " then
   <13> if r@ emit ." RDR " then
   <14> if r@ emit ." XDR " then
   then
   <16:> if
   <26> if r@ emit ." MST " then
   <25> if r@ emit ." WRITE " then
   <16> if r@ emit ." S " then
   <17> if r@ emit ." P " then
   <20> if r@ emit ." OA0 " then
   <21> if r@ emit ." OA1 " then
   <22> if r@ emit ." OA2 " then
   <23> if r@ emit ." OA3 " then
   then
   rdrop
;

0 value: prev-irq
0 value: prev-bufstat
:noname ( -- )
   [chain] init-handler
   0 to prev-irq
   $8000 to prev-bufstat
; is init-handler

$c0 hfield: ~bufstat

: ~poller ( -- )
   prev-bufstat ~bufstat dup to prev-bufstat <> if
      %yellow prev-bufstat <8:14> (b.) ." /" b. %-
   then
   prev-irq ~irq-en and ?dup if to ~irq-clr then
   ~info                        \ -- cur
   dup prev-irq = if drop exit then
   dup prev-irq rbic ?dup if    \ -- new fell
      %red
      [char] - list-info
      bic-to prev-irq           \ -- new
   then
   prev-irq bic ?dup if         \ -- rise
      dup ~irq-en and ?dup if   \ -- rise rise&clear
         dup to ~irq-clr
         ~info bic ?dup if              \ -- rise events
            %yellow
            0 list-info
            bic                         \ -- rise
         then
      then
      %green
      [char] + list-info
      or-to prev-irq
   then
   %-
;

done

: poller ( -- ) i2c0 ~poller ;

true value: poller-en?

: i2c0-init
   false to poller-en?
   i2c0-init
   0 i2c0 to prev-irq
   $8000 i2c0 to prev-bufstat
   true to poller-en?
   &i2c0 to ~
;

i2c0-init

:noname [chain] init-handler i2c0-init ; is init-handler

:noname ( -- )
   [chain] yield
   poller-en? if
      false to poller-en?
      poller
      true to poller-en?
   then
; is yield

:noname ( -- )
   false to poller-en?
   [chain] pre-halt
; is pre-halt