Very simple but extensible MODBUS server for STM8 eForth

BUSCTRL

\ STM8 eForth C0135 bus control for RS485 - MODBUS

\res MCU: STM8S103
\res export PB_ODR PB_DDR

#require ]B!

NVM
  \ Set RS485 Driver to "RX"
  : BUSrx ( -- )
    [ 0 PB_ODR 5 ]B!
  ;

  \ Set RS485 Driver to "TX"
  : BUStx ( -- )
    [ 1 PB_ODR 5 ]B!
  ;

  \ Initialize GPIO and RS485 Driver
  : BUSCTRL ( -- )
    BUSrx
    [ 1 PB_DDR 5 ]B!
  ;
RAM

MBPROTO

\ STM8 eForth MODBUS protocol implementation

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

NVM
  VARIABLE crcerr

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

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

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

  \ 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"
  : FCNUL ( -- )
    1 MBEC
  ;

  \ FC-XT Table
  CREATE FCXT ' FCNUL
    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* FCXT +
  ;

  \ 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 ) IF
        rxbuf    C@  ( DUP  ." S: " . CR )     txc+
        rxbuf 1+ C@  DUP txc+  ( fc )
        DUP 1 17 WITHIN IF
           FC>XT @ EXECUTE
        ELSE
          FCNUL
        THEN
        tbp @ txbuf ( a1 a0 ) MBCRC ( CRC-LE ) tx+
      ELSE
        1 crcerr +!
      THEN
      send rxres
    THEN
  ;

WIPE RAM

\\

  \ show contents the RX and TX buffers
  : bufdump ( -- )
    CR ."  rxbuf:"
    rxbuf rxp @ OVER - DUP . DUMP
    CR ."  txbuf:"
    txbuf tbp @ OVER - DUP . DUMP
  ;

MBSERVER

\ STM8 eForth MODBUS Server implementation

#require MBPROTO
#require ALIAS
#require 'IDLE
#require :NVM
#require WIPE

2 CONSTANT BAUD9600

