Merge pull request #26 from TG9541/C0135-FC01-FC02

C0135 fc01 fc02

MBPROTO

@@ -33,8 +33,8 @@ NVM
     rxbuf 4 + @
   ;
 
-  \ MODBUS single write response (e.g FC05, FC06)
-  : MBSWR  ( -- )
+  \ MODBUS write response (e.g FC05, FC06, FC15, FC16)
+  : MBWR  ( -- )
     mbp1 tx+ mbp2 tx+  \ copy 1st and 2nd parameter
   ;
 
@@ -73,18 +73,31 @@ NVM
     1- 2* ( [ tab ] ) LITERAL +
   ;
 
-  \ process MB  loop in (xt), steps from mbp1 to mbp1+mbp2
+  \ MB loop (xt) from mbp1 to mbp1+mbp2
   : mbloop ( xt -- )
     mbp1 mbp2 OVER + SWAP  DO
-      ( xt ) I OVER EXECUTE ( inc )
-    +LOOP
-    DROP
+      ( xt ) I OVER EXECUTE
+    LOOP
+    ( xt ) DROP
+  ;
+
+  \ true if n in range mbp1,mbp2, else false and MODBUS EC=2
+  : mbrange? ( n -- b )
+    -1 SWAP mbp1 mbp2 + - 0< IF
+      2 MBEC NOT
+    THEN
+  ;
+
+  \ Quantity of bits / 8, if the remainder is different of 0 => N = N+1
+  : N* ( -- N* )
+    1- 8 / 1+
   ;
 
-  \ MB looped read action (xt) with bpu bit per increment
-  : mbread ( xt bpu -- )
-    mbp2 * 1- 8 / 1+ txc+
-    ( xt bpu ) mbloop
+  \ MB looped bit read with action xt, build response (FC01, FC02)
+  : mbrbits ( xt -- )
+    ( xt ) mbp2 N* DUP txc+       \ response: number of bytes
+    ( xt N* ) 1- FOR 0 txc+ NEXT  \ init packed bits in response with 0
+    ( xt ) mbloop
   ;
 
   \ MODBUS protocol handler
@@ -97,9 +110,9 @@ NVM
       ( crc-ok ) IF
         mbnode @ rxbuf C@ = IF  \ node address match
           mbpre @?EXEC    \ preparation handler, e.g. read inputs
-          rxbuf    C@     txc+
-          rxbuf 1+ C@ DUP txc+  ( fc )
-          DUP 1 17 WITHIN IF
+          rxbuf    C@     txc+  \ write Node-ID
+          rxbuf 1+ C@ DUP txc+  \ write FC
+          ( fc ) DUP 1 17 WITHIN IF
              FC>XT @?EXEC \ get and execute FC handler
           ELSE
             FCDEF         \ default handler

MBSERVER

@@ -18,8 +18,8 @@ WIPE
 #require ULOCK
 
 \ Compile time symbols
-4 CONSTANT COILBYTES
-2 CONSTANT INPUTCELLS
+4 CONSTANT COILCELLS
+4 CONSTANT INPUTCELLS
 2 CONSTANT HOLDINGCELLS
 
 1024  CONSTANT EECELLS   \ this is the maximum for any STM8 device
@@ -29,40 +29,50 @@ NVM  \ compile to Flash memory from here on
 #require BF!
 #require BF@
 
+
   \ --- FC01 "Read Coils"
 
-  VARIABLE coils COILBYTES 2- ALLOT
+  VARIABLE coils COILCELLS 1- 2* ALLOT
 
-  \ FC01 coils iterated transfer
-  :NVM  ( i -- 8 )
-    8 / coils + B>L C@ txc+   8 ( inc )
-  ;NVM ( xt )
+  \ FC01 Read Coils transfer
+  :NVM  ( i -- )
+    ( i ) coils OVER ( i a i ) BF@
+    ( i b ) SWAP mbp1 - ( b i0 )
+    txbuf 3 + SWAP ( b a i0 ) LEBF!
+  ;RAM ALIAS FC01ACT NVM
 
   \ FC01 handler
   :NVM  ( -- )
