epics/epics-base
0
0
Fork 0
Code Issues Pull Requests Projects Wiki Activity

Merge commit '10d472202dc2bf1fa5c569d2a14d460e95030564' into PSI-7.0

Browse Source 
This is before PVA is modified
This commit is contained in:
zimoch
2020-11-16 17:06:22 +01:00
parent ce43a67cbd 10d472202d
commit 1db2cba81d
22 changed files with 527 additions and 447 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
modules/ca/src/client/access.cpp
View File

@@ -603,7 +603,7 @@ void epicsStdCall ca_signal_formated ( long ca_status, const char *pfilenm,
}
else {
fprintf ( stderr, "CA exception in thread w/o CA ctx: status=%s file=%s line=%d: \n",
ca_message ( ca_status ), pfilenm, lineno );
ca_message ( ca_status ), pfilenm ? pfilenm : "<null>", lineno );
if ( pFormat ) {
vfprintf ( stderr, pFormat, theArgs );
}

6
modules/ca/src/perl/Makefile
View File

@@ -13,11 +13,11 @@ ifdef T_A
PERL_ARCHNAME = $(shell $(PERL) ../perlConfig.pl archname)
PERL_ARCHPATH := $(PERL_VERSION)/$(PERL_ARCHNAME)
PERL_ARCHLIB := $(shell $(PERL) ../perlConfig.pl archlib)
PERL_ARCHLIB := $(shell $(PERL) ../perlConfig.pl archlibexp)
PERL_h = $(PERL_ARCHLIB)/CORE/perl.h
EXTUTILS := $(shell $(PERL) ../perlConfig.pl privlib)/ExtUtils
PERLBIN := $(shell $(PERL) ../perlConfig.pl bin)
EXTUTILS := $(shell $(PERL) ../perlConfig.pl privlibexp)/ExtUtils
PERLBIN := $(shell $(PERL) ../perlConfig.pl binexp)
XSUBPP := $(firstword $(wildcard $(PERLBIN)/xsubpp $(EXTUTILS)/xsubpp))
# Special settings for Darwin:

46
modules/ca/src/perl/capr.pl
View File