NVM

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

  \ --- FC01 "Read Coils"

  VARIABLE coils

  \ FC01 coils iterated transfer
  :NVM  ( i -- 8 )
    8 / coils + B>L C@ txc+   8 ( inc )
  ;NVM ( xt )

  \ FC01 handler
  :NVM  ( -- )
    [ ( xt1 xt2 ) SWAP ] LITERAL 1 ( xt bpu ) mbread
  ;NVM ( xt ) 1 FC>XT !


  \ --- FC02 "Read Discrete Inputs"

  VARIABLE inputs

  \ FC02 input register iterated transfer
  :NVM  ( i -- 8 )
    8 / inputs + B>L C@ txc+   8 ( inc )
  ;NVM ( xt )

  \ FC02 handler
  :NVM  ( -- )
     [ ( xt1 xt2 ) SWAP ] LITERAL 1 ( xt bpu ) mbread
  ;NVM ( xt ) 2 FC>XT !


  \ --- FC03 "Read Holding Registers"

  VARIABLE holding 6 ALLOT

  \ FC03 holding register iterated transfer
  :NVM  ( i -- 1 )
    2* holding + @ tx+   1 ( inc )
  ;NVM ( xt )

  \ FC03 handler
  :NVM  ( -- )
     [ ( xt1 xt2 ) SWAP ] LITERAL 16 ( xt bpu ) mbread
  ;NVM ( xt ) 3 FC>XT !


  \ --- FC04 "Read Input Registers"

  \ FC04 input register iterated transfer
  :NVM  ( i -- 1 )
    2* inputs + @ tx+   1 ( inc )
  ;NVM ( xt )

  \ FC04 handler
  :NVM  ( -- )
     [ ( xt1 xt2 ) SWAP ] LITERAL 16 ( xt bpu ) mbread
  ;NVM ( xt ) 4 FC>XT !


  \ MB 2 x 16 bit response
  :NVM  ( -- )
    mbp1 tx+ mbp2 tx+
  ;RAM ALIAS txp12+ NVM


  \ --- FC05 handler "Write Single Coil"

  :NVM   ( -- )
    mbp1 1- ( #b) DUP 0 8 WITHIN IF
      mbp2 $FF00 =
      ( #b f ) coils B>L
      ( #b f a ) ROT ( f a #b ) B!
    ELSE
      DROP
    THEN
    txp12+
  ;NVM 5 FC>XT !


  \ MB read rxbuf payload data
  :NVM  ( i -- i a )
    DUP rxbuf + 7 +
  ;RAM ALIAS mbrxd


  \ --- FC15 "Write Multiple Coils"

  \ FC15 Write Multiple Coils write transfer
  :NVM  ( i -- 1 )
    ( i ) mbrxd C@ SWAP ( n i )
    coils + B>L C!   1 ( inc )
  ;NVM ( xt )

  \ FC15 handler
  :NVM  ( -- )
    [ ( xt1 xt2 ) SWAP ] LITERAL  ( xt ) mbloop
    txp12+
  ;NVM ( xt ) 15 FC>XT !


  \ --- FC16 "Write Multiple Register"

  \ FC16 holding register write transfer
  :NVM  ( i -- 1 )
    ( i ) 2* mbrxd @ SWAP ( n 2i )
    holding + !   1 ( inc )
  ;NVM ( xt )

  \ FC16 handler
  :NVM  ( -- )
    [ ( xt1 xt2 ) SWAP ] LITERAL  ( xt ) mbloop
    txp12+
  ;NVM ( xt ) 16 FC>XT !


  \ --- MODBUS server startup

  : init ( -- )
    BAUD9600 UARTISR
    0 coils !
    [ ' MBPROTO ] LITERAL 'IDLE !
  ;

  ' init    'BOOT !
WIPE RAM

UARTISR

\ STM8 eForth buffered UART for MODBUS

#require WIPE

NVM
  20 CONSTANT RXLEN
  VARIABLE rxbuf RXLEN 2- ALLOT
  VARIABLE rxp       \ receive xfer pointer in ISR
  VARIABLE tstamp    \ receive timestamp

  16 CONSTANT TXLEN
  VARIABLE txbuf TXLEN 2- ALLOT
  VARIABLE txp       \ transmit xfer pointer in ISR
  VARIABLE tbp       \ transmit buffer pointer
RAM WIPE

\res MCU: STM8S103
\res export INT_UARTRX INT_UARTTX
\res export UART1_SR UART1_DR UART1_CR2

\ #require PINDEBUG

#require BUSCTRL

#require WIPE
#require :NVM
#require ALIAS
#require ]B!
#require ]B?

5 CONSTANT #RIEN
6 CONSTANT #TC
6 CONSTANT #TCIEN
7 CONSTANT #TIEN

NVM

  \ Start UART TX ISR chain

  : send ( -- )
    BUStx                  \ enable TX driver
    txbuf txp !              \ next char: buffer start
    [ 1 UART1_CR2 #TIEN ]B!  \ start ISR chain (TXE is active)
  ;

  \ reset TX buffer pointer
  : txres ( -- )
    txbuf tbp !
  ;

  \ TX ISR handler
  :NVM
    SAVEC
    \ P2H
    txp DUP @ ( va a1 ) DUP tbp @ < IF
      ( va a1 ) C@ UART1_DR C!
      ( va ) 1 SWAP +!
    ELSE
      ( va a1 ) 2DROP
      [ 0 UART1_CR2 #TIEN ]B!      \ spin down ISR chain
      [ 1 UART1_CR2 #TCIEN ]B!     \ next ISR call: transfer complete
      \ test and clear TC ISR
      [ UART1_SR #TC ]B? IF
        \ terminate ISR chain and release bus
        [ 0 UART1_CR2 #TCIEN ]B!
        txres   BUSrx
      THEN
    THEN
    \ P2L
    IRET
  [ OVERT INT_UARTTX !

  \ headerless: test for enough free space in txbuf for putting n bytes
  :NVM  ( n -- f )
    tbp @ txbuf - + 1- TXLEN <
  ;RAM ALIAS test-tbp

NVM

  \ add c to TX buffer
  : txc+ ( c -- )
    1 test-tbp IF
      tbp @ C! 1 tbp +!
    THEN
  ;

  \ add n to TX buffer
  : tx+ ( n -- )
    2 test-tbp IF
      tbp @ ! 2 tbp +!
    THEN
  ;

  \ RX ISR handler
  :NVM
    SAVEC
    \ P1H
    UART1_DR C@
      ( c ) rxp @ ( c a ) DUP rxbuf - ( c a len ) RXLEN < IF
      ( c a ) SWAP ( a c ) OVER ( a c a ) C!
      ( a ) 1+ rxp !
    THEN
    TIM tstamp !
    \ P1L
    IRET
  [ OVERT INT_UARTRX !

  \ reset RX buffer and initialize RX ISR handler
  : rxres ( -- )
    rxbuf rxp !
    [ 1 UART1_CR2 #RIEN ]B!
  ;

WIPE RAM

\res export UART1_CR2 UART1_BRR1

#require ]C!
#require OSCFREQ
#require UART_DIV


: BR ( br -- )   \ shorthand for baud rate table
  OSCFREQ UART_DIV
;

NVM

  HERE  \ pass-on baud rate table address to UARTISR
  240 BR , 480 BR , 960 BR , 1920 BR , 5760 BR , 11520 BR , 23040 BR ,

  \ initilization of buffered UART handler (call this once)
  : UARTISR ( n -- )
    2* ( BR table ) LITERAL + @ UART1_BRR1 !
    [ $0C UART1_CR2 ]C! \ enable TX and RX
    \ PINDEBUG
    BUSCTRL
    txres rxres
  ;

WIPE RAM

\\ Example, run e.g. in SWIMCOM
#include UARTISR

  \ show contents the RX and TX buffers
  : bufdump ( -- )
    CR ."  rxbuf:"
    rxbuf rxp @ OVER - DUP . DUMP
    CR ."  txbuf:"
    txbuf tbp @ OVER - DUP . DUMP
  ;

2 UARTISR
txbuf TXLEN 66 FILL
65 txbuf C!
10 txbuf TXLEN 1- + C!
txlen tbp +!
send

Refer to issue #238.