-    [ ( xt xth ) SWAP ] LITERAL 1 ( xt bpu ) mbread
-  ;NVM ( xth ) 1 FC>XT !
-
+    [ COILCELLS 16 * ] LITERAL mbrange? IF
+      [ ' FC01ACT ] LITERAL ( xt ) mbrbits
+    THEN
+  ;NVM ( xt ) 1 FC>XT !
 
   \ --- FC02 "Read Discrete Inputs"
 
   VARIABLE inputs INPUTCELLS 1- 2* ALLOT
 
-  \ FC02 input register iterated transfer
-  :NVM  ( i -- 8 )
-    8 / inputs + B>L C@ txc+   8 ( inc )
-  ;NVM ( xt )
+  \ FC02 input register transfer
+  :NVM  ( i -- )
+    ( i ) inputs OVER ( i a i ) BF@
+    ( i b ) SWAP mbp1 - ( b i0 )
+    txbuf 3 + SWAP ( b a i0 ) LEBF!
+  ;RAM ALIAS FC02ACT NVM
 
   \ FC02 handler
   :NVM  ( -- )
-     [ ( xt xth ) SWAP ] LITERAL 1 ( xt bpu ) mbread
-  ;NVM ( xth ) 2 FC>XT !
-
+    [ INPUTCELLS 16 * ] LITERAL mbrange? IF
+      [ ' FC02ACT ] LITERAL ( xt ) mbrbits
+    THEN
+  ;NVM ( xt ) 2 FC>XT !
 
   \ --- FC03 "Read Holding Registers"
 
   VARIABLE holding HOLDINGCELLS 1- 2* ALLOT
 
+  \ dummy
+  : mbread ;
+
   \ FC03 holding register iterated transfer
   :NVM  ( i -- 1 )
     ( i ) DUP 0 EECELLS WITHIN IF
@@ -98,11 +108,11 @@ NVM  \ compile to Flash memory from here on
 
   \ --- FC05 handler "Write Single Coil"
   :NVM   ( -- )
-    mbp1 1- ( #b ) DUP 0 [ COILBYTES 8 * ] LITERAL WITHIN IF
+    mbp1 1- ( #b ) DUP 0 [ COILCELLS 16 * ] LITERAL WITHIN IF
       mbp2 $FF00 =
       ( #b f ) coils B>L
       ( #b f a ) ROT ( f a #b ) B!
-      MBSWR   \ single write response
+      MBWR   \ MODBUS write response
     ELSE
       DROP   2 MBEC
     THEN
@@ -115,10 +125,10 @@ NVM  \ compile to Flash memory from here on
       ULOCK
       mbp2 SWAP ( n #r ) 2* EESTART + !
       LOCK
-      MBSWR   \ single write response
+      MBWR   \ MODBUS write response
     ELSE ( #r ) EECELLS - DUP 0 HOLDINGCELLS WITHIN IF
         mbp2 SWAP ( n #r ) 2* holding + !
-        MBSWR   \ single write response
+        MBWR   \ MODBUS write response
       ELSE
         DROP   2 MBEC
       THEN
@@ -131,46 +141,35 @@ NVM  \ compile to Flash memory from here on
     DUP rxbuf + 7 +
   ;RAM ALIAS mbrxd
 
-  \ MB test range mbp1,mbp2 in n
-  :NVM  ( n -- f )
-    mbp1 mbp2 + - 0< NOT
-  ;RAM ALIAS mbprange? NVM
-
   \ --- FC15 "Write Multiple Coils"
 
   \ FC15 Write Multiple Coils write transfer
-  :NVM  ( i -- 1 )
+  :NVM  ( i -- )
     ( i ) rxbuf 7 + OVER mbp1 - ( i a i0 ) LEBF@ SWAP ( b i )
     coils SWAP ( b a i ) BF!
-    1 ( inc )
-  ;RAM ALIAS FC15ACT NVM
+  ;RAM ALIAS FC15ACT
 
   \ FC15 handler
   :NVM  ( -- )
-    COILBYTES 8 * mbprange? IF
+    [ COILCELLS 16 * ] LITERAL mbrange? IF
       [ ' FC15ACT ] LITERAL ( xt ) mbloop
-      MBSWR
-    ElSE
-      2 MBEC
+      MBWR   \ MODBUS write response
     THEN
   ;NVM ( xth ) 15 FC>XT !
 
   \ --- FC16 "Write Multiple Register"
 
   \ FC16 holding register write transfer
-  :NVM  ( i -- 1 )
+  :NVM  ( i -- )
     ( i ) 2* mbrxd @ SWAP ( n 2i )
-    holding + !   1 ( inc )
-  ;NVM ( xt )
+    holding + !
+  ;RAM ALIAS FC16ACT
 
   \ FC16 handler
   :NVM  ( -- )
-    HOLDINGCELLS mbprange? IF
-      [ ( xt1 xt2 ) SWAP ] LITERAL 1 ( xt bpu ) mbloop
-      MBSWR
-    ElSE
-      2 MBEC
-    THEN
+    HOLDINGCELLS mbrange? IF
+      [ ' FC16ACT ] LITERAL ( xt ) mbloop
+      MBWR   \ MODBUS write response
   ;NVM ( xt ) 16 FC>XT !
 
   \ Registration of FC handlers complete

README.md

@@ -47,17 +47,15 @@ When using PB5 for RS485 direction control (-> `BUSCTRL`) the C0135 code can be
 
 FC | Description | Support
 -|-|-
-**1**| **Read Coils** | implemented ++
-**2** | **Read Discrete Inputs** | implemented ++
-**3** | **Read Holding Registers** | implemented (variables or EEPROM)
-**4** | **Read Input Registers** | implemented
+**1**| **Read Coils** | implemented
+**2** | **Read Discrete Inputs** | implemented
+3 | Read Holding Registers | partial
+4 | Read Input Registers | partial
 **5** | **Write Single Coil** | implemented
 **6** | **Write Single (Holding) Register** | implemented
 **15** | **Write Multiple Coils** | implemented
 16 | Write Multiple Registers | partial
 
-++: *currently limited to "8bit aligned start address", e.g. 0, 8, 16*
-
 A working example with Node-ID and Baud Rate stored in EEPROM is implemented in `C0135/board.fs`. An example that shows how to develop minimal servers with FC handlers from scratch using the Forth console is in `main.fs`.
 
 ## Installation

UARTISR

@@ -39,7 +39,6 @@ RAM WIPE
 NVM
 
   \ Start UART TX ISR chain
-
   : send ( -- )
     BUStx                  \ enable TX driver
     txbuf txp !              \ next char: buffer start
@@ -51,11 +50,16 @@ NVM
     txbuf tbp !
   ;
 
+  \ get current transmit buffe
+  : ctx ( -- a )
+    tbp @
+  ;
+
   \ TX ISR handler
   :NVM
     SAVEC
     \ P2H
-    txp DUP @ ( va a1 ) DUP tbp @ < IF
+    txp DUP @ ( va a1 ) DUP ctx < IF
       ( va a1 ) C@ UART1_DR C!
       ( va ) 1 SWAP +!
     ELSE
@@ -73,9 +77,9 @@ NVM
     IRET
   [ OVERT INT_UARTTX !
 
-  \ headerless: test for enough free space in txbuf for putting n bytes
+  \ test if there is enough free space in txbuf for putting n bytes
   :NVM  ( n -- f )
-    tbp @ txbuf - + 1- TXLEN <
+    ctx txbuf - + 1- TXLEN <
   ;RAM ALIAS test-tbp NVM
 
   \ RX ISR handler
@@ -101,14 +105,14 @@ NVM
   \ add c to TX buffer
   : txc+ ( c -- )
     1 test-tbp IF
-      tbp @ C! 1 tbp +!
+      ctx C! 1 tbp +!
     THEN
   ;
 
   \ add n to TX buffer
   : tx+ ( n -- )
     2 test-tbp IF
-      tbp @ ! 2 tbp +!
+      ctx ! 2 tbp +!
     THEN
   ;
 
@@ -153,7 +157,7 @@ WIPE RAM
     CR ."  rxbuf:"
     rxbuf rxp @ OVER - DUP . DUMP
     CR ."  txbuf:"
-    txbuf tbp @ OVER - DUP . DUMP
+    txbuf ctx OVER - DUP . DUMP
   ;
 
 2 UARTISR

test/FC01

@@ -0,0 +1,65 @@
+\ Minimal MODBUS server with FC01 "Read Coils" handler
+\ Features:
+\ - prints debug infos to the console
+\ - interactive tests from the console, e.g. set coils manually "7 coils !"
+
+\ check if the MODBUS protocol core is already present
+\ hint: the development cycle will be faster if you PERSIST it
+#require MBPROTO
+
+\ Resetting the FC handler table can be helpful for development
+#require WIPE
+#require MBRESET
+MBRESET   \ Reset the MODBUS Function Code table
+
+#require ALIAS
+#require :NVM
+#require 'IDLE
+#require .OK
+
+NVM
+
+#require MBDUMP
+#require BF!
+#require BF@
+
+  8 CONSTANT COILBYTES
+  VARIABLE coils COILBYTES 2- ALLOT
+
+  \ FC01 Read Coils transfer
+  :NVM  ( i -- )
+    DUP .
+    ( i ) coils OVER ( i a i ) BF@
+    ( i b ) SWAP mbp1 - ( b i0 )
+    DUP . CR
+    txbuf 3 + SWAP ( b a i0 ) LEBF!
+  ;RAM ALIAS FC01ACT NVM
+
+  \ FC01 handler
+  :NVM  ( -- )
+    \ write register address and value to the console
+    ." Read coil bits: A:" mbp1 . ."  Q:" mbp2 . CR
+    ." bits to coils end:" COILBYTES 8 * mbp1 mbp2 + - . CR
+
+    COILBYTES 8 * mbrange? IF
+      [ ' FC01ACT ] LITERAL ( xt ) mbrbits
+    THEN
+  ;NVM ( xt ) 1 FC>XT !
+
+  \ custom default action handler
+  : showfc ( -- )
+    rxbuf C@ ." FC:" . CR
+    1 MBEC  \ set error code
+  ;
+
+  : init ( -- )
+    0 UARTISR                     \ init UART handler w/ default baud rate
+    1 mbnode !                    \ set 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
+    .OK
+  ;
+
+  ' init 'BOOT !
+WIPE RAM