Merge lp:~anj/epics-base/compiled-dbd into lp:~epics-core/epics-base/3.15

[Andrew Johnson]

This branch replaces the dbToMenuH, dbToRecordH and dbExpand programs with Perl versions that perform the same functionality but don't have to be compiled first. This fixes a dependency problem we're having at the moment with parallel builds on the 3.15 branch. The underlying Perl technology will also allow other improvements in DBD file handling, including eventually removing the need for the IOC load a DBD file, although that will need more work.

This also fixes the issue of someone using field names in a record type that happen to be C or C++ keywords.

I have not tested this code on Windows yet.

[lp:~anj/epics-base/compiled-dbd]

12285. By Andrew Johnson on 2012-03-27

Convert registerRecordDeviceDriver.pl to use DBD module.

The output is now a bit more compact as it uses Text::Wrap on
the declarations and array data.

12286. By Andrew Johnson on 2012-03-28

Use the new DBD processing scripts to generate dependency files.

12287. By Andrew Johnson on 2012-04-02

configure: Clean up some other DBDEPENDS stuff

[Andrew Johnson (anj)]

I'm planning to merge this branch into the main trunk (3.15 series) very soon. It needs a little bit of work to merge cleanly, but I'll do that at the time.

- Andrew

[Andrew Johnson (anj)]

review: Approve

=== modified file 'configure/CONFIG_BASE'
--- configure/CONFIG_BASE	2011-02-27 00:24:51 +0000
+++ configure/CONFIG_BASE	2012-04-02 20:38:19 +0000
@@ -57,11 +57,11 @@
 # Epics base build tools and tool flags
 
 MAKEBPT                    = $(call PATH_FILTER, $(TOOLS)/makeBpt$(HOSTEXE))
-DBEXPAND                   = $(call PATH_FILTER, $(TOOLS)/dbExpand$(HOSTEXE))
-DBTORECORDTYPEH            = $(call PATH_FILTER, $(TOOLS)/dbToRecordtypeH$(HOSTEXE))
-DBTOMENUH                  = $(call PATH_FILTER, $(TOOLS)/dbToMenuH$(HOSTEXE))
+DBEXPAND                   = $(PERL) $(TOOLS)/dbdExpand.pl
+DBTORECORDTYPEH            = $(PERL) $(TOOLS)/dbdToRecordtypeH.pl
+DBTOMENUH                  = $(PERL) $(TOOLS)/dbdToMenuH.pl
 REGISTERRECORDDEVICEDRIVER = $(PERL) $(TOOLS)/registerRecordDeviceDriver.pl
-CONVERTRELEASE=$(PERL) $(TOOLS)/convertRelease.pl
+CONVERTRELEASE             = $(PERL) $(TOOLS)/convertRelease.pl
 
 #-------------------------------------------------------
 # tools for installing libraries and products

=== modified file 'configure/RULES.Db'
--- configure/RULES.Db	2012-04-02 20:36:02 +0000
+++ configure/RULES.Db	2012-04-02 20:38:19 +0000
@@ -112,9 +112,6 @@
                     $(patsubst $(COMMON_DIR)/%,%,$(COMMON_DBS)) \
                     $(patsubst $(COMMON_DIR)/%,%,$(COMMON_DBDS)))
 
-DBDDEPENDS_FLAGS = $(subst -I,,$(filter-out -S%,$(DBDFLAGS)))
-DBDDEPENDS_CMD = -$(MKMF) -m $(notdir $@)$(DEP) $(DBDDEPENDS_FLAGS) $@ $<
-
 MAKEDBDEPENDS = $(PERL) $(TOOLS)/makeDbDepends.pl
 
 ##################################################### 
@@ -226,35 +223,63 @@
 
 $(COMMON_DIR)/%Record.h: $(COMMON_DIR)/%Record.dbd
 	@$(RM) $(notdir $@)$(DEP)
+<<<<<<< TREE
 	@$(DBDDEPENDS_CMD)
 	echo "$< : ../Makefile" >> $(notdir $@)$(DEP)
 	@$(RM) $(notdir $@)
 	$(DBTORECORDTYPEH) $(DBDFLAGS) $< $(notdir $@)
 	@$(MV) $(notdir $@) $@
+=======
+	@$(DBTORECORDTYPEH) -D $(DBDFLAGS) -o $@ $< > $(notdir $@)$(DEP)
+	@echo "$@: ../Makefile" >> $(notdir $@)$(DEP)
+	@$(RM) $@
+	$(DBTORECORDTYPEH) $(DBDFLAGS) -o $@ $<
+>>>>>>> MERGE-SOURCE
 
 $(COMMON_DIR)/%Record.h: %Record.dbd
 	@$(RM) $(notdir $@)$(DEP)
+<<<<<<< TREE
 	@$(DBDDEPENDS_CMD)
 	echo "$< : ../Makefile" >> $(notdir $@)$(DEP)
 	@$(RM) $(notdir $@)
 	$(DBTORECORDTYPEH) $(DBDFLAGS) $< $(notdir $@)
 	@$(MV) $(notdir $@) $@
+=======
+	@$(DBTORECORDTYPEH) -D $(DBDFLAGS) -o $@ $< > $(notdir $@)$(DEP)
+	@echo "$@: ../Makefile" >> $(notdir $@)$(DEP)
+	@$(RM) $@
+	$(DBTORECORDTYPEH) $(DBDFLAGS) -o $@ $<
+>>>>>>> MERGE-SOURCE
 
 $(COMMON_DIR)/menu%.h: $(COMMON_DIR)/menu%.dbd
 	@$(RM) $(notdir $@)$(DEP)
+<<<<<<< TREE
 	@$(DBDDEPENDS_CMD)
 	echo "$< : ../Makefile" >> $(notdir $@)$(DEP)
 	@$(RM) $(notdir $@)
 	$(DBTOMENUH) $(DBDFLAGS) $< $(notdir $@)
 	@$(MV) $(notdir $@) $@
+=======
+	@$(DBTOMENUH) -D $(DBDFLAGS) -o $@ $< > $(notdir $@)$(DEP)
+	@echo "$@: ../Makefile" >> $(notdir $@)$(DEP)
+	@$(RM) $@
+	$(DBTOMENUH) $(DBDFLAGS) -o $@ $<
+>>>>>>> MERGE-SOURCE
 
 $(COMMON_DIR)/menu%.h: menu%.dbd
 	@$(RM) $(notdir $@)$(DEP)
+<<<<<<< TREE
 	@$(DBDDEPENDS_CMD)
 	echo "$< : ../Makefile" >> $(notdir $@)$(DEP)
 	@$(RM) $(notdir $@)
 	$(DBTOMENUH) $(DBDFLAGS) $< $(notdir $@)
 	@$(MV) $(notdir $@) $@
+=======
+	@$(DBTOMENUH) -D $(DBDFLAGS) -o $@ $< > $(notdir $@)$(DEP)
+	@echo "$@: ../Makefile" >> $(notdir $@)$(DEP)
+	@$(RM) $@
+	$(DBTOMENUH) $(DBDFLAGS) -o $@ $<
+>>>>>>> MERGE-SOURCE
 
 .PRECIOUS: $(COMMON_DIR)/%.h
 
@@ -264,10 +289,15 @@
 	$(MAKEBPT) $< $(notdir $@)
 	@$(MV) $(notdir $@) $@
 
-$(COMMON_DIR)/%.dbd: $(COMMON_DIR)/%Include.dbd 
+$(COMMON_DIR)/%.dbd: $(COMMON_DIR)/%Include.dbd
 	@$(RM) $(notdir $@)$(DEP)
+<<<<<<< TREE
 	@$(DBDDEPENDS_CMD)
 	echo "$< : ../Makefile" >> $(notdir $@)$(DEP)
+=======
+	@$(DBEXPAND) -D $(DBDFLAGS) -o $@ $< > $(notdir $@)$(DEP)
+	@echo "$@: ../Makefile" >> $(notdir $@)$(DEP)
+>>>>>>> MERGE-SOURCE
 	$(ECHO) "Expanding dbd"
 	@$(RM) $(notdir $@)
 	@$(DBEXPAND) $(DBDFLAGS) -o $(notdir $@) $<
@@ -275,8 +305,13 @@
 
 $(COMMON_DIR)/%.dbd: %Include.dbd 
 	@$(RM) $(notdir $@)$(DEP)
+<<<<<<< TREE
 	@$(DBDDEPENDS_CMD)
 	echo "$< : ../Makefile" >> $(notdir $@)$(DEP)
+=======
+	@$(DBEXPAND) -D $(DBDFLAGS) -o $@ $< > $(notdir $@)$(DEP)
+	@echo "$@: ../Makefile" >> $(notdir $@)$(DEP)
+>>>>>>> MERGE-SOURCE
 	$(ECHO) "Expanding dbd"
 	@$(RM) $(notdir $@)
 	$(DBEXPAND) $(DBDFLAGS) -o $(notdir $@) $<
@@ -313,8 +348,13 @@
 
 $(COMMON_DIR)/%.db$(RAW): %.substitutions
 	@$(RM) $(notdir $@)$(DEP)
+<<<<<<< TREE
 	@$(MAKEDBDEPENDS) $@ $< $(TEMPLATE_FILENAME) >> $(notdir $@)$(DEP)
 	echo "$@ : $(TEMPLATE_FILENAME)" >> $(notdir $@)$(DEP)
+=======
+	$(MAKEDBDEPENDS) $@ $< $(TEMPLATE_FILENAME) > $(notdir $@)$(DEP)
+	@echo "$@: $(TEMPLATE_FILENAME)" >> $(notdir $@)$(DEP)
+>>>>>>> MERGE-SOURCE
 	$(ECHO) "Inflating database from $< $(TEMPLATE_FILENAME)"
 	@$(RM) $@ $*.tmp
 	$(MSI) $(DBFLAGS) -S$< $(TEMPLATE_FILENAME) > $*.tmp
@@ -322,7 +362,7 @@
 
 $(COMMON_DIR)/%.db$(RAW): %.template
 	@$(RM) $(notdir $@)$(DEP)
-	@$(MAKEDBDEPENDS) $@ $^  >> $(notdir $@)$(DEP)
+	@$(MAKEDBDEPENDS) $@ $< > $(notdir $@)$(DEP)
 	$(ECHO) "Inflating database from $<"
 	@$(RM) $@ $*.tmp
 	$(MSI) $(DBFLAGS) $< > $*.tmp

=== modified file 'src/Makefile'
--- src/Makefile	2011-02-27 00:24:51 +0000
+++ src/Makefile	2012-04-02 20:38:19 +0000
@@ -15,6 +15,9 @@
 
 DIRS += tools
 
+DIRS += tools/test
+tools/test_DEPEND_DIRS = tools
+
 DIRS += template/base
 template/base_DEPEND_DIRS = tools
 

=== modified file 'src/ioc/db/RULES'
--- src/ioc/db/RULES	2011-11-15 00:25:13 +0000
+++ src/ioc/db/RULES	2012-04-02 20:38:19 +0000
@@ -15,6 +15,7 @@
 
 # $(filter-out $(STATIC_SRCS),$(dbCore_SRCS)) : $(COMMON_DIR)/dbCommon.h
 
+<<<<<<< TREE
 dbCommon.h$(DEP): $(IOCDIR)/db/dbCommonRecord.dbd $(IOCDIR)/db/dbCommon.dbd
 	@$(RM) $@
 	@$(MKMF) -m $@ ../db $(COMMON_DIR)/dbCommon.h $<
@@ -29,3 +30,10 @@
 $(patsubst %,$(COMMON_DIR)/%.h,$(DBDINC) menuConvert menuGlobal) : \
 $(COMMON_DIR)/%.h : $(DBTOMENUH)
 
+=======
+$(COMMON_DIR)/dbCommon.h: $(IOCDIR)/db/dbCommonRecord.dbd
+	@$(RM) $(notdir $@)$(DEP)
+	@$(DBTORECORDTYPEH) -D -I ../db -o $@ $< > $(notdir $@)$(DEP)
+	$(RM) $@
+	$(DBTORECORDTYPEH) -I ../db -o $@ $<
+>>>>>>> MERGE-SOURCE

=== modified file 'src/ioc/db/dbCommon.dbd'
--- src/ioc/db/dbCommon.dbd	2009-04-23 20:35:02 +0000
+++ src/ioc/db/dbCommon.dbd	2012-04-02 20:38:19 +0000
@@ -82,14 +82,14 @@
 		prompt("Monitor lock")
 		special(SPC_NOMOD)
 		interest(4)
