----- Original Message Header -----
Subject: Re: AW: [asyn] link already open!
From: [email protected];
To: [email protected];
Cc: [email protected];
-----------------------------------
Warning: Attachment contains virus code or meets the filtering/blocking
rules. Use caution when accessing the contents.
--- Begin Message ---
Hi Pavel,
In the attachment is my "stupid" parser. I have a tclx version, but I
also have tried to make a slightly simpler simpler perl version.
In my Makefile, I do 2 things:
1. Overwrite DBEXPAND
DBEXPAND = $(PERL) path/to/my/expandDBD.pl
2. Generate local registerRecordDeviceDriver
$(APP)_SRCS += $(APP)_registerRecordDeviceDriver.cpp
In EPICS 3.14.12, you can use dlload to load the library:
dlload /path/libmymodule.so
dbLoadDatabase /path/mymodule.dbd
mymodule_registerRecordDeviceDriver
But I also have my own load function, that does all the above plus more.
It can handle different versions of a module. It keeps a list of already
loaded modules. It skips requests to load the same module twice. It
refused to load a different version of a module already loaded. It
checks which other modules must be loaded first (with the help of my
Makefile, which creates a dependency file).
With that tool, I simply write:
require "mymodule"
It works on Linux, vxWorks and should also work on Windows.
Dirk
On 13.08.2013 10:43, Pavel Maslov wrote:
Andrew, but can I get away with including base.dbd in the support
module? What if it's included in the main IOC for the second time?
Dirk, are you using the dlload command or your own c routine? Could you
also elaborate on your "stupid" dbd parser script?
--
Regards,
Pavel Maslov, MS
On Mon, Aug 12, 2013 at 9:02 PM, Andrew Johnson <[email protected]
<mailto:[email protected]>> wrote:
On 08/12/2013 01:44 PM, Zimoch Dirk wrote:
Unfortunately it is broken on 3.15 because the new parser is
more whimpy.
I would use the word "strict" myself. The device support is asking
it to believe that the named record type will actually exist when
the IOC is booted. Your version believes anything you tell it, the
newer 3.15 one is more like a doubting Thomas (or a financial
auditor if you prefer, it wants to see real evidence).
- Andrew
--
Advertising may be described as the science of arresting the human
intelligence long enough to get money from it. -- Stephen Leacock
#!/usr/bin/tclsh
package require Tclx
set global_context [scancontext create]
set epicsversion 3.13
set quiet 0
set recordtypes 0
set seachpath {}
while {[llength $argv]} {
switch -glob -- [lindex $argv 0] {
"-3.14" { set epicsversion 3.14 }
"-q" { set quiet 1 }
"-r" { set recordtypes 1; set quiet 1 }
"-I" { lappend seachpath [lindex $argv 1]; set argv [lreplace $argv 0 1]; continue }
"-I*" { lappend seachpath [string range [lindex $argv 0] 2 end] }
"--" { set argv [lreplace $argv 0 0]; break }
"-*" { puts stderr "Unknown option [lindex $argv 0] ignored" }
default { break }
}
set argv [lreplace $argv 0 0]
}
proc opendbd {name} {
global seachpath
foreach dir $seachpath {
if ![catch {
set file [open [file join $dir $name]]
}] {
return $file
}
}
return -code error "file $name not found"
}
scanmatch $global_context {^[ \t]*(#|%|$)} {
continue
}
if {$recordtypes} {
scanmatch $global_context {include[ \t]+"?((.*)Record.dbd)"?} {
if ![catch {
close [opendbd $matchInfo(submatch0)]
}] {
puts $matchInfo(submatch1)
}
continue
}
} else {
scanmatch $global_context {(registrar|variable|function)[ \t]*\([ \t]*"?([a-zA-Z0-9_]+)"?[ \t]*\)} {
global epicsversion
if {$epicsversion == 3.14} {puts $matchInfo(submatch0)($matchInfo(submatch1))}
}
scanmatch $global_context {variable[ \t]*\([ \t]*"?([a-zA-Z0-9_]+)"?[ \t]*,[ \t]*"?([a-zA-Z0-9_]+)"?[ \t]*\)} {
global epicsversion
if {$epicsversion == 3.14} {puts variable($matchInfo(submatch0),$matchInfo(submatch1))}
}
scanmatch $global_context {
puts $matchInfo(line)
}
}
scanmatch $global_context {include[ \t]+"?([^"]*)"?} {
global seachpath
global FileName
global quiet
if [catch {
includeFile $global_context $matchInfo(submatch0)
} msg] {
if {!$quiet} {
puts stderr "ERROR: $msg in path \"$seachpath\" called from $FileName($matchInfo(handle)) line $matchInfo(linenum)"
exit 1
}
}
continue
}
proc includeFile {context name} {
global global_context FileName
set file [opendbd $name]
set FileName($file) $name
scanfile $context $file
close $file
}
foreach filename $argv {
set file [open $filename]
set FileName($file) $filename
scanfile $global_context $file
close $file
}
# $Header: /cvs/G/DRV/misc/App/tools/expandDBD.tcl,v 1.4 2011/12/22 10:33:20 zimoch Exp $
Attachment:
expandDBD.pl
Description: Perl program
--- End Message ---
- Navigate by Date:
- Prev:
Re: Should Linux C++ builds have debug symbols by default in R3.14.12.3? Andrew Johnson
- Next:
Setting console buad rate Yoram Fisher
- Index:
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
<2013>
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
- Navigate by Thread:
- Prev:
Re: Should Linux C++ builds have debug symbols by default in R3.14.12.3? Andrew Johnson
- Next:
Setting console buad rate Yoram Fisher
- Index:
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
<2013>
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
|