\ *********************************************************************
\                                                                     *
\    Filename:      i2c.fth                                           *
\    Date:          15.1.2008                                         *
\    FF Version:    3.2                                               *
\    Copyright:     Mikael Nordman                                    *
\    Author:        Mikael Nordman                                    *
\ *********************************************************************
\    FlashForth is licensed acording to the GNU General Public License*
\ *********************************************************************
-i2c
marker -i2c
hex ram
\ needs from asm.fth bcf, bsf, btfsc, btfss, movf, movwf, andwf,
\            Sminus
\ For convinience these are provided here.
0 con w,     \ Destination W register
1 con f,     \ Destination File
0 con a,     \ Force Access Bank
1 con b,          \ Force Bank Select Register
ffed con Sminus
$14 as3 andwf,          ( f d a -- )  
$50 as3 movf,           ( f d a -- )  
$6e as2 movwf,          ( f a -- )    
$90 as3 bcf,            ( f b a -- )  
$80 as3 bsf,            ( f b a -- )  
$b0 as3 btfsc,          ( f b a -- )  
$a0 as3 btfss,          ( f b a -- )  
$0e00 as1 movlw,        ( k -- )  
$0012 as0 return,       ( -- )    

\ NOTE: 18F2455 and friends USB pics do NOT use PORTC for SDA,SCL.
\ Most others do. 
ff82 con portc
ff94 con trisc

ffc5 con sspcon2
ffc6 con sspcon1
ffc7 con sspstat
ffc8 con sspadd
ffc9 con sspbuf
ff9e con pir1

\ pir1 bits
3 con sspif

\ SSPCON2 bits
0 con sen
1 con rsen
2 con pen
3 con rcen
4 con acken
5 con ackdt
6 con ackstat

bin
: i2cinit ( -- )
  [ trisc 011 0 bsf, ]
  [ trisc 100 0 bsf, ]
  10000000 sspstat c!
  [ khz #2 rshift #100 / ] literal sspadd c! \ 100 KHz i2c
  00101000 sspcon1 c!
  00000000 sspcon2 c!
;
hex

: ssen  ( -- ) \ Send start condition enable /stretch bit
  [ 
    pir1 sspif a, bcf,
    sspcon2 sen a, bsf,
    begin,
      pir1 sspif a, btfss,
    again,
  ]
;
: srsen ( -- ) \ Send repeated start condition enable bit
  [
    pir1 sspif a, bcf,
    sspcon2 rsen a, bsf,
    begin,
      pir1 sspif a, btfss,
    again,
  ]
;
: spen  ( -- ) \ Send stop bit 
  [
  pir1 sspif a, bcf,
  sspcon2 pen a, bsf,        \ pen   send stop bit
  begin,
    pir1 sspif a, btfss,
  again,
  ]
;
: srcen ( -- ) \ Send receive enable
  [ 
  pir1 sspif a, bcf,        \ sspif clear interrupt flag
  sspcon2 rcen a, bsf,      \ rcen  enable receive mode
  begin,
    pir1 sspif a, btfss,    \ sspif Wait for reception to complete
  again,
  ]
;
: snoack ( -- )             \ send no ack
  [
  pir1 sspif a, bcf,        \ sspif clear interrupt flag
  sspcon2 ackdt a, bsf,     \ ackdt no ACK
  sspcon2 acken a, bsf,     \ acken send ACKDT bit
  begin,
    pir1 sspif a, btfss,    \ sspif Wait
  again,
  ]
;
: sack ( -- ) \ Send ack
  [
  pir1 sspif a, bcf,        \ sspif clear interrupt flag
  sspcon2 ackdt a, bcf,     \ ackdt ACK
  sspcon2 acken a, bsf,     \ acken send ACKDT bit
  begin,
    pir1 sspif a, btfss,    \ sspif Wait
  again,
  ]
;
: sspbuf! ( c -- )          \ sspbuf! takes 90 us @ 100 KHz
  [ 
  pir1 sspif a, bcf,
  Sminus w, a, movf,
  Sminus w, a, movf,
  sspbuf  a, movwf,
  begin,
    pir1 sspif a, btfss,
  again, 
  ]
;

: i2cwakeslave ( slaveaddr -- )
  ssen
  begin
    dup sspbuf!
    [
    1 ackstat lshift movlw, \ check for Acknowledge from slave
    sspcon2 w, a, andwf, 
    z, if,
      Sminus w, a, movf,    \ Exit if ack received
      Sminus w, a, movf,
      return,
    then,
    ]
    srsen                   \ Repeated start condition
  again
;

: i2cwr ( c --  write one byte to the i2c bus )
  sspbuf!
  begin
    [ sspcon2 ackstat a, btfsc, ] \ ackstat Wait for ACK from slave
  again
;
: i2crc ( -- c ) \ read one byte from the i2c bus
        srcen                      \ Receive enable
        sspbuf c@                  \ save data to stack
        snoack                     \ NO ACK
        spen                       \ send stop bit 
;
: i2cr ( -- c c ) \ read two bytes from the i2c bus
        srcen                      \ Receive enable
        sspbuf c@                  \ save data to stack
        sack                       \ Send  ACK
        srcen                      \ Receive enable
        sspbuf c@                  \ save data to stack
        snoack                     \ NO ACK
        spen                       \ send stop bit
;

: i2caddr ( addr -- )
        $a0 i2cwakeslave     \ wake in write mode
        dup 8 rshift i2cwr   \ addr hi byte
        $ff and i2cwr        \ addr lo byte
;
: i2c@ ( addr -- c )
        i2cinit
        i2caddr
        srsen                \ Repeted start enable
        $a1 i2cwr            \ write the read bit
        i2crc                \ get data
;

: i2c! ( c addr -- )
        i2cinit
        i2caddr
        i2cwr                \ c
        spen                 \ pen   send stop bit
;
hex

\ Read temp from tcn75 temp sensor
-temp
marker -temp
: temp ( -- n )
  i2cinit
  $9b i2cwakeslave
  i2crc dup $7f > if $ff80 or then
;

\ Average temperature over 16 samples
: avt ( -- n )
  i2cinit
  0
  #40
  for
    #50 ms
    $9b i2cwakeslave i2crc +
  next
  2+ #40 / dup $7f > if $ff80 or then
;

-bt
marker -bt
: bt temp ." The board temperature is " . ." degrees celcius." cr
;
: dt avt ." The board temperature is " . ." degrees celcius." cr
;
decimal
-btc
marker -btc
: btc decimal begin bt #4000 ms key? until ;
: dtc decimal begin dt key? until ;
ram