-		extra("epicsMutexId	mlok")
+		extra("epicsMutexId        mlok")
 	}
 	%#include "ellLib.h"
 	field(MLIS,DBF_NOACCESS) {
 		prompt("Monitor List")
 		special(SPC_NOMOD)
 		interest(4)
-		extra("ELLLIST		mlis")
+		extra("ELLLIST             mlis")
 	}
 	field(DISP,DBF_UCHAR) {
 		prompt("Disable putField")
@@ -167,13 +167,13 @@
 		prompt("Access Security Pvt")
 		special(SPC_NOMOD)
 		interest(4)
-		extra("struct asgMember *asp")
+		extra("struct asgMember    *asp")
 	}
 	field(PPN,DBF_NOACCESS) {
 		prompt("addr of PUTNOTIFY")
 		special(SPC_NOMOD)
 		interest(4)
-		extra("struct putNotify *ppn")
+		extra("struct putNotify    *ppn")
 	}
 	field(PPNR,DBF_NOACCESS) {
 		prompt("pputNotifyRecord")
@@ -191,19 +191,19 @@
 		prompt("Address of RSET")
 		special(SPC_NOMOD)
 		interest(4)
-		extra("struct rset	*rset")
+		extra("struct rset         *rset")
 	}
 	field(DSET,DBF_NOACCESS) {
 		prompt("DSET address")
 		special(SPC_NOMOD)
 		interest(4)
-		extra("struct dset	*dset")
+		extra("struct dset         *dset")
 	}
 	field(DPVT,DBF_NOACCESS) {
 		prompt("Device Private")
 		special(SPC_NOMOD)
 		interest(4)
-		extra("void		*dpvt")
+		extra("void                *dpvt")
 	}
 	field(RDES,DBF_NOACCESS) {
 		prompt("Address of dbRecordType")
@@ -215,7 +215,7 @@
 		prompt("Lock Set")
 		special(SPC_NOMOD)
 		interest(4)
-		extra("struct lockRecord *lset")
+		extra("struct lockRecord   *lset")
 	}
 	field(PRIO,DBF_MENU) {
 		prompt("Scheduling Priority")
@@ -231,7 +231,7 @@
 		prompt("Break Point")
 		special(SPC_NOMOD)
 		interest(1)
-		extra("char bkpt")
+		extra("char                bkpt")
 	}
 	field(UDF,DBF_UCHAR) {
 		prompt("Undefined")
@@ -245,7 +245,7 @@
 		prompt("Time")
 		special(SPC_NOMOD)
 		interest(2)
-		extra("epicsTimeStamp	time")
+		extra("epicsTimeStamp      time")
 	}
 	field(FLNK,DBF_FWDLINK) {
 		prompt("Forward Process Link")

=== modified file 'src/ioc/dbStatic/Makefile'
--- src/ioc/dbStatic/Makefile	2011-09-15 19:05:05 +0000
+++ src/ioc/dbStatic/Makefile	2012-04-02 20:38:19 +0000
@@ -32,26 +32,10 @@
 dbCore_SRCS += dbStaticIocRegister.c
 
 dbStaticHost_SRCS += $(STATIC_SRCS)
-dbStaticHost_SRCS += dbStaticNoRun.c 
+dbStaticHost_SRCS += dbStaticNoRun.c
 
 LIBRARY_HOST += dbStaticHost
 
 dbStaticHost_LIBS = Com
 
-PROD_HOST += dbReadTest dbExpand dbToMenuH dbToRecordtypeH
-
-dbReadTest_SRCS = dbReadTest.c
-dbExpand_SRCS = dbExpand.c
-dbToMenuH_SRCS = dbToMenuH.c
-dbToRecordtypeH_SRCS = dbToRecordtypeH.c
-
-# Include dbStaticHost objects directly in executables
-# because of a Circular dependency induced by a rule
-#  $(INSTALL_LIBS): $(INSTALL_SHRLIBS)
-# in RULES_BUILD
-dbReadTest_SRCS += $(dbStaticHost_SRCS)
-dbExpand_SRCS += $(dbStaticHost_SRCS)
-dbToMenuH_SRCS += $(dbStaticHost_SRCS)
-dbToRecordtypeH_SRCS += $(dbStaticHost_SRCS)
-
 CLEANS += dbLex.c dbYacc.c

=== renamed file 'src/ioc/dbStatic/dbExpand.c' => 'src/ioc/dbStatic/dbExpand.c.THIS'
=== removed file 'src/ioc/dbStatic/dbReadTest.c'
--- src/ioc/dbStatic/dbReadTest.c	2004-07-08 14:43:45 +0000
+++ src/ioc/dbStatic/dbReadTest.c	1970-01-01 00:00:00 +0000
@@ -1,90 +0,0 @@
-/*************************************************************************\
-* Copyright (c) 2002 The University of Chicago, as Operator of Argonne
-*     National Laboratory.
-* Copyright (c) 2002 The Regents of the University of California, as
-*     Operator of Los Alamos National Laboratory.
-* EPICS BASE Versions 3.13.7
-* and higher are distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
-\*************************************************************************/
-/* dbReadTest.c */
-/*	Author: Marty Kraimer	Date: 13JUL95	*/
-
-#include <stdlib.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "dbDefs.h"
-#include "epicsPrint.h"
-#include "errMdef.h"
-#include "dbStaticLib.h"
-#include "dbStaticPvt.h"
-#include "dbBase.h"
-#include "gpHash.h"
-#include "osiFileName.h"
-
-DBBASE *pdbbase = NULL;
-

-int main(int argc,char **argv)
-{
-    int         i;
-    int		strip;
-    char	*path = NULL;
-    char	*sub = NULL;
-    int		pathLength = 0;
-    int		subLength = 0;
-    char	**pstr;
-    char	*psep;
-    int		*len;
-    long	status;
-    static char *pathSep = OSI_PATH_LIST_SEPARATOR;
-    static char *subSep = ",";
-
-    /*Look for options*/
-    if(argc<2) {
-	printf("usage: dbReadTest -Idir -Smacsub file.dbd file.db \n");
-	exit(0);
-    }
-    while((strncmp(argv[1],"-I",2)==0)||(strncmp(argv[1],"-S",2)==0)) {
-	if(strncmp(argv[1],"-I",2)==0) {
-	    pstr = &path;
-	    psep = pathSep;
-	    len = &pathLength;
-	} else {
-	    pstr = &sub;
-	    psep = subSep;
-	    len = &subLength;
-	}
-	if(strlen(argv[1])==2) {
-	    dbCatString(pstr,len,argv[2],psep);
-	    strip = 2;
-	} else {
-	    dbCatString(pstr,len,argv[1]+2,psep);
-	    strip = 1;
-	}
-	argc -= strip;
-	for(i=1; i<argc; i++) argv[i] = argv[i + strip];
-    }
-    if(argc<2 || (strncmp(argv[1],"-",1)==0)) {
-	printf("usage: dbReadTest -Idir -Idir file.dbd file.dbd \n");
-	exit(0);
-    }
-    for(i=1; i<argc; i++) {
-	status = dbReadDatabase(&pdbbase,argv[i],path,sub);
-	if(!status) continue;
-	fprintf(stderr,"For input file %s",argv[i]);
-	errMessage(status,"from dbReadDatabase");
-    }
-/*
-    dbDumpRecordType(pdbbase,"ai");
-    dbDumpRecordType(pdbbase,NULL);
-    dbPvdDump(pdbbase,1);
-    gphDump(pdbbase->pgpHash);
-    dbDumpMenu(pdbbase,NULL);
-    dbDumpRecord(pdbbase,NULL,0);
-    dbReportDeviceConfig(pdbbase,stdout);
-*/
-    dbFreeBase(pdbbase);
-    return(0);
-}

=== removed file 'src/ioc/dbStatic/dbToMenuH.c'
--- src/ioc/dbStatic/dbToMenuH.c	2008-08-05 22:48:45 +0000
+++ src/ioc/dbStatic/dbToMenuH.c	1970-01-01 00:00:00 +0000
@@ -1,124 +0,0 @@
-/*************************************************************************\
-* Copyright (c) 2002 The University of Chicago, as Operator of Argonne
-*     National Laboratory.
-* Copyright (c) 2002 The Regents of the University of California, as
-*     Operator of Los Alamos National Laboratory.
-* EPICS BASE Versions 3.13.7
-* and higher are distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
-\*************************************************************************/
-/* dbToMenu.c */
-/*	Author: Marty Kraimer	Date: 11Sep95	*/
-#include <stdlib.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "dbDefs.h"
-#include "epicsPrint.h"
-#include "errMdef.h"
-#include "dbStaticLib.h"
-#include "dbStaticPvt.h"
-#include "dbBase.h"
-#include "gpHash.h"
-#include "osiFileName.h"
-
-DBBASE *pdbbase = NULL;
-

-int main(int argc,char **argv)
-{
-    dbMenu	*pdbMenu;
-    char	*outFilename;
-    char	*pext;
-    FILE	*outFile;
-    char	*plastSlash;
-    int		i;
-    int		strip;
-    char	*path = NULL;
-    char	*sub = NULL;
-    int		pathLength = 0;
-    int		subLength = 0;
-    char	**pstr;
-    char	*psep;
-    int		*len;
-    long	status;
-    static char *pathSep = OSI_PATH_LIST_SEPARATOR;
-    static char *subSep = ",";
-
-    /*Look for options*/
-    if(argc<2) {
-	fprintf(stderr,"usage: dbToMenu -Idir -Idir file.dbd [outfile]\n");
-	exit(0);
-    }
-    while((strncmp(argv[1],"-I",2)==0)||(strncmp(argv[1],"-S",2)==0)) {
-	if(strncmp(argv[1],"-I",2)==0) {
-	    pstr = &path;
-	    psep = pathSep;
-	    len = &pathLength;
-	} else {
-	    pstr = &sub;
-	    psep = subSep;
-	    len = &subLength;
-	}
-	if(strlen(argv[1])==2) {
-	    dbCatString(pstr,len,argv[2],psep);
-	    strip = 2;
-	} else {
-	    dbCatString(pstr,len,argv[1]+2,psep);
-	    strip = 1;
-	}
-	argc -= strip;
-	for(i=1; i<argc; i++) argv[i] = argv[i + strip];
-    }
-    if(argc<2 || (strncmp(argv[1],"-",1)==0)) {
-	fprintf(stderr,"usage: dbToMenu -Idir -Idir file.dbd [outfile]\n");
-	exit(0);
-    }
-    if (argc==2) {
-        /*remove path so that outFile is created where program is executed*/
-        plastSlash = strrchr(argv[1],'/');
-        if(!plastSlash)  plastSlash = strrchr(argv[1],'\\');
-        plastSlash = (plastSlash ? plastSlash+1 : argv[1]);
-        outFilename = dbCalloc(1,strlen(plastSlash)+1);
-        strcpy(outFilename,plastSlash);
-        pext = strstr(outFilename,".dbd");
-        if (!pext) {
-            fprintf(stderr,"Input file MUST have .dbd extension\n");
-            exit(-1);
-        }
-        strcpy(pext,".h");
-    } else {
-        outFilename = dbCalloc(1,strlen(argv[2])+1);
-        strcpy(outFilename,argv[2]);
-    }
-    pdbbase = dbAllocBase();
-    pdbbase->ignoreMissingMenus = TRUE;
-    status = dbReadDatabase(&pdbbase,argv[1],path,sub);
-    if (status) {
-        errlogFlush();
-        fprintf(stderr, "dbToMenuH: Input errors, no output generated\n");
-        exit(1);
-    }
-    outFile = fopen(outFilename, "w");
-    if (!outFile) {
-        epicsPrintf("Error creating output file \"%s\"\n", outFilename);
-        exit(1);
-    }
-    pdbMenu = (dbMenu *)ellFirst(&pdbbase->menuList);
-    while(pdbMenu) {
-	fprintf(outFile,"#ifndef INC%sH\n",pdbMenu->name);
-	fprintf(outFile,"#define INC%sH\n",pdbMenu->name);
-	fprintf(outFile,"typedef enum {\n");
-	for(i=0; i<pdbMenu->nChoice; i++) {
-	    fprintf(outFile,"\t%s",pdbMenu->papChoiceName[i]);
-	    if(i < (pdbMenu->nChoice - 1)) fprintf(outFile,",");
-	    fprintf(outFile,"\n");
-	}
-	fprintf(outFile,"}%s;\n",pdbMenu->name);
-	fprintf(outFile,"#endif /*INC%sH*/\n",pdbMenu->name);
-	pdbMenu = (dbMenu *)ellNext(&pdbMenu->node);
-    }
-    fclose(outFile);
-    free((void *)outFilename);
-    return(0);
-}

=== removed file 'src/ioc/dbStatic/dbToRecordtypeH.c'
--- src/ioc/dbStatic/dbToRecordtypeH.c	2008-08-05 22:48:45 +0000
+++ src/ioc/dbStatic/dbToRecordtypeH.c	1970-01-01 00:00:00 +0000
@@ -1,267 +0,0 @@
-/*************************************************************************\
-* Copyright (c) 2007 UChicago Argonne LLC, as Operator of Argonne
-*     National Laboratory.
-* Copyright (c) 2002 The Regents of the University of California, as
-*     Operator of Los Alamos National Laboratory.
-* EPICS BASE is distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
-\*************************************************************************/
-/* dbToRecordtypeH.c */
-/*	Author: Marty Kraimer	Date: 11Sep95	*/
-
-#include <stdlib.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <string.h>
-#include <ctype.h>
-
-#include "dbDefs.h"
-#include "epicsPrint.h"
-#include "errMdef.h"
-#include "dbStaticLib.h"
-#include "dbStaticPvt.h"
-#include "dbBase.h"
-#include "gpHash.h"
-#include "osiFileName.h"
-
-DBBASE *pdbbase = NULL;
-

-int main(int argc,char **argv)
-{
-    int		i;
-    char	*outFilename;
-    char	*pext;
-    FILE	*outFile;
-    dbMenu	*pdbMenu;
-    dbRecordType	*pdbRecordType;
-    dbFldDes	*pdbFldDes;
-    dbText	*pdbCdef;
-    int		isdbCommonRecord = FALSE;
-    char	*plastSlash;
-    int		strip;
-    char	*path = NULL;
-    char	*sub = NULL;
-    int		pathLength = 0;
-    int		subLength = 0;
-    char	**pstr;
-    char	*psep;
-    int		*len;
-    long	status;
-    static char *pathSep = OSI_PATH_LIST_SEPARATOR;
-    static char *subSep = ",";
-
-    /*Look for options*/
-    if(argc<2) {
-	fprintf(stderr,"usage: dbToRecordtypeH -Idir -Idir file.dbd [outfile]\n");
-	exit(0);
-    }
-    while((strncmp(argv[1],"-I",2)==0)||(strncmp(argv[1],"-S",2)==0)) {
-	if(strncmp(argv[1],"-I",2)==0) {
-	    pstr = &path;
-	    psep = pathSep;
-	    len = &pathLength;
-	} else {
-	    pstr = &sub;
-	    psep = subSep;
-	    len = &subLength;
-	}
-	if(strlen(argv[1])==2) {
-	    dbCatString(pstr,len,argv[2],psep);
-	    strip = 2;
-	} else {
-	    dbCatString(pstr,len,argv[1]+2,psep);
-	    strip = 1;
-	}
-	argc -= strip;
-	for(i=1; i<argc; i++) argv[i] = argv[i + strip];
-    }
-    if(argc<2 || (strncmp(argv[1],"-",1)==0)) {
-	fprintf(stderr,"usage: dbToRecordtypeH -Idir -Idir file.dbd [outfile]\n");
-	exit(0);
-    }
-    if(argc==2){
-    /*remove path so that outFile is created where program is executed*/
-    plastSlash = strrchr(argv[1],'/');
-    if(!plastSlash)  plastSlash = strrchr(argv[1],'\\');
-    plastSlash = (plastSlash ? plastSlash+1 : argv[1]);
-    outFilename = dbCalloc(1,strlen(plastSlash)+1);
-    strcpy(outFilename,plastSlash);
-    pext = strstr(outFilename,".dbd");
-    if(!pext) {
-	fprintf(stderr,"Input file MUST have .dbd extension\n");
-	exit(-1);
-    }
-    strcpy(pext,".h");
-    if(strcmp(outFilename,"dbCommonRecord.h")==0) {
-	strcpy(outFilename,"dbCommon.h");
-	isdbCommonRecord = TRUE;
-    }
-    }else {
-    outFilename = dbCalloc(1,strlen(argv[2])+1);
-    strcpy(outFilename,argv[2]);
-    if(strstr(outFilename,"dbCommon.h")!=0) {
-	isdbCommonRecord = TRUE;
-    }
-    }
-    pdbbase = dbAllocBase();
-    pdbbase->ignoreMissingMenus = TRUE;
-    pdbbase->loadCdefs = TRUE;
-    status = dbReadDatabase(&pdbbase,argv[1],path,sub);
-    if(status)  {
-        errlogFlush();
-        fprintf(stderr, "dbToMenuH: Input errors, no output generated\n");
-        exit(1);
-    }
-    outFile = fopen(outFilename,"w");
-    if(!outFile) {
-        epicsPrintf("Error creating output file \"%s\"\n", outFilename);
-        exit(1);
-    }
-
-    pdbMenu = (dbMenu *)ellFirst(&pdbbase->menuList);
-    while(pdbMenu) {
-	fprintf(outFile,"\n#ifndef INC%sH\n",pdbMenu->name);
-	fprintf(outFile,"#define INC%sH\n",pdbMenu->name);
-	fprintf(outFile,"typedef enum {\n");
-	for(i=0; i<pdbMenu->nChoice; i++) {
-            fprintf(outFile,"\t%s",pdbMenu->papChoiceName[i]);
-            if(i < (pdbMenu->nChoice - 1)) fprintf(outFile,",");
-            fprintf(outFile,"\n");
-	}
-	fprintf(outFile,"}%s;\n",pdbMenu->name);
-	fprintf(outFile,"#endif /*INC%sH*/\n",pdbMenu->name);
-	pdbMenu = (dbMenu *)ellNext(&pdbMenu->node);
-    }
-    pdbRecordType = (dbRecordType *)ellFirst(&pdbbase->recordTypeList);
-    while(pdbRecordType) {
-        fprintf(outFile,"#ifndef INC%sH\n",pdbRecordType->name);
-        fprintf(outFile,"#define INC%sH\n",pdbRecordType->name);
-	pdbCdef = (dbText *)ellFirst(&pdbRecordType->cdefList);
-	while (pdbCdef) {
-	    fprintf(outFile,"%s\n",pdbCdef->text);
-	    pdbCdef = (dbText *)ellNext(&pdbCdef->node);
-	}
-	fprintf(outFile,"typedef struct %s",pdbRecordType->name);
-	if(!isdbCommonRecord) fprintf(outFile,"Record");
-	fprintf(outFile," {\n");
-	for(i=0; i<pdbRecordType->no_fields; i++) {
-	    char	name[256];
-	    int		j;
-
-	    pdbFldDes = pdbRecordType->papFldDes[i];
-	    for(j=0; j< (int)strlen(pdbFldDes->name); j++)
-		name[j] = tolower(pdbFldDes->name[j]);
-	    name[strlen(pdbFldDes->name)] = 0;
-	    switch(pdbFldDes->field_type) {
-		case DBF_STRING :
-		    fprintf(outFile, "\tchar\t\t%s[%d];\t/* %s */\n",
-			name, pdbFldDes->size, pdbFldDes->prompt);
-		    break;
-		case DBF_CHAR :
-		    fprintf(outFile, "\tepicsInt8\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_UCHAR :
-		    fprintf(outFile, "\tepicsUInt8\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_SHORT :
-		    fprintf(outFile, "\tepicsInt16\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_USHORT :
-		    fprintf(outFile, "\tepicsUInt16\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_LONG :
-		    fprintf(outFile, "\tepicsInt32\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_ULONG :
-		    fprintf(outFile, "\tepicsUInt32\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_FLOAT :
-		    fprintf(outFile, "\tepicsFloat32\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_DOUBLE :
-		    fprintf(outFile, "\tepicsFloat64\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_ENUM :
-		case DBF_MENU :
-		case DBF_DEVICE :
-		    fprintf(outFile, "\tepicsEnum16\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_INLINK :
-		case DBF_OUTLINK :
-		case DBF_FWDLINK :
-		    fprintf(outFile, "\tDBLINK\t\t%s;\t/* %s */\n",
-			name, pdbFldDes->prompt);
-		    break;
-		case DBF_NOACCESS:
-		    fprintf(outFile, "\t%s;\t/* %s */\n",
-			pdbFldDes->extra, pdbFldDes->prompt);
-		    break;
-		default:
-		    fprintf(outFile,"ILLEGAL FIELD TYPE\n");
-	    }
-	}
-	fprintf(outFile,"} %s",pdbRecordType->name);
-	if(!isdbCommonRecord) fprintf(outFile,"Record");
-	fprintf(outFile,";\n");
-	if(!isdbCommonRecord) {
-	    for(i=0; i<pdbRecordType->no_fields; i++) {
-		pdbFldDes = pdbRecordType->papFldDes[i];
-		fprintf(outFile,"#define %sRecord%s\t%d\n",
-		    pdbRecordType->name,pdbFldDes->name,pdbFldDes->indRecordType);
-	    }
-	}
-	fprintf(outFile,"#endif /*INC%sH*/\n",pdbRecordType->name);
-	pdbRecordType = (dbRecordType *)ellNext(&pdbRecordType->node);
-	if(pdbRecordType) fprintf(outFile,"\n");
-    }
-    if(!isdbCommonRecord) {
-	fprintf(outFile,"#ifdef GEN_SIZE_OFFSET\n");
-	fprintf(outFile,"#ifdef __cplusplus\n");
-	fprintf(outFile,"extern \"C\" {\n");
-	fprintf(outFile,"#endif\n");
-        fprintf(outFile,"#include <epicsExport.h>\n");
-	pdbRecordType = (dbRecordType *)ellFirst(&pdbbase->recordTypeList);
-	while(pdbRecordType) {
-		fprintf(outFile,"static int %sRecordSizeOffset(dbRecordType *pdbRecordType)\n{\n",
-		pdbRecordType->name);
-	    fprintf(outFile,"    %sRecord *prec = 0;\n",pdbRecordType->name);
-	    for(i=0; i<pdbRecordType->no_fields; i++) {
-		char	name[256];
-		int		j;
-
-		pdbFldDes = pdbRecordType->papFldDes[i];
-		for(j=0; j< (int)strlen(pdbFldDes->name); j++)
-		    name[j] = tolower(pdbFldDes->name[j]);
-		name[strlen(pdbFldDes->name)] = 0;
-		fprintf(outFile,
-		"  pdbRecordType->papFldDes[%d]->size=sizeof(prec->%s);\n",
-		    i,name);
-		fprintf(outFile,"  pdbRecordType->papFldDes[%d]->offset=",i);
-		fprintf(outFile,
-		    "(short)((char *)&prec->%s - (char *)prec);\n",name);
-	    }
-	    fprintf(outFile,"    pdbRecordType->rec_size = sizeof(*prec);\n");
-	    fprintf(outFile,"    return(0);\n");
-	    fprintf(outFile,"}\n");
-	    fprintf(outFile,"epicsExportRegistrar(%sRecordSizeOffset);\n",
-		pdbRecordType->name);
-	    pdbRecordType = (dbRecordType *)ellNext(&pdbRecordType->node);
-	}
-	fprintf(outFile,"#ifdef __cplusplus\n");
-	fprintf(outFile,"}\n");
-	fprintf(outFile,"#endif\n");
-	fprintf(outFile,"#endif /*GEN_SIZE_OFFSET*/\n");
-    }
-    fclose(outFile);
-    free((void *)outFilename);
-    return(0);
-}

=== modified file 'src/ioc/registry/registerRecordDeviceDriver.pl'
--- src/ioc/registry/registerRecordDeviceDriver.pl	2010-12-16 23:02:15 +0000
+++ src/ioc/registry/registerRecordDeviceDriver.pl	2012-04-02 20:38:19 +0000
@@ -1,7 +1,7 @@
 eval 'exec perl -S $0 ${1+"$@"}'  # -*- Mode: perl -*-
     if $running_under_some_shell; # registerRecordDeviceDriver 
 #*************************************************************************
-# Copyright (c) 2009 UChicago Argonne LLC, as Operator of Argonne
+# Copyright (c) 2012 UChicago Argonne LLC, as Operator of Argonne
 #     National Laboratory.
 # Copyright (c) 2002 The Regents of the University of California, as
 #     Operator of Los Alamos National Laboratory.
@@ -9,52 +9,35 @@
 # in file LICENSE that is included with this distribution. 
 #*************************************************************************
 
+use strict;
+
 use FindBin qw($Bin);
 use lib "$Bin/../../lib/perl";
+
+use DBD;
+use DBD::Parser;
+use EPICS::Readfile;
 use EPICS::Path;
-
-($file, $subname, $bldTop) = @ARGV;
-$numberRecordType = 0;
-$numberDeviceSupport = 0;
-$numberDriverSupport = 0;
+use Text::Wrap;
+
+my ($file, $subname, $bldTop) = @ARGV;
+
+my $dbd = DBD->new();
+&ParseDBD($dbd, &Readfile($file));
+
+$Text::Wrap::columns = 75;
 
 # Eliminate chars not allowed in C symbol names
-$c_bad_ident_chars = '[^0-9A-Za-z_]';
+my $c_bad_ident_chars = '[^0-9A-Za-z_]';
 $subname =~ s/$c_bad_ident_chars/_/g;
 
 # Process bldTop like convertRelease.pl does
 $bldTop = LocalPath(UnixPath($bldTop));
 $bldTop =~ s/([\\"])/\\\1/g; # escape back-slashes and double-quotes
 
-open(INP,"$file") or die "$! opening file";
-while(<INP>) {
-    next if m/ ^ \s* \# /x;
-    if (m/ \b recordtype \s* \( \s* (\w+) \s* \) /x) {
-        $recordType[$numberRecordType++] = $1;
-    }
-    elsif (m/ \b device \s* \( \s* (\w+) \W+ \w+ \W+ (\w+) /x) {
-        $deviceRecordType[$numberDeviceSupport] = $1;
-        $deviceSupport[$numberDeviceSupport] = $2;
-        $numberDeviceSupport++;
-    }
-    elsif (m/ \b driver \s* \( \s* (\w+) \s* \) /x) {
-        $driverSupport[$numberDriverSupport++] = $1;
-    }
-    elsif (m/ \b registrar \s* \( \s* (\w+) \s* \) /x) {
-        push @registrars, $1;
-    }
-    elsif (m/ \b function \s* \( \s* (\w+) \s* \) /x) {
-        push @registrars, "register_func_$1";
-    }
-    elsif (m/ \b variable \s* \( \s* (\w+) \s* , \s* (\w+) \s* \) /x) {
-        $varType{$1} = $2;
-        push @variables, $1;
-    }
-}
-close(INP) or die "$! closing file";
-
-
-# beginning of generated routine
+
+# Start of generated file
+
 print << "END" ;
 /* THIS IS A GENERATED FILE. DO NOT EDIT! */
 /* Generated from $file */
@@ -70,104 +53,115 @@
 
 END
 
-#definitions for recordtype
-if($numberRecordType>0) {
-    for ($i=0; $i<$numberRecordType; $i++) {
-        print "epicsShareExtern rset *pvar_rset_$recordType[$i]RSET;\n";
-        print "epicsShareExtern int (*pvar_func_$recordType[$i]RecordSizeOffset)(dbRecordType *pdbRecordType);\n"
-    }
-    print "\nstatic const char * const recordTypeNames[$numberRecordType] = {\n";
-    for ($i=0; $i<$numberRecordType; $i++) {
-        print "    \"$recordType[$i]\"";
-        if($i < $numberRecordType-1) { print ",";}
-        print "\n";
-    }
-    print "};\n\n";
-
-    print "static const recordTypeLocation rtl[$i] = {\n";
-    for ($i=0; $i<$numberRecordType; $i++) {
-        print "    {pvar_rset_$recordType[$i]RSET, pvar_func_$recordType[$i]RecordSizeOffset}";
-        if($i < $numberRecordType-1) { print ",";}
-        print "\n";
-    }
-    print "};\n\n";
-}
-
-#definitions for device
-if($numberDeviceSupport>0) {
-    for ($i=0; $i<$numberDeviceSupport; $i++) {
-        print "epicsShareExtern dset *pvar_dset_$deviceSupport[$i];\n";
-    }
-    print "\nstatic const char * const deviceSupportNames[$numberDeviceSupport] = {\n";
-    for ($i=0; $i<$numberDeviceSupport; $i++) {
-        print "    \"$deviceSupport[$i]\"";
-        if($i < $numberDeviceSupport-1) { print ",";}
-        print "\n";
-    }
-    print "};\n\n";
-
-    print "static const dset * const devsl[$i] = {\n";
-    for ($i=0; $i<$numberDeviceSupport; $i++) {
-        print "    pvar_dset_$deviceSupport[$i]";
-        if($i < $numberDeviceSupport-1) { print ",";}
-        print "\n";
-    }
-    print "};\n\n";
-}
-
-#definitions for driver
-if($numberDriverSupport>0) {
-    for ($i=0; $i<$numberDriverSupport; $i++) {
-        print "epicsShareExtern drvet *pvar_drvet_$driverSupport[$i];\n";
-    }
-    print "\nstatic const char *driverSupportNames[$numberDriverSupport] = {\n";
-    for ($i=0; $i<$numberDriverSupport; $i++) {
-        print "    \"$driverSupport[$i]\"";
-        if($i < $numberDriverSupport-1) { print ",";}
-        print "\n";
-    }
-    print "};\n\n";
-    
-    print "static struct drvet *drvsl[$i] = {\n";
-    for ($i=0; $i<$numberDriverSupport; $i++) {
-        print "    pvar_drvet_$driverSupport[$i]";
-        if($i < $numberDriverSupport-1) { print ",";}
-        print "\n";
-    }
-    print "};\n\n";
-}
-
-#definitions registrar
-if(@registrars) {
-    foreach $reg (@registrars) {
-	print "epicsShareExtern void (*pvar_func_$reg)(void);\n";
-    }
-    print "\n";
-}
-
-if (@variables) {
-    foreach $var (@variables) {
-        print "epicsShareExtern $varType{$var} *pvar_$varType{$var}_$var;\n";
-    }
-    %iocshTypes = (
-        'int' => 'iocshArgInt',
-        'double' => 'iocshArgDouble'
-    );
-    print "static struct iocshVarDef vardefs[] = {\n";
-    foreach $var (@variables) {
-        $argType = $iocshTypes{$varType{$var}};
-        die "Unknown variable type $varType{$var} for variable $var"
-            unless $argType;
-        print "\t{\"$var\", $argType, (void * const)pvar_$varType{$var}_$var},\n";
-    }
-    print "\t{NULL, iocshArgInt, NULL}\n};\n\n";
-}
-
-#Now actual registration code.
-
-print "int $subname(DBBASE *pbase)\n{\n";
-
-print << "END" if ($bldTop ne '') ;
+my %rectypes = %{$dbd->recordtypes};
+my @dsets;
+if (%rectypes) {
+    my @rtypnames = sort keys %rectypes;
+
+    # Declare the record support entry tables
+    print wrap('epicsShareExtern rset ', '    ',
+        join(', ', map {"*pvar_rset_${_}RSET"} @rtypnames)), ";\n\n";
+
+    # Declare the RecordSizeOffset functions
+    print "typedef int (*rso_func)(dbRecordType *pdbRecordType);\n";
+    print wrap('epicsShareExtern rso_func ', '    ',
+        join(', ', map {"pvar_func_${_}RecordSizeOffset"} @rtypnames)), ";\n\n";
+
+    # List of record type names
+    print "static const char * const recordTypeNames[] = {\n";
+    print wrap('    ', '    ', join(', ', map {"\"$_\""} @rtypnames));
+    print "\n};\n\n";
+
+    # List of pointers to each RSET and RecordSizeOffset function
+    print "static const recordTypeLocation rtl[] = {\n";
+    print join(",\n", map {
+            "    {pvar_rset_${_}RSET, pvar_func_${_}RecordSizeOffset}"
+        } @rtypnames);
+    print "\n};\n\n";
+
+    for my $rtype (@rtypnames) {
+        my @devices = $rectypes{$rtype}->devices;
+        for my $dtype (@devices) {
+            my $dset = $dtype->name;
+            push @dsets, $dset;
+        }
+    }
+
+    if (@dsets) {
+        # Declare the device support entry tables
+        print wrap('epicsShareExtern dset ', '    ',
+            join(', ', map {"*pvar_dset_$_"} @dsets)), ";\n\n";
+
+        # List of dset names
+        print "static const char * const deviceSupportNames[] = {\n";
+        print wrap('    ', '    ', join(', ', map {"\"$_\""} @dsets));
+        print "\n};\n\n";
+
+        # List of pointers to each dset
+        print "static const dset * const devsl[] = {\n";
+        print wrap('    ', '    ', join(", ", map {"pvar_dset_$_"} @dsets));
+        print "\n};\n\n";
+    }
+}
+
+my %drivers = %{$dbd->drivers};
+if (%drivers) {
+    my @drivers = sort keys %drivers;
+
+    # Declare the driver entry tables
+    print wrap('epicsShareExtern drvet ', '    ',
+        join(', ', map {"*pvar_drvet_$_"} @drivers)), ";\n\n";
+
+    # List of drvet names
+    print "static const char *driverSupportNames[] = {\n";
+    print wrap('    ', '    ', join(', ', map {"\"$_\""} @drivers));
+    print "};\n\n";
+
+    # List of pointers to each drvet
+    print "static struct drvet *drvsl[] = {\n";
+    print join(",\n", map {"    pvar_drvet_$_"} @drivers);
+    print "};\n\n";
+}
+
+my @registrars = sort keys %{$dbd->registrars};
+my @functions = sort keys %{$dbd->functions};
+push @registrars, map {"register_func_$_"} @functions;
+if (@registrars) {
+    # Declare the registrar functions
+    print "typedef void (*reg_func)(void);\n";
+    print wrap('epicsShareExtern reg_func ', '    ',
+        join(', ', map {"pvar_func_$_"} @registrars)), ";\n\n";
+}
+
+my %variables = %{$dbd->variables};
+if (%variables) {
+    my @varnames = sort keys %variables;
+
+    # Declare the variables
+    for my $var (@varnames) {
+        my $vtype = $variables{$var}->var_type;
+        print "epicsShareExtern $vtype * const pvar_${vtype}_$var;\n";
+    }
+
+    # Generate the structure for registering variables with iocsh
+    print "\nstatic struct iocshVarDef vardefs[] = {\n";
+    for my $var (@varnames) {
+        my $vtype = $variables{$var}->var_type;
+        my $itype = $variables{$var}->iocshArg_type;
+        print "    {\"$var\", $itype, pvar_${vtype}_$var},\n";
+    }
+    print "    {NULL, iocshArgInt, NULL}\n};\n\n";
+}
+
+# Now for actual registration routine
+
+print << "END";
+int $subname(DBBASE *pbase)
+{
+    static int executed = 0;
+END
+
+print << "END" if $bldTop ne '';
     const char *bldTop = "$bldTop";
     const char *envTop = getenv("TOP");
 
@@ -179,57 +173,62 @@
 
 END
 
-print << "END" ;
+print << 'END';
     if (!pbase) {
-        printf("pdbbase is NULL; you must load a DBD file first.\\n");
+        printf("pdbbase is NULL; you must load a DBD file first.\n");
         return -1;
     }
 
-END
-
-if($numberRecordType>0) {
-    print "    registerRecordTypes(pbase, $numberRecordType, ",
-				  "recordTypeNames, rtl);\n";
-}
-if($numberDeviceSupport>0) {
-    print "    registerDevices(pbase, $numberDeviceSupport, ",
-				  "deviceSupportNames, devsl);\n";
-}
-if($numberDriverSupport>0) {
-    print "    registerDrivers(pbase, $numberDriverSupport, ",
-				  "driverSupportNames, drvsl);\n";
-}
-foreach $reg (@registrars) {
-    print "    (*pvar_func_$reg)();\n";
-}
-
-if (@variables) {
-    print "    iocshRegisterVariable(vardefs);\n";
-}
-print << "END" ;
+    if (executed) {
+        printf("Registration already done.\n");
+        return 0;
+    }
+    executed = 1;
+
+END
+
+print << 'END' if %rectypes;
+    registerRecordTypes(pbase, NELEMENTS(rtl), recordTypeNames, rtl);
+END
+
+print << 'END' if @dsets;
+    registerDevices(pbase, NELEMENTS(devsl), deviceSupportNames, devsl);
+END
+
+print << 'END' if %drivers;
+    registerDrivers(pbase, NELEMENTS(drvsl), driverSupportNames, drvsl);
+END
+
+print << "END" for @registrars;
+    pvar_func_$_();
+END
+
+print << 'END' if %variables;
+    iocshRegisterVariable(vardefs);
+END
+
+print << "END";
     return 0;
 }
 
-/* registerRecordDeviceDriver */
-static const iocshArg registerRecordDeviceDriverArg0 =
-                                            {"pdbbase",iocshArgPdbbase};
-static const iocshArg *registerRecordDeviceDriverArgs[1] =
-                                            {&registerRecordDeviceDriverArg0};
-static const iocshFuncDef registerRecordDeviceDriverFuncDef =
-                {"$subname",1,registerRecordDeviceDriverArgs};
-static void registerRecordDeviceDriverCallFunc(const iocshArgBuf *)
+/* $subname */
+static const iocshArg rrddArg0 = {"pdbbase", iocshArgPdbbase};
+static const iocshArg *rrddArgs[] = {&rrddArg0};
+static const iocshFuncDef rrddFuncDef =
+    {"$subname", 1, rrddArgs};
+static void rrddCallFunc(const iocshArgBuf *)
 {
     $subname(*iocshPpdbbase);
 }
 
 } // extern "C"
+
 /*
  * Register commands on application startup
  */
 static int Registration() {
     iocshRegisterCommon();
-    iocshRegister(&registerRecordDeviceDriverFuncDef,
-        registerRecordDeviceDriverCallFunc);
+    iocshRegister(&rrddFuncDef, rrddCallFunc);
     return 0;
 }
 

=== added directory 'src/tools/DBD'
=== added file 'src/tools/DBD.pm'
--- src/tools/DBD.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,81 @@
+package DBD;
+
+use DBD::Base;
+use DBD::Breaktable;
+use DBD::Driver;
+use DBD::Menu;
+use DBD::Recordtype;
+use DBD::Recfield;
+use DBD::Registrar;
+use DBD::Function;
+use DBD::Variable;
+
+use Carp;
+
+sub new {
+    my ($class) = @_;
+    my $this = {
+        'DBD::Breaktable' => {},
+        'DBD::Driver'     => {},
+        'DBD::Function'   => {},
+        'DBD::Menu'       => {},
+        'DBD::Recordtype' => {},
+        'DBD::Registrar'  => {},
+        'DBD::Variable'   => {}
+    };
+    bless $this, $class;
+    return $this;
+}
+
+sub add {
+    my ($this, $obj) = @_;
+    my $obj_class;
+    foreach (keys %{$this}) {
+        next unless m/^DBD::/;
+        $obj_class = $_ and last if $obj->isa($_);
+    }
+    confess "Unknown object type"
+        unless defined $obj_class;
+    my $obj_name = $obj->name;
+    dieContext("Duplicate name '$obj_name'")
+        if exists $this->{$obj_class}->{$obj_name};
+    $this->{$obj_class}->{$obj_name} = $obj;
+}
+
+sub breaktables {
+    return shift->{'DBD::Breaktable'};
+}
+
+sub drivers {
+    return shift->{'DBD::Driver'};
+}
+
+sub functions {
+    return shift->{'DBD::Function'};
+}
+
+sub menus {
+    return shift->{'DBD::Menu'};
+}
+sub menu {
+    my ($this, $menu_name) = @_;
+    return $this->{'DBD::Menu'}->{$menu_name};
+}
+
+sub recordtypes {
+    return shift->{'DBD::Recordtype'};
+}
+sub recordtype {
+    my ($this, $rtyp_name) = @_;
+    return $this->{'DBD::Recordtype'}->{$rtyp_name};
+}
+
+sub registrars {
+    return shift->{'DBD::Registrar'};
+}
+
+sub variables {
+    return shift->{'DBD::Variable'};
+}
+
+1;

=== added file 'src/tools/DBD/Base.pm'
--- src/tools/DBD/Base.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Base.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,127 @@
+# Common utility functions used by the DBD components
+
+package DBD::Base;
+
+use Carp;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&pushContext &popContext &dieContext &warnContext &is_reserved
+    &identifier &unquote &escapeCcomment &escapeCstring $RXident $RXname
+    $RXuint $RXint $RXhex $RXoct $RXuintx $RXintx $RXnum $RXdqs $RXsqs $RXstr);
+
+
+our $RXident = qr/ [a-zA-Z] [a-zA-Z0-9_]* /x;
+our $RXname =  qr/ [a-zA-Z0-9_\-:.<>;]+ /x;
+our $RXhex =   qr/ (?: 0 [xX] [0-9A-Fa-f]+ ) /x;
+our $RXoct =   qr/ 0 [0-7]* /x;
+our $RXuint =  qr/ \d+ /x;
+our $RXint =   qr/ -? $RXuint /ox;
+our $RXuintx = qr/ ( $RXhex | $RXoct | $RXuint ) /ox;
+our $RXintx =  qr/ ( $RXhex | $RXoct | $RXint ) /ox;
+our $RXnum =   qr/ -? (?: \d+ | \d* \. \d+ ) (?: [eE] [-+]? \d+ )? /x;
+our $RXdqs =   qr/" (?: [^"] | \\" )* " /x;
+our $RXsqs =   qr/' (?: [^'] | \\' )* ' /x;
+our $RXstr =   qr/ ( $RXname | $RXnum | $RXdqs | $RXsqs ) /ox;
+
+our @context;
+
+
+sub pushContext {
+    my ($ctxt) = @_;
+    unshift @context, $ctxt;
+}
+
+sub popContext {
+    my ($ctxt) = @_;
+    my ($pop) = shift @context;
+    ($ctxt ne $pop) and
+        dieContext("Exiting context \"$ctxt\", found \"$pop\" instead.",
+            "\tBraces must close in the same file they were opened.");
+}
+
+sub dieContext {
+    my ($msg) = join "\n\t", @_;
+    print "$msg\n" if $msg;
+    die "Context: ", join(' in ', @context), "\n";
+}
+
+sub warnContext {
+    my ($msg) = join "\n\t", @_;
+    print "$msg\n" if $msg;
+    print "Context: ", join(' in ', @context), "\n";
+}
+
+
+# Input checking
+
+sub unquote (\$) {
+    my ($s) = @_;
+    $$s =~ s/^"(.*)"$/$1/o;
+    return $$s;
+}
+
+# Reserved words from C++ and the DB/DBD file parser
+my %reserved = map { $_ => undef } qw(and and_eq asm auto bitand bitor bool
+    break case catch char class compl const const_cast continue default delete
+    do double dynamic_cast else enum explicit export extern false float for
+    friend goto if inline int long mutable namespace new not not_eq operator or
+    or_eq private protected public register reinterpret_cast return short signed
+    sizeof static static_cast struct switch template this throw true try typedef
+    typeid typename union unsigned using virtual void volatile wchar_t while xor
+    xor_eq addpath alias breaktable choice device driver field function grecord
+    include info menu path record recordtype registrar variable);
+sub is_reserved {
+    my $id = shift;
+    return exists $reserved{$id};
+}
+
+sub identifier {
+    my ($id, $what) = @_;
+    unquote $id;
+    confess "$what undefined!" unless defined $id;
+    $id =~ m/^$RXident$/o or dieContext("Illegal $what '$id'",
+        "Identifiers are used in C code so must start with a letter, followed",
+        "by letters, digits and/or underscore characters only.");
+    dieContext("Illegal $what '$id'",
+        "Identifier is a C++ reserved word.")
+        if is_reserved($id);
+    return $id;
+}
+
+
+# Output filtering
+
+sub escapeCcomment {
+    ($_) = @_;
+    s/\*\//**/g;
+    return $_;
+}
+
+sub escapeCstring {
+    ($_) = @_;
+    # How to do this?
+    return $_;
+}
+
+
+# Base class routines for the DBD component objects
+
+sub new {
+    my $class = shift;
+    my $this = {};
+    bless $this, $class;
+    return $this->init(@_);
+}
+
+sub init {
+    my ($this, $name, $what) = @_;
+    $this->{NAME} = identifier($name, $what);
+    return $this;
+}
+
+sub name {
+    return shift->{NAME};
+}
+
+1;

=== added file 'src/tools/DBD/Breaktable.pm'
--- src/tools/DBD/Breaktable.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Breaktable.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,32 @@
+package DBD::Breaktable;
+use DBD::Base;
+@ISA = qw(DBD::Base);
+
+use Carp;
+
+sub init {
+	my ($this, $name) = @_;
+	$this->SUPER::init($name, "breakpoint table name");
+        $this->{POINT_LIST} = [];
+        return $this;
+}
+
+sub add_point {
+	my ($this, $raw, $eng) = @_;
+	confess "Raw value undefined!" unless defined $raw;
+	confess "Engineering value undefined!" unless defined $eng;
+	unquote $raw;
+	unquote $eng;
+	push @{$this->{POINT_LIST}}, [$raw, $eng];
+}
+
+sub points {
+	return @{shift->{POINT_LIST}};
+}
+
+sub point {
+    my ($this, $idx) = @_;
+    return $this->{POINT_LIST}[$idx];
+}
+
+1;

=== added file 'src/tools/DBD/Device.pm'
--- src/tools/DBD/Device.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Device.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,45 @@
+package DBD::Device;
+use DBD::Base;
+@ISA = qw(DBD::Base);
+
+my %link_types = (
+	CONSTANT  => qr/$RXnum/o,
+	PV_LINK   => qr/$RXname \s+ [.NPCAMS ]*/ox,
+	VME_IO    => qr/\# (?: \s* [CS] \s* $RXintx)* \s* (?: @ .*)?/ox,
+	CAMAC_IO  => qr/\# (?: \s* [BCNAF] \s* $RXintx)* \s* (?: @ .*)?/ox,
+	RF_IO     => qr/\# (?: \s* [RMDE] \s* $RXintx)*/ox,
+	AB_IO     => qr/\# (?: \s* [LACS] \s* $RXintx)* \s* (?: @ .*)?/ox,
+	GPIB_IO   => qr/\# (?: \s* [LA] \s* $RXintx)* \s* (?: @ .*)?/ox,
+	BITBUS_IO => qr/\# (?: \s* [LNPS] \s* $RXuintx)* \s* (?: @ .*)?/ox,
+	BBGPIB_IO => qr/\# (?: \s* [LBG] \s* $RXuintx)* \s* (?: @ .*)?/ox,
+	VXI_IO    => qr/\# (?: \s* [VCS] \s* $RXintx)* \s* (?: @ .*)?/ox,
+	INST_IO   => qr/@.*/
+);
+
+sub init {
+	my ($this, $link_type, $dset, $choice) = @_;
+        unquote $choice;
+	dieContext("Unknown link type '$link_type', valid types are:",
+		sort keys %link_types) unless exists $link_types{$link_type};
+	$this->SUPER::init($dset, "DSET name");
+	$this->{LINK_TYPE} = $link_type;
+	$this->{CHOICE} = $choice;
+	return $this;
+}
+
+sub link_type {
+	return shift->{LINK_TYPE};
+}
+
+sub choice {
+	return shift->{CHOICE};
+}
+
+sub legal_addr {
+        my ($this, $addr) = @_;
+        my $rx = $link_types{$this->{LINK_TYPE}};
+        unquote $addr;
+        return $addr =~ m/^ $rx $/x;
+}
+
+1;

=== added file 'src/tools/DBD/Driver.pm'
--- src/tools/DBD/Driver.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Driver.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,9 @@
+package DBD::Driver;
+use DBD::Base;
+@ISA = qw(DBD::Base);
+
+sub init {
+    return shift->SUPER::init(shift, "driver entry table name");
+}
+
+1;

=== added file 'src/tools/DBD/Function.pm'
--- src/tools/DBD/Function.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Function.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,10 @@
+package DBD::Function;
+use DBD::Base;
+@ISA = qw(DBD::Base);
+
+sub init {
+    return shift->SUPER::init(shift, "function name");
+}
+
+1;
+

=== added file 'src/tools/DBD/Menu.pm'
--- src/tools/DBD/Menu.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Menu.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,66 @@
+package DBD::Menu;
+use DBD::Base;
+@ISA = qw(DBD::Base);
+
+sub init {
+    my ($this, $name) = @_;
+    $this->SUPER::init($name, "menu name");
+    $this->{CHOICE_LIST} = [];
+    $this->{CHOICE_INDEX} = {};
+    return $this;
+}
+
+sub add_choice {
+    my ($this, $name, $value) = @_;
+    $name = identifier($name, "Choice name");
+    unquote $value;
+    foreach $pair ($this->choices) {
+    	dieContext("Duplicate choice name") if ($pair->[0] eq $name);
+    	dieContext("Duplicate choice string") if ($pair->[1] eq $value);
+    }
+    push @{$this->{CHOICE_LIST}}, [$name, $value];
+    $this->{CHOICE_INDEX}->{$value} = $name;
+}
+
+sub choices {
+    return @{shift->{CHOICE_LIST}};
+}
+
+sub choice {
+    my ($this, $idx) = @_;
+    return $this->{CHOICE_LIST}[$idx];
+}
+
+sub legal_choice {
+    my ($this, $value) = @_;
+    unquote $value;
+    return exists $this->{CHOICE_INDEX}->{$value};
+}
+
+sub toDeclaration {
+    my $this = shift;
+    my $name = $this->name;
+    my @choices = map {
+        sprintf "    %-31s /* %s */", @{$_}[0], escapeCcomment(@{$_}[1]);
+    } $this->choices;
+    return "typedef enum {\n" .
+               join(",\n", @choices) .
+           ",\n    ${name}_NUM_CHOICES\n" .
+           "} $name;\n\n";
+}
+
+sub toDefinition {
+    my $this = shift;
+    my $name = $this->name;
+    my @strings = map {
+        "\t\"" . escapeCstring(@{$_}[1]) . "\""
+    } $this->choices;
+    return "static const char * const ${name}ChoiceStrings[] = {\n" .
+               join(",\n", @strings) . "\n};\n" .
+           "const dbMenu ${name}MenuMetaData = {\n" .
+           "\t\"" . escapeCstring($name) . "\",\n" .
+           "\t${name}_NUM_CHOICES,\n" .
+           "\t${name}ChoiceStrings\n};\n\n";
+}
+
+1;

=== added file 'src/tools/DBD/Output.pm'
--- src/tools/DBD/Output.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Output.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,98 @@
+package DBD::Output;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&OutputDBD);
+
+use DBD;
+use DBD::Base;
+use DBD::Breaktable;
+use DBD::Device;
+use DBD::Driver;
+use DBD::Menu;
+use DBD::Recordtype;
+use DBD::Recfield;
+use DBD::Registrar;
+use DBD::Function;
+use DBD::Variable;
+
+sub OutputDBD {
+    my ($out, $dbd) = @_;
+    &OutputMenus($out, $dbd->menus);
+    &OutputRecordtypes($out, $dbd->recordtypes);
+    &OutputDrivers($out, $dbd->drivers);
+    &OutputRegistrars($out, $dbd->registrars);
+    &OutputFunctions($out, $dbd->functions);
+    &OutputVariables($out, $dbd->variables);
+    &OutputBreaktables($out, $dbd->breaktables);
+}
+
+sub OutputMenus {
+    my ($out, $menus) = @_;
+    while (my ($name, $menu) = each %{$menus}) {
+        printf $out "menu(%s) {\n", $name;
+        printf $out "    choice(%s, \"%s\")\n", @{$_}
+            foreach $menu->choices;
+        print $out "}\n";
+    }
+}
+
+sub OutputRecordtypes {
+    my ($out, $recordtypes) = @_;
+    while (my ($name, $recordtype) = each %{$recordtypes}) {
+        printf $out "recordtype(%s) {\n", $name;
+        print $out "    %$_\n"
+            foreach $recordtype->cdefs;
+        foreach $field ($recordtype->fields) {
+            printf $out "    field(%s, %s) {\n",
+                $field->name, $field->dbf_type;
+            while (my ($attr, $val) = each %{$field->attributes}) {
+                $val = "\"$val\"" if $val !~ m/^[a-zA-Z0-9_\-+:.\[\]<>;]*$/;
+                printf $out "        %s(%s)\n", $attr, $val;
+            }
+            print $out "    }\n";
+        }
+        printf $out "}\n";
+        printf $out "device(%s, %s, %s, \"%s\")\n",
+            $name, $_->link_type, $_->name, $_->choice
+            foreach $recordtype->devices;
+    }
+}
+
+sub OutputDrivers {
+    my ($out, $drivers) = @_;
+    printf $out "driver(%s)\n", $_
+        foreach keys %{$drivers};
+}
+
+sub OutputRegistrars {
+    my ($out, $registrars) = @_;
+    printf $out "registrar(%s)\n", $_
+        foreach keys %{$registrars};
+}
+
+sub OutputFunctions {
+    my ($out, $functions) = @_;
+    printf $out "function(%s)\n", $_
+        foreach keys %{$functions};
+}
+
+sub OutputVariables {
+    my ($out, $variables) = @_;
+    while (my ($name, $variable) = each %{$variables}) {
+        printf $out "variable(%s, %s)\n", $name, $variable->var_type;
+    }
+}
+
+sub OutputBreaktables {
+    my ($out, $breaktables) = @_;
+    while (my ($name, $breaktable) = each %{$breaktables}) {
+        printf $out "breaktable(\"%s\") {\n", $name;
+        printf $out "    point(%s, %s)\n", @{$_}
+            foreach $breaktable->points;
+        print $out "}\n";
+    }
+}
+
+1;

=== added file 'src/tools/DBD/Parser.pm'
--- src/tools/DBD/Parser.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Parser.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,197 @@
+package DBD::Parser;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&ParseDBD);
+
+use DBD;
+use DBD::Base;
+use DBD::Breaktable;
+use DBD::Device;
+use DBD::Driver;
+use DBD::Menu;
+use DBD::Recordtype;
+use DBD::Recfield;
+use DBD::Registrar;
+use DBD::Function;
+use DBD::Variable;
+
+my $RXnam = qr/[a-zA-Z0-9_\-:.<>;]+/o;
+my $RXnum = qr/-? (?: \d+ ) | (?: \d* \. \d+ ) (?: [eE] [-+]? \d+ )?/ox;
+my $RXdqs = qr/" (?: [^"] | \\" )* "/ox;
+my $RXsqs = qr/' (?: [^'] | \\' )* '/ox;
+my $string = qr/ ( $RXnam | $RXnum | $RXdqs | $RXsqs ) /ox;
+
+our $debug=0;
+
+sub ParseDBD {
+    my $dbd = shift;
+    $_ = shift;
+    while (1) {
+        parseCommon();
+        if (m/\G menu \s* \( \s* $string \s* \) \s* \{/oxgc) {
+            print "Menu: $1\n" if $debug;
+            parse_menu($dbd, $1);
+        }
+        elsif (m/\G driver \s* \( \s* $string \s* \)/oxgc) {
+            print "Driver: $1\n" if $debug;
+            $dbd->add(DBD::Driver->new($1));
+        }
+        elsif (m/\G registrar \s* \( \s* $string \s* \)/oxgc) {
+            print "Registrar: $1\n" if $debug;
+            $dbd->add(DBD::Registrar->new($1));
+        }
+        elsif (m/\G function \s* \( \s* $string \s* \)/oxgc) {
+            print "Function: $1\n" if $debug;
+            $dbd->add(DBD::Function->new($1));
+        }
+        elsif (m/\G breaktable \s* \( \s* $string \s* \) \s* \{/oxgc) {
+            print "Breaktable: $1\n" if $debug;
+            parse_breaktable($dbd, $1);
+        }
+        elsif (m/\G recordtype \s* \( \s* $string \s* \) \s* \{/oxgc) {
+            print "Recordtype: $1\n" if $debug;
+            parse_recordtype($dbd, $1);
+        }
+        elsif (m/\G variable \s* \( \s* $string \s* \)/oxgc) {
+            print "Variable: $1\n" if $debug;
+            $dbd->add(DBD::Variable->new($1, 'int'));
+        }
+        elsif (m/\G variable \s* \( \s* $string \s* , \s* $string \s* \)/oxgc) {
+            print "Variable: $1, $2\n" if $debug;
+            $dbd->add(DBD::Variable->new($1, $2));
+        }
+        elsif (m/\G device \s* \( \s* $string \s* , \s* $string \s* ,
+                          \s* $string \s* , \s*$string \s* \)/oxgc) {
+            print "Device: $1, $2, $3, $4\n" if $debug;
+            my $rtyp = $dbd->recordtype($1);
+            dieContext("Unknown record type '$1'") unless defined $rtyp;
+            $rtyp->add_device(DBD::Device->new($2, $3, $4));
+        } else {
+            last unless m/\G (.*) $/moxgc;
+            dieContext("Syntax error in '$1'");
+        }
+    }
+}
+
+sub parseCommon {
+    while (1) {
+        # Skip leading whitespace
+        m/\G \s* /oxgc;
+
+        if (m/\G \# /oxgc) {
+            if (m/\G \#!BEGIN\{ ( [^}]* ) \}!\#\# \n/oxgc) {
+                print "File-Begin: $1\n" if $debug;
+                pushContext("file '$1'");
+            }
+            elsif (m/\G \#!END\{ ( [^}]* ) \}!\#\# \n?/oxgc) {
+                print "File-End: $1\n" if $debug;
+                popContext("file '$1'");
+            }
+            else {
+                m/\G (.*) \n/oxgc;
+                print "Comment: $1\n" if $debug;
+            }
+        } else {
+            return;
+        }
+    }
+}
+
+sub parse_menu {
+    my ($dbd, $name) = @_;
+    pushContext("menu($name)");
+    my $menu = DBD::Menu->new($name);
+    while(1) {
+        parseCommon();
+        if (m/\G choice \s* \( \s* $string \s* , \s* $string \s* \)/oxgc) {
+            print " Menu-Choice: $1, $2\n" if $debug;
+            $menu->add_choice($1, $2);
+        }
+        elsif (m/\G \}/oxgc) {
+            print " Menu-End:\n" if $debug;
+            $dbd->add($menu);
+            popContext("menu($name)");
+            return;
+        } else {
+            m/\G (.*) $/moxgc or dieContext("Unexpected end of input");
+            dieContext("Syntax error in '$1'");
+        }
+    }
+}
+
+sub parse_breaktable {
+    my ($dbd, $name) = @_;
+    pushContext("breaktable($name)");
+    my $bt = DBD::Breaktable->new($name);
+    while(1) {
+        parseCommon();
+        if (m/\G point\s* \(\s* $string \s* , \s* $string \s* \)/oxgc) {
+            print " Breaktable-Point: $1, $2\n" if $debug;
+            $bt->add_point($1, $2);
+        }
+        elsif (m/\G $string \s* (?: , \s*)? $string (?: \s* ,)?/oxgc) {
+            print " Breaktable-Data: $1, $2\n" if $debug;
+            $bt->add_point($1, $2);
+        }
+        elsif (m/\G \}/oxgc) {
+            print " Breaktable-End:\n" if $debug;
+            $dbd->add($bt);
+            popContext("breaktable($name)");
+            return;
+        } else {
+            m/\G (.*) $/moxgc or dieContext("Unexpected end of input");
+            dieContext("Syntax error in '$1'");
+        }
+    }
+}
+
+sub parse_recordtype {
+    my ($dbd, $name) = @_;
+    pushContext("recordtype($name)");
+    my $rtyp = DBD::Recordtype->new($name);
+    while(1) {
+        parseCommon();
+        if (m/\G field \s* \( \s* $string \s* , \s* $string \s* \) \s* \{/oxgc) {
+            print " Recordtype-Field: $1, $2\n" if $debug;
+            parse_field($rtyp, $1, $2);
+        }
+        elsif (m/\G \}/oxgc) {
+            print " Recordtype-End:\n" if $debug;
+            $dbd->add($rtyp);
+            popContext("recordtype($name)");
+            return;
+        }
+        elsif (m/\G % (.*) \n/oxgc) {
+            print " Recordtype-Cdef: $1\n" if $debug;
+            $rtyp->add_cdef($1);
+        } else {
+            m/\G (.*) $/moxgc or dieContext("Unexpected end of input");
+            dieContext("Syntax error in '$1'");
+        }
+    }
+}
+
+sub parse_field {
+    my ($rtyp, $name, $field_type) = @_;
+    my $fld = DBD::Recfield->new($name, $field_type);
+    pushContext("field($name, $field_type)");
+    while(1) {
+        parseCommon();
+        if (m/\G (\w+) \s* \( \s* $string \s* \)/oxgc) {
+            print "  Field-Attribute: $1, $2\n" if $debug;
+            $fld->add_attribute($1, $2);
+        }
+        elsif (m/\G \}/oxgc) {
+            print "  Field-End:\n" if $debug;
+            $rtyp->add_field($fld);
+            popContext("field($name, $field_type)");
+            return;
+        } else {
+            m/\G (.*) $/moxgc or dieContext("Unexpected end of input");
+            dieContext("Syntax error in '$1'");
+        }
+    }
+}
+
+1;

=== added file 'src/tools/DBD/Recfield.pm'
--- src/tools/DBD/Recfield.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Recfield.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,436 @@
+package DBD::Recfield;
+use DBD::Base;
+@ISA = qw(DBD::Base);
+
+# The hash value is a regexp that matches all legal values of this field
+our %field_types = (
+    DBF_STRING   => qr/.{0,40}/,
+    DBF_CHAR     => $RXintx,
+    DBF_UCHAR    => $RXuintx,
+    DBF_SHORT    => $RXintx,
+    DBF_USHORT   => $RXuintx,
+    DBF_LONG     => $RXintx,
+    DBF_ULONG    => $RXuintx,
+    DBF_FLOAT    => $RXnum,
+    DBF_DOUBLE   => $RXnum,
+    DBF_ENUM     => qr/.*/,
+    DBF_MENU     => qr/.*/,
+    DBF_DEVICE   => qr/.*/,
+    DBF_INLINK   => qr/.*/,
+    DBF_OUTLINK  => qr/.*/,
+    DBF_FWDLINK  => qr/.*/,
+    DBF_NOACCESS => qr//
+);
+
+# The hash value is a regexp that matches all legal values of this attribute
+our %field_attrs = (
+    asl         => qr/^ASL[01]$/,
+    initial     => qr/^.*$/,
+    promptgroup => qr/^GUI_\w+$/,
+    prompt      => qr/^.*$/,
+    special     => qr/^(?:SPC_\w+|\d{3,})$/,
+    pp          => qr/^(?:TRUE|FALSE)$/,
+    interest    => qr/^\d+$/,
+    base        => qr/^(?:DECIMAL|HEX)$/,
+    size        => qr/^\d+$/,
+    extra       => qr/^.*$/,
+    menu        => qr/^$RXident$/o
+);
+
+sub new {
+    my ($class, $name, $type) = @_;
+    dieContext("Illegal field type '$type', valid field types are:",
+        sort keys %field_types) unless exists $field_types{$type};
+    my $this = {};
+    bless $this, "${class}::${type}";
+    return $this->init($name, $type);
+}
+
+sub init {
+    my ($this, $name, $type) = @_;
+    unquote $type;
+    $this->SUPER::init($name, "record field name");
+    dieContext("Illegal field type '$type', valid field types are:",
+        sort keys %field_types) unless exists $field_types{$type};
+    $this->{DBF_TYPE} = $type;
+    $this->{ATTR_INDEX} = {};
+    return $this;
+}
+
+sub dbf_type {
+    return shift->{DBF_TYPE};
+}
+
+sub set_number {
+    my ($this, $number) = @_;
+    $this->{NUMBER} = $number;
+}
+
+sub number {
+    return shift->{NUMBER};
+}
+
+sub add_attribute {
+    my ($this, $attr, $value) = @_;
+    unquote $value;
+    my $match = $field_attrs{$attr};
+    dieContext("Unknown field attribute '$1', valid attributes are:",
+           sort keys %field_attrs)
+        unless defined $match;
+    dieContext("Bad value '$value' for field '$attr' attribute")
+        unless $value =~ m/$match/;
+    $this->{ATTR_INDEX}->{$attr} = $value;
+}
+
+sub attributes {
+    return shift->{ATTR_INDEX};
+}
+
+sub attribute {
+    my ($this, $attr) = @_;
+    return $this->attributes->{$attr};
+}
+
+sub check_valid {
+    my ($this) = @_;
+    my $name = $this->name;
+    my $default = $this->attribute("initial");
+    dieContext("Default value '$default' is invalid for field '$name'")
+        if (defined($default) and !$this->legal_value($default));
+}
+
+# The C structure member name is usually the field name converted to
+# lower-case.  However if that is a reserved word, use the original.
+sub C_name {
+    my ($this) = @_;
+    my $name = lc $this->name;
+    $name = $this->name
+        if is_reserved($name);
+    return $name;
+}
+
+sub toDeclaration {
+    my ($this, $ctype) = @_;
+    my $name = $this->C_name;
+    my $result = sprintf "    %-19s %-12s", $ctype, "$name;";
+    my $prompt = $this->attribute('prompt');
+    $result .= "/* $prompt */" if defined $prompt;
+    return $result;
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_STRING;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    return (length $value < $this->attribute('size'));
+    # NB - we use '<' to allow space for the terminating nil byte
+}
+
+sub check_valid {
+    my ($this) = @_;
+    dieContext("Size missing for DBF_STRING field '$name'")
+        unless exists $this->attributes->{'size'};
+    $this->SUPER::check_valid;
+}
+
+sub toDeclaration {
+    my ($this) = @_;
+    my $name = lc $this->name;
+    my $size = $this->attribute('size');
+    my $result = sprintf "    %-19s %-12s", 'char', "${name}[${size}];";
+    my $prompt = $this->attribute('prompt');
+    $result .= "/* $prompt */" if defined $prompt;
+    return $result;
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_CHAR;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    $value =~ s/^ ( $RXhex | $RXoct ) $/ oct($1) /xe;
+    return ($value =~ m/^ $RXint $/x and
+            $value >= -128 and
+            $value <= 127);
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsInt8");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_UCHAR;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    $value =~ s/^ ( $RXhex | $RXoct ) $/ oct($1) /xe;
+    return ($value =~ m/^ $RXuint $/x and
+            $value >= 0 and
+            $value <= 255);
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsUInt8");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_SHORT;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    $value =~ s/^ ( $RXhex | $RXoct ) $/ oct($1) /xe;
+    return ($value =~ m/^ $RXint $/x and
+            $value >= -32768 and
+            $value <= 32767);
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsInt16");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_USHORT;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    $value =~ s/^ ( $RXhex | $RXoct ) $/ oct($1) /xe;
+    return ($value =~ m/^ $RXuint $/x and
+            $value >= 0 and
+            $value <= 65535);
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsUInt16");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_LONG;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    $value =~ s/^ ( $RXhex | $RXoct ) $/ oct($1) /xe;
+    return ($value =~ m/^ $RXint $/x);
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsInt32");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_ULONG;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    $value =~ s/^ ( $RXhex | $RXoct ) $/ oct($1) /xe;
+    return ($value =~ m/^ $RXuint $/x and
+            $value >= 0);
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsUInt32");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_FLOAT;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    return ($value =~ m/^ $RXnum $/x);
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsFloat32");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_DOUBLE;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    return ($value =~ m/^ $RXnum $/x);
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsFloat64");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_ENUM;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    return 1;
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsEnum16");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_MENU;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    # FIXME: If we know the menu name and the menu exists, check further
+    return 1;
+}
+
+sub check_valid {
+    my ($this) = @_;
+    dieContext("Menu name missing for DBF_MENU field '$name'")
+        unless defined($this->attribute("menu"));
+    $this->SUPER::check_valid;
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsEnum16");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_DEVICE;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    return 1;
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("epicsEnum16");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_INLINK;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    return 1;
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("DBLINK");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_OUTLINK;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    return 1;
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("DBLINK");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_FWDLINK;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    return 1;
+}
+
+sub toDeclaration {
+    return shift->SUPER::toDeclaration("DBLINK");
+}
+
+
+################################################################################
+
+package DBD::Recfield::DBF_NOACCESS;
+
+use DBD::Base;
+@ISA = qw(DBD::Recfield);
+
+sub legal_value {
+    my ($this, $value) = @_;
+    return ($value eq '');
+}
+
+sub check_valid {
+    my ($this) = @_;
+    dieContext("Type information missing for DBF_NOACCESS field '$name'")
+        unless defined($this->attribute("extra"));
+    $this->SUPER::check_valid;
+}
+
+sub toDeclaration {
+    my ($this) = @_;
+    my $extra = $this->attribute('extra');
+    my $result = sprintf "    %-31s ", "$extra;";
+    my $prompt = $this->attribute('prompt');
+    $result .= "/* $prompt */" if defined $prompt;
+    return $result;
+}
+
+1;

=== added file 'src/tools/DBD/Recordtype.pm'
--- src/tools/DBD/Recordtype.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Recordtype.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,100 @@
+package DBD::Recordtype;
+use DBD::Base;
+@ISA = qw(DBD::Base);
+
+use Carp;
+
+sub init {
+    my $this = shift;
+    $this->SUPER::init(@_);
+    $this->{FIELD_LIST} = [];
+    $this->{FIELD_INDEX} = {};
+    $this->{DEVICE_LIST} = [];
+    $this->{DEVICE_INDEX} = {};
+    $this->{CDEFS} = [];
+    return $this;
+}
+
+sub add_field {
+    my ($this, $field) = @_;
+    confess "Not a DBD::Recfield" unless $field->isa('DBD::Recfield');
+    my $field_name = $field->name;
+    dieContext("Duplicate field name '$field_name'")
+        if exists $this->{FIELD_INDEX}->{$field_name};
+    $field->check_valid;
+    $field->set_number(scalar @{$this->{FIELD_LIST}});
+    push @{$this->{FIELD_LIST}}, $field;
+    $this->{FIELD_INDEX}->{$field_name} = $field;
+}
+
+sub fields {
+    return @{shift->{FIELD_LIST}};
+}
+
+sub field_names { # In their original order...
+    my $this = shift;
+    my @names = ();
+    foreach ($this->fields) {
+        push @names, $_->name
+    }
+    return @names;
+}
+
+sub field {
+    my ($this, $field_name) = @_;
+    return $this->{FIELD_INDEX}->{$field_name};
+}
+
+sub add_device {
+    my ($this, $device) = @_;
+    confess "Not a DBD::Device" unless $device->isa('DBD::Device');
+    my $choice = $device->choice;
+    if (exists $this->{DEVICE_INDEX}->{$choice}) {
+        my @warning = ("Duplicate device type '$choice'");
+        my $old = $this->{DEVICE_INDEX}->{$choice};
+        push @warning, "Link types differ"
+            if ($old->link_type ne $device->link_type);
+        push @warning, "DSETs differ"
+            if ($old->name ne $device->name);
+        warnContext(@warning);
+        return;
+    }
+    push @{$this->{DEVICE_LIST}}, $device;
+    $this->{DEVICE_INDEX}->{$choice} = $device;
+}
+
+sub devices {
+    return @{shift->{DEVICE_LIST}};
+}
+
+sub device {
+    my ($this, $choice) = @_;
+    return $this->{DEVICE_INDEX}->{$choice};
+}
+
+sub add_cdef {
+    my ($this, $cdef) = @_;
+    push @{$this->{CDEFS}}, $cdef;
+}
+
+sub cdefs {
+    return @{shift->{CDEFS}};
+}
+
+sub toCdefs {
+    return join("\n", shift->cdefs) . "\n\n";
+}
+
+sub toDeclaration {
+    my $this = shift;
+    my @fields = map {
+        $_->toDeclaration
+    } $this->fields;
+    my $name = $this->name;
+    $name .= "Record" unless $name eq "dbCommon";
+    return "typedef struct $name {\n" .
+               join("\n", @fields) .
+           "\n} $name;\n\n";
+}
+
+1;

=== added file 'src/tools/DBD/Registrar.pm'
--- src/tools/DBD/Registrar.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Registrar.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,11 @@
+package DBD::Registrar;
+use DBD::Base;
+@ISA = qw(DBD::Base);
+
+sub init {
+    return shift->SUPER::init(shift, "registrar function name");
+}
+
+
+1;
+

=== added file 'src/tools/DBD/Variable.pm'
--- src/tools/DBD/Variable.pm	1970-01-01 00:00:00 +0000
+++ src/tools/DBD/Variable.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,36 @@
+package DBD::Variable;
+use DBD::Base;
+@ISA = qw(DBD::Base);
+
+my %valid_types = (
+    # C type name => corresponding iocshArg type identifier
+    int => 'iocshArgInt',
+    double => 'iocshArgDouble'
+);
+
+sub init {
+    my ($this, $name, $type) = @_;
+    if (defined $type) {
+        unquote $type;
+    } else {
+        $type = "int";
+    }
+    exists $valid_types{$type} or
+        dieContext("Unknown variable type '$type', valid types are:",
+            sort keys %valid_types);
+    $this->SUPER::init($name, "variable name");
+    $this->{VAR_TYPE} = $type;
+    return $this;
+}
+
+sub var_type {
+    my $this = shift;
+    return $this->{VAR_TYPE};
+}
+
+sub iocshArg_type {
+    my $this = shift;
+    return $valid_types{$this->{VAR_TYPE}};
+}
+
+1;

=== added file 'src/tools/EPICS/Readfile.pm'
--- src/tools/EPICS/Readfile.pm	1970-01-01 00:00:00 +0000
+++ src/tools/EPICS/Readfile.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,101 @@
+#*************************************************************************
+# Copyright (c) 2010 UChicago Argonne LLC, as Operator of Argonne
+#     National Laboratory.
+# EPICS BASE is distributed subject to a Software License Agreement found
+# in file LICENSE that is included with this distribution.
+#*************************************************************************
+
+# $Id$
+
+package EPICS::Readfile;
+require 5.000;
+require Exporter;
+
+use EPICS::macLib;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(@inputfiles &Readfile);
+
+our $debug=0;
+our @inputfiles;
+
+sub slurp {
+    my ($FILE, $Rpath) = @_;
+    my @path = @{$Rpath};
+    print "slurp($FILE):\n" if $debug;
+    if ($FILE !~ m[/]) {
+        foreach $dir (@path) {
+            print " trying $dir/$FILE\n" if $debug;
+            if (-r "$dir/$FILE") {
+                $FILE = "$dir/$FILE";
+                last;
+            }
+        }
+        die "Can't find file '$FILE'\n" unless -r $FILE;
+    }
+    print " opening $FILE\n" if $debug;
+    open FILE, "<$FILE" or die "Can't open $FILE: $!\n";
+    push @inputfiles, $FILE;
+    my @lines = ("##!BEGIN{$FILE}!##\n");
+    # Consider replacing these markers with C pre-processor linemarkers.
+    # See 'info cpp' * Preprocessor Output:: for details.
+    push @lines, <FILE>;
+    push @lines, "##!END{$FILE}!##\n";
+    close FILE or die "Error closing $FILE: $!\n";
+    print " read ", scalar @lines, " lines\n" if $debug;
+    return join '', @lines;
+}
+
+sub expandMacros {
+    my ($macros, $input) = @_;
+    return $input unless $macros;
+    return $macros->expandString($input);
+}
+
+sub splitPath {
+    my ($path) = @_;
+    my (@path) = split /[:;]/, $path;
+    grep s/^$/./, @path;
+    return @path;
+}
+
+my $RXstr = qr/ " (?: [^"] | \\" )* "/ox;
+my $RXnam = qr/[a-zA-Z0-9_\-:.[\]<>;]+/o;
+my $string = qr/ ( $RXnam | $RXstr ) /ox;
+
+sub unquote {
+    my ($s) = @_;
+    $s =~ s/^"(.*)"$/$1/o;
+    return $s;
+}
+
+sub Readfile {
+    my ($file, $macros, $Rpath) = @_;
+    print "Readfile($file)\n" if $debug;
+    my $input = &expandMacros($macros, &slurp($file, $Rpath));
+    my @input = split /\n/, $input;
+    my @output;
+    foreach (@input) {
+        if (m/^ \s* include \s+ $string /ox) {
+            $arg = &unquote($1);
+            print " include $arg\n" if $debug;
+            push @output, "##! include \"$arg\"";
+            push @output, &Readfile($arg, $macros, $Rpath);
+        } elsif (m/^ \s* addpath \s+ $string /ox) {
+            $arg = &unquote($1);
+            print " addpath $arg\n" if $debug;
+            push @output, "##! addpath \"$arg\"";
+            push @{$Rpath}, &splitPath($arg);
+        } elsif (m/^ \s* path \s+ $string /ox) {
+            $arg = &unquote($1);
+            print " path $arg\n" if $debug;
+            push @output, "##! path \"$arg\"";
+            @{$Rpath} = &splitPath($arg);
+        } else {
+            push @output, $_;
+        }
+    }
+    return join "\n", @output;
+}
+
+1;

=== added file 'src/tools/EPICS/macLib.pm'
--- src/tools/EPICS/macLib.pm	1970-01-01 00:00:00 +0000
+++ src/tools/EPICS/macLib.pm	2012-04-02 20:38:19 +0000
@@ -0,0 +1,251 @@
+#*************************************************************************
+# Copyright (c) 2010 UChicago Argonne LLC, as Operator of Argonne
+#     National Laboratory.
+# EPICS BASE is distributed subject to a Software License Agreement found
+# in file LICENSE that is included with this distribution.
+#*************************************************************************
+
+# $Id$
+
+package EPICS::macLib::entry;
+
+sub new ($$) {
+    my $class = shift;
+    my $this = {
+        name => shift,
+        type => shift,
+        raw => '',
+        val => '',
+        visited => 0,
+        error => 0,
+    };
+    bless $this, $class;
+    return $this;
+}
+
+sub report ($) {
+    my ($this) = @_;
+    return unless defined $this->{raw};
+    printf "%1s %-16s %-16s %s\n",
+        ($this->{error} ? '*' : ' '), $this->{name}, $this->{raw}, $this->{val};
+}
+
+
+package EPICS::macLib;
+
+use Carp;
+
+sub new ($@) {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $this = {
+        dirty => 0,
+        noWarn => 0,
+        macros => [{}], # [0] is current scope, [1] is parent etc.
+    };
+    bless $this, $class;
+    $this->installList(@_);
+    return $this;
+}
+
+sub installList ($@) {
+    # Argument is a list of strings which are arguments to installMacros
+    my $this = shift;
+    while (@_) {
+        $this->installMacros(shift);
+    }
+}
+
+sub installMacros ($$) {
+    # Argument is a string: a=1,b="2",c,d='hello'
+    my $this = shift;
+    $_ = shift;
+    until (defined pos($_) and pos($_) == length($_)) {
+        m/\G \s* /xgc;    # Skip whitespace
+        if (m/\G ( [A-Za-z0-9_-]+ ) \s* /xgc) {
+            my ($name, $val) = ($1);
+            if (m/\G = \s* /xgc) {
+                # The value follows, handle quotes and escapes
+                until (pos($_) == length($_)) {
+                    if (m/\G , /xgc) { last; }
+                    elsif (m/\G ' ( ( [^'] | \\ ' )* ) ' /xgc) { $val .= $1; }
+                    elsif (m/\G " ( ( [^"] | \\ " )* ) " /xgc) { $val .= $1; }
+                    elsif (m/\G \\ ( . ) /xgc) { $val .= $1; }
+                    elsif (m/\G ( . ) /xgc) { $val .= $1; }
+                    else { die "How did I get here?"; }
+                }
+                $this->putValue($name, $val);
+            } elsif (m/\G , /xgc or (pos($_) == length($_))) {
+                $this->putValue($name, undef);
+            } else {
+                warn "How did I get here?";
+            }
+        } elsif (m/\G ( .* )/xgc) {
+            croak "Can't find a macro definition in '$1'";
+        } else {
+            last;
+        }
+    }
+}
+
+sub putValue ($$$) {
+    my ($this, $name, $raw) = @_;
+    if (exists $this->{macros}[0]{$name}) {
+        if (!defined $raw) {
+            delete $this->{macros}[0]{$name};
+        } else {
+            $this->{macros}[0]{$name}{raw} = $raw;
+        }
+    } else {
+        my $entry = EPICS::macLib::entry->new($name, 'macro');
+        $entry->{raw} = $raw;
+        $this->{macros}[0]{$name} = $entry;
+    }
+    $this->{dirty} = 1;
+}
+
+sub pushScope ($) {
+    my ($this) = @_;
+    unshift @{$this->{macros}}, {};
+}
+
+sub popScope ($) {
+    my ($this) = @_;
+    shift @{$this->{macros}};
+}
+
+sub suppressWarning($$) {
+    my ($this, $suppress) = @_;
+    $this->{noWarn} = $suppress;
+}
+
+sub expandString($$) {
+    my ($this, $src) = @_;
+    $this->_expand;
+    my $entry = EPICS::macLib::entry->new($src, 'string');
+    my $result = $this->_translate($entry, 0, $src);
+    return $result unless $entry->{error};
+    return $this->{noWarn} ? $result : undef;
+}
+
+sub reportMacros ($) {
+    my ($this) = @_;
+    $this->_expand;
+    print "Macro report\n============\n";
+    foreach my $scope (@{$this->{macros}}) {
+        foreach my $name (keys %{$scope}) {
+            my $entry = $scope->{$name};
+            $entry->report;
+        }
+    } continue {
+        print " -- scope ends --\n";
+    }
+}
+
+
+# Private routines, not intended for public use
+
+sub _expand ($) {
+    my ($this) = @_;
+    return unless $this->{dirty};
+    foreach my $scope (@{$this->{macros}}) {
+        foreach my $name (keys %{$scope}) {
+            my $entry = $scope->{$name};
+            $entry->{val} = $this->_translate($entry, 1, $entry->{raw});
+        }
+    }
+    $this->{dirty} = 0;
+}
+
+sub _lookup ($$$$$) {
+    my ($this, $name) = @_;
+    foreach my $scope (@{$this->{macros}}) {
+        if (exists $scope->{$name}) {
+            return undef   # Macro marked as deleted
+                unless defined $scope->{$name}{raw};
+            return $scope->{$name};
+        }
+    }
+    return undef;
+}
+
+sub _translate ($$$$) {
+    my ($this, $entry, $level, $str) = @_;
+    return $this->_trans($entry, $level, '', \$str);
+}
+
+sub _trans ($$$$$) {
+    my ($this, $entry, $level, $term, $R) = @_;
+    return $$R
+        if (!defined $$R or
+            $$R =~ m/\A [^\$]* \Z/x);   # Short-circuit if no macros
+    my $quote = 0;
+    my $val;
+    until (defined pos($$R) and pos($$R) == length($$R)) {
+        if ($term and ($$R =~ m/\G (?= [$term] ) /xgc)) {
+            last;
+        }
+        if ($$R =~ m/\G \$ ( [({] ) /xgc) {
+            my $macEnd = $1;
+            $macEnd =~ tr/({/)}/;
+            my $name2 = $this->_trans($entry, $level+1, "=$macEnd", $R);
+            my $entry2 = $this->_lookup($name2);
+            if (!defined $entry2) {             # Macro not found
+                if ($$R =~ m/\G = /xgc) {       # Use default value given
+                    $val .= $this->_trans($entry, $level+1, $macEnd, $R);
+                } else {
+                    unless ($this->{noWarn}) {
+                        $entry->{error} = 1;
+                        printf STDERR "macLib: macro '%s' is undefined (expanding %s '%s')\n",
+                            $name2, $entry->{type}, $entry->{name};
+                    }
+                    $val .= "\$($name2)";
+                }
+                $$R =~ m/\G [$macEnd] /xgc;     # Discard close bracket
+            } else {                            # Macro found
+                if ($entry2->{visited}) {
+                    $entry->{error} = 1;
+                    printf STDERR "macLib: %s '%s' is recursive (expanding %s '%s')\n",
+                        $entry->{type}, $entry->{name}, $entry2->{type}, $entry2->{name};
+                    $val .= "\$($name)";
+                } else {
+                    if ($$R =~ m/\G = /xgc) {   # Discard default value
+                        local $this->{noWarn} = 1; # Temporarily kill warnings
+                        $this->_trans($entry, $level+1, $macEnd, $R);
+                    }
+                    $$R =~ m/\G [$macEnd] /xgc; # Discard close bracket
+                    if ($this->{dirty}) {       # Translate raw value
+                        $entry2->{visited} = 1;
+                        $val .= $this->_trans($entry, $level+1, '', \$entry2->{raw});
+                        $entry2->{visited} = 0;
+                    } else {
+                        $val .= $entry2->{val}; # Here's one I made earlier...
+                    }
+                }
+            }
+        } elsif ($level > 0) {  # Discard quotes and escapes
+            if ($quote and $$R =~ m/\G $quote /xgc) {
+                $quote = 0;
+            } elsif ($$R =~ m/\G ( ['"] ) /xgc) {
+                $quote = $1;
+            } elsif ($$R =~ m/\G \\? ( . ) /xgc) {
+                $val .= $1;
+            } else {
+                warn "How did I get here? level=$level";
+            }
+        } else {                # Level 0
+            if ($$R =~ m/\G \\ ( . ) /xgc) {
+                $val .= "\\$1";
+            } elsif ($$R =~ m/\G ( [^\\\$'")}]* ) /xgc) {
+                $val .= $1;
+            } elsif ($$R =~ m/\G ( . ) /xgc) {
+                $val .= $1;
+            } else {
+                warn "How did I get here? level=$level";
+            }
+        }
+    }
+    return $val;
+}
+
+1;

=== modified file 'src/tools/Makefile'
--- src/tools/Makefile	2008-09-23 22:13:52 +0000
+++ src/tools/Makefile	2012-04-02 20:38:19 +0000
@@ -1,5 +1,5 @@
 #*************************************************************************
-# Copyright (c) 2008 UChicago Argonne LLC, as Operator of Argonne
+# Copyright (c) 2012 UChicago Argonne LLC, as Operator of Argonne
 #     National Laboratory.
 # EPICS BASE is distributed subject to a Software License Agreement found
 # in file LICENSE that is included with this distribution. 
@@ -14,7 +14,23 @@
 PERL_MODULES += EPICS/Copy.pm
 PERL_MODULES += EPICS/Path.pm
 PERL_MODULES += EPICS/Release.pm
+PERL_MODULES += EPICS/Readfile.pm
 PERL_MODULES += EPICS/Getopts.pm
+PERL_MODULES += EPICS/macLib.pm
+
+PERL_MODULES += DBD.pm
+PERL_MODULES += DBD/Base.pm
+PERL_MODULES += DBD/Breaktable.pm
+PERL_MODULES += DBD/Device.pm
+PERL_MODULES += DBD/Driver.pm
+PERL_MODULES += DBD/Function.pm
+PERL_MODULES += DBD/Menu.pm
+PERL_MODULES += DBD/Output.pm
+PERL_MODULES += DBD/Parser.pm
+PERL_MODULES += DBD/Recfield.pm
+PERL_MODULES += DBD/Recordtype.pm
+PERL_MODULES += DBD/Registrar.pm
+PERL_MODULES += DBD/Variable.pm
 
 PERL_SCRIPTS += convertRelease.pl
 PERL_SCRIPTS += cvsclean.pl
@@ -32,5 +48,10 @@
 PERL_SCRIPTS += replaceVAR.pl
 PERL_SCRIPTS += useManifestTool.pl
 
+PERL_SCRIPTS += dbdToMenuH.pl
+PERL_SCRIPTS += dbdToRecordtypeH.pl
+PERL_SCRIPTS += dbdExpand.pl
+PERL_SCRIPTS += dbdToHtml.pl
+
 include $(TOP)/configure/RULES
  

=== added file 'src/tools/dbdExpand.pl'
--- src/tools/dbdExpand.pl	1970-01-01 00:00:00 +0000
+++ src/tools/dbdExpand.pl	2012-04-02 20:38:19 +0000
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+#*************************************************************************
+# Copyright (c) 2010 UChicago Argonne LLC, as Operator of Argonne
+#     National Laboratory.
+# EPICS BASE is distributed subject to a Software License Agreement found
+# in file LICENSE that is included with this distribution.
+#*************************************************************************
+
+# $Id$
+
+use FindBin qw($Bin);
+use lib "$Bin/../../lib/perl";
+
+use DBD;
+use DBD::Parser;
+use DBD::Output;
+use EPICS::Getopts;
+use EPICS::Readfile;
+use EPICS::macLib;
+
+getopts('DI@S@o:') or
+    die "Usage: dbdExpand [-D] [-I dir] [-S macro=val] [-o out.dbd] in.dbd ...";
+
+my @path = map { split /[:;]/ } @opt_I; # FIXME: Broken on Win32?
+my $macros = EPICS::macLib->new(@opt_S);
+my $dbd = DBD->new();
+
+while (@ARGV) {
+    &ParseDBD($dbd, &Readfile(shift @ARGV, $macros, \@opt_I));
+}
+
+if ($opt_D) {   # Output dependencies only
+    my %filecount;
+    my @uniqfiles = grep { not $filecount{$_}++ } @inputfiles;
+    print "$opt_o: ", join(" \\\n    ", @uniqfiles), "\n\n";
+    print map { "$_:\n" } @uniqfiles;
+    exit 0;
+}
+
+my $out;
+if ($opt_o) {
+    open $out, '>', $opt_o or die "Can't create $opt_o: $!\n";
+} else {
+    $out = STDOUT;
+}
+
+&OutputDBD($out, $dbd);
+
+if ($opt_o) {
+    close $out or die "Closing $opt_o failed: $!\n";
+}
+exit 0;

=== added file 'src/tools/dbdReport.pl'
--- src/tools/dbdReport.pl	1970-01-01 00:00:00 +0000
+++ src/tools/dbdReport.pl	2012-04-02 20:38:19 +0000
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+#*************************************************************************
+# Copyright (c) 2010 UChicago Argonne LLC, as Operator of Argonne
+#     National Laboratory.
+# EPICS BASE is distributed subject to a Software License Agreement found
+# in file LICENSE that is included with this distribution.
+#*************************************************************************
+
+# $Id$
+
+use FindBin qw($Bin);
+use lib "$Bin/../../lib/perl";
+
+use DBD;
+use DBD::Parser;
+use EPICS::Getopts;
+use EPICS::macLib;
+use EPICS::Readfile;
+use Text::Wrap;
+
+#$EPICS::Readfile::debug = 1;
+#$DBD::Parser::debug = 1;
+
+getopts('I@S@') or die usage();
+
+sub usage() {
+    "Usage: dbdReport [-I dir:dir2] [-S macro=val,...] file.dbd ...";
+}
+
+my @path = map { split /[:;]/ } @opt_I; # FIXME: Broken on Win32?
+my $macros = EPICS::macLib->new(@opt_S);
+my $dbd = DBD->new();
+
+&ParseDBD($dbd, &Readfile(shift @ARGV, $macros, \@opt_I));
+
+$Text::Wrap::columns = 75;
+
+my @menus = sort keys %{$dbd->menus};
+print wrap("Menus:\t", "\t", join(', ', @menus)), "\n"
+        if @menus;
+my @drivers = sort keys %{$dbd->drivers};
+print wrap("Drivers: ", "\t", join(', ', @drivers)), "\n"
+        if @drivers;
+my @variables = sort keys %{$dbd->variables};
+print wrap("Variables: ", "\t", join(', ', @variables)), "\n"
+        if @variables;
+my @registrars = sort keys %{$dbd->registrars};
+print wrap("Registrars: ", "\t", join(', ', @registrars)), "\n"
+        if @registrars;
+my @breaktables = sort keys %{$dbd->breaktables};
+print wrap("Breaktables: ", "\t", join(', ', @breaktables)), "\n"
+        if @breaktables;
+my %recordtypes = %{$dbd->recordtypes};
+if (%recordtypes) {
+    @rtypes = sort keys %recordtypes;
+    print wrap("Recordtypes: ", "\t", join(', ', @rtypes)), "\n";
+    foreach my $rtyp (@rtypes) {
+        my @devices = $recordtypes{$rtyp}->devices;
+        print wrap("Devices($rtyp): ", "\t",
+                   join(', ', map {$_->choice} @devices)), "\n"
+            if @devices;
+    }
+}

=== added file 'src/tools/dbdToHtml.pl'
--- src/tools/dbdToHtml.pl	1970-01-01 00:00:00 +0000
+++ src/tools/dbdToHtml.pl	2012-04-02 20:38:19 +0000
@@ -0,0 +1,252 @@
+#!/usr/bin/perl
+
+#*************************************************************************
+# Copyright (c) 2010 UChicago Argonne LLC, as Operator of Argonne
+#     National Laboratory.
+# EPICS BASE is distributed subject to a Software License Agreement found
+# in file LICENSE that is included with this distribution.
+#*************************************************************************
+
+# $Id$
+
+use FindBin qw($Bin);
+use lib "$Bin/../../lib/perl";
+
+use DBD;
+use DBD::Parser;
+use EPICS::Getopts;
+use EPICS::macLib;
+use EPICS::Readfile;
+
+my $tool = 'dbdToHtml';
+getopts('DI@o:') or
+    die "Usage: $tool [-D] [-I dir] [-o xRecord.html] xRecord.dbd\n";
+
+my @path = map { split /[:;]/ } @opt_I;
+my $dbd = DBD->new();
+
+my $infile = shift @ARGV;
+$infile =~ m/\.dbd$/ or
+    die "$tool: Input file '$infile' must have '.dbd' extension\n";
+
+&ParseDBD($dbd, &Readfile($infile, 0, \@opt_I));
+
+if ($opt_D) {   # Output dependencies only
+    my %filecount;
+    my @uniqfiles = grep { not $filecount{$_}++ } @inputfiles;
+    print "$opt_o: ", join(" \\\n    ", @uniqfiles), "\n\n";
+    print map { "$_:\n" } @uniqfiles;
+    exit 0;
+}
+
+my $out;
+if ($opt_o) {
+    $out = $opt_o;
+} else {
+    ($out = $infile) =~ s/\.dbd$/.html/;
+    $out =~ s/^.*\///;
+    $out =~ s/dbCommonRecord/dbCommon/;
+}
+open $out, '>', $opt_o or die "Can't create $opt_o: $!\n";
+
+print $out "<h1>$infile</h1>\n";
+
+my $rtypes = $dbd->recordtypes;
+
+my ($rn, $rtyp) = each %{$rtypes};
+print $out "<h2>Record Name $rn</h2>\n";
+
+my @fields = $rtyp->fields;
+
+#create a Hash to store the table of field information for each GUI type
+%dbdTables = (
+    "GUI_COMMON" => "",
+    "GUI_COMMON" => "",
+    "GUI_ALARMS" => "",
+    "GUI_BITS1" => "",
+    "GUI_BITS2" => "",
+    "GUI_CALC" => "",
+    "GUI_CLOCK" => "",
+    "GUI_COMPRESS" => "",
+    "GUI_CONVERT" => "",
+    "GUI_DISPLAY" => "",
+    "GUI_HIST" => "",
+    "GUI_INPUTS" => "",
+    "GUI_LINKS" => "",
+    "GUI_MBB" => "",
+    "GUI_MOTOR" => "",
+    "GUI_OUTPUT" => "",
+    "GUI_PID" => "",
+    "GUI_PULSE" => "",
+    "GUI_SELECT" => "",
+    "GUI_SEQ1" => "",
+    "GUI_SEQ2" => "",
+    "GUI_SEQ3" => "",
+    "GUI_SUB" => "",
+    "GUI_TIMER" => "",
+    "GUI_WAVE" => "",
+    "GUI_SCAN" => "",
+    "GUI_NONE" => ""
+);
+
+
+#Loop over all of the fields.  Build a string that contains the table body
+#for each of the GUI Types based on which fields go with which GUI type.
+foreach $fVal (@fields) {
+    my $pg = $fVal->attribute('promptgroup');
+    while ( ($typ1, $content) = each %dbdTables) {
+        if ( $pg eq $typ1 or ($pg eq "" and $typ1 eq "GUI_NONE")) {
+            buildTableRow($fVal, $dbdTables{$typ1} );
+        }
+    }
+}
+
+#Write out each table
+while ( ($typ2, $content) = each %dbdTables) {
+    printHtmlTable($typ2, $content);
+}
+
+
+#add a field to a table body.  The specified field and table body are passed 
+#in as parameters
+sub buildTableRow {
+    my ( $fld, $outStr) = @_;
+    $longDesc = "&nbsp;";
+    %htmlCellFmt = (
+        rowStart => "<tr><td rowspan = \"2\">",
+        nextCell => "</td><td>",
+        endRow   => "</td></tr>",
+        nextRow  => "<tr><td colspan = \"7\" align=left>"
+        );
+    my %cellFmt = %htmlCellFmt;
+    my $rowStart = $cellFmt{rowStart};
+    my $nextCell = $cellFmt{nextCell};
+    my $endRow   = $cellFmt{endRow};
+    my $nextRow  = $cellFmt{nextRow};
+    $outStr = $outStr . $rowStart;
+    $outStr = $outStr . $fld->name;
+    $outStr = $outStr . $nextCell;
+    $outStr = $outStr . $fld->attribute('prompt');
+    $outStr = $outStr . $nextCell;
+    my $recType = $fld->dbf_type;
+    $typStr = $recType;
+    if ($recType eq "DBF_STRING") {
+        $typStr = $recType . " [" . $fld->attribute('size') . "]";
+    }
+    
+    $outStr = $outStr . $typStr;
+    $outStr = $outStr . $nextCell;
+    $outStr = $outStr . design($fld);
+    $outStr = $outStr . $nextCell;
+    my $initial = $fld->attribute('initial');
+    if ( $initial eq '' ) {$initial = "&nbsp;";}
+    $outStr = $outStr . $initial;
+    $outStr = $outStr . $nextCell;
+    $outStr = $outStr . readable($fld);
+    $outStr = $outStr . $nextCell;
+    $outStr = $outStr . writable($fld);
+    $outStr = $outStr . $nextCell;
+    $outStr = $outStr . processPassive($fld);
+    $outStr = $outStr . $endRow;
+    $outStr = $outStr . "\n";
+    $outStr = $outStr . $nextRow;
+    $outStr = $outStr . $longDesc;
+    $outStr = $outStr . $endRow;
+    $outStr = $outStr . "\n";
+    $_[1] = $outStr;
+}
+
+#Check if the prompt group is defined so that this can be used by clients
+sub design {
+    my $fld = $_[0];
+    my $pg = $fld->attribute('promptgroup');
+    if ( $pg eq '' ) {
+        my $result = 'No';
+    }
+    else {
+        my $result = 'Yes';
+    } 
+}
+
+#Check if this field is readable by clients
+sub readable {
+    my $fld = $_[0];
+    if ( $fld->attribute('special') eq "SPC_DBADDR") {
+        $return = "Probably";
+    }
+    else{
+        if ( $fld->dbf_type eq "DBF_NOACCESS" ) {
+            $return = "No";
+        }
+        else {
+            $return = "Yes"
+        }
+    }
+}
+
+#Check if this field is writable by clients
+sub writable {
+    my $fld = $_[0];
+    my $spec = $fld->attribute('special');
+    if ( $spec eq "SPC_NOMOD" ) {
+        $return = "No";
+    }
+    else {
+        if ( $spec ne "SPC_DBADDR") {
+            if ( $fld->dbf_type eq "DBF_NOACCESS" ) {
+                $return = "No";
+            }
+            else {
+                $return = "Yes";
+            }
+        }
+        else {
+            $return = "Maybe";
+        }
+    }
+}
+
+
+#Check to see if the field is process passive on caput
+sub processPassive {
+    my $fld = $_[0];
+    $pp = $fld->attribute('pp');
+    if ( $pp eq "YES" or $pp eq "TRUE" ) {
+        $result = "Yes";
+    }
+    elsif ( $PP eq "NO" or $pp eq "FALSE"  or $pp eq "" ) {
+        $result = "No";
+    }
+}
+
+#print the start row to define a table
+sub printTableStart {
+    print $out "<table border =\"1\"> \n";
+    print $out "<caption><em>$_[0]</em></caption>";
+    print $out "<th>Field</th>\n";
+    print $out "<th>Summary</th>\n";
+    print $out "<th>Type</th>\n";
+    print $out "<th>DCT</th>\n";
+    print $out "<th>Default</th>\n";
+    print $out "<th>Read</th>\n";
+    print $out "<th>Write</th>\n";
+    print $out "<th>caPut=PP</th></tr>\n";
+
+}
+
+#print the tail end of the table
+sub printTableEnd {
+    print $out "</table>\n";
+}
+
+# Print the table for a GUI type.  The name of the GUI type and the Table body
+# for this type are fed in as parameters
+sub printHtmlTable {
+    my ($typ2, $content) = $_;
+    if ( (length $_[1]) gt 0) {
+        printTableStart($_[0]);
+        print $out "$_[1]\n";
+        printTableEnd();
+    }
+    
+}

=== added file 'src/tools/dbdToMenuH.pl'
--- src/tools/dbdToMenuH.pl	1970-01-01 00:00:00 +0000
+++ src/tools/dbdToMenuH.pl	2012-04-02 20:38:19 +0000
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+#*************************************************************************
+# Copyright (c) 2010 UChicago Argonne LLC, as Operator of Argonne
+#     National Laboratory.
+# EPICS BASE is distributed subject to a Software License Agreement found
+# in file LICENSE that is included with this distribution.
+#*************************************************************************
+
+# $Id$
+
+use FindBin qw($Bin);
+use lib "$Bin/../../lib/perl";
+
+use EPICS::Getopts;
+use File::Basename;
+use DBD;
+use DBD::Parser;
+use EPICS::macLib;
+use EPICS::Readfile;
+
+my $tool = 'dbdToMenuH.pl';
+
+use vars qw($opt_D @opt_I $opt_o $opt_s);
+getopts('DI@o:') or
+    die "Usage: $tool: [-D] [-I dir] [-o menu.h] menu.dbd [menu.h]\n";
+
+my @path = map { split /[:;]/ } @opt_I; # FIXME: Broken on Win32?
+my $dbd = DBD->new();
+
+my $infile = shift @ARGV;
+$infile =~ m/\.dbd$/ or
+    die "$tool: Input file '$infile' must have '.dbd' extension\n";
+my $inbase = basename($infile);
+
+my $outfile;
+if ($opt_o) {
+    $outfile = $opt_o;
+} elsif (@ARGV) {
+    $outfile = shift @ARGV;
+} else {
+    ($outfile = $infile) =~ s/\.dbd$/.h/;
+    $outfile =~ s/^.*\///;
+}
+my $outbase = basename($outfile);
+
+# Derive a name for the include guard
+my $guard_name = "INC_$outbase";
+$guard_name =~ tr/a-zA-Z0-9_/_/cs;
+$guard_name =~ s/(_[hH])?$/_H/;
+
+&ParseDBD($dbd, &Readfile($infile, 0, \@opt_I));
+
+if ($opt_D) {
+    my %filecount;
+    my @uniqfiles = grep { not $filecount{$_}++ } @inputfiles;
+    print "$outfile: ", join(" \\\n    ", @uniqfiles), "\n\n";
+    print map { "$_:\n" } @uniqfiles;
+} else {
+    open OUTFILE, ">$outfile" or die "$tool: Can't open $outfile: $!\n";
+    print OUTFILE "/* $outbase generated from $inbase */\n\n",
+        "#ifndef $guard_name\n",
+        "#define $guard_name\n\n";
+    my $menus = $dbd->menus;
+    while (my ($name, $menu) = each %{$menus}) {
+        print OUTFILE $menu->toDeclaration;
+    }
+# FIXME: Where to put metadata for widely used menus?
+# In the generated menu.h file is wrong: can't create a list of menu.h files.
+# Can only rely on registerRecordDeviceDriver output, so we must require that
+# all such menus be named "menu...", and any other menus must be defined in
+# the record.dbd file that needs them.
+#    print OUTFILE "\n#ifdef GEN_MENU_METADATA\n\n";
+#    while (($name, $menu) = each %{$menus}) {
+#        print OUTFILE $menu->toDefinition;
+#    }
+#    print OUTFILE "\n#endif /* GEN_MENU_METADATA */\n";
+    print OUTFILE "\n#endif /* $guard_name */\n";
+    close OUTFILE;
+}

=== added file 'src/tools/dbdToRecordtypeH.pl'
--- src/tools/dbdToRecordtypeH.pl	1970-01-01 00:00:00 +0000
+++ src/tools/dbdToRecordtypeH.pl	2012-04-02 20:38:19 +0000
@@ -0,0 +1,231 @@
+#!/usr/bin/perl
+
+#*************************************************************************
+# Copyright (c) 2010 UChicago Argonne LLC, as Operator of Argonne
+#     National Laboratory.
+# EPICS BASE is distributed subject to a Software License Agreement found
+# in file LICENSE that is included with this distribution.
+#*************************************************************************
+
+# $Id$
+
+use FindBin qw($Bin);
+use lib "$Bin/../../lib/perl";
+
+use EPICS::Getopts;
+use File::Basename;
+use DBD;
+use DBD::Parser;
+use EPICS::macLib;
+use EPICS::Readfile;
+
+my $tool = 'dbdToRecordtypeH.pl';
+
+use vars qw($opt_D @opt_I $opt_o $opt_s);
+getopts('DI@o:s') or
+    die "Usage: $tool [-D] [-I dir] [-o xRecord.h] xRecord.dbd [xRecord.h]\n";
+
+my @path = map { split /[:;]/ } @opt_I; # FIXME: Broken on Win32?
+my $dbd = DBD->new();
+
+my $infile = shift @ARGV;
+$infile =~ m/\.dbd$/ or
+    die "$tool: Input file '$infile' must have '.dbd' extension\n";
+my $inbase = basename($infile);
+
+my $outfile;
+if ($opt_o) {
+    $outfile = $opt_o;
+} elsif (@ARGV) {
+    $outfile = shift @ARGV;
+} else {
+    ($outfile = $infile) =~ s/\.dbd$/.h/;
+    $outfile =~ s/^.*\///;
+    $outfile =~ s/dbCommonRecord/dbCommon/;
+}
+my $outbase = basename($outfile);
+
+# Derive a name for the include guard
+my $guard_name = "INC_$outbase";
+$guard_name =~ tr/a-zA-Z0-9_/_/cs;
+$guard_name =~ s/(_[hH])?$/_H/;
+
+&ParseDBD($dbd, &Readfile($infile, 0, \@opt_I));
+
+my $rtypes = $dbd->recordtypes;
+die "$tool: Input file must contain a single recordtype definition.\n"
+    unless (1 == keys %{$rtypes});
+
+if ($opt_D) {   # Output dependencies only, to stdout
+    my %filecount;
+    my @uniqfiles = grep { not $filecount{$_}++ } @inputfiles;
+    print "$outfile: ", join(" \\\n    ", @uniqfiles), "\n\n";
+    print map { "$_:\n" } @uniqfiles;
+} else {
+    open OUTFILE, ">$outfile" or die "$tool: Can't open $outfile: $!\n";
+    print OUTFILE "/* $outbase generated from $inbase */\n\n",
+        "#ifndef $guard_name\n",
+        "#define $guard_name\n\n";
+
+    our ($rn, $rtyp) = each %{$rtypes};
+
+    print OUTFILE $rtyp->toCdefs;
+
+    my @menu_fields = grep {
+            $_->dbf_type eq 'DBF_MENU'
+        } $rtyp->fields;
+    my %menu_used;
+    grep {
+            !$menu_used{$_}++
+        } map {
+            $_->attribute('menu')
+        } @menu_fields;
+    our $menus_defined = $dbd->menus;
+    while (my ($name, $menu) = each %{$menus_defined}) {
+        print OUTFILE $menu->toDeclaration;
+        if ($menu_used{$name}) {
+            delete $menu_used{$name}
+        } else {
+            warn "Menu '$name' defined but not used\n";
+        }
+    }
+    our @menus_external = keys %menu_used;
+
+    print OUTFILE $rtyp->toDeclaration;
+
+    unless ($rn eq 'dbCommon') {
+        my $n = 0;
+        print OUTFILE "typedef enum {\n",
+            join(",\n",
+                map { "\t${rn}Record$_ = " . $n++ } $rtyp->field_names),
+            "\n} ${rn}FieldIndex;\n\n";
+        print OUTFILE "#ifdef GEN_SIZE_OFFSET\n\n";
+        if ($opt_s) {
+            &newtables;
+        } else {
+            &oldtables;
+        }
+        print OUTFILE "#endif /* GEN_SIZE_OFFSET */\n";
+    }
+    print OUTFILE "\n",
+        "#endif /* $guard_name */\n";
+    close OUTFILE;
+}
+
+sub oldtables {
+    # Output compatible with R3.14.x
+    print OUTFILE "#ifdef __cplusplus\n" .
+        "extern \"C\" {\n" .
+        "#endif\n" .
+        "#include <epicsExport.h>\n" .
+        "static int ${rn}RecordSizeOffset(dbRecordType *prt)\n" .
+        "{\n" .
+        "    ${rn}Record *prec = 0;\n" .
+        join("\n", map {
+                "    prt->papFldDes[${rn}Record" . $_->name . "]->size = " .
+                "sizeof(prec->" . $_->C_name . ");"
+            } $rtyp->fields) . "\n" .
+        join("\n", map {
+                "    prt->papFldDes[${rn}Record" . $_->name . "]->offset = " .
+                "(char *)&prec->" . $_->C_name . " - (char *)prec;"
+            } $rtyp->fields) . "\n" .
+        "    prt->rec_size = sizeof(*prec);\n" .
+        "    return 0;\n" .
+        "}\n" .
+        "epicsExportRegistrar(${rn}RecordSizeOffset);\n\n" .
+        "#ifdef __cplusplus\n" .
+        "}\n" .
+        "#endif\n";
+}
+
+sub newtables {
+    # Output for an eventual DBD-less IOC
+    print OUTFILE (map {
+            "extern const dbMenu ${_}MenuMetaData;\n"
+        } @menus_external), "\n";
+    while (my ($name, $menu) = each %{$menus_defined}) {
+        print OUTFILE $menu->toDefinition;
+    }
+    print OUTFILE (map {
+        "static const char ${rn}FieldName$_\[] = \"$_\";\n" }
+        $rtyp->field_names), "\n";
+    my $n = 0;
+    print OUTFILE "static const dbRecordData ${rn}RecordMetaData;\n\n",
+        "static dbFldDes ${rn}FieldMetaData[] = {\n",
+        join(",\n", map {
+                my $fn = $_->name;
+                my $cn = $_->C_name;
+                "    { ${rn}FieldName${fn}," .
+                    $_->dbf_type . ',"' .
+                    $_->attribute('initial') . '",' .
+                    ($_->attribute('special') || '0') . ',' .
+                    ($_->attribute('pp') || 'FALSE') . ',' .
+                    ($_->attribute('interest') || '0') . ',' .
+                    ($_->attribute('asl') || 'ASL0') . ',' .
+                    $n++ . ",\n\t\&${rn}RecordMetaData," .
+                    "GEOMETRY_DATA(${rn}Record,$cn) }";
+            } $rtyp->fields),
+        "\n};\n\n";
+    print OUTFILE "static const ${rn}FieldIndex ${rn}RecordLinkFieldIndices[] = {\n",
+        join(",\n", map {
+                "    ${rn}Record" . $_->name; 
+            } grep {
+                $_->dbf_type =~ m/^DBF_(IN|OUT|FWD)LINK/;
+            } $rtyp->fields),
+        "\n};\n\n";
+    my @sorted_names = sort $rtyp->field_names;
+    print OUTFILE "static const char * const ${rn}RecordSortedFieldNames[] = {\n",
+        join(",\n", map {
+            "    ${rn}FieldName$_"
+        } @sorted_names),
+        "\n};\n\n";
+    print OUTFILE "static const ${rn}FieldIndex ${rn}RecordSortedFieldIndices[] = {\n",
+        join(",\n", map {
+            "    ${rn}Record$_"
+        } @sorted_names),
+        "\n};\n\n";
+    print OUTFILE "extern rset ${rn}RSET;\n\n",
+        "static const dbRecordData ${rn}RecordMetaData = {\n",
+        "    \"$rn\",\n",
+        "    sizeof(${rn}Record),\n",
+        "    NELEMENTS(${rn}FieldMetaData),\n",
+        "    ${rn}FieldMetaData,\n",
+        "    ${rn}RecordVAL,\n",
+        "    \&${rn}FieldMetaData[${rn}RecordVAL],\n",
+        "    NELEMENTS(${rn}RecordLinkFieldIndices),\n",
+        "    ${rn}RecordLinkFieldIndices,\n",
+        "    ${rn}RecordSortedFieldNames,\n",
+        "    ${rn}RecordSortedFieldIndices,\n",
+        "    \&${rn}RSET\n",
+        "};\n\n",
+        "#ifdef __cplusplus\n",
+        "extern \"C\" {\n",
+        "#endif\n\n";
+    print OUTFILE "dbRecordType * epicsShareAPI ${rn}RecordRegistrar(dbBase *pbase, int nDevs)\n",
+        "{\n",
+        "    dbRecordType *prt = dbCreateRecordtype(&${rn}RecordMetaData, nDevs);\n";
+    print OUTFILE "    ${rn}FieldMetaData[${rn}RecordDTYP].typDat.pdevMenu = \&prt->devMenu;\n";
+    while (my ($name, $menu) = each %{$menus_defined}) {
+        print OUTFILE "    dbRegisterMenu(pbase, \&${name}MenuMetaData);\n";
+    }
+    print OUTFILE map {
+            "    ${rn}FieldMetaData[${rn}Record" . 
+            $_->name .
+            "].typDat.pmenu = \n".
+            "        \&" .
+            $_->attribute('menu') .
+            "MenuMetaData;\n";
+        } @menu_fields;
+    print OUTFILE map {
+                "    ${rn}FieldMetaData[${rn}Record" .
+                $_->name .
+            "].typDat.base = CT_HEX;\n"; 
+            } grep {
+                $_->attribute('base') eq 'HEX';
+            } $rtyp->fields;
+    print OUTFILE "    dbRegisterRecordtype(pbase, prt);\n";
+    print OUTFILE "    return prt;\n}\n\n",
+        "#ifdef __cplusplus\n",
+        "} /* extern \"C\" */\n",
+        "#endif\n\n";
+}

=== added directory 'src/tools/test'
=== added file 'src/tools/test/Breaktable.plt'
--- src/tools/test/Breaktable.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/Breaktable.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 9;
+
+use DBD::Breaktable;
+
+my $bpt = DBD::Breaktable->new('test');
+isa_ok $bpt, 'DBD::Breaktable';
+is $bpt->name, 'test', 'Breakpoint table name';
+is $bpt->points, 0, 'Points == zero';
+$bpt->add_point(0, 0.5);
+is $bpt->points, 1, 'First point added';
+is_deeply $bpt->point(0), [0, 0.5], 'First point correct';
+$bpt->add_point(1, 1.5);
+is $bpt->points, 2, 'Second point added';
+is_deeply $bpt->point(0), [0, 0.5], 'First point still correct';
+is_deeply $bpt->point(1), [1, 1.5], 'Second point correct';
+is_deeply $bpt->point(2), undef, 'Third point undefined';
+

=== added file 'src/tools/test/DBD.plt'
--- src/tools/test/DBD.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/DBD.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 18;
+
+use DBD;
+
+my $dbd = DBD->new;
+isa_ok $dbd, 'DBD';
+
+is keys %{$dbd->breaktables}, 0, 'No breaktables yet';
+my $brk = DBD::Breaktable->new('Brighton');
+$dbd->add($brk);
+my %brks = %{$dbd->breaktables};
+is_deeply \%brks, {Brighton => $brk}, 'Added breaktable';
+
+is keys %{$dbd->drivers}, 0, 'No drivers yet';
+my $drv = DBD::Driver->new('Danforth');
+$dbd->add($drv);
+my %drvs = %{$dbd->drivers};
+is_deeply \%drvs, {Danforth => $drv}, 'Added driver';
+
+is keys %{$dbd->functions}, 0, 'No functions yet';
+my $fnc = DBD::Function->new('Frank');
+$dbd->add($fnc);
+my %fncs = %{$dbd->functions};
+is_deeply \%fncs, {Frank => $fnc}, 'Added function';
+
+is keys %{$dbd->menus}, 0, 'No menus yet';
+my $menu = DBD::Menu->new('Mango');
+$dbd->add($menu);
+my %menus = %{$dbd->menus};
+is_deeply \%menus, {Mango => $menu}, 'Added menu';
+is $dbd->menu('Mango'), $menu, 'Named menu';
+
+is keys %{$dbd->recordtypes}, 0, 'No recordtypes yet';
+my $rtyp = DBD::Recordtype->new('Rita');
+$dbd->add($rtyp);
+my %rtypes = %{$dbd->recordtypes};
+is_deeply \%rtypes, {Rita => $rtyp}, 'Added recordtype';
+is $dbd->recordtype('Rita'), $rtyp, 'Named recordtype';
+
+is keys %{$dbd->registrars}, 0, 'No registrars yet';
+my $reg = DBD::Registrar->new('Reggie');
+$dbd->add($reg);
+my %regs = %{$dbd->registrars};
+is_deeply \%regs, {Reggie => $reg}, 'Added registrar';
+
+is keys %{$dbd->variables}, 0, 'No variables yet';
+my $ivar = DBD::Variable->new('IntVar');
+my $dvar = DBD::Variable->new('DblVar', 'double');
+$dbd->add($ivar);
+my %vars = %{$dbd->variables};
+is_deeply \%vars, {IntVar => $ivar}, 'First variable';
+$dbd->add($dvar);
+%vars = %{$dbd->variables};
+is_deeply \%vars, {IntVar => $ivar, DblVar => $dvar}, 'Second variable';
+

=== added file 'src/tools/test/Device.plt'
--- src/tools/test/Device.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/Device.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 16;
+
+use DBD::Device;
+
+my $dev = DBD::Device->new('VME_IO', 'test', '"Device"');
+isa_ok $dev, 'DBD::Device';
+is $dev->name, 'test', 'Device name';
+is $dev->link_type, 'VME_IO', 'Link type';
+is $dev->choice, 'Device', 'Choice string';
+ok $dev->legal_addr('#C0xFEED S123 @xxx'), 'Address legal';
+my %dev_addrs = (
+	CONSTANT  => '12345',
+	PV_LINK   => 'Any:Record.NAME CPP.MS',
+	VME_IO    => '# C1 S2 @Anything',
+	CAMAC_IO  => '# B1 C2 N3 A4 F5 @Anything',
+	RF_IO     => '# R1 M2 D3 E4',
+	AB_IO     => '# L1 A2 C3 S4 @Anything',
+	GPIB_IO   => '# L1 A2 @Anything',
+	BITBUS_IO => '# L1 N2 P3 S4 @Anything',
+	BBGPIB_IO => '# L1 B2 G3 @Anything',
+	VXI_IO    => '# V1 C2 S3 @Anything',
+	INST_IO   => '@Anything'
+);
+while (my ($link, $addr) = each(%dev_addrs)) {
+    $dev->init($link, 'test', '"Device"');
+    ok $dev->legal_addr($addr), "$link address";
+}
+

=== added file 'src/tools/test/Driver.plt'
--- src/tools/test/Driver.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/Driver.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 2;
+
+use DBD::Driver;
+
+my $drv = DBD::Driver->new('test');
+isa_ok $drv, 'DBD::Driver';
+is $drv->name, 'test', 'Driver name';
+

=== added file 'src/tools/test/Function.plt'
--- src/tools/test/Function.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/Function.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 2;
+
+use DBD::Function;
+
+my $func = DBD::Function->new('test');
+isa_ok $func, 'DBD::Function';
+is $func->name, 'test', 'Function name';
+

=== added file 'src/tools/test/Makefile'
--- src/tools/test/Makefile	1970-01-01 00:00:00 +0000
+++ src/tools/test/Makefile	2012-04-02 20:38:19 +0000
@@ -0,0 +1,26 @@
+#*************************************************************************
+# Copyright (c) 2012 UChicago Argonne LLC, as Operator of Argonne
+#     National Laboratory.
+# EPICS BASE is distributed subject to a Software License Agreement found
+# in the file LICENSE that is included with this distribution. 
+#*************************************************************************
+TOP=../../..
+
+include $(TOP)/configure/CONFIG
+
+TESTS += Breaktable
+TESTS += DBD
+TESTS += Device
+TESTS += Driver
+TESTS += Function
+TESTS += macLib
+TESTS += Menu
+TESTS += Recfield
+TESTS += Recordtype
+TESTS += Registrar
+TESTS += Variable
+
+TESTSCRIPTS_HOST += $(TESTS:%=%.t)
+
+include $(TOP)/configure/RULES
+

=== added file 'src/tools/test/Menu.plt'
--- src/tools/test/Menu.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/Menu.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 14;
+
+use DBD::Menu;
+
+my $menu = DBD::Menu->new('test');
+isa_ok $menu, 'DBD::Menu';
+is $menu->name, 'test', 'Menu name';
+is $menu->choices, 0, 'Choices == zero';
+$menu->add_choice('ch1', '"Choice 1"');
+is $menu->choices, 1, 'First choice added';
+ok $menu->legal_choice('Choice 1'), 'First choice legal';
+is_deeply $menu->choice(0), ['ch1', 'Choice 1'], 'First choice found';
+$menu->add_choice('ch2', '"Choice 2"');
+is $menu->choices, 2, 'Second choice added';
+ok $menu->legal_choice('Choice 1'), 'First choice still legal';
+is_deeply $menu->choice(0), ['ch1', 'Choice 1'], 'First choice still found';
+ok $menu->legal_choice('Choice 2'), 'Second choice legal';
+is_deeply $menu->choice(1), ['ch2', 'Choice 2'], 'Second choice found';
+ok !$menu->legal_choice('Choice 3'), 'Third choice not legal';
+is_deeply $menu->choice(2), undef, 'Third choice undefined';
+
+like $menu->toDeclaration, qr/ ^
+    \s* typedef \s+ enum \s+ {
+    \s+     ch1 \s+ \/\* [^*]* \*\/,
+    \s+     ch2 \s+ \/\* [^*]* \*\/,
+    \s+     test_NUM_CHOICES ,?
+    \s+ } \s+ test; \s* $ /x, 'C declaration';

=== added file 'src/tools/test/Recfield.plt'
--- src/tools/test/Recfield.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/Recfield.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 76;
+
+use DBD::Recfield;
+
+my $fld_string = DBD::Recfield->new('str', 'DBF_STRING');
+isa_ok $fld_string, 'DBD::Recfield';
+isa_ok $fld_string, 'DBD::Recfield::DBF_STRING';
+$fld_string->set_number(0);
+is $fld_string->number, 0, 'Field number';
+$fld_string->add_attribute("size", "41");
+is keys %{$fld_string->attributes}, 1, "Size set";
+ok $fld_string->legal_value("Hello, world!"), 'Legal value';
+ok !$fld_string->legal_value("x"x41), 'Illegal string';
+$fld_string->check_valid;
+like $fld_string->toDeclaration, qr/^\s*char\s+str\[41\];\s*$/, "C declaration";
+
+my $fld_char = DBD::Recfield->new('chr', 'DBF_CHAR');
+isa_ok $fld_char, 'DBD::Recfield';
+isa_ok $fld_char, 'DBD::Recfield::DBF_CHAR';
+is $fld_char->name, 'chr', 'Field name';
+is $fld_char->dbf_type, 'DBF_CHAR', 'Field type';
+ok !$fld_char->legal_value("-129"), 'Illegal - value';
+ok $fld_char->legal_value("-128"), 'Legal - value';
+ok $fld_char->legal_value("127"), 'Legal + value';
+ok !$fld_char->legal_value("0x80"), 'Illegal + hex value';
+$fld_char->check_valid;
+like $fld_char->toDeclaration, qr/^\s*epicsInt8\s+chr;\s*$/, "C declaration";
+
+my $fld_uchar = DBD::Recfield->new('uchr', 'DBF_UCHAR');
+isa_ok $fld_uchar, 'DBD::Recfield';
+isa_ok $fld_uchar, 'DBD::Recfield::DBF_UCHAR';
+is $fld_uchar->name, 'uchr', 'Field name';
+is $fld_uchar->dbf_type, 'DBF_UCHAR', 'Field type';
+ok !$fld_uchar->legal_value("-1"), 'Illegal - value';
+ok $fld_uchar->legal_value("0"), 'Legal 0 value';
+ok $fld_uchar->legal_value("0377"), 'Legal + value';
+ok !$fld_uchar->legal_value("0400"), 'Illegal + octal value';
+$fld_uchar->check_valid;
+like $fld_uchar->toDeclaration, qr/^\s*epicsUInt8\s+uchr;\s*$/, "C declaration";
+
+my $fld_short = DBD::Recfield->new('shrt', 'DBF_SHORT');
+isa_ok $fld_short, 'DBD::Recfield';
+isa_ok $fld_short, 'DBD::Recfield::DBF_SHORT';
+is $fld_short->name, 'shrt', 'Field name';
+is $fld_short->dbf_type, 'DBF_SHORT', 'Field type';
+ok !$fld_short->legal_value("-32769"), 'Illegal - value';
+ok $fld_short->legal_value("-32768"), 'Legal - value';
+ok $fld_short->legal_value("32767"), 'Legal + value';
+ok !$fld_short->legal_value("0x8000"), 'Illegal + hex value';
+$fld_short->check_valid;
+like $fld_short->toDeclaration, qr/^\s*epicsInt16\s+shrt;\s*$/, "C declaration";
+
+my $fld_ushort = DBD::Recfield->new('ushrt', 'DBF_USHORT');
+isa_ok $fld_ushort, 'DBD::Recfield';
+isa_ok $fld_ushort, 'DBD::Recfield::DBF_USHORT';
+is $fld_ushort->name, 'ushrt', 'Field name';
+is $fld_ushort->dbf_type, 'DBF_USHORT', 'Field type';
+ok !$fld_ushort->legal_value("-1"), 'Illegal - value';
+ok $fld_ushort->legal_value("0"), 'Legal 0 value';
+ok $fld_ushort->legal_value("65535"), 'Legal + value';
+ok !$fld_ushort->legal_value("0x10000"), 'Illegal + hex value';
+$fld_ushort->check_valid;
+like $fld_ushort->toDeclaration, qr/^\s*epicsUInt16\s+ushrt;\s*$/, "C declaration";
+
+my $fld_long = DBD::Recfield->new('lng', 'DBF_LONG');
+isa_ok $fld_long, 'DBD::Recfield';
+isa_ok $fld_long, 'DBD::Recfield::DBF_LONG';
+is $fld_long->name, 'lng', 'Field name';
+is $fld_long->dbf_type, 'DBF_LONG', 'Field type';
+ok $fld_long->legal_value("-12345678"), 'Legal - value';
+ok $fld_long->legal_value("0x12345678"), 'Legal + value';
+ok !$fld_long->legal_value("0xfigure"), 'Illegal value';
+$fld_long->check_valid;
+like $fld_long->toDeclaration, qr/^\s*epicsInt32\s+lng;\s*$/, "C declaration";
+
+my $fld_ulong = DBD::Recfield->new('ulng', 'DBF_ULONG');
+isa_ok $fld_ulong, 'DBD::Recfield';
+isa_ok $fld_ulong, 'DBD::Recfield::DBF_ULONG';
+is $fld_ulong->name, 'ulng', 'Field name';
+is $fld_ulong->dbf_type, 'DBF_ULONG', 'Field type';
+ok !$fld_ulong->legal_value("-1"), 'Illegal - value';
+ok $fld_ulong->legal_value("00"), 'Legal 0 value';
+ok $fld_ulong->legal_value("0xffffffff"), 'Legal + value';
+ok !$fld_ulong->legal_value("0xfacepaint"), 'Illegal value';
+$fld_ulong->check_valid;
+like $fld_ulong->toDeclaration, qr/^\s*epicsUInt32\s+ulng;\s*$/, "C declaration";
+
+my $fld_float = DBD::Recfield->new('flt', 'DBF_FLOAT');
+isa_ok $fld_float, 'DBD::Recfield';
+isa_ok $fld_float, 'DBD::Recfield::DBF_FLOAT';
+is $fld_float->name, 'flt', 'Field name';
+is $fld_float->dbf_type, 'DBF_FLOAT', 'Field type';
+ok $fld_float->legal_value("-1.2345678e9"), 'Legal - value';
+ok $fld_float->legal_value("0.12345678e9"), 'Legal + value';
+ok !$fld_float->legal_value("0x1.5"), 'Illegal value';
+$fld_float->check_valid;
+like $fld_float->toDeclaration, qr/^\s*epicsFloat32\s+flt;\s*$/, "C declaration";
+
+my $fld_double = DBD::Recfield->new('dbl', 'DBF_DOUBLE');
+isa_ok $fld_double, 'DBD::Recfield';
+isa_ok $fld_double, 'DBD::Recfield::DBF_DOUBLE';
+is $fld_double->name, 'dbl', 'Field name';
+is $fld_double->dbf_type, 'DBF_DOUBLE', 'Field type';
+ok $fld_double->legal_value("-12345e-67"), 'Legal - value';
+ok $fld_double->legal_value("12345678e+9"), 'Legal + value';
+ok !$fld_double->legal_value("e5"), 'Illegal value';
+$fld_double->check_valid;
+like $fld_double->toDeclaration, qr/^\s*epicsFloat64\s+dbl;\s*$/, "C declaration";
+

=== added file 'src/tools/test/Recordtype.plt'
--- src/tools/test/Recordtype.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/Recordtype.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 17;
+
+use DBD::Recordtype;
+use DBD::Recfield;
+use DBD::Device;
+
+my $rtyp = DBD::Recordtype->new('test');
+isa_ok $rtyp, 'DBD::Recordtype';
+is $rtyp->name, 'test', 'Record name';
+is $rtyp->fields, 0, 'No fields yet';
+
+my $fld1 = DBD::Recfield->new('NAME', 'DBF_STRING');
+$fld1->add_attribute("size", "41");
+$fld1->check_valid;
+
+my $fld2 = DBD::Recfield->new('DTYP', 'DBF_DEVICE');
+$fld2->check_valid;
+
+$rtyp->add_field($fld1);
+is $rtyp->fields, 1, 'First field added';
+
+$rtyp->add_field($fld2);
+is $rtyp->fields, 2, 'Second field added';
+
+my @fields = $rtyp->fields;
+is_deeply \@fields, [$fld1, $fld2], 'Field list';
+
+my @names = $rtyp->field_names;
+is_deeply \@names, ['NAME', 'DTYP'], 'Field name list';
+
+is $rtyp->field('NAME'), $fld1, 'Field name lookup';
+
+is $fld1->number, 0, 'Field number 0';
+is $fld2->number, 1, 'Field number 1';
+
+is $rtyp->devices, 0, 'No devices yet';
+
+my $dev1 = DBD::Device->new('INST_IO', 'testDset', 'test device');
+$rtyp->add_device($dev1);
+is $rtyp->devices, 1, 'First device added';
+
+my @devices = $rtyp->devices;
+is_deeply \@devices, [$dev1], 'Device list';
+
+is $rtyp->device('test device'), $dev1, 'Device name lookup';
+
+is $rtyp->cdefs, 0, 'No cdefs yet';
+$rtyp->add_cdef("cdef");
+is $rtyp->cdefs, 1, 'First cdef added';
+
+my @cdefs = $rtyp->cdefs;
+is_deeply \@cdefs, ["cdef"], 'cdef list';

=== added file 'src/tools/test/Registrar.plt'
--- src/tools/test/Registrar.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/Registrar.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 2;
+
+use DBD::Registrar;
+
+my $reg = DBD::Registrar->new('test');
+isa_ok $reg, 'DBD::Registrar';
+is $reg->name, 'test', 'Registrar name';
+

=== added file 'src/tools/test/Variable.plt'
--- src/tools/test/Variable.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/Variable.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 4;
+
+use DBD::Variable;
+
+my $ivar = DBD::Variable->new('test');
+isa_ok $ivar, 'DBD::Variable';
+is $ivar->name, 'test', 'Variable name';
+is $ivar->var_type, 'int', 'variable defaults to int';
+my $dvar = DBD::Variable->new('test', 'double');
+is $dvar->var_type, 'double', 'double variable';

=== added file 'src/tools/test/macLib.plt'
--- src/tools/test/macLib.plt	1970-01-01 00:00:00 +0000
+++ src/tools/test/macLib.plt	2012-04-02 20:38:19 +0000
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+
+use FindBin qw($Bin);
+use lib "$Bin/../../../../lib/perl";
+
+use Test::More tests => 34;
+
+use EPICS::macLib;
+
+use Data::Dumper;
+
+my $m = EPICS::macLib->new;
+isa_ok $m, 'EPICS::macLib';
+is $m->expandString(''), '', 'Empty string';
+is $m->expandString('$(undef)'), undef, 'Warning $(undef)';
+
+$m->suppressWarning(1);
+is $m->expandString('$(undef)'), '$(undef)', 'Suppressed $(undef)';
+
+$m->putValue('a', 'foo');
+is $m->expandString('$(a)'), 'foo', '$(a)';
+is $m->expandString('${a}'), 'foo', '${a}';
+is $m->expandString('$(a=bar)'), 'foo', '$(a=bar)';
+is $m->expandString('${a=bar}'), 'foo', '${a=bar}';
+is $m->expandString('$(undef)'), '$(undef)', '$(undef) again';
+is $m->expandString('${undef}'), '$(undef)', '${undef} again';
+
+$m->suppressWarning(0);
+is $m->expandString('$(undef=$(a))'), 'foo', '$(undef=$(a))';
+is $m->expandString('${undef=${a}}'), 'foo', '${undef=${a}}';
+is $m->expandString('${undef=$(a)}'), 'foo', '${undef=$(a)}';
+is $m->expandString('$(undef=${a})'), 'foo', '$(undef=${a})';
+is $m->expandString('$(a=$(undef))'), 'foo', '$(a=$(undef))';
+
+$m->putValue('b', 'baz');
+is $m->expandString('$(b)'), 'baz', '$(b)';
+is $m->expandString('$(a)'), 'foo', '$(a)';
+is $m->expandString('$(a)$(b)'), 'foobaz', '$(a)$(b)';
+is $m->expandString('$(a)/$(b)'), 'foo/baz', '$(a)/$(b)';
+is $m->expandString('$(a)\$(b)'), 'foo\$(b)', '$(a)\$(b)';
+is $m->expandString('$(a)$$(b)'), 'foo$baz', '$(a)$$(b)';
+
+$m->putValue('c', '$(a)');
+is $m->expandString('$(c)'), 'foo', '$(c)';
+is $m->expandString('$(undef=$(c))'), 'foo', '$(undef=$(c))';
+
+$m->putValue('d', 'c');
+is $m->expandString('$(d)'), 'c', '$(d)';
+is $m->expandString('$($(d))'), 'foo', '$($(d))';
+is $m->expandString('$($(b)=$(a))'), 'foo', '$($(b)=$(a))';
+
+$m->suppressWarning(1);
+$m->putValue('c', undef);
+is $m->expandString('$(c)'), '$(c)', '$(c) deleted';
+
+$m->installMacros('c=fum,d');
+is $m->expandString('$(c)'), 'fum', 'installMacros, $(c)';
+
+is $m->expandString('$(d)'), '$(d)', 'installMacros deletion';
+
+$m->pushScope;
+is $m->expandString('$(a)'), 'foo', 'pushScope, $(a)';
+$m->putValue('a', 'grinch');
+is $m->expandString('$(a)'), 'grinch', 'new $(a) in child';
+
+$m->putValue('b', undef);
+is $m->expandString('$(b)'), '$(b)', '$(b) deleted in child';
+
+$m->popScope;
+is $m->expandString('$(a)'), 'foo', 'popScope, $(a) restored';
+is $m->expandString('$(b)'), 'baz', '$(b) restored';
+