Experimental Physics and
Industrial Control System

----- 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 ---

Subject:	Re: AW: [asyn] link already open!
From:	Dirk Zimoch <[email protected]>
To:	Pavel Maslov <[email protected]>
Cc:	EPICS Tech Talk <[email protected]>
Date:	Wed, 14 Aug 2013 15:04:37 +0200

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