@@ -35,9 +35,11 @@ my %fieldType = (
DBF_DOUBLE => 'DBF_FLOAT',
DBF_FLOAT => 'DBF_FLOAT',
DBF_LONG => 'DBF_LONG',
DBF_INT64 => 'DBF_FLOAT',
DBF_SHORT => 'DBF_LONG',
DBF_ULONG => 'DBF_LONG',
DBF_USHORT => 'DBF_LONG',
DBF_UINT64 => 'DBF_FLOAT',
DBF_DEVICE => 'DBF_STRING',
DBF_ENUM => 'DBF_STRING',
DBF_FWDLINK => 'DBF_STRING',
@@ -86,7 +88,7 @@ if (@ARGV) {
printRecord($_, @ARGV);
} else {
if (m/^ \s* ([]+:;<>0-9A-Za-z[-]+) (?:\. \w+)? \s* , \s* (\d+) \s* $/x) {
# Recognizes ",n" as an interest leve, drops any ".FIELD" part
# Recognizes ",n" as an interest level, drops any ".FIELD" part
printRecord($1, $2);
} else {
# Drop any ".FIELD" part
@@ -235,8 +237,9 @@ sub printField {
$outStr = sprintf('%-5s %.8f', $field, $fieldData);
} elsif ( $dataType eq 'DBF_CHAR' ) {
$outStr = sprintf('%-5s %d', $field, ord($fieldData));
}else {
# DBF_LONG, DBF_SHORT, DBF_UCHAR, DBF_ULONG, DBF_USHORT
} else {
# DBF_INT64, DBF_LONG, DBF_SHORT,
# DBF_UINT64, DBF_ULONG, DBF_USHORT, DBF_UCHAR,
$outStr = sprintf('%-5s %d', $field, $fieldData);
}
@@ -270,17 +273,18 @@ sub printField {
sub caget {
my @chans = map { CA->new($_); } @_;
#clear results;
#clear any previous results;
%callback_data = ();
%timed_out = ();
eval { CA->pend_io($opt_w); };
if ($@) {
if ($@ =~ m/^ECA_TIMEOUT/) {
my $err = (@chans > 1) ? 'some PV(s)' : '"' . $chans[0]->name . '"';
my $name = $chans[0]->name;
my $err = (@chans > 1) ? 'some fields' : "'$name'";
print "Channel connect timed out: $err not found.\n";
foreach my $chan (@chans) {
$timed_out{$chan->name} = $chan->is_connected;
$timed_out{$chan->name} = !$chan->is_connected;
}
@chans = grep { $_->is_connected } @chans;
} else {
@@ -289,14 +293,12 @@ sub caget {
}
map {
my $type;
$type = $_->field_type;
$_->get_callback(\&caget_callback, $type);
$_->get_callback(\&caget_callback, $_->field_type);
} @chans;
my $fields_read = @chans;
$callback_incomplete = @chans;
CA->pend_event(0.1) while $callback_incomplete;
my $fields_read = $callback_incomplete = @chans;
CA->pend_event(0.1)
while $callback_incomplete;
return $fields_read;
}
@@ -325,9 +327,10 @@ sub printRecord {
my @bases = (); #bases, from parser
foreach my $field (sort keys %{$record{$recType}}) {
# Skip DTYP field if this rec type doesn't have device support defined
if ($field eq 'DTYP' && !(exists($device{$recType}))) { next; }
next if $field eq 'DTYP' && !exists($device{$recType});
my ($fType, $fInterest, $base) = getFieldParams($recType, $field);
# FIXME: Support waveform.VAL fields etc.
unless( $fType eq 'DBF_NOACCESS' ) {
if ($interest >= $fInterest ) {
my $fToGet = "$name.$field";
@@ -346,15 +349,10 @@ sub printRecord {
my $field = $fields_pr[$i];
my $fToGet = $readlist[$i];
my ($fType, $data, $base);
if ($timed_out{$fToGet}) {
$fType = $fieldType{DBF_STRING};
$data = '<timeout>';
}
else {
$fType = $ftypes[$i];
$base = $bases[$i];
$data = $callback_data{$fToGet};
}
next if $timed_out{$fToGet};
$fType = $ftypes[$i];
$base = $bases[$i];
$data = $callback_data{$fToGet};
$col = printField($field, $data, $fType, $base, $col);
}
print("\n"); # Final newline
@@ -387,8 +385,8 @@ sub printRecordList {
if (exists($record{$type}) ) {
print("Record type - $type\n");
foreach my $fkey (sort keys %{$record{$type}}) {
printf('%-4s', $fkey);
printf(" interest = $record{$type}{$fkey}[$iIdx]");
printf('%-8s', $fkey);
printf(" interest = $record{$type}{$fkey}[$iIdx]");
printf(" type = %-12s ",$record{$type}{$fkey}[$tIdx]);
print (" base = $record{$type}{$fkey}[$bIdx]\n");
}

2
modules/ca/src/tools/cainfo.c
View File

@@ -157,7 +157,7 @@ int main (int argc, char *argv[])
}
break;
case 's': /* ca_client_status interest level */
if (sscanf(optarg,"%du", &statLevel) != 1)
if (sscanf(optarg,"%u", &statLevel) != 1)
{
fprintf(stderr, "'%s' is not a valid interest level "
"- ignored. ('cainfo -h' for help.)\n", optarg);

2
modules/ca/src/tools/camonitor.c
View File

@@ -258,7 +258,7 @@ int main (int argc, char *argv[])
}
break;
case '#': /* Array count */
if (sscanf(optarg,"%ld", &reqElems) != 1)
if (sscanf(optarg,"%lu", &reqElems) != 1)
{
fprintf(stderr, "'%s' is not a valid array element count "
"- ignored. ('camonitor -h' for help.)\n", optarg);

9
modules/ca/src/tools/caput.c
View File

@@ -437,6 +437,7 @@ int main (int argc, char *argv[])
dbuf = calloc (count, sizeof(double));
if(!sbuf || !dbuf) {
fprintf(stderr, "Memory allocation failed\n");
free(sbuf); free(dbuf);
return 1;
}
@@ -450,6 +451,7 @@ int main (int argc, char *argv[])
result = ca_pend_io(caTimeout);
if (result == ECA_TIMEOUT) {
fprintf(stderr, "Read operation timed out: ENUM data was not read.\n");
free(sbuf); free(dbuf);
return 1;
}
@@ -460,6 +462,7 @@ int main (int argc, char *argv[])
if (*(argv+optind+i) == pend) { /* Conversion didn't work */
fprintf(stderr, "Enum index value '%s' is not a number.\n",
*(argv+optind+i));
free(sbuf); free(dbuf);
return 1;
}
if (dbuf[i] >= bufGrEnum.no_str) {
@@ -486,6 +489,7 @@ int main (int argc, char *argv[])
dbuf[i] = epicsStrtod(sbuf[i], &pend);
if (sbuf[i] == pend || enumAsString) {
fprintf(stderr, "Enum string value '%s' invalid.\n", sbuf[i]);
free(sbuf); free(dbuf);
return 1;
}
if (dbuf[i] >= bufGrEnum.no_str) {
@@ -503,6 +507,7 @@ int main (int argc, char *argv[])
ebuf = calloc(len, sizeof(char));
if(!ebuf) {
fprintf(stderr, "Memory allocation failed\n");
free(sbuf); free(dbuf); free(ebuf);
return 1;
}
count = epicsStrnRawFromEscaped(ebuf, len, cbuf, len-1) + 1;
@@ -537,12 +542,14 @@ int main (int argc, char *argv[])
}
if (result != ECA_NORMAL) {
fprintf(stderr, "Error from put operation: %s\n", ca_message(result));
free(sbuf); free(dbuf); free(ebuf);
return 1;
}
result = ca_pend_io(caTimeout);
if (result == ECA_TIMEOUT) {
fprintf(stderr, "Write operation timed out: Data was not written.\n");
free(sbuf); free(dbuf); free(ebuf);
return 1;
}
if (request == callback) { /* Also wait for callbacks */
@@ -556,6 +563,7 @@ int main (int argc, char *argv[])
if (result != ECA_NORMAL) {
fprintf(stderr, "Error occured writing data: %s\n", ca_message(result));
free(sbuf); free(dbuf); free(ebuf);
return 1;
}
@@ -567,6 +575,7 @@ int main (int argc, char *argv[])
/* Shut down Channel Access */
ca_context_destroy();
free(sbuf); free(dbuf); free(ebuf);
return result;
}