epics/pcas
0
0
Fork 0
Code Issues Pull Requests Projects Wiki Activity

2004-07-30: Work continues.

Browse Source 
Make dbToRecordtypeH generate the same output as my 2002 C++ code.
Other changes in testing and macros.
This commit is contained in:
Andrew Johnson
2010-04-08 16:18:03 -05:00
parent a1b72626ec
commit daa0630361
7 changed files with 144 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/dbHost/DBD/Base.pm
View File

@@ -76,11 +76,14 @@ sub identifier {
sub escapeCcomment {
($_) = @_;
s/\*\//**/;
s/\*\//**/g;
return $_;
}
sub escapeCstring {
($_) = @_;
# How to do this?
return $_;
}

20
src/dbHost/DBD/Menu.pm
View File

@@ -39,12 +39,28 @@ sub legal_choice {
sub toDeclaration {
my $this = shift;
my $name = $this->name;
my @choices = map {
"\t" . @{$_}[0] . "\t/* " . escapeCcomment(@{$_}[1]) . " */"
} $this->choices;
return "typedef enum {\n" .
join(",\n", @choices) .
"\n} " . $this->name . ";\n";
join(",\n", @choices) .
"\n\t${name}_NUM_CHOICES\n" .
"} $name;\n";
}
sub toDefinition {
my $this = shift;
my $name = $this->name;
my @strings = map {
"\t\"" . escapeCstring(@{$_}[1]) . "\""
} $this->choices;
return "static const char * const ${name}MenuData = {\n" .
join(",\n", @strings) . "};\n\n" .
"dbMenu ${name}MenuData = {\n" .
"\t\"" . escapeCstring(name) . "\",\n" .
"\t${name}_NUM_CHOICES,\n" .
"\t${name}ChoiceStrings\n};\n";
}
1;

16
src/dbHost/DBD/Recfield.pm
View File

@@ -29,7 +29,7 @@ our %field_attrs = (
promptgroup => qr/^GUI_\w+$/,
prompt => qr/^.*$/,
special => qr/^(?:SPC_\w+|\d{3,})$/,
pp => qr/^(?:YES|NO|TRUE|FALSE)$/,
pp => qr/^(?:TRUE|FALSE)$/,
interest => qr/^\d+$/,
base => qr/^(?:DECIMAL|HEX)$/,
size => qr/^\d+$/,
@@ -102,9 +102,9 @@ sub check_valid {
sub toDeclaration {
my ($this, $ctype) = @_;
my $name = lc $this->name;
my $result = "$ctype $name;";
my $result = sprintf " %-19s %-12s", $ctype, "$name;";
my $prompt = $this->attribute('prompt');
$result .= "\t/* $prompt */" if defined $prompt;
$result .= "/* $prompt */" if defined $prompt;
return $result;
}
@@ -133,9 +133,9 @@ sub toDeclaration {
my ($this) = @_;
my $name = lc $this->name;
my $size = $this->attribute('size');
my $result = "char ${name}[${size}];";
my $result = sprintf " %-19s %-12s", 'char', "${name}[${size}];";
my $prompt = $this->attribute('prompt');
$result .= "\t/* $prompt */" if defined $prompt;
$result .= "/* $prompt */" if defined $prompt;
return $result;
}
@@ -416,10 +416,10 @@ sub check_valid {
sub toDeclaration {
my ($this) = @_;
my $name = lc $this->name;
my $result = $this->attribute('extra') . ";";
my $extra = $this->attribute('extra');
my $result = sprintf " %-32s", "$extra;";
my $prompt = $this->attribute('prompt');
$result .= "\t/* $prompt */" if defined $prompt;
$result .= "/* $prompt */" if defined $prompt;
return $result;
}

4
src/dbHost/DBD/Recordtype.pm
View File

@@ -79,8 +79,8 @@ sub toDeclaration {
} $this->fields;
my $name = $this->name;
$name .= "Record" unless $name eq "dbCommon";
return "typedef struct $name {\n\t" .
join("\n\t", @fields) .
return "typedef struct $name {\n" .
join("\n", @fields) .
"\n} $name;\n";
}

7
src/dbHost/dbToMenuH
View File

@@ -48,6 +48,11 @@ if ($opt_D) {
while (($name, $menu) = each %{$menus}) {
print OUTFILE $menu->toDeclaration;
}
print OUTFILE "\n#endif /* $guard_name */\n";
print OUTFILE "\n#ifdef GEN_MENU_CHOICES\n\n";
while (($name, $menu) = each %{$menus}) {
print OUTFILE $menu->toDefinition;
}
print OUTFILE "\n#endif /* GEN_MENU_CHOICES */\n",
"#endif /* $guard_name */\n";
close OUTFILE;
}

103
src/dbHost/dbToRecordtypeH
View File

@@ -49,12 +49,7 @@ if ($opt_D) { # Output dependencies only, to stdout
print OUTFILE "/* $outfile generated from $infile */\n\n",
"#ifndef $guard_name\n",
"#define $guard_name\n\n",
"#include \"ellLib.h\"\n",
"#include \"epicsMutex.h\"\n",
"#include \"link.h\"\n",
"#include \"epicsTime.h\"\n",
"#include \"epicsTypes.h\"\n",
"#include \"epicsExport.h\"\n\n",
"#include \"recDecls.h\"\n\n",
"#ifdef __cplusplus\n",
"extern \"C\" {\n",
"#endif\n\n";
@@ -69,18 +64,94 @@ if ($opt_D) { # Output dependencies only, to stdout
print OUTFILE $rtyp->toDeclaration;
unless ($rn eq 'dbCommon') {
print OUTFILE "\nenum {\n",
join(",\n", map { "\t${rn}Record$_" } $rtyp->field_names),
"\n};\n\n";
my $n=0;
print OUTFILE "\ntypedef enum {\n",
join(",\n", map { "\t${rn}Record$_ = " . $n++ } $rtyp->field_names),
"\n} ${rn}FieldIndex;\n\n";
print OUTFILE "#ifdef GEN_SIZE_OFFSET\n",
"static int ${rn}RecordSizeOffset(dbRecordType *pdbRecordType)\n",
"{\n";
# ... FIXME: add size-offset data, etc.
print OUTFILE "}\n\n",
"epicsExportRegistrar(${rn}RecordSizeOffset);\n\n";
join("\n",
map { "static const char ${rn}FieldName$_\[] = \"$_\";" }
$rtyp->field_names),
"\n\n";
$n=0;
print OUTFILE "static const dbRecordData ${rn}RecordRecordData;\n\n",
"static dbFldDes ${rn}RecordFieldData[] = {\n",
join(",\n", map {
my $fn = $_->name;
" { ${rn}RecordFieldName$fn," .
$_->dbf_type . ',"' .
$_->attribute('initial') . '",' .
($_->attribute('special') || '0') . ',' .
($_->attribute('pp') || 'FALSE') . ',' .
($_->attribute('interest') || '0') . ',' .
($_->attribute('asl') || 'ASL0') . ',' .
$n++ . ",\n\t\&${rn}RecordRecordData," .
"GEOMETRY_DATA(${rn}Record," . lc($fn) . ') }';
} $rtyp->fields),
"\n};\n\n";
print OUTFILE "static const short ${rn}RecordFieldLinks[] = {\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}RecordFieldSortedNames[] = {\n",
join(",\n", map {
" ${rn}RecordFieldName$_"
} @sorted_names),
"\n};\n\n";
print OUTFILE "static const short ${rn}RecordFieldSortedIndex[] = {\n",
join(",\n", map {
" ${rn}Record$_"
} @sorted_names),
"\n};\n\n";
print OUTFILE "extern rset ${rn}RSET;\n\n",
"static const dbRecordData ${rn}RecordRecordData = {\n",
" \"$rn\",\n",
" sizeof(${rn}Record),\n",
" NELEMENTS(${rn}RecordFieldData),\n",
" ${rn}RecordFieldData,\n",
" ${rn}RecordVAL,\n",
" \&${rn}RecordFieldData[${rn}RecordVAL],\n",
" NELEMENTS(${rn}RecordFieldLinks),\n",
" ${rn}RecordFieldLinks,\n",
" ${rn}RecordFieldSortedNames,\n",
" ${rn}RecordFieldSortedIndex,\n",
" \&${rn}RSET\n",
"};\n\n";
my @menu_fields = grep {
$_->dbf_type eq 'DBF_MENU'
} $rtyp->fields;
my %menu_uniq;
my @menu_names = grep {
!$menu_uniq{$_}++
} map {
$_->attribute('menu')
} @menu_fields;
print OUTFILE join ("\n", map {
"extern dbMenu ${_}MenuData;"
} @menu_names), "\n\n";
print OUTFILE "dbRecordType * ${rn}RecordRegistrar(dbBase *pbase, int nDevs)\n",
"{\n",
" dbRecordType *prt;\n";
print OUTFILE map {
" dbRegisterMenu(pbase, \&${_}MenuData);\n"
} @menu_names;
print OUTFILE map {
" ${rn}RecordFieldData[${rn}Record" .
$_->name .
"].typDat.pmenu = \&" .
$_->attribute('menu') .
"MenuData;\n"
} @menu_fields;
# ... FIXME ... Missing prt, devMenu, CT_HEX/CT_DECIMAL
print OUTFILE " return prt;\n}\n\n",
"epicsExportRegistrar(${rn}RecordSizeOffset);\n",
"#endif\n";
}
print OUTFILE "#ifdef __cplusplus\n",
print OUTFILE "\n#ifdef __cplusplus\n",
"} /* extern \"C\" */\n",
"#endif\n\n",
"#endif /* $guard_name */\n";

36
src/dbHost/macLib.pm
View File

@@ -39,23 +39,8 @@ sub new ($@) {
return $this;
}
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 = macLib::entry->new($name, 'macro');
$entry->{raw} = $raw;
$this->{macros}[0]{$name} = $entry;
}
$this->{dirty} = 1;
}
sub installList ($@) {
# Argument is a list of strings which are arguments to installMacros
my $this = shift;
while (@_) {
$this->installMacros(shift);
@@ -63,11 +48,12 @@ sub installList ($@) {
}
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 ( \w+ ) \s* /xgc) {
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
@@ -93,6 +79,22 @@ sub installMacros ($$) {
}
}
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 = macLib::entry->new($name, 'macro');
$entry->{raw} = $raw;
$this->{macros}[0]{$name} = $entry;
}
$this->{dirty} = 1;
}
sub pushScope ($) {
my ($this) = @_;
unshift @{$this->{macros}}, {};