From 4b1fd8cba0fd63addbf80d3f1baa432b74b16b14 Mon Sep 17 00:00:00 2001
From: Andrew Johnson <anj@aps.anl.gov>
Date: Mon, 28 Jul 2014 00:18:37 -0500
Subject: [PATCH] Modify registerRecordDeviceDriver for loadable support

Don't generate code to register record types that have only
been declared, i.e. that have no fields defined in them.
This allows libraries to created which only contain device
support without the record types that they support. The
library must have a DBD file that may declare the record
types (to avoid generating a warning) and also contains any
other device(), variable(), function() and registrar()
entries for software included in the library.

Adds -l flag to the registerRecordDeviceDriver program,
which results in epicsExportSharedSymbols being defined
and shareLib.h being reloaded so the generated output file
can be linked into the library that it is registering.
This aspect has not been tested on Windows DLLs yet.
---
 src/tools/registerRecordDeviceDriver.pl | 61 +++++++++++++++----------
 1 file changed, 38 insertions(+), 23 deletions(-)

diff --git a/src/tools/registerRecordDeviceDriver.pl b/src/tools/registerRecordDeviceDriver.pl
index 91a22c903..368d7acea 100644
--- a/src/tools/registerRecordDeviceDriver.pl
+++ b/src/tools/registerRecordDeviceDriver.pl
@@ -20,10 +20,10 @@ use EPICS::Path;
 use EPICS::Getopts;
 use Text::Wrap;
 
-our ($opt_D, @opt_I, $opt_o);
+our ($opt_D, @opt_I, $opt_o, $opt_l);
 
-getopts('Do:I@') or
-    die "Usage: registerRecordDeviceDriver [-D] [-o out.c] [-I dir] in.dbd subname [TOP]";
+getopts('Dlo:I@') or
+    die "Usage: registerRecordDeviceDriver [-D] [-l] [-o out.c] [-I dir] in.dbd subname [TOP]";
 
 my @path = map { split /[:;]/ } @opt_I; # FIXME: Broken on Win32?
 
@@ -69,37 +69,52 @@ print $out (<< "END");
 #include "iocshRegisterCommon.h"
 #include "registryCommon.h"
 
+END
+
+print $out (<< "END") if $opt_l;
+#define epicsExportSharedSymbols
+#include "shareLib.h"
+
+END
+
+print $out (<< "END");
 extern "C" {
 
 END
 
 my %rectypes = %{$dbd->recordtypes};
+my @rtypnames;
 my @dsets;
 if (%rectypes) {
-    my @rtypnames = sort keys %rectypes;
+    my @allrtypnames = sort keys %rectypes;
+    # Record types with no fields defined are declarations,
+    # for building shared libraries containing device support.
+    @rtypnames = grep { scalar $rectypes{$_}->fields } @allrtypnames;
 
-    # Declare the record support entry tables
-    print $out wrap('epicsShareExtern rset ', '    ',
-        join(', ', map {"*pvar_rset_${_}RSET"} @rtypnames)), ";\n\n";
+    if (@rtypnames) {
+        # Declare the record support entry tables
+        print $out wrap('epicsShareExtern rset ', '    ',
+            join(', ', map {"*pvar_rset_${_}RSET"} @rtypnames)), ";\n\n";
 
-    # Declare the RecordSizeOffset functions
-    print $out "typedef int (*rso_func)(dbRecordType *pdbRecordType);\n";
-    print $out wrap('epicsShareExtern rso_func ', '    ',
-        join(', ', map {"pvar_func_${_}RecordSizeOffset"} @rtypnames)), ";\n\n";
+        # Declare the RecordSizeOffset functions
+        print $out "typedef int (*rso_func)(dbRecordType *pdbRecordType);\n";
+        print $out wrap('epicsShareExtern rso_func ', '    ',
+            join(', ', map {"pvar_func_${_}RecordSizeOffset"} @rtypnames)), ";\n\n";
 
-    # List of record type names
-    print $out "static const char * const recordTypeNames[] = {\n";
-    print $out wrap('    ', '    ', join(', ', map {"\"$_\""} @rtypnames));
-    print $out "\n};\n\n";
+        # List of record type names
+        print $out "static const char * const recordTypeNames[] = {\n";
+        print $out wrap('    ', '    ', join(', ', map {"\"$_\""} @rtypnames));
+        print $out "\n};\n\n";
 
-    # List of pointers to each RSET and RecordSizeOffset function
-    print $out "static const recordTypeLocation rtl[] = {\n";
-    print $out join(",\n", map {
-            "    {pvar_rset_${_}RSET, pvar_func_${_}RecordSizeOffset}"
-        } @rtypnames);
-    print $out "\n};\n\n";
+        # List of pointers to each RSET and RecordSizeOffset function
+        print $out "static const recordTypeLocation rtl[] = {\n";
+        print $out join(",\n", map {
+                "    {pvar_rset_${_}RSET, pvar_func_${_}RecordSizeOffset}"
+            } @rtypnames);
+        print $out "\n};\n\n";
+    }
 
-    for my $rtype (@rtypnames) {
+    for my $rtype (@allrtypnames) {
         my @devices = $rectypes{$rtype}->devices;
         for my $dtype (@devices) {
             my $dset = $dtype->name;
@@ -206,7 +221,7 @@ print $out (<< 'END');
 
 END
 
-print $out (<< 'END') if %rectypes;
+print $out (<< 'END') if %rectypes && @rtypnames;
     registerRecordTypes(pbase, NELEMENTS(rtl), recordTypeNames, rtl);
 END