MBPROTO

\ STM8 eForth MODBUS protocol handler - intended to run as an IDLE task

#require UARTISR
#require CRC16
#require ]B!
#require WIPE

NVM
  VARIABLE mbnode  \ MODBUS node id
  VARIABLE crcerr  \ CRC error counter
  VARIABLE mbact   \ action XT for generic extensions (e.g. debugging)
  VARIABLE mbdef   \ action XT for default handler

  \ get MODBUS FC
  : mbfc ( -- c )
    rxbuf 1+ C@
  ;

  \ 1st MODBUS FC parameter
  : mbp1 ( -- n )
    rxbuf 2+ @
  ;

  \ 2nd MODBUS FC parameter
  : mbp2 ( -- n )
    rxbuf 4 + @
  ;

  \ MODBUS single write response (e.g FC05, FC06)
  : MBSWR  ( -- )
    mbp1 tx+ mbp2 tx+  \ copy 1st and 2nd parameter
  ;

  \ calc CRC16 from buffer a0 to a1
  : MBCRC ( a1 a0 -- crc-le )
    -1 ROT ROT ( -1 a1 a0 ) DO
      I C@ CRC16
    LOOP
    ( CRC16 ) EXG ( CRC-LE )
  ;

  \ flag MODBUS Exception and set code
  : MBEC ( ec -- )
    [ 1 txbuf 1+ 7 ]B!
    ( ec ) txc+
  ;

  \ default FC handler - raise EC 1 "ILLEGAL FUNCTION"
  : FCDEF ( -- )
    mbdef @ ?DUP IF
      \ maybe there is something else you want to try
      ( xt ) EXECUTE
    ELSE
      1 MBEC
    THEN
    [ HERE ( xt ) ]
  ;

  \ make FC-XT Table for FC>XT, initialize with "default FC handler"
  HERE ( [ tab ] ) ' FCDEF ( [ a1 a2 ] )
    DUP , DUP , DUP , DUP , DUP , DUP , DUP , DUP ,
    DUP , DUP , DUP , DUP , DUP , DUP , DUP ,     ,

  \ turn FC into XT table address
  : FC>XT ( fc -- a )
    1- 2* ( [ tab ] ) LITERAL +
  ;

  \ process MB  loop in (xt), steps from mbp1 to mbp1+mbp2
  : mbloop ( xt -- )
    mbp1 mbp2 OVER + SWAP  DO
      ( xt ) I OVER EXECUTE ( inc )
    +LOOP
    DROP
  ;

  \ MB looped read action (xt) with bpu bit per increment
  : mbread ( xt bpu -- )
    mbp2 * 1- 8 / 1+ txc+
    ( xt bpu ) mbloop
  ;

  \ MODBUS protocol handler
  : MBPROTO ( -- )
    rxbuf rxp @ - ( rx )
    1 TIM tstamp @ - <   AND ( message trigger )
    IF
      rxp @ 2- ( a1 ) DUP rxbuf ( a1 a1 a0 )
      MBCRC ( a1 crc-le ) SWAP @ = ( crc OK )
      ( crc-ok ) IF
        mbnode @ rxbuf C@ = ( node address match ) IF
          rxbuf    C@  ( DUP  ." S: " . CR )     txc+
          rxbuf 1+ C@  DUP txc+  ( fc )
          DUP 1 17 WITHIN IF
             FC>XT @ EXECUTE
          ELSE
            FCDEF
          THEN
          tbp @ txbuf ( a1 a0 ) MBCRC ( CRC-LE ) tx+
          mbact @ ?DUP IF
            ( xt ) EXECUTE
          THEN
          send rxres
        THEN
      ELSE
        1 crcerr +!
      THEN
    THEN
  ;

  \ address Big Endien to Little Endien
  : B>L ( aBE -- aLE )
    1 XOR
  ;

WIPE RAM

\\ Example

\ Minimal MODBUS server with a FC06 "Write Single Register" handler

#require MBPROTO

RAM
#require MBRESET
MBRESET   \ Reset the MODBUS Function Code table

#require :NVM
#require 'IDLE

  2 CONSTANT BAUD9600

NVM
#require MBDUMP

  \ --- FC06 handler "Write Single Register"
  :NVM  ( -- )
    \ write register address and value to the console
    ." Write register:" mbp1 . ." =" mbp2 . CR
    MBSWR  \ acknowledge FC06
  ;NVM ( xt ) 6 FC>XT !   \ register the FC handler

  : showfc ( -- )
    rxbuf C@ ." FC:" . CR
    1 MBEC  \ set error code
  ;

  : init ( -- )
    BAUD9600 UARTISR              \ initialize UART handler, set baud rate
    1 mbnode !                    \ 10 is the node address
    [ ' showfc ] LITERAL mbdef !  \ FC default action (optional feature)
    [ ' MBDUMP ] LITERAL mbact !  \ show buffers (debug demo)
    [ ' MBPROTO ] LITERAL 'IDLE ! \ run MB protocol handler as idle task
  ;

  ' init    'BOOT !
WIPE RAM