From 68e0fba01b3da2a2aefba60e8cea3d5f3fbd797a Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Thu, 8 Apr 2010 17:23:32 -0500 Subject: [PATCH] 2009-02-08: Work with & match R3.14.10 output; rename tools. --- src/dbHost/DBD/Menu.pm | 4 +- src/dbHost/DBD/Recfield.pm | 16 +- src/dbHost/Makefile | 30 ++++ src/dbHost/{dbExpand => dbExpand.pl} | 5 +- src/dbHost/dbToRecordtypeH | 177 ------------------- src/dbHost/{dbToMenuH => dbdToMenuH.pl} | 19 +- src/dbHost/dbdToRecordtypeH.pl | 222 ++++++++++++++++++++++++ 7 files changed, 280 insertions(+), 193 deletions(-) create mode 100644 src/dbHost/Makefile rename src/dbHost/{dbExpand => dbExpand.pl} (93%) delete mode 100755 src/dbHost/dbToRecordtypeH rename src/dbHost/{dbToMenuH => dbdToMenuH.pl} (81%) create mode 100755 src/dbHost/dbdToRecordtypeH.pl diff --git a/src/dbHost/DBD/Menu.pm b/src/dbHost/DBD/Menu.pm index 61309f54d..ec59e8567 100644 --- a/src/dbHost/DBD/Menu.pm +++ b/src/dbHost/DBD/Menu.pm @@ -41,11 +41,11 @@ sub toDeclaration { my $this = shift; my $name = $this->name; my @choices = map { - "\t" . @{$_}[0] . "\t/* " . escapeCcomment(@{$_}[1]) . " */" + sprintf " %-31s /* %s */", @{$_}[0], escapeCcomment(@{$_}[1]); } $this->choices; return "typedef enum {\n" . join(",\n", @choices) . - ",\n\t${name}_NUM_CHOICES\n" . + ",\n ${name}_NUM_CHOICES\n" . "} $name;\n\n"; } diff --git a/src/dbHost/DBD/Recfield.pm b/src/dbHost/DBD/Recfield.pm index 9b3b76ee6..2b3e38089 100644 --- a/src/dbHost/DBD/Recfield.pm +++ b/src/dbHost/DBD/Recfield.pm @@ -156,7 +156,7 @@ sub legal_value { } sub toDeclaration { - return shift->SUPER::toDeclaration("signed char"); + return shift->SUPER::toDeclaration("epicsInt8"); } @@ -176,7 +176,7 @@ sub legal_value { } sub toDeclaration { - return shift->SUPER::toDeclaration("unsigned char"); + return shift->SUPER::toDeclaration("epicsUInt8"); } @@ -196,7 +196,7 @@ sub legal_value { } sub toDeclaration { - return shift->SUPER::toDeclaration("short"); + return shift->SUPER::toDeclaration("epicsInt16"); } @@ -216,7 +216,7 @@ sub legal_value { } sub toDeclaration { - return shift->SUPER::toDeclaration("unsigned short"); + return shift->SUPER::toDeclaration("epicsUInt16"); } @@ -253,7 +253,7 @@ sub legal_value { } sub toDeclaration { - return shift->SUPER::toDeclaration("unsigned long"); + return shift->SUPER::toDeclaration("epicsUInt32"); } @@ -270,7 +270,7 @@ sub legal_value { } sub toDeclaration { - return shift->SUPER::toDeclaration("float"); + return shift->SUPER::toDeclaration("epicsFloat32"); } @@ -287,7 +287,7 @@ sub legal_value { } sub toDeclaration { - return shift->SUPER::toDeclaration("double"); + return shift->SUPER::toDeclaration("epicsFloat64"); } @@ -417,7 +417,7 @@ sub check_valid { sub toDeclaration { my ($this) = @_; my $extra = $this->attribute('extra'); - my $result = sprintf " %-32s", "$extra;"; + my $result = sprintf " %-31s ", "$extra;"; my $prompt = $this->attribute('prompt'); $result .= "/* $prompt */" if defined $prompt; return $result; diff --git a/src/dbHost/Makefile b/src/dbHost/Makefile new file mode 100644 index 000000000..03f17cc85 --- /dev/null +++ b/src/dbHost/Makefile @@ -0,0 +1,30 @@ +#************************************************************************* +# Copyright (c) 2009 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. +#************************************************************************* +TOP=../.. +include $(TOP)/configure/CONFIG + +PERL_MODULES += macLib.pm +PERL_MODULES += Readfile.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/Parser.pm +PERL_MODULES += DBD/Recfield.pm +PERL_MODULES += DBD/Recordtype.pm +PERL_MODULES += DBD/Registrar.pm +PERL_MODULES += DBD/Variable.pm + +PERL_SCRIPTS += dbdToMenuH.pl +PERL_SCRIPTS += dbdToRecordtypeH.pl +PERL_SCRIPTS += dbExpand.pl + +include $(TOP)/configure/RULES + diff --git a/src/dbHost/dbExpand b/src/dbHost/dbExpand.pl similarity index 93% rename from src/dbHost/dbExpand rename to src/dbHost/dbExpand.pl index d70a594a1..5ff79e58b 100755 --- a/src/dbHost/dbExpand +++ b/src/dbHost/dbExpand.pl @@ -4,7 +4,10 @@ # duplicate definitions, unlike the dbStaticLib version. It does do the # include file expansion and macro substitution though. -use Getopts; +use FindBin qw($Bin); +use lib "$Bin/../../lib/perl"; + +use EPICS::Getopts; use Readfile; use macLib; diff --git a/src/dbHost/dbToRecordtypeH b/src/dbHost/dbToRecordtypeH deleted file mode 100755 index 190b669f4..000000000 --- a/src/dbHost/dbToRecordtypeH +++ /dev/null @@ -1,177 +0,0 @@ -#!/usr/bin/perl - -use DBD; -use DBD::Parser; -use Getopts; -use macLib; -use Readfile; - -my $tool = 'dbToRecordtypeH'; -getopts('DI@o:') or - die "Usage: $tool [-D] [-I dir] [-o xRecord.h] xRecord.dbd [xRecord.h]\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"; - -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/; -} - -# Derive a name for the include guard -my $guard_name = "INC_$outfile"; -$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 "/* $outfile generated from $infile */\n\n", - "#ifndef $guard_name\n", - "#define $guard_name\n\n"; - - my ($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; - my $menus_defined = $dbd->menus; - while (($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"; - } - } - my @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"; - print OUTFILE (map { - "extern const dbMenu ${_}MenuMetaData;\n" - } @menus_external), "\n"; - while (($name, $menu) = each %{$menus_defined}) { - print OUTFILE $menu->toDefinition; - } - print OUTFILE (map { - "static const char ${rn}FieldName$_\[] = \"$_\";\n" } - $rtyp->field_names), "\n"; - $n=0; - print OUTFILE "static const dbRecordData ${rn}RecordMetaData;\n\n", - "static dbFldDes ${rn}FieldMetaData[] = {\n", - join(",\n", map { - my $fn = $_->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," . lc($fn) . ') }'; - } $rtyp->fields), - "\n};\n\n"; - print OUTFILE "static const ${rn}FieldIndex ${rn}RecordLinkFields[] = {\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}RecordSortedFieldIndex[] = {\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}RecordLinkFields),\n", - " ${rn}RecordLinkFields,\n", - " ${rn}RecordSortedFieldNames,\n", - " ${rn}RecordSortedFieldIndex,\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 (($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", - "#endif /* GEN_SIZE_OFFSET */\n"; - } - print OUTFILE "\n", - "#endif /* $guard_name */\n"; - close OUTFILE; -} diff --git a/src/dbHost/dbToMenuH b/src/dbHost/dbdToMenuH.pl similarity index 81% rename from src/dbHost/dbToMenuH rename to src/dbHost/dbdToMenuH.pl index da030f1c8..e321bc336 100755 --- a/src/dbHost/dbToMenuH +++ b/src/dbHost/dbdToMenuH.pl @@ -1,12 +1,19 @@ #!/usr/bin/perl +# $Id$ +use FindBin qw($Bin); +use lib "$Bin/../../lib/perl"; + +use EPICS::Getopts; +use File::Basename; use DBD; use DBD::Parser; -use Getopts; use macLib; use Readfile; -my $tool = 'dbToMenuH'; +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"; @@ -16,6 +23,7 @@ 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) { @@ -26,9 +34,10 @@ if ($opt_o) { ($outfile = $infile) =~ s/\.dbd$/.h/; $outfile =~ s/^.*\///; } +my $outbase = basename($outfile); # Derive a name for the include guard -my $guard_name = "INC_$outfile"; +my $guard_name = "INC_$outbase"; $guard_name =~ tr/a-zA-Z0-9_/_/cs; $guard_name =~ s/(_[hH])?$/_H/; @@ -41,11 +50,11 @@ if ($opt_D) { print map { "$_:\n" } @uniqfiles; } else { open OUTFILE, ">$outfile" or die "$tool: Can't open $outfile: $!\n"; - print OUTFILE "/* $outfile generated from $infile */\n\n", + print OUTFILE "/* $outbase generated from $inbase */\n\n", "#ifndef $guard_name\n", "#define $guard_name\n\n"; my $menus = $dbd->menus; - while (($name, $menu) = each %{$menus}) { + while (my ($name, $menu) = each %{$menus}) { print OUTFILE $menu->toDeclaration; } # FIXME: Where to put metadata for widely used menus? diff --git a/src/dbHost/dbdToRecordtypeH.pl b/src/dbHost/dbdToRecordtypeH.pl new file mode 100755 index 000000000..0850b6e2a --- /dev/null +++ b/src/dbHost/dbdToRecordtypeH.pl @@ -0,0 +1,222 @@ +#!/usr/bin/perl +# $Id$ + +use FindBin qw($Bin); +use lib "$Bin/../../lib/perl"; + +use EPICS::Getopts; +use File::Basename; +use DBD; +use DBD::Parser; +use macLib; +use 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; +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 \n" . + "static int ${rn}RecordSizeOffset(dbRecordType *prt)\n" . + "{\n" . + " ${rn}Record *prec = 0;\n" . + join("\n", map { + " prt->papFldDes[${rn}Record$_]->size = " . + "sizeof(prec->" . lc($_) . ");" + } $rtyp->field_names) . "\n" . + join("\n", map { + " prt->papFldDes[${rn}Record$_]->offset = " . + "(char *)&prec->" . lc($_) . " - (char *)prec;" + } $rtyp->field_names) . "\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; + " { ${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," . lc($fn) . ') }'; + } $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"; +}