Re: AW: [asyn] link already open!

[Dirk Zimoch <dirk.zimoch@psi.ch>]

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 <anj@aps.anl.gov
> <mailto:anj@aps.anl.gov>> 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