Menu
▾
▴
nscldaq-cvscommits — CVS Commits are logged here.
You can subscribe to this list here.
| 2003 |
Jan
|
Feb
(5) |
Mar
(86) |
Apr
(3) |
May
(5) |
Jun
(18) |
Jul
|
Aug
(44) |
Sep
(27) |
Oct
(17) |
Nov
(1) |
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(14) |
Feb
(33) |
Mar
(61) |
Apr
(52) |
May
(24) |
Jun
(52) |
Jul
(28) |
Aug
(73) |
Sep
(47) |
Oct
(29) |
Nov
(162) |
Dec
(51) |
| 2005 |
Jan
(44) |
Feb
(42) |
Mar
(32) |
Apr
(12) |
May
(55) |
Jun
(116) |
Jul
(10) |
Aug
(39) |
Sep
(39) |
Oct
(26) |
Nov
(58) |
Dec
(122) |
| 2006 |
Jan
(46) |
Feb
(38) |
Mar
(78) |
Apr
(71) |
May
(44) |
Jun
(25) |
Jul
(55) |
Aug
(53) |
Sep
(54) |
Oct
(55) |
Nov
(87) |
Dec
(33) |
| 2007 |
Jan
(13) |
Feb
(32) |
Mar
(33) |
Apr
(49) |
May
(100) |
Jun
(51) |
Jul
(29) |
Aug
(63) |
Sep
(14) |
Oct
(90) |
Nov
(43) |
Dec
(25) |
| 2008 |
Jan
(22) |
Feb
(31) |
Mar
(44) |
Apr
(23) |
May
(65) |
Jun
(30) |
Jul
(41) |
Aug
(31) |
Sep
(18) |
Oct
(41) |
Nov
(26) |
Dec
|
| 2009 |
Jan
(18) |
Feb
(23) |
Mar
(21) |
Apr
(28) |
May
(3) |
Jun
(18) |
Jul
(10) |
Aug
(9) |
Sep
|
Oct
(9) |
Nov
(3) |
Dec
(5) |
| 2010 |
Jan
(34) |
Feb
(40) |
Mar
(17) |
Apr
(6) |
May
(4) |
Jun
(5) |
Jul
(49) |
Aug
(34) |
Sep
(10) |
Oct
(3) |
Nov
(10) |
Dec
(16) |
| 2011 |
Jan
(22) |
Feb
(3) |
Mar
(5) |
Apr
(36) |
May
(39) |
Jun
(6) |
Jul
(1) |
Aug
(6) |
Sep
(9) |
Oct
(11) |
Nov
(35) |
Dec
(12) |
| 2012 |
Jan
(24) |
Feb
(30) |
Mar
(22) |
Apr
(20) |
May
(17) |
Jun
(21) |
Jul
(33) |
Aug
(26) |
Sep
(30) |
Oct
(21) |
Nov
(24) |
Dec
(61) |
| 2013 |
Jan
(44) |
Feb
(43) |
Mar
(17) |
Apr
(30) |
May
(29) |
Jun
(2) |
Jul
(17) |
Aug
(15) |
Sep
(19) |
Oct
(62) |
Nov
(25) |
Dec
(15) |
| 2014 |
Jan
(78) |
Feb
(40) |
Mar
(50) |
Apr
(79) |
May
(46) |
Jun
(30) |
Jul
(96) |
Aug
(82) |
Sep
(171) |
Oct
(199) |
Nov
(101) |
Dec
(158) |
| 2015 |
Jan
(124) |
Feb
(62) |
Mar
(102) |
Apr
(29) |
May
(83) |
Jun
(92) |
Jul
(61) |
Aug
(42) |
Sep
(43) |
Oct
(79) |
Nov
(51) |
Dec
|
|
From: Ron F. <ro...@us...> - 2006-01-02 15:57:15
|
Update of /cvsroot/nscldaq/clients In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24244 Modified Files: Tag: daqclients-7_3_fixes CHANGELOG configure.in Log Message: Fix some stuff related to autotools updates. Index: CHANGELOG =================================================================== RCS file: /cvsroot/nscldaq/clients/CHANGELOG,v retrieving revision 3.10.2.22 retrieving revision 3.10.2.23 diff -C2 -d -r3.10.2.22 -r3.10.2.23 *** CHANGELOG 31 May 2005 12:56:08 -0000 3.10.2.22 --- CHANGELOG 2 Jan 2006 15:57:04 -0000 3.10.2.23 *************** *** 152,154 **** 7.3-018 February 23, 2005 Fix inconsistent timestamp treatments of tm_month: ! January will now be month 1 everywhere. \ No newline at end of file --- 152,156 ---- 7.3-018 February 23, 2005 Fix inconsistent timestamp treatments of tm_month: ! January will now be month 1 everywhere. ! 7-3-019 ! January 2, 2006 - Make this work with newer versions of auto tools \ No newline at end of file Index: configure.in =================================================================== RCS file: /cvsroot/nscldaq/clients/configure.in,v retrieving revision 3.15.2.13 retrieving revision 3.15.2.14 diff -C2 -d -r3.15.2.13 -r3.15.2.14 *** configure.in 31 May 2005 12:56:08 -0000 3.15.2.13 --- configure.in 2 Jan 2006 15:57:04 -0000 3.15.2.14 *************** *** 6,10 **** # Separate device libraries. ! AM_INIT_AUTOMAKE(nscldaq, 7.3-018) # --- 6,10 ---- # Separate device libraries. ! AM_INIT_AUTOMAKE(nscldaq, 7.3-019) # |
|
From: Ron F. <ro...@us...> - 2006-01-02 15:57:12
|
Update of /cvsroot/nscldaq/clients/LogDisplay In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24244/LogDisplay Modified Files: Tag: daqclients-7_3_fixes Makefile.am Log Message: Fix some stuff related to autotools updates. Index: Makefile.am =================================================================== RCS file: /cvsroot/nscldaq/clients/LogDisplay/Makefile.am,v retrieving revision 3.1 retrieving revision 3.1.2.1 diff -C2 -d -r3.1 -r3.1.2.1 *** Makefile.am 22 Mar 2003 04:02:59 -0000 3.1 --- Makefile.am 2 Jan 2006 15:57:04 -0000 3.1.2.1 *************** *** 6,10 **** for f in *.tcl; do $(INSTALL_DATA) $$f $(prefix)/Scripts; done ./installpkg $(prefix) - EXTRA_DIST = AddButton.gif \ --- 6,9 ---- *************** *** 27,29 **** installpkg \ LogDisplay - \ No newline at end of file --- 26,27 ---- |
|
From: Ron F. <ro...@us...> - 2006-01-02 15:46:37
|
Update of /cvsroot/nscldaq/clients In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22192 Modified Files: Tag: daqclients-7_4_fixes CHANGELOG configure.in Log Message: Update makefiles for current versions of autotools. Index: CHANGELOG =================================================================== RCS file: /cvsroot/nscldaq/clients/CHANGELOG,v retrieving revision 3.14.2.16 retrieving revision 3.14.2.17 diff -C2 -d -r3.14.2.16 -r3.14.2.17 *** CHANGELOG 24 May 2005 11:11:13 -0000 3.14.2.16 --- CHANGELOG 2 Jan 2006 15:46:27 -0000 3.14.2.17 *************** *** 156,158 **** - Fix error in burngui - sent 2 \n's at the child causing it to not wait for the next dvd. ! 7.4-005 --- 156,163 ---- - Fix error in burngui - sent 2 \n's at the child causing it to not wait for the next dvd. ! 7.4-006 ! - Make this work with newer autoconfs that try to put deps in the ! dist. This has problems with variable builds like VMEAPi ! if they are expressed as $(VMEAPI) not @VMEAPI@ etc. ! - Remove lines from Makefiles.am which are ^I# as these make ! automake/autconf stop. \ No newline at end of file Index: configure.in =================================================================== RCS file: /cvsroot/nscldaq/clients/configure.in,v retrieving revision 3.19.2.5 retrieving revision 3.19.2.6 diff -C2 -d -r3.19.2.5 -r3.19.2.6 *** configure.in 24 May 2005 11:11:13 -0000 3.19.2.5 --- configure.in 2 Jan 2006 15:46:27 -0000 3.19.2.6 *************** *** 6,10 **** # Separate device libraries. ! AM_INIT_AUTOMAKE(nscldaq, 7.4-005) # --- 6,10 ---- # Separate device libraries. ! AM_INIT_AUTOMAKE(nscldaq, 7.4-006) # |
|
From: Ron F. <ro...@us...> - 2006-01-02 15:46:37
|
Update of /cvsroot/nscldaq/clients/VMEApi In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22192/VMEApi Modified Files: Tag: daqclients-7_4_fixes Makefile.am Log Message: Update makefiles for current versions of autotools. Index: Makefile.am =================================================================== RCS file: /cvsroot/nscldaq/clients/VMEApi/Makefile.am,v retrieving revision 3.5 retrieving revision 3.5.4.1 diff -C2 -d -r3.5 -r3.5.4.1 *** Makefile.am 18 Jun 2004 12:11:04 -0000 3.5 --- Makefile.am 2 Jan 2006 15:46:27 -0000 3.5.4.1 *************** *** 1,4 **** lib_LTLIBRARIES = libVmeAPI.la ! libVmeAPI_la_SOURCES = $(VMEDEVICE)API.cpp Locking.cpp libVmeAPI_la_LDFLAGS = -version-info $(SOVERSION):0 $(VMEBUILDLIBS) \ -Wl"-rpath-$(libdir)" --- 1,4 ---- lib_LTLIBRARIES = libVmeAPI.la ! libVmeAPI_la_SOURCES = @VMEDEVICE@API.cpp Locking.cpp libVmeAPI_la_LDFLAGS = -version-info $(SOVERSION):0 $(VMEBUILDLIBS) \ -Wl"-rpath-$(libdir)" |
|
From: Ron F. <ro...@us...> - 2006-01-02 15:46:37
|
Update of /cvsroot/nscldaq/clients/contrib/scriptedReadout In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22192/contrib/scriptedReadout Modified Files: Tag: daqclients-7_4_fixes Makefile.am Log Message: Update makefiles for current versions of autotools. Index: Makefile.am =================================================================== RCS file: /cvsroot/nscldaq/clients/contrib/scriptedReadout/Makefile.am,v retrieving revision 1.6 retrieving revision 1.6.4.1 diff -C2 -d -r1.6 -r1.6.4.1 *** Makefile.am 18 Jun 2004 12:11:07 -0000 1.6 --- Makefile.am 2 Jan 2006 15:46:27 -0000 1.6.4.1 *************** *** 121,127 **** # install-exec-local: - # - # Make my directory hierarchy. - # $(mkinstalldirs) $(prefix)/contrib $(mkinstalldirs) $(prefix)/contrib/scriptedReadout --- 121,124 ---- *************** *** 129,143 **** $(mkinstalldirs) $(prefix)/contrib/scriptedReadout/skel $(mkinstalldirs) $(prefix)/contrib/scriptedReadout/src - # - # put the raw files where they belong: - # $(INSTALL_DATA) *.cpp $(prefix)/contrib/scriptedReadout/src $(INSTALL_DATA) *.h $(prefix)/contrib/scriptedReadout/include $(INSTALL_DATA) skeleton.cpp ReadoutMain.cpp \ $(prefix)/contrib/scriptedReadout/skel - # - # Now build Makefile from Makefile.skel along with other stuff - # that autoconf has figured out for us: - # echo INSTDIR=$(prefix) > Makefile.user cat Makefile.skel >> Makefile.user --- 126,133 ---- |
|
From: Ron F. <ro...@us...> - 2006-01-02 15:46:37
|
Update of /cvsroot/nscldaq/clients/contrib/scalerdisplay In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22192/contrib/scalerdisplay Modified Files: Tag: daqclients-7_4_fixes Makefile.am Log Message: Update makefiles for current versions of autotools. Index: Makefile.am =================================================================== RCS file: /cvsroot/nscldaq/clients/contrib/scalerdisplay/Makefile.am,v retrieving revision 1.3 retrieving revision 1.3.4.1 diff -C2 -d -r1.3 -r1.3.4.1 *** Makefile.am 18 Jun 2004 12:11:06 -0000 1.3 --- Makefile.am 2 Jan 2006 15:46:27 -0000 1.3.4.1 *************** *** 100,112 **** $(mkinstalldirs) $(prefix)/contrib/scalerdisplay/scripts $(mkinstalldirs) $(prefix)/contrib/scalerdisplay/skel - # - # Install the headers, sources and scripts. - # $(INSTALL_DATA) *.cpp $(prefix)/contrib/scalerdisplay/src $(INSTALL_DATA) *.h $(prefix)/contrib/scalerdisplay/include $(INSTALL_DATA) *.tcl $(prefix)/contrib/scalerdisplay/scripts - # - # Build the skeleton directory: - # $(INSTALL_DATA) tkAppInit.cpp $(prefix)/contrib/scalerdisplay/skel echo INSTDIR=$(prefix) > Makefile.user --- 100,106 ---- |
|
From: Ron F. <ro...@us...> - 2006-01-02 14:10:23
|
Update of /cvsroot/nscldaq/bufdump In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5654 Modified Files: CHANGELOG INSTALL Makefile.am Log Message: Added install-webdocs target to support 'automated' installation/update of web based documentation and integration of it into a larger directory tree. Index: Makefile.am =================================================================== RCS file: /cvsroot/nscldaq/bufdump/Makefile.am,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Makefile.am 31 Dec 2005 19:58:08 -0000 1.4 --- Makefile.am 2 Jan 2006 14:10:04 -0000 1.5 *************** *** 84,87 **** --- 84,100 ---- + # Install the documentation alone in some web-place. + # + # + install-webdocs: docs + $(mkinstalldirs) $(prefix) + $(INSTALL_DATA) manual.pdf $(prefix) + if [ -d htmldocs ]; then \ + $(INSTALL_DATA) htmldocs/* $(prefix); \ + $(INSTALL_DATA) $(HTMLGRAPHICS) $(prefix); \ + $(mkinstalldirs) $(prefix)/../images $(prefix)/../images/callouts; \ + $(INSTALL_DATA) calloutgraphics/*.gif $(prefix)/../images/callouts; \ + fi + docs: manpage manual htmldocs Index: INSTALL =================================================================== RCS file: /cvsroot/nscldaq/bufdump/INSTALL,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** INSTALL 31 Dec 2005 19:43:03 -0000 1.2 --- INSTALL 2 Jan 2006 14:10:04 -0000 1.3 *************** *** 117,120 **** --- 117,126 ---- install - Install a source based distribtution of the software. dist - Recreate the distribution tarball. + install-webdocs + - Installs documentation alone in a directory hierachy suitable for + linkage into a larger web. In particular, the manual.pdf + and html documentation are installed in the directory specified + at configuration time, and the callout images are installed + in prefix/../images/callouts Index: CHANGELOG =================================================================== RCS file: /cvsroot/nscldaq/bufdump/CHANGELOG,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** CHANGELOG 31 Dec 2005 18:33:39 -0000 1.1 --- CHANGELOG 2 Jan 2006 14:10:04 -0000 1.2 *************** *** 0 **** --- 1,3 ---- + January 2, 2006 + - Added an install-webdocs target that allows automated updates + of the web documentation. |
|
From: Ron F. <ro...@us...> - 2005-12-31 19:58:17
|
Update of /cvsroot/nscldaq/bufdump In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16896 Modified Files: Makefile.am Log Message: Add/debug dist target for Makefile. Index: Makefile.am =================================================================== RCS file: /cvsroot/nscldaq/bufdump/Makefile.am,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Makefile.am 31 Dec 2005 19:16:33 -0000 1.3 --- Makefile.am 31 Dec 2005 19:58:08 -0000 1.4 *************** *** 24,30 **** --- 24,37 ---- gui.html help.html intro.html overview.html packets.html \ plugins.html search.html + HTMLGRAPHICS=filemenu.gif opencallout.gif filtermenu.gif filtercallouts.gif \ searchcallouts.gif seqmatch.gif helpmenu.gif bufdump.gif open.gif + EPSGRAPHICS=bufdump.eps filemenu.eps filtercallouts.eps helpmenu.eps filtermenu.eps \ + open.eps opencallout.eps searchcallouts.eps seqmatch.eps + + DOCUMENTATION=concepts.xml extending.xml filemenu.xml filtermenu.xml helpmenu.xml \ + manpage.xml manual.xml quickstart.xml refman.xml + WINRUNTIME=./kit-win32-MTall.exe *************** *** 130,131 **** --- 137,144 ---- $(WGET) http://www.equi4.com/pub/sk/sdx.kit + + EXTRA_DIST=$(TCLPACKAGES) $(HELPFILES) $(HTMLGRAPHICS) \ + $(WINRUNTIME) $(LINUXRUNTIME) calloutgraphics \ + packets.def bwidgets iwidgets tcllib bufdump.tcl \ + $(DOCUMENTATION) $(EPSGRAPHICS) + |
|
From: Ron F. <ro...@us...> - 2005-12-31 19:43:10
|
Update of /cvsroot/nscldaq/bufdump In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13356 Modified Files: INSTALL README Log Message: Write the initial documentation files. Index: README =================================================================== RCS file: /cvsroot/nscldaq/bufdump/README,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** README 31 Dec 2005 18:33:39 -0000 1.1 --- README 31 Dec 2005 19:43:03 -0000 1.2 *************** *** 0 **** --- 1,23 ---- + bufdump README - + + This directory contains a distribution of the + bufdump utility. This utility can produce formatted + dumps of data from the NSCL data acquisition system. + + For redistribution information see: + + LICENSE + + For installation instructions see: + + INSTALL + + Note that INSTALL also describes how to get more complete documentation. + The software is known to run on the following platforms: + + linux-x86 + Windows-2000 pro + + It will probably run on MAC OS-X as well, See the INSTALL + document for more information. + Index: INSTALL =================================================================== RCS file: /cvsroot/nscldaq/bufdump/INSTALL,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** INSTALL 31 Dec 2005 18:33:39 -0000 1.1 --- INSTALL 31 Dec 2005 19:43:03 -0000 1.2 *************** *** 0 **** --- 1,120 ---- + Installation documentation for bufdump + ====================================== + 1. Introduction + 2. Building stand-alone-executables for supported platforms. + 3. Building a Tcl source based installation + 4. Other Makefile Targets. + + 1. Introduction + =============== + bufdump is a pure Tcl/Tk utility that can dump buffers from event files or the + online system. The software includes extensive documentation including + + - Online help that can be accessed from the running program. + - A pdf manual + - A man page + + + In addition, stand alon executables can be built for both Windows and + Linux-x86. As a result of this, there are many ways that you can run + the Makefile for this software. + + 2. Building stand-alone-executables for supported platforms. + =========================================================== + + Tcl/Tk Starkit/StarPack technologies allow the production + of an executable that includes both the run-time support for + bufdump (e.g. Tcl/Tk, and requried packages), as well as the application + itself in such a way that running that executable runs the aplication. + If you need to distribute bufdump to many system, some of which may not + have the required execution environment, you should consider building + starpacks. + + To build starpackes you must run on a linux-x86 system and: + + ./configure + make starpacks + + + This should result in two executable files: + + bufdump - A linux-x86 executable for bufdump. + bufdump.exe - A windows executable for bufdump. + + These executables are completely standalone and can be simply copied to the + targe system and run with no further installation procedure. + + As the full runtime is present in the starpack executables, it is not necessary + to install Tcl/Tk. + + I want to acknowledge Steve Landers of Digital Smarties for his work on + starkits and starpacks. I also want to thank equi4.com for redistributing this + software as well as dq software for distributing the augmented runtimes that + are bundled into these starpacks. + + 3. Building a Tcl source based installation + =========================================== + + A Tcl source based installation consists of a directory tree that + contains the bufdump script and the packages that make up this program. + While this type of installation is not stand-alone, you can probably make + it work on just about any target system not supported by starpack distributions + that supports the following pre-requisite packages: + + Tcl, Tk + BWidget + IWidgets + snit + dns + docbook2dvi (for printable manuals) + docbook2html (for web browsable manuals) + dvipdf (to produce a printable manual from the output of docbook2dvi). + xmlto (to produce a man page for the program). + + and their prerequisites (e.g. Iwidgets requires itk). + + Note that dns and snit are both part of tcllib which, on many systems is + distributed as a separate package. + + + To build a Tcl source based installation, choose a target. + For this example, we'll asssume you chose /usr/opt/daqutils/bufdump: + + ./configure --prefix=/usr/opt/daqutils/bufdump + make install + + + This produces the following directory subtree under the target: + + + bin - contains bufdump, run bufdump to run the program. + help - contains bufdump's online help. + doc - contains the printable manual for bufdump. + man - contains the manpage for bufdump (man/man1/bufdump.1). + htmldocs- contains html documentation for bufdump. + images - contains some images required by the html documentation of bufdump. + etc - contains data files (packet definition file e.g.) for bufdump. + + + 4. Other Makefile Targets + ========================== + The following are notable makefile targets: + + docs - Creates: + ./manual.pdf - The manual + ./htmldocs - Directory containing the html version of the manual + ./bufdumpl.1 - A unix manpage for the application. + + clean - Removes all files previous runs of Make created. + starpacks- Creates starpacks for supported platforms. Note that + ./tclkit - tclkit for linux-x86 used to build the starpakcs. + ./kit-linux-x86-MTall.bin - dq software's extended runtime for linux-x86 + ./kit-win32-MTall.exe - dq software's extended runtime for windows. + bufdump.vfs - The bufdump directory tree that is wrapped + into the starpacks (after Make). + sdx-toolchain - Used by the starpacks target to fetch the starkit toolchain + from equi4.com + install - Install a source based distribtution of the software. + dist - Recreate the distribution tarball. + + |
|
From: Ron F. <ro...@us...> - 2005-12-31 19:16:42
|
Update of /cvsroot/nscldaq/bufdump In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6546 Modified Files: Makefile.am bufdump.tcl Log Message: Add latent support for displaying the manual Index: Makefile.am =================================================================== RCS file: /cvsroot/nscldaq/bufdump/Makefile.am,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Makefile.am 31 Dec 2005 18:33:39 -0000 1.2 --- Makefile.am 31 Dec 2005 19:16:33 -0000 1.3 *************** *** 88,92 **** htmldocs: $(HTMLDOCBOOK) -o htmldocs manual.xml ! cp *.gif htmldocs clean: --- 88,94 ---- htmldocs: $(HTMLDOCBOOK) -o htmldocs manual.xml ! if [ -d htmldocs ]; then \ ! cp *.gif htmldocs; \ ! fi clean: *************** *** 96,100 **** rm -f *.gz *.kit ! starpacks: sdx-toolchain rm -rf tclkit cp $(SDXRUNTIME) tclkit --- 98,102 ---- rm -f *.gz *.kit ! starpacks: sdx-toolchain htmldocs rm -rf tclkit cp $(SDXRUNTIME) tclkit *************** *** 107,110 **** --- 109,119 ---- mkdir bufdump.vfs/help cp $(HELPFILES) bufdump.vfs/help + if [ -d htmldocs ]; then \ + mkdir -p bufdump.vfs/htmldocs; \ + mkdir -p bufdump.vfs/images/callouts; \ + cp htmldocs/* bufdump.vfs/htmldocs; \ + cp $(HTMLGRAPHICS) bufdump.vfs/htmldocs; \ + cp calloutgraphics/*.gif bufdump.vfs/images/callouts; \ + fi tar czf - bwidgets iwidgets tcllib | (cd bufdump.vfs/lib; tar xzf -) ./tclkit sdx.kit wrap bufdump.kit -runtime $(WINRUNTIME) Index: bufdump.tcl =================================================================== RCS file: /cvsroot/nscldaq/bufdump/bufdump.tcl,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** bufdump.tcl 31 Dec 2005 18:33:39 -0000 1.3 --- bufdump.tcl 31 Dec 2005 19:16:33 -0000 1.4 *************** *** 94,105 **** # packet files are in $starkit::topdir/etc # and helpfiles $starkit::topdir/help ! # Otherwise they are ../etc ./help if {[info exists starkit::topdir]} { set packetDefinitionFile [file join $starkit::topdir etc packets.def] set helpDirectory [file join $starkit::topdir help] } else { set packetDefinitionFile [file join $here .. etc packets.def] ! set helpDirectory [file join $here .. help] } --- 94,109 ---- # packet files are in $starkit::topdir/etc # and helpfiles $starkit::topdir/help ! # and html manual in $starkit::topdir/htmldocs ! # Otherwise they are ../etc ../help ../htmldocs ! # if {[info exists starkit::topdir]} { set packetDefinitionFile [file join $starkit::topdir etc packets.def] set helpDirectory [file join $starkit::topdir help] + set manualDirectory [file join $starkit::topdir htmldocs] } else { set packetDefinitionFile [file join $here .. etc packets.def] ! set helpDirectory [file join $here .. help] ! set manualDirectory [file join $here ../ htmldocs] } *************** *** 147,150 **** --- 151,168 ---- .topics showtopic intro } + #------------------------------------------------------------------------ + # showManual + # Shows the documentation using a scrolled html widget in a top level. + # + proc showManual {} { + global manualDirectory + if {![winfo exists .manual]} { + set topFile [file join $manualDirectory index.html] + toplevel .manual + ::iwidgets::scrolledhtml .manual.browser + pack .manual.browser -fill both -expand 1 + .manual.browser import $topFile + } + } #------------------------------------------------------------------------- # listToMasks patterns *************** *** 756,759 **** --- 774,779 ---- proc GUISetup {} { global radix + global manualDirectory + set radix hex *************** *** 800,803 **** --- 820,834 ---- -accelerator {F1} + # We can only give a manual menu entry if there's a manualDirectory. + + # Unfortunately, the scrolledhtml widget is not up to the job of + # rendering docbook html output so we shelve this for now. + + if {0} { + if {[file readable [file join $manualDirectory index.html]]} { + .menu.help add command -label {Manual} -command showManual + } + } + .menu add cascade -label {File} -menu .menu.file .menu add cascade -label {Filter} -menu .menu.filter |
|
From: Ron F. <ro...@us...> - 2005-12-31 18:36:55
|
Update of /cvsroot/nscldaq/bufdump In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27401 Removed Files: filplugin.html Log Message: This was just a mis-spelled fileplugin.html --- filplugin.html DELETED --- |
|
From: Ron F. <ro...@us...> - 2005-12-31 18:35:58
|
Update of /cvsroot/nscldaq/bufdump In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27144 Added Files: kit-linux-x86-MTall.bin kit-win32-MTall.exe Log Message: Add the kits as binaries. --- NEW FILE: kit-win32-MTall.exe --- (This appears to be a binary file; contents omitted.) --- NEW FILE: kit-linux-x86-MTall.bin --- (This appears to be a binary file; contents omitted.) |
|
From: Ron F. <ro...@us...> - 2005-12-31 18:35:03
|
Update of /cvsroot/nscldaq/bufdump In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26898 Removed Files: kit-linux-x86-MTall.bin kit-win32-MTall.exe Log Message: Get these added back with -kb. --- kit-win32-MTall.exe DELETED --- --- kit-linux-x86-MTall.bin DELETED --- |
|
From: Ron F. <ro...@us...> - 2005-12-31 18:33:48
|
Update of /cvsroot/nscldaq/bufdump In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26591 Modified Files: Makefile.am bufdump.kpf bufdump.tcl Added Files: CHANGELOG INSTALL LICENSE README Log Message: 1. Add callout graphics from docbook (open source). 2. Get the INSTALL Target to workl 3. Make bufdump.tcl capable of running if tclsh is in the path and it is just set to executable (for install target). 4. Add templates for CHANGELOG, INSTALL, LICENSE, README (Still need to write all but LICENSE. Index: bufdump.tcl =================================================================== RCS file: /cvsroot/nscldaq/bufdump/bufdump.tcl,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** bufdump.tcl 29 Dec 2005 22:17:56 -0000 1.2 --- bufdump.tcl 31 Dec 2005 18:33:39 -0000 1.3 *************** *** 1,889 **** ! # ! # This software is Copyright by the Board of Trustees of Michigan ! # State University (c) Copyright 2005. ! # ! # You may use this software under the terms of the GNU public license ! # (GPL). The terms of this license are described at: ! # ! # http://www.gnu.org/licenses/gpl.txt ! # ! # Author: [...1763 lines suppressed...] ! .fdumper registerPlugin $id $script ! } ! ! ! GUISetup ! ! # Read the system wide packet descriptions ! ! ! if {[catch {open $packetDefinitionFile r} fd] == 0} { ! readPacketFile $fd ! close $fd ! } ! nsclBuffer filter ! foreach type $knownBufferTypes { ! set id [lindex $type 0] ! set text [lindex $type 1] ! filter addTypeName $id $text ! } ! --- NEW FILE: LICENSE --- This software is Copyright by the Board of Trustees of Michigan State University (c) Copyright 2005. You may use this software under the terms of the GNU public license Full text of license is below GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS ' --- NEW FILE: CHANGELOG --- Index: Makefile.am =================================================================== RCS file: /cvsroot/nscldaq/bufdump/Makefile.am,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Makefile.am 29 Dec 2005 22:17:56 -0000 1.1 --- Makefile.am 31 Dec 2005 18:33:39 -0000 1.2 *************** *** 1,2 **** --- 1,18 ---- + # This software is Copyright by the Board of Trustees of Michigan + # State University (c) Copyright 2005. + # + # You may use this software under the terms of the GNU public license + # (GPL). The terms of this license are described at: + # + # http://www.gnu.org/licenses/gpl.txt + # + # Author: + # Ron Fox + # NSCL + # Michigan State University + # East Lansing, MI 48824-1321 + + + TCLPACKAGES=bufdumpDialogs.tcl bufdumpWidgets.tcl bufferAssembly.tcl \ dataSources.tcl eventData.tcl pkgIndex.tcl *************** *** 8,15 **** --- 24,81 ---- gui.html help.html intro.html overview.html packets.html \ plugins.html search.html + HTMLGRAPHICS=filemenu.gif opencallout.gif filtermenu.gif filtercallouts.gif \ + searchcallouts.gif seqmatch.gif helpmenu.gif bufdump.gif open.gif + WINRUNTIME=./kit-win32-MTall.exe LINUXRUNTIME=./kit-linux-x86-MTall.bin + all: docs starpacks + + # + # Heres's where we do the installation. + # $(prefix) is our installation top level dir. + # Underneath we build the following tree: + # lib - Where the packages we depend on are + # installed. + # help - Where the online help files are installed. + # doc - Where the printed manual is installed. + # man/man1- Where the manpage is installed. + # htmldocs- Where the web documentation is installed. + # images - Where the htmldocs expect the callout images installed. + # etc - Where the packet definition file is. + # bin - where the script is installed. + # + # Note that if docbook is not installed in all it's + # glory we will not be able to generate the documentation + # and that's just life. + # + install-exec-am: docs + $(mkinstalldirs) $(prefix)/lib + $(mkinstalldirs) $(prefix)/help + $(mkinstalldirs) $(prefix)/doc + $(mkinstalldirs) $(prefix)/man $(prefix)/man/man1 + $(mkinstalldirs) $(prefix)/htmldocs + $(mkinstalldirs) $(prefix)/images $(prefix)/images/callouts + $(mkinstalldirs) $(prefix)/etc + $(mkinstalldirs) $(prefix)/bin + $(INSTALL_PROGRAM) bufdump.tcl $(prefix)/bin/bufdump + $(INSTALL_DATA) $(TCLPACKAGES) $(prefix)/lib + $(INSTALL_DATA) $(HELPFILES) $(prefix)/help + $(INSTALL_DATA) packets.def $(prefix)/etc + if [ -e bufdump.1 ]; then \ + $(INSTALL_DATA) bufdump.1 $(prefix)/man/man1; \ + fi + if [ -e manual.pdf ]; then \ + $(INSTALL_DATA) manual.pdf $(prefix)/doc; \ + fi + if [ -d htmldocs ]; then \ + $(INSTALL_DATA) htmldocs/* $(prefix)/htmldocs; \ + $(INSTALL_DATA) $(HTMLGRAPHICS) $(prefix)/htmldocs; \ + $(INSTALL_DATA) calloutgraphics/*.gif $(prefix)/images/callouts; \ + fi + + + docs: manpage manual htmldocs --- NEW FILE: INSTALL --- --- NEW FILE: README --- Index: bufdump.kpf =================================================================== RCS file: /cvsroot/nscldaq/bufdump/bufdump.kpf,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** bufdump.kpf 29 Dec 2005 19:04:29 -0000 1.1.1.1 --- bufdump.kpf 31 Dec 2005 18:33:39 -0000 1.2 *************** *** 15,24 **** <preference-set id="default"> <string id="postparams"></string> ! <string id="tclInterpreterType">tclsh</string> ! <boolean id="show-dialog">1</boolean> ! <boolean id="use-console">0</boolean> <string id="getparams"></string> <string id="mpostparams"></string> ! <string id="filename">H:\Wincluster\DAQDocs\2005a\daq\bufdump\testrunner.tcl</string> <string id="request-method">GET</string> <string id="params"></string> --- 15,24 ---- <preference-set id="default"> <string id="postparams"></string> ! <string id="userEnvironment"></string> <string id="getparams"></string> + <boolean id="use-console">0</boolean> + <string id="tclInterpreterType">tclsh</string> <string id="mpostparams"></string> ! <boolean id="show-dialog">1</boolean> <string id="request-method">GET</string> <string id="params"></string> *************** *** 27,31 **** <string id="documentRoot"></string> <string id="cookieparams"></string> ! <string id="userEnvironment"></string> <boolean id="sim-cgi">0</boolean> <string id="cwd">H:\Wincluster\DAQDocs\2005a\daq\bufdump</string> --- 27,31 ---- <string id="documentRoot"></string> <string id="cookieparams"></string> ! <string id="filename">H:\Wincluster\DAQDocs\2005a\daq\bufdump\testrunner.tcl</string> <boolean id="sim-cgi">0</boolean> <string id="cwd">H:\Wincluster\DAQDocs\2005a\daq\bufdump</string> *************** *** 79,86 **** <preference-set id="default"> <string id="postparams"></string> - <string id="userEnvironment"></string> - <string id="getparams"></string> - <boolean id="use-console">0</boolean> <string id="tclInterpreterType">wish</string> <string id="mpostparams"></string> <boolean id="show-dialog">1</boolean> --- 79,86 ---- <preference-set id="default"> <string id="postparams"></string> <string id="tclInterpreterType">wish</string> + <boolean id="use-console">0</boolean> + <string id="getparams"></string> + <string id="filename">H:\Wincluster\DAQDocs\2005a\daq\bufdump\bufdumpWidgets.tcl</string> <string id="mpostparams"></string> <boolean id="show-dialog">1</boolean> *************** *** 91,95 **** <string id="documentRoot"></string> <string id="cookieparams"></string> ! <string id="filename">H:\Wincluster\DAQDocs\2005a\daq\bufdump\bufdumpWidgets.tcl</string> <boolean id="sim-cgi">0</boolean> <string id="cwd"></string> --- 91,95 ---- <string id="documentRoot"></string> <string id="cookieparams"></string> ! <string id="userEnvironment"></string> <boolean id="sim-cgi">0</boolean> <string id="cwd"></string> *************** *** 139,144 **** <file url="fileopen.html" id="2149676D-D87F-409A-A016-DF879E556A50" name="fileopen.html"> </file> - <file url="filplugin.html" id="5539DC2E-AE36-4C46-BEF8-C618842B6217" name="filplugin.html"> - </file> <file url="filter.html" id="6442E5A9-2D0A-40EA-86AF-610E0AFC139E" name="filter.html"> </file> --- 139,142 ---- *************** *** 153,160 **** <file url="fileexit.html" id="51AA532A-3482-4EF4-87BC-9125D084DE14" name="fileexit.html"> </file> - <file url="fitlerfilter.html" id="FC4CDA25-3700-415A-9F22-B12677C539AC" name="fitlerfilter.html"> - </file> <file url="filtersearchnext.html" id="702FE214-B811-46C3-AA11-E2456C69EABB" name="filtersearchnext.html"> </file> </folder> <folder id="85B87FE8-5463-4988-8460-7279288A6DE2" name="printedDocs"> --- 151,160 ---- <file url="fileexit.html" id="51AA532A-3482-4EF4-87BC-9125D084DE14" name="fileexit.html"> </file> <file url="filtersearchnext.html" id="702FE214-B811-46C3-AA11-E2456C69EABB" name="filtersearchnext.html"> </file> + <file url="fileplugin.html" id="7B4D4868-C7C3-4441-AB09-704E6D5541C5" name="fileplugin.html"> + </file> + <file url="filterfilter.html" id="47FBBD8B-1A2F-4715-BC3B-30364B3F4CEB" name="filterfilter.html"> + </file> </folder> <folder id="85B87FE8-5463-4988-8460-7279288A6DE2" name="printedDocs"> *************** *** 192,201 **** <preference-set id="default"> <string id="postparams"></string> ! <string id="tclInterpreterType">tclsh</string> ! <boolean id="use-console">0</boolean> <string id="getparams"></string> ! <string id="filename">H:\Wincluster\DAQDocs\2005a\daq\bufdump\bufdump.tcl</string> <string id="mpostparams"></string> ! <boolean id="show-dialog">1</boolean> <string id="request-method">GET</string> <string id="params"></string> --- 192,201 ---- <preference-set id="default"> <string id="postparams"></string> ! <string id="userEnvironment"></string> <string id="getparams"></string> ! <boolean id="use-console">0</boolean> ! <string id="tclInterpreterType">tclsh</string> <string id="mpostparams"></string> ! <string id="filename">H:\Wincluster\DAQDocs\2005a\daq\bufdump\bufdump.tcl</string> <string id="request-method">GET</string> <string id="params"></string> *************** *** 204,208 **** <string id="documentRoot"></string> <string id="cookieparams"></string> ! <string id="userEnvironment"></string> <boolean id="sim-cgi">0</boolean> <string id="cwd">H:\Wincluster\DAQDocs\2005a\daq\bufdump</string> --- 204,208 ---- <string id="documentRoot"></string> <string id="cookieparams"></string> ! <boolean id="show-dialog">1</boolean> <boolean id="sim-cgi">0</boolean> <string id="cwd">H:\Wincluster\DAQDocs\2005a\daq\bufdump</string> |
|
From: Ron F. <ro...@us...> - 2005-12-31 18:33:47
|
Update of /cvsroot/nscldaq/bufdump/calloutgraphics In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26591/calloutgraphics Added Files: 1.gif 10.gif 11.gif 12.gif 13.gif 14.gif 15.gif 2.gif 3.gif 4.gif 5.gif 6.gif 7.gif 8.gif 9.gif Log Message: 1. Add callout graphics from docbook (open source). 2. Get the INSTALL Target to workl 3. Make bufdump.tcl capable of running if tclsh is in the path and it is just set to executable (for install target). 4. Add templates for CHANGELOG, INSTALL, LICENSE, README (Still need to write all but LICENSE. --- NEW FILE: 8.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 6.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 14.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 1.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 11.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 13.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 4.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 3.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 2.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 9.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 7.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 12.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 5.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 10.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 15.gif --- (This appears to be a binary file; contents omitted.) |
|
From: Ron F. <ro...@us...> - 2005-12-31 17:49:17
|
Update of /cvsroot/nscldaq/bufdump/calloutgraphics In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4315/calloutgraphics Log Message: Directory /cvsroot/nscldaq/bufdump/calloutgraphics added to the repository |
|
From: Ron F. <ro...@us...> - 2005-12-31 15:04:01
|
Update of /cvsroot/nscldaq/clients/VMEApi In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25317 Modified Files: WIENERUSBAPI.cpp Log Message: Set debugging off by default...forgot that. Index: WIENERUSBAPI.cpp =================================================================== RCS file: /cvsroot/nscldaq/clients/VMEApi/WIENERUSBAPI.cpp,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** WIENERUSBAPI.cpp 30 Dec 2005 18:07:33 -0000 1.6 --- WIENERUSBAPI.cpp 31 Dec 2005 15:03:52 -0000 1.7 *************** *** 190,194 **** // or call WienerUSBVMEInterface::setDebug prior to the first // open call. ! static unsigned debug_level(1); --- 190,194 ---- // or call WienerUSBVMEInterface::setDebug prior to the first // open call. ! static unsigned debug_level(0); |
|
From: Ron F. <ro...@us...> - 2005-12-30 19:19:11
|
Update of /cvsroot/nscldaq/clients/Readout In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22833/Readout Modified Files: Active.cpp Reader.cpp ReadoutMain.cpp Log Message: Modify the locking so that this should work with a VM-USB interface which requires the lock to be held during all VME accesses. Index: ReadoutMain.cpp =================================================================== RCS file: /cvsroot/nscldaq/clients/Readout/ReadoutMain.cpp,v retrieving revision 8.2 retrieving revision 8.3 diff -C2 -d -r8.2 -r8.3 *** ReadoutMain.cpp 24 Jun 2005 11:32:03 -0000 8.2 --- ReadoutMain.cpp 30 Dec 2005 19:19:03 -0000 8.3 *************** *** 1,280 **** /* ! GNU GENERAL PUBLIC LICENSE ! Version 2, June 1991 ! ! Copyright (C) 1989, 1991 Free Software Foundation, Inc. ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ! Everyone is permitted to copy and distribute verbatim copies ! of this license document, but changing it is not allowed. ! ! Preamble ! ! The licenses for most software are designed to take away your ! freedom to share and change it. By contrast, the GNU General Public ! License is intended to guarantee your freedom to share and change free ! software--to make sure the software is free for all its users. This ! General Public License applies to most of the Free Software ! Foundation's software and to any other program whose authors commit to ! using it. (Some other Free Software Foundation software is covered by ! the GNU Library General Public License instead.) You can apply it to ! your programs, too. ! ! When we speak of free software, we are referring to freedom, not ! price. Our General Public Licenses are designed to make sure that you ! have the freedom to distribute copies of free software (and charge for ! this service if you wish), that you receive source code or can get it ! if you want it, that you can change the software or use pieces of it ! in new free programs; and that you know you can do these things. ! ! To protect your rights, we need to make restrictions that forbid ! anyone to deny you these rights or to ask you to surrender the rights. ! These restrictions translate to certain responsibilities for you if you ! distribute copies of the software, or if you modify it. ! ! For example, if you distribute copies of such a program, whether ! gratis or for a fee, you must give the recipients all the rights that ! you have. You must make sure that they, too, receive or can get the ! source code. And you must show them these terms so they know their ! rights. ! ! We protect your rights with two steps: (1) copyright the software, and ! (2) offer you this license which gives you legal permission to copy, ! distribute and/or modify the software. ! ! Also, for each author's protection and ours, we want to make certain ! that everyone understands that there is no warranty for this free ! software. If the software is modified by someone else and passed on, we ! want its recipients to know that what they have is not the original, so ! that any problems introduced by others will not reflect on the original ! authors' reputations. ! ! Finally, any free program is threatened constantly by software ! patents. We wish to avoid the danger that redistributors of a free ! program will individually obtain patent licenses, in effect making the ! program proprietary. To prevent this, we have made it clear that any ! patent must be licensed for everyone's free use or not licensed at all. ! ! The precise terms and conditions for copying, distribution and ! modification follow. ! ! GNU GENERAL PUBLIC LICENSE ! TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION ! ! 0. This License applies to any program or other work which contains ! a notice placed by the copyright holder saying it may be distributed ! under the terms of this General Public License. The "Program", below, ! refers to any such program or work, and a "work based on the Program" ! means either the Program or any derivative work under copyright law: ! that is to say, a work containing the Program or a portion of it, ! either verbatim or with modifications and/or translated into another ! language. (Hereinafter, translation is included without limitation in ! the term "modification".) Each licensee is addressed as "you". ! ! Activities other than copying, distribution and modification are not ! covered by this License; they are outside its scope. The act of ! running the Program is not restricted, and the output from the Program ! is covered only if its contents constitute a work based on the ! Program (independent of having been made by running the Program). ! Whether that is true depends on what the Program does. ! ! 1. You may copy and distribute verbatim copies of the Program's ! source code as you receive it, in any medium, provided that you ! conspicuously and appropriately publish on each copy an appropriate ! copyright notice and disclaimer of warranty; keep intact all the ! notices that refer to this License and to the absence of any warranty; ! and give any other recipients of the Program a copy of this License ! along with the Program. ! ! You may charge a fee for the physical act of transferring a copy, and ! you may at your option offer warranty protection in exchange for a fee. ! ! 2. You may modify your copy or copies of the Program or any portion ! of it, thus forming a work based on the Program, and copy and ! distribute such modifications or work under the terms of Section 1 ! above, provided that you also meet all of these conditions: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! b) You must cause any work that you distribute or publish, that in ! whole or in part contains or is derived from the Program or any ! part thereof, to be licensed as a whole at no charge to all third ! parties under the terms of this License. ! ! c) If the modified program normally reads commands interactively ! when run, you must cause it, when started running for such ! interactive use in the most ordinary way, to print or display an ! announcement including an appropriate copyright notice and a ! notice that there is no warranty (or else, saying that you provide ! a warranty) and that users may redistribute the program under ! these conditions, and telling the user how to view a copy of this ! License. (Exception: if the Program itself is interactive but ! does not normally print such an announcement, your work based on ! the Program is not required to print an announcement.) ! ! These requirements apply to the modified work as a whole. If ! identifiable sections of that work are not derived from the Program, ! and can be reasonably considered independent and separate works in ! themselves, then this License, and its terms, do not apply to those ! sections when you distribute them as separate works. But when you ! distribute the same sections as part of a whole which is a work based ! on the Program, the distribution of the whole must be on the terms of ! this License, whose permissions for other licensees extend to the ! entire whole, and thus to each and every part regardless of who wrote it. ! ! Thus, it is not the intent of this section to claim rights or contest ! your rights to work written entirely by you; rather, the intent is to ! exercise the right to control the distribution of derivative or ! collective works based on the Program. ! ! In addition, mere aggregation of another work not based on the Program ! with the Program (or with a work based on the Program) on a volume of ! a storage or distribution medium does not bring the other work under ! the scope of this License. ! ! 3. You may copy and distribute the Program (or a work based on it, ! under Section 2) in object code or executable form under the terms of ! Sections 1 and 2 above provided that you also do one of the following: ! ! a) Accompany it with the complete corresponding machine-readable ! source code, which must be distributed under the terms of Sections ! 1 and 2 above on a medium customarily used for software interchange; or, ! ! b) Accompany it with a written offer, valid for at least three ! years, to give any third party, for a charge no more than your ! cost of physically performing source distribution, a complete ! machine-readable copy of the corresponding source code, to be ! distributed under the terms of Sections 1 and 2 above on a medium ! customarily used for software interchange; or, ! ! c) Accompany it with the information you received as to the offer ! to distribute corresponding source code. (This alternative is ! allowed only for noncommercial distribution and only if you ! received the program in object code or executable form with such ! an offer, in accord with Subsection b above.) ! ! The source code for a work means the preferred form of the work for ! making modifications to it. For an executable work, complete source ! code means all the source code for all modules it contains, plus any ! associated interface definition files, plus the scripts used to ! control compilation and installation of the executable. However, as a ! special exception, the source code distributed need not include ! anything that is normally distributed (in either source or binary ! form) with the major components (compiler, kernel, and so on) of the ! operating system on which the executable runs, unless that component ! itself accompanies the executable. ! ! If distribution of executable or object code is made by offering ! access to copy from a designated place, then offering equivalent ! access to copy the source code from the same place counts as ! distribution of the source code, even though third parties are not ! compelled to copy the source along with the object code. ! ! 4. You may not copy, modify, sublicense, or distribute the Program ! except as expressly provided under this License. Any attempt ! otherwise to copy, modify, sublicense or distribute the Program is ! void, and will automatically terminate your rights under this License. ! However, parties who have received copies, or rights, from you under ! this License will not have their licenses terminated so long as such ! parties remain in full compliance. ! ! 5. You are not required to accept this License, since you have not ! signed it. However, nothing else grants you permission to modify or ! distribute the Program or its derivative works. These actions are ! prohibited by law if you do not accept this License. Therefore, by ! modifying or distributing the Program (or any work based on the ! Program), you indicate your acceptance of this License to do so, and ! all its terms and conditions for copying, distributing or modifying ! the Program or works based on it. ! ! 6. Each time you redistribute the Program (or any work based on the ! Program), the recipient automatically receives a license from the ! original licensor to copy, distribute or modify the Program subject to ! these terms and conditions. You may not impose any further ! restrictions on the recipients' exercise of the rights granted herein. ! You are not responsible for enforcing compliance by third parties to ! this License. ! ! 7. If, as a consequence of a court judgment or allegation of patent ! infringement or for any other reason (not limited to patent issues), ! conditions are imposed on you (whether by court order, agreement or ! otherwise) that contradict the conditions of this License, they do not ! excuse you from the conditions of this License. If you cannot ! distribute so as to satisfy simultaneously your obligations under this ! License and any other pertinent obligations, then as a consequence you ! may not distribute the Program at all. For example, if a patent ! license would not permit royalty-free redistribution of the Program by ! all those who receive copies directly or indirectly through you, then ! the only way you could satisfy both it and this License would be to ! refrain entirely from distribution of the Program. ! ! If any portion of this section is held invalid or unenforceable under ! any particular circumstance, the balance of the section is intended to ! apply and the section as a whole is intended to apply in other ! circumstances. ! ! It is not the purpose of this section to induce you to infringe any ! patents or other property right claims or to contest validity of any ! such claims; this section has the sole purpose of protecting the ! integrity of the free software distribution system, which is ! implemented by public license practices. Many people have made ! generous contributions to the wide range of software distributed ! through that system in reliance on consistent application of that ! system; it is up to the author/donor to decide if he or she is willing ! to distribute software through any other system and a licensee cannot ! impose that choice. ! ! This section is intended to make thoroughly clear what is believed to ! be a consequence of the rest of this License. ! ! 8. If the distribution and/or use of the Program is restricted in ! certain countries either by patents or by copyrighted interfaces, the ! original copyright holder who places the Program under this License ! may add an explicit geographical distribution limitation excluding ! those countries, so that distribution is permitted only in or among ! countries not thus excluded. In such case, this License incorporates ! the limitation as if written in the body of this License. ! ! 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. ! ! Each version is given a distinguishing version number. If the Program ! specifies a version number of this License which applies to it and "any ! later version", you have the option of following the terms and conditions ! either of that version or of any later version published by the Free Software ! Foundation. If the Program does not specify a version number of this License, ! you may choose any version ever published by the Free Software Foundation. ! ! 10. If you wish to incorporate parts of the Program into other free ! programs whose distribution conditions are different, write to the author to ! ask for permission. For software which is copyrighted by the Free Software ! Foundation, write to the Free Software Foundation; we sometimes make ! exceptions for this. Our decision will be guided by the two goals of ! preserving the free status of all derivatives of our free software and of ! promoting the sharing and reuse of software generally. ! ! NO WARRANTY ! 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR ! THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN ! OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE ! THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND ! FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND ! PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, ! YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. ! 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING ! WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR ! REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, ! INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING ! OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO ! LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR ! THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), ! EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH ! DAMAGES. ! END OF TERMS AND CONDITIONS ' */ // ReadoutMain.cpp: // This file is the version 0.1 readout control main program. --- 1,19 ---- /* ! This software is Copyright by the Board of Trustees of Michigan ! State University (c) Copyright 2005. ! You may use this software under the terms of the GNU public license ! (GPL). The terms of this license are described at: ! http://www.gnu.org/licenses/gpl.txt ! Author: ! Ron Fox ! NSCL ! Michigan State University ! East Lansing, MI 48824-1321 */ + // ReadoutMain.cpp: // This file is the version 0.1 readout control main program. Index: Reader.cpp =================================================================== RCS file: /cvsroot/nscldaq/clients/Readout/Reader.cpp,v retrieving revision 8.2 retrieving revision 8.3 diff -C2 -d -r8.2 -r8.3 *** Reader.cpp 24 Jun 2005 11:32:03 -0000 8.2 --- Reader.cpp 30 Dec 2005 19:19:03 -0000 8.3 *************** *** 1,279 **** /* ! GNU GENERAL PUBLIC LICENSE ! Version 2, June 1991 ! ! Copyright (C) 1989, 1991 Free Software Foundation, Inc. ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ! Everyone is permitted to copy and distribute verbatim copies ! of this license document, but changing it is not allowed. ! ! Preamble ! ! The licenses for most software are designed to take away your ! freedom to share and change it. By contrast, the GNU General Public ! License is intended to guarantee your freedom to share and change free ! software--to make sure the software is free for all its users. This ! General Public License applies to most of the Free Software ! Foundation's software and to any other program whose authors commit to ! using it. (Some other Free Software Foundation software is covered by ! the GNU Library General Public License instead.) You can apply it to ! your programs, too. ! ! When we speak of free software, we are referring to freedom, not ! price. Our General Public Licenses are designed to make sure that you ! have the freedom to distribute copies of free software (and charge for ! this service if you wish), that you receive source code or can get it ! if you want it, that you can change the software or use pieces of it ! in new free programs; and that you know you can do these things. ! ! To protect your rights, we need to make restrictions that forbid ! anyone to deny you these rights or to ask you to surrender the rights. ! These restrictions translate to certain responsibilities for you if you ! distribute copies of the software, or if you modify it. ! ! For example, if you distribute copies of such a program, whether ! gratis or for a fee, you must give the recipients all the rights that ! you have. You must make sure that they, too, receive or can get the ! source code. And you must show them these terms so they know their ! rights. ! ! We protect your rights with two steps: (1) copyright the software, and ! (2) offer you this license which gives you legal permission to copy, ! distribute and/or modify the software. ! ! Also, for each author's protection and ours, we want to make certain ! that everyone understands that there is no warranty for this free ! software. If the software is modified by someone else and passed on, we ! want its recipients to know that what they have is not the original, so ! that any problems introduced by others will not reflect on the original ! authors' reputations. ! ! Finally, any free program is threatened constantly by software ! patents. We wish to avoid the danger that redistributors of a free ! program will individually obtain patent licenses, in effect making the ! program proprietary. To prevent this, we have made it clear that any ! patent must be licensed for everyone's free use or not licensed at all. ! ! The precise terms and conditions for copying, distribution and ! modification follow. ! ! GNU GENERAL PUBLIC LICENSE ! TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION ! ! 0. This License applies to any program or other work which contains ! a notice placed by the copyright holder saying it may be distributed ! under the terms of this General Public License. The "Program", below, ! refers to any such program or work, and a "work based on the Program" ! means either the Program or any derivative work under copyright law: ! that is to say, a work containing the Program or a portion of it, ! either verbatim or with modifications and/or translated into another ! language. (Hereinafter, translation is included without limitation in ! the term "modification".) Each licensee is addressed as "you". ! ! Activities other than copying, distribution and modification are not ! covered by this License; they are outside its scope. The act of ! running the Program is not restricted, and the output from the Program ! is covered only if its contents constitute a work based on the ! Program (independent of having been made by running the Program). ! Whether that is true depends on what the Program does. ! ! 1. You may copy and distribute verbatim copies of the Program's ! source code as you receive it, in any medium, provided that you ! conspicuously and appropriately publish on each copy an appropriate ! copyright notice and disclaimer of warranty; keep intact all the ! notices that refer to this License and to the absence of any warranty; ! and give any other recipients of the Program a copy of this License ! along with the Program. ! ! You may charge a fee for the physical act of transferring a copy, and ! you may at your option offer warranty protection in exchange for a fee. ! ! 2. You may modify your copy or copies of the Program or any portion ! of it, thus forming a work based on the Program, and copy and ! distribute such modifications or work under the terms of Section 1 ! above, provided that you also meet all of these conditions: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! b) You must cause any work that you distribute or publish, that in ! whole or in part contains or is derived from the Program or any ! part thereof, to be licensed as a whole at no charge to all third ! parties under the terms of this License. ! ! c) If the modified program normally reads commands interactively ! when run, you must cause it, when started running for such ! interactive use in the most ordinary way, to print or display an ! announcement including an appropriate copyright notice and a ! notice that there is no warranty (or else, saying that you provide ! a warranty) and that users may redistribute the program under ! these conditions, and telling the user how to view a copy of this ! License. (Exception: if the Program itself is interactive but ! does not normally print such an announcement, your work based on ! the Program is not required to print an announcement.) ! ! These requirements apply to the modified work as a whole. If ! identifiable sections of that work are not derived from the Program, ! and can be reasonably considered independent and separate works in ! themselves, then this License, and its terms, do not apply to those ! sections when you distribute them as separate works. But when you ! distribute the same sections as part of a whole which is a work based ! on the Program, the distribution of the whole must be on the terms of ! this License, whose permissions for other licensees extend to the ! entire whole, and thus to each and every part regardless of who wrote it. ! ! Thus, it is not the intent of this section to claim rights or contest ! your rights to work written entirely by you; rather, the intent is to ! exercise the right to control the distribution of derivative or ! collective works based on the Program. ! ! In addition, mere aggregation of another work not based on the Program ! with the Program (or with a work based on the Program) on a volume of ! a storage or distribution medium does not bring the other work under ! the scope of this License. ! ! 3. You may copy and distribute the Program (or a work based on it, ! under Section 2) in object code or executable form under the terms of ! Sections 1 and 2 above provided that you also do one of the following: ! ! a) Accompany it with the complete corresponding machine-readable ! source code, which must be distributed under the terms of Sections ! 1 and 2 above on a medium customarily used for software interchange; or, ! ! b) Accompany it with a written offer, valid for at least three ! years, to give any third party, for a charge no more than your ! cost of physically performing source distribution, a complete ! machine-readable copy of the corresponding source code, to be ! distributed under the terms of Sections 1 and 2 above on a medium ! customarily used for software interchange; or, ! ! c) Accompany it with the information you received as to the offer ! to distribute corresponding source code. (This alternative is ! allowed only for noncommercial distribution and only if you ! received the program in object code or executable form with such ! an offer, in accord with Subsection b above.) ! ! The source code for a work means the preferred form of the work for ! making modifications to it. For an executable work, complete source ! code means all the source code for all modules it contains, plus any ! associated interface definition files, plus the scripts used to ! control compilation and installation of the executable. However, as a ! special exception, the source code distributed need not include ! anything that is normally distributed (in either source or binary ! form) with the major components (compiler, kernel, and so on) of the ! operating system on which the executable runs, unless that component ! itself accompanies the executable. ! ! If distribution of executable or object code is made by offering ! access to copy from a designated place, then offering equivalent ! access to copy the source code from the same place counts as ! distribution of the source code, even though third parties are not ! compelled to copy the source along with the object code. ! ! 4. You may not copy, modify, sublicense, or distribute the Program ! except as expressly provided under this License. Any attempt ! otherwise to copy, modify, sublicense or distribute the Program is ! void, and will automatically terminate your rights under this License. ! However, parties who have received copies, or rights, from you under ! this License will not have their licenses terminated so long as such ! parties remain in full compliance. ! ! 5. You are not required to accept this License, since you have not ! signed it. However, nothing else grants you permission to modify or ! distribute the Program or its derivative works. These actions are ! prohibited by law if you do not accept this License. Therefore, by ! modifying or distributing the Program (or any work based on the ! Program), you indicate your acceptance of this License to do so, and ! all its terms and conditions for copying, distributing or modifying ! the Program or works based on it. ! ! 6. Each time you redistribute the Program (or any work based on the ! Program), the recipient automatically receives a license from the ! original licensor to copy, distribute or modify the Program subject to ! these terms and conditions. You may not impose any further ! restrictions on the recipients' exercise of the rights granted herein. ! You are not responsible for enforcing compliance by third parties to ! this License. ! ! 7. If, as a consequence of a court judgment or allegation of patent ! infringement or for any other reason (not limited to patent issues), ! conditions are imposed on you (whether by court order, agreement or ! otherwise) that contradict the conditions of this License, they do not ! excuse you from the conditions of this License. If you cannot ! distribute so as to satisfy simultaneously your obligations under this ! License and any other pertinent obligations, then as a consequence you ! may not distribute the Program at all. For example, if a patent ! license would not permit royalty-free redistribution of the Program by ! all those who receive copies directly or indirectly through you, then ! the only way you could satisfy both it and this License would be to ! refrain entirely from distribution of the Program. ! ! If any portion of this section is held invalid or unenforceable under ! any particular circumstance, the balance of the section is intended to ! apply and the section as a whole is intended to apply in other ! circumstances. ! ! It is not the purpose of this section to induce you to infringe any ! patents or other property right claims or to contest validity of any ! such claims; this section has the sole purpose of protecting the ! integrity of the free software distribution system, which is ! implemented by public license practices. Many people have made ! generous contributions to the wide range of software distributed ! through that system in reliance on consistent application of that ! system; it is up to the author/donor to decide if he or she is willing ! to distribute software through any other system and a licensee cannot ! impose that choice. ! ! This section is intended to make thoroughly clear what is believed to ! be a consequence of the rest of this License. ! ! 8. If the distribution and/or use of the Program is restricted in ! certain countries either by patents or by copyrighted interfaces, the ! original copyright holder who places the Program under this License ! may add an explicit geographical distribution limitation excluding ! those countries, so that distribution is permitted only in or among ! countries not thus excluded. In such case, this License incorporates ! the limitation as if written in the body of this License. ! ! 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. ! ! Each version is given a distinguishing version number. If the Program ! specifies a version number of this License which applies to it and "any ! later version", you have the option of following the terms and conditions ! either of that version or of any later version published by the Free Software ! Foundation. If the Program does not specify a version number of this License, ! you may choose any version ever published by the Free Software Foundation. ! ! 10. If you wish to incorporate parts of the Program into other free ! programs whose distribution conditions are different, write to the author to ! ask for permission. For software which is copyrighted by the Free Software ! Foundation, write to the Free Software Foundation; we sometimes make ! exceptions for this. Our decision will be guided by the two goals of ! preserving the free status of all derivatives of our free software and of ! promoting the sharing and reuse of software generally. ! ! NO WARRANTY ! 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR ! THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN ! OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE ! THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND ! FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND ! PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, ! YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. ! 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING ! WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR ! REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, ! INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING ! OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO ! LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR ! THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), ! EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH ! DAMAGES. ! END OF TERMS AND CONDITIONS ' */ static const char* Copyright= "(C) Copyright Michigan State University 2002, All rights reserved";/*! \file Reader.cpp --- 1,18 ---- /* ! This software is Copyright by the Board of Trustees of Michigan ! State University (c) Copyright 2005. ! You may use this software under the terms of the GNU public license ! (GPL). The terms of this license are described at: ! http://www.gnu.org/licenses/gpl.txt ! Author: ! Ron Fox ! NSCL ! Michigan State University ! East Lansing, MI 48824-1321 */ + static const char* Copyright= "(C) Copyright Michigan State University 2002, All rights reserved";/*! \file Reader.cpp *************** *** 335,338 **** --- 74,79 ---- // Initialize the user's code: + CVMEInterface::Lock(); + ::initevt(); ::clearevt(); *************** *** 348,351 **** --- 89,93 ---- m_pBusy->Initialize(); m_pBusy->Clear(); + CVMEInterface::Unlock(); *************** *** 359,364 **** --- 101,109 ---- CReader::Disable() { + CVMEInterface::Lock(); m_pBusy->Set(); // Set computer not accepting. m_pTrigger->Disable(); // Disable further event receipt. + CVMEInterface::Unlock(); + } *************** *** 394,397 **** --- 139,143 ---- } + CVMEInterface::Lock(); try { for (unsigned int i = 0; i < nPasses; i++) { *************** *** 402,408 **** m_BufferPtr++; // Reserve space for event size. - CVMEInterface::Lock(); nEventSize = ::readevt(m_BufferPtr); - CVMEInterface::Unlock(); if(nEventSize > 0) { *hdr = nEventSize + 1; // Fill in the size header. --- 148,152 ---- *************** *** 423,427 **** --- 167,173 ---- if(m_nWords >= m_nBufferSize) { + CVMEInterface::Unlock(); OverFlow(hdr); + CVMEInterface::Lock(); } } // Trigger present. *************** *** 434,437 **** --- 180,184 ---- catch(string& rsMessage) { + CVMEInterface::Unlock(); cerr << __FILE__ << __LINE__ << "A string exception was caught during readout: \n"; *************** *** 442,445 **** --- 189,193 ---- } catch(char* pszMessage) { + CVMEInterface::Unlock(); cerr << __FILE__ << __LINE__ << "A C-string exception was caught during readout:\n"; *************** *** 449,452 **** --- 197,201 ---- } catch(...) { + CVMEInterface::Unlock(); cerr << __FILE__ << __LINE__ << "An exception was caught during readout:\n"; *************** *** 455,458 **** --- 204,209 ---- throw; } + CVMEInterface::Unlock(); + } Index: Active.cpp =================================================================== RCS file: /cvsroot/nscldaq/clients/Readout/Active.cpp,v retrieving revision 8.3 retrieving revision 8.4 diff -C2 -d -r8.3 -r8.4 *** Active.cpp 8 Sep 2005 13:30:50 -0000 8.3 --- Active.cpp 30 Dec 2005 19:19:03 -0000 8.4 *************** *** 1,370 **** /* ! GNU GENERAL PUBLIC LICENSE ! Version 2, June 1991 ! ! Copyright (C) 1989, 1991 Free Software Foundation, Inc. ! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ! Everyone is permitted to copy and distribute verbatim copies ! of this license document, but changing it is not allowed. ! ! Preamble ! ! The licenses for most software are designed to take away your ! freedom to share and change it. By contrast, the GNU General Public ! License is intended to guarantee your freedom to share and change free ! software--to make sure the software is free for all its users. This ! General Public License applies to most of the Free Software ! Foundation's software and to any other program whose authors commit to ! using it. (Some other Free Software Foundation software is covered by ! the GNU Library General Public License instead.) You can apply it to ! your programs, too. ! ! When we speak of free software, we are referring to freedom, not ! price. Our General Public Licenses are designed to make sure that you ! have the freedom to distribute copies of free software (and charge for ! this service if you wish), that you receive source code or can get it ! if you want it, that you can change the software or use pieces of it ! in new free programs; and that you know you can do these things. ! ! To protect your rights, we need to make restrictions that forbid ! anyone to deny you these rights or to ask you to surrender the rights. ! These restrictions translate to certain responsibilities for you if you ! distribute copies of the software, or if you modify it. ! ! For example, if you distribute copies of such a program, whether ! gratis or for a fee, you must give the recipients all the rights that ! you have. You must make sure that they, too, receive or can get the ! source code. And you must show them these terms so they know their ! rights. ! ! We protect your rights with two steps: (1) copyright the software, and ! (2) offer you this license which gives you legal permission to copy, ! distribute and/or modify the software. ! ! Also, for each author's protection and ours, we want to make certain ! that everyone understands that there is no warranty for this free ! software. If the software is modified by someone else and passed on, we ! want its recipients to know that what they have is not the original, so ! that any problems introduced by others will not reflect on the original ! authors' reputations. ! ! Finally, any free program is threatened constantly by software ! patents. We wish to avoid the danger that redistributors of a free ! program will individually obtain patent licenses, in effect making the ! program proprietary. To prevent this, we have made it clear that any ! patent must be licensed for everyone's free use or not licensed at all. ! ! The precise terms and conditions for copying, distribution and ! modification follow. ! ! GNU GENERAL PUBLIC LICENSE ! TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION ! ! 0. This License applies to any program or other work which contains ! a notice placed by the copyright holder saying it may be distributed ! under the terms of this General Public License. The "Program", below, ! refers to any such program or work, and a "work based on the Program" ! means either the Program or any derivative work under copyright law: ! that is to say, a work containing the Program or a portion of it, ! either verbatim or with modifications and/or translated into another ! language. (Hereinafter, translation is included without limitation in ! the term "modification".) Each licensee is addressed as "you". ! ! Activities other than copying, distribution and modification are not ! covered by this License; they are outside its scope. The act of ! running the Program is not restricted, and the output from the Program ! is covered only if its contents constitute a work based on the ! Program (independent of having been made by running the Program). ! Whether that is true depends on what the Program does. ! ! 1. You may copy and distribute verbatim copies of the Program's ! source code as you receive it, in any medium, provided that you ! conspicuously and appropriately publish on each copy an appropriate ! copyright notice and disclaimer of warranty; keep intact all the ! notices that refer to this License and to the absence of any warranty; ! and give any other recipients of the Program a copy of this License ! along with the Program. ! ! You may charge a fee for the physical act of transferring a copy, and ! you may at your option offer warranty protection in exchange for a fee. ! ! 2. You may modify your copy or copies of the Program or any portion ! of it, thus forming a work based on the Program, and copy and ! distribute such modifications or work under the terms of Section 1 ! above, provided that you also meet all of these conditions: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! b) You must cause any work that you distribute or publish, that in ! whole or in part contains or is derived from the Program or any ! part thereof, to be licensed as a whole at no charge to all third ! parties under the terms of this License. ! ! c) If the modified program normally reads commands interactively ! when run, you must cause it, when started running for such ! interactive use in the most ordinary way, to print or display an ! announcement including an appropriate copyright notice and a ! notice that there is no warranty (or else, saying that you provide ! a warranty) and that users may redistribute the program under ! these conditions, and telling the user how to view a copy of this ! License. (Exception: if the Program itself is interactive but ! does not normally print such an announcement, your work based on ! the Program is not required to print an announcement.) ! ! These requirements apply to the modified work as a whole. If ! identifiable sections of that work are not derived from the Program, ! and can be reasonably considered independent and separate works in ! themselves, then this License, and its terms, do not apply to those ! sections when you distribute them as separate works. But when you ! distribute the same sections as part of a whole which is a work based ! on the Program, the distribution of the whole must be on the terms of ! this License, whose permissions for other licensees extend to the ! entire whole, and thus to each and every part regardless of who wrote it. ! ! Thus, it is not the intent of this section to claim rights or contest ! your rights to work written entirely by you; rather, the intent is to ! exercise the right to control the distribution of derivative or ! collective works based on the Program. ! ! In addition, mere aggregation of another work not based on the Program ! with the Program (or with a work based on the Program) on a volume of ! a storage or distribution medium does not bring the other work under ! the scope of this License. ! ! 3. You may copy and distribute the Program (or a work based on it, ! under Section 2) in object code or executable form under the terms of ! Sections 1 and 2 above provided that you also do one of the following: ! ! a) Accompany it with the complete corresponding machine-readable ! source code, which must be distributed under the terms of Sections ! 1 and 2 above on a medium customarily used for software interchange; or, ! ! b) Accompany it with a written offer, valid for at least three ! years, to give any third party, for a charge no more than your ! cost of physically performing source distribution, a complete ! machine-readable copy of the corresponding source code, to be ! distributed under the terms of Sections 1 and 2 above on a medium ! customarily used for software interchange; or, ! ! c) Accompany it with the information you received as to the offer ! to distribute corresponding source code. (This alternative is ! allowed only for noncommercial distribution and only if you ! received the program in object code or executable form with such ! an offer, in accord with Subsection b above.) ! ! The source code for a work means the preferred form of the work for ! making modifications to it. For an executable work, complete source ! code means all the source code for all modules it contains, plus any ! associated interface definition files, plus the scripts used to ! control compilation and installation of the executable. However, as a ! special exception, the source code distributed need not include ! anything that is normally distributed (in either source or binary ! form) with the major components (compiler, kernel, and so on) of the ! operating system on which the executable runs, unless that component ! itself accompanies the executable. ! ! If distribution of executable or object code is made by offering ! access to copy from a designated place, then offering equivalent ! access to copy the source code from the same place counts as ! distribution of the source code, even though third parties are not ! compelled to copy the source along with the object code. ! ! 4. You may not copy, modify, sublicense, or distribute the Program ! except as expressly provided under this License. Any attempt ! otherwise to copy, modify, sublicense or distribute the Program is ! void, and will automatically terminate your rights under this License. ! However, parties who have received copies, or rights, from you under ! this License will not have their licenses terminated so long as such ! parties remain in full compliance. ! ! 5. You are not required to accept this License, since you have not ! signed it. However, nothing else grants you permission to modify or ! distribute the Program or its derivative works. These actions are ! prohibited by law if you do not accept this License. Therefore, by ! modifying or distributing the Program (or any work based on the ! Program), you indicate your acceptance of this License to do so, and ! all its terms and conditions for copying, distributing or modifying ! the Program or works based on it. ! ! 6. Each time you redistribute the Program (or any work based on the ! Program), the recipient automatically receives a license from the ! original licensor to copy, distribute or modify the Program subject to ! these terms and conditions. You may not impose any further ! restrictions on the recipients' exercise of the rights granted herein. ! You are not responsible for enforcing compliance by third parties to ! this License. ! ! 7. If, as a consequence of a court judgment or allegation of patent ! infringement or for any other reason (not limited to patent issues), ! conditions are imposed on you (whether by court order, agreement or ! otherwise) that contradict the conditions of this License, they do not ! excuse you from the conditions of this License. If you cannot ! distribute so as to satisfy simultaneously your obligations under this ! License and any other pertinent obligations, then as a consequence you ! may not distribute the Program at all. For example, if a patent ! license would not permit royalty-free redistribution of the Program by ! all those who receive copies directly or indirectly through you, then ! the only way you could satisfy both it and this License would be to ! refrain entirely from distribution of the Program. ! ! If any portion of this section is held invalid or unenforceable under ! any particular circumstance, the balance of the section is intended to ! apply and the section as a whole is intended to apply in other ! circumstances. ! ! It is not the purpose of this section to induce you to infringe any ! patents or other property right claims or to contest validity of any ! such claims; this section has the sole purpose of protecting the ! integrity of the free software distribution system, which is ! implemented by public license practices. Many people have made ! generous contributions to the wide range of software distributed ! through that system in reliance on consistent application of that ! system; it is up to the author/donor to decide if he or she is willing ! to distribute software through any other system and a licensee cannot ! impose that choice. ! ! This section is intended to make thoroughly clear what is believed to ! be a consequence of the rest of this License. ! ! 8. If the distribution and/or use of the Program is restricted in ! certain countries either by patents or by copyrighted interfaces, the ! original copyright holder who places the Program under this License ! may add an explicit geographical distribution limitation excluding ! those countries, so that distribution is permitted only in or among ! countries not thus excluded. In such case, this License incorporates ! the limitation as if written in the body of this License. ! ! 9. The Free Software Foundation may publish revised and/or versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. ! ! Each version is given a distinguishing version number. If the Program ! specifies a version number of this License which applies to it and "any ! later version", you have the option of following the terms and conditions ! either of that version or of any later version published by the Free Software ! Foundation. If the Program does not specify a version number of this License, ! you may choose any version ever published by the Free Software Foundation. ! ! 10. If you wish to incorporate parts of the Program into other free ! programs whose distribution conditions are different, write to the author to ! ask for permission. For software which is copyrighted by the Free Software ! Foundation, write to the Free Software Foundation; we sometimes make ! exceptions for this. Our decision will be guided by the two goals of ! preserving the free status of all derivatives of our free software and of ! promoting the sharing and reuse of software generally. ! ! NO WARRANTY ! 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR ! THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN ! OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE ! THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND ! FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND ! PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, ! YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. ! 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING ! WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR ! REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, ! INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING ! OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO ! LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR ! THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), ! EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH ! DAMAGES. ! END OF TERMS AND CONDITIONS ' */ - // Active.cpp - // State representing an active run. - // Enter: - // Depending on prior state emit either - // Begin or Resume buffer. - // Set priority to one suitable for event - // Polling... enable the daq hardware, - // clear the hardware. - // - // Author: - // Ron Fox - // NSCL - // Michigan State University - // East Lansing, MI 48824-1321 - // mailto:fo...@ns... - // - //////////////////////////.cpp file////////////////////////////////////////// - // - - /* - Modification History: - $Log$ - Revision 8.3 2005/09/08 13:30:50 ron-fox - When using the Wiener USB interface, don't poll the trigger as many - times so that the end run e.g. stays responsivel - - Revision 8.2 2005/06/24 11:32:01 ron-fox - Bring the entire world onto the 8.2 line - - Revision 4.2 2004/11/16 18:51:36 ron-fox - Port to gcc/g++ 3.x - - Revision 4.1 2004/11/08 17:37:39 ron-fox - bring to mainline - - Revision 3.7 2004/11/08 17:31:41 ron-fox - mainline - - Revision 3.3.4.1 2004/02/09 17:49:44 ron-fox - Bugzilla 76: Improve accuracy of the elpased run time by doing differences of absolute times - rather than summing incremental times. - - Revision 3.3 2003/08/14 17:59:22 ron-fox - Add functions to allow programmatic replacement of trigger and busy modules. - - Revision 3.2 2003/03/31 14:42:08 ron-fox - Do a try {} catch(...) in Active::EndRun to ensure that the current state is actually active before asking the run to end. - - Revision 3.1 2003/03/22 04:03:27 ron-fox - Added SBS/Bit3 device driver. - - Revision 2.1 2003/02/11 16:44:06 ron-fox - Retag to version 2.1 to remove the weird branch I accidently made. - - Revision 1.2 2003/02/05 18:06:11 ron-fox - Catch up on drift between Readout and the snapshot from which we started - the port to autotools. - - Revision 2.8 2003/02/05 15:46:01 fox - finaly commit before moving completely to sourceforge. - - Revision 2.7 2002/12/30 18:46:57 fox - Support the WIENER VC/CC32 crate controller hardware thanks to - Dave Caussyn at FSU (ca...@nu...) - - Revision 2.6 2002/11/20 16:03:07 fox - Support multiple VME crates and CAMAC Branches spread across the multiple VME - crates. - - Revision 2.5 2002/10/22 17:45:48 fox - Straighten out revision history - - - Revision 2.4 2002/10/10 12:54:18 fox - Remove multiple copyright strings. - - Revision 2.3 2002/10/09 11:27:32 fox - Add copyright/license stamp. - - Revision 2.2 2002/07/02 15:12:05 fox - Go to 2.xx based releases (recover from client crash too). - - Revision 2.1 2002/07/02 15:04:56 fox - Transition to 2.1 releases - - Revision 1.14 2002/07/02 15:00:10 fox - Complete suppport for selection amongst alternative PCI<--> VME bus bridges. - - */ // // Header Files: --- 1,19 ---- /* ! This software is Copyright by the Board of Trustees of Michigan ! State University (c) Copyright 2005. ! You may use this software under the terms of the GNU public license ! (GPL). The terms of this license are described at: ! http://www.gnu.org/licenses/gpl.txt ! Author: ! Ron Fox ! NSCL ! Michigan State University ! East Lansing, MI 48824-1321 */ // // Header Files: *************** *** 388,391 **** --- 37,41 ---- #include <buftypes.h> #include <spectrodaq.h> + #include <CVMEInterface.h> #include "CESTrigger.h" #include "VMETrigger.h" *************** *** 474,477 **** --- 124,128 ---- // This should be updated now: + CVMEInterface::Lock(); SetBusy(); // This is probably already set, but... UpdateInternalTime(); *************** *** 488,491 **** --- 139,143 ---- } ClearBusy(); // Dropping the computer busy. + CVMEInterface::Unlock(); } *************** *** 515,522 **** --- 167,176 ---- ReadoutStateMachine& rRun((ReadoutStateMachine&)rMachine); + CVMEInterface::Lock(); SetBusy(); // Disable electronics triggers. ClearEventTrigger(); // Clear triggers in the timing hole. rRun.SetPriorState(); + CVMEInterface::Unlock(); } *************** *** 551,554 **** --- 205,209 ---- // Check for scalers and commands: + CVMEInterface::Lock(); if(CheckScalerTrigger(rRun)) { m_pBusy->ScalerSet(); // Hold computer busy while scalers are read. *************** *** 559,562 **** --- 214,219 ---- m_pBusy->ScalerClear(); // busy, otherwise, the event will do it. } + CVMEInterface::Unlock(); + if(rRun.PollForCommand()) { m_pReader->FlushBuffer(); *************** *** 565,570 **** --- 222,229 ---- if(m_EndRunRequested) { m_pReader->FlushBuffer(); + CVMEInterface::Lock(); m_pBusy->Set(); m_pBusy->ScalerSet(); + CVMEInterface::Unlock(); rRun.UpdateRunTime(); return rRun.NameToEventId("END"); *************** *** 586,589 **** --- 245,250 ---- // 1. Set the Gate generator to latched mode. + + CVMEInterface::Lock(); if(UsingVME == TESTMODE) { if(!m_pTrigger) { *************** *** 631,634 **** --- 292,296 ---- m_pReader->setTrigger(m_pTrigger); m_pReader->setBusy(m_pBusy); + CVMEInterface::Unlock(); } *************** *** 643,647 **** --- 305,311 ---- Active::DisableTrigger() { + CVMEInterface::Lock(); m_pTrigger->Disable(); + CVMEInterface::Unlock(); } ////////////////////////////////////////////////////////////// |
|
From: Ron F. <ro...@us...> - 2005-12-30 19:19:11
|
Update of /cvsroot/nscldaq/clients In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22833 Modified Files: CHANGELOG Log Message: Modify the locking so that this should work with a VM-USB interface which requires the lock to be held during all VME accesses. Index: CHANGELOG =================================================================== RCS file: /cvsroot/nscldaq/clients/CHANGELOG,v retrieving revision 8.44 retrieving revision 8.45 diff -C2 -d -r8.44 -r8.45 *** CHANGELOG 30 Dec 2005 18:13:07 -0000 8.44 --- CHANGELOG 30 Dec 2005 19:19:02 -0000 8.45 *************** *** 576,578 **** December 30, 2005 - Get the VM-USB to work on the 2.6 kernel... note there's still ! a problem with the 8 bit reads (writes are fine). \ No newline at end of file --- 576,580 ---- December 30, 2005 - Get the VM-USB to work on the 2.6 kernel... note there's still ! a problem with the 8 bit reads (writes are fine). ! - Modify locking in Readout classic to reflect the needs of ! the VM-USB locking. \ No newline at end of file |
|
From: Ron F. <ro...@us...> - 2005-12-30 18:13:20
|
Update of /cvsroot/nscldaq/clients In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7213 Modified Files: CHANGELOG configure.in Log Message: Did some autoconf magic to ensure that if necessary the default locking module in VMEApi can be overridden by a specific drivers locking module. Index: CHANGELOG =================================================================== RCS file: /cvsroot/nscldaq/clients/CHANGELOG,v retrieving revision 8.43 retrieving revision 8.44 diff -C2 -d -r8.43 -r8.44 *** CHANGELOG 14 Dec 2005 12:21:49 -0000 8.43 --- CHANGELOG 30 Dec 2005 18:13:07 -0000 8.44 *************** *** 573,575 **** - Unnumbered defect in epicsdisplay: If there are no strip chart channels, the clearStripChart proc was called which referenced ! widgets that did not exist. \ No newline at end of file --- 573,578 ---- - Unnumbered defect in epicsdisplay: If there are no strip chart channels, the clearStripChart proc was called which referenced ! widgets that did not exist. ! December 30, 2005 ! - Get the VM-USB to work on the 2.6 kernel... note there's still ! a problem with the 8 bit reads (writes are fine). \ No newline at end of file Index: configure.in =================================================================== RCS file: /cvsroot/nscldaq/clients/configure.in,v retrieving revision 8.13 retrieving revision 8.14 diff -C2 -d -r8.13 -r8.14 *** configure.in 29 Nov 2005 16:09:05 -0000 8.13 --- configure.in 30 Dec 2005 18:13:07 -0000 8.14 *************** *** 414,417 **** --- 414,419 ---- # require that specific type of VME interface # to build (try to keep this number small!!). + # SEPARABLELOCK - Locking if the 'default' locking is good enough + # for this interface. case "$vmeinterface" in *************** *** 431,434 **** --- 433,437 ---- AC_DEFINE(HAVE_VME_MAPPING, "1",[VME interface capable of mmap(2)]) DEPENDSON_VME="PowerCheck" + SEPERABLELOCK="Locking" case $kernel_version in *************** *** 472,475 **** --- 475,479 ---- VMELIBRARY="-L\$(prefix)/lib -lpcivme" DEPENDSON_VME="" + SEPERABLELOCK="Locking" AC_DEFINE(HAVE_WIENERVME_INTERFACE,"1",[VME Interface is Wiener]) *************** *** 486,489 **** --- 490,494 ---- VMELIBRARY="-lusb" DEPENDSON_VME="" + SEPERABLELOCK="NullLock" AC_DEFINE(HAVE_WIENERUSBVME_INTERFACE,"1",[VME interfaces is WienerUSB]) *************** *** 500,503 **** --- 505,509 ---- VMELIBRARY="" DEPENDSON_VME="" + SEPERABLELOCK="NullLock" AC_DEFINE(HAVE_NOVME_INTERFACE, "1",[No VME interface selected]) *************** *** 721,724 **** --- 727,731 ---- AC_SUBST(VMEBUILDLIBS) AC_SUBST(DEPENDSON_VME) + AC_SUBST(SEPERABLELOCK) # CAMAC device: |
|
From: Ron F. <ro...@us...> - 2005-12-30 18:07:42
|
Update of /cvsroot/nscldaq/clients/VMEApi In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5850 Modified Files: Makefile.am WIENERUSBAPI.cpp WienerUSBVMEInterface.h Added Files: NullLock.cpp Log Message: Null lock module for interfaces that must implement their own locking. --- NEW FILE: NullLock.cpp --- // This is a bit of dirt for vme interface software // that must have it's own lock implementation...see // e.g. the Wiener usb implementation. // In that case this module is compiled instead of Locking.cpp // ...all this to fool autoconf. // // - Yes, I know this is empty. It's supposed to be. Index: Makefile.am =================================================================== RCS file: /cvsroot/nscldaq/clients/VMEApi/Makefile.am,v retrieving revision 8.4 retrieving revision 8.5 diff -C2 -d -r8.4 -r8.5 *** Makefile.am 5 Sep 2005 19:22:31 -0000 8.4 --- Makefile.am 30 Dec 2005 18:07:33 -0000 8.5 *************** *** 1,4 **** lib_LTLIBRARIES = libVmeAPI.la ! libVmeAPI_la_SOURCES = @VMEDEVICE@API.cpp Locking.cpp libVmeAPI_la_LDFLAGS = -version-info $(SOVERSION):0 $(VMEBUILDLIBS) \ -Wl"-rpath=$(libdir)" --- 1,8 ---- lib_LTLIBRARIES = libVmeAPI.la ! libVmeAPI_la_SOURCES = @VMEDEVICE@API.cpp @SEPERABLELOCK@.cpp ! ! # Locking.cpp ! ! libVmeAPI_la_LDFLAGS = -version-info $(SOVERSION):0 $(VMEBUILDLIBS) \ -Wl"-rpath=$(libdir)" *************** *** 9,13 **** EXTRA_DIST = NSCLBIT3API.cpp NULLAPI.cpp SBSBIT3API.cpp WIENERAPI.cpp \ ! WIENERUSBAPI.cpp bin_SCRIPTS = VmeDevice --- 13,17 ---- EXTRA_DIST = NSCLBIT3API.cpp NULLAPI.cpp SBSBIT3API.cpp WIENERAPI.cpp \ ! WIENERUSBAPI.cpp Locking.cpp NullLock.cpp bin_SCRIPTS = VmeDevice Index: WienerUSBVMEInterface.h =================================================================== RCS file: /cvsroot/nscldaq/clients/VMEApi/WienerUSBVMEInterface.h,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** WienerUSBVMEInterface.h 5 Sep 2005 15:17:00 -0000 1.1 --- WienerUSBVMEInterface.h 30 Dec 2005 18:07:33 -0000 1.2 *************** *** 84,87 **** --- 84,89 ---- void* inputBuffer, unsigned long readSize); + + static void setDebug(int level); //Sets the Debug level for the usb. }; Index: WIENERUSBAPI.cpp =================================================================== RCS file: /cvsroot/nscldaq/clients/VMEApi/WIENERUSBAPI.cpp,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** WIENERUSBAPI.cpp 18 Oct 2005 15:17:19 -0000 1.5 --- WIENERUSBAPI.cpp 30 Dec 2005 18:07:33 -0000 1.6 *************** *** 35,38 **** --- 35,45 ---- #include <string> + #include <sys/types.h> + #include <sys/ipc.h> + #include <sys/sem.h> + #include <assert.h> + + #include <iostream> + using namespace std; *************** *** 94,97 **** --- 101,121 ---- // Data Structures: + typedef struct usb_device *usb_device_ptr; + + // In some cases we need to define the semun union: + + #if defined(__GNU_LIBRARY__) && !(defined(_SEM_SEMUN_UNDEFINED)) + #else + union semun { + int val; // SETVAL value. + struct semid_ds *buf; // IPC_STAT, IPC_SET buffer. + unsigned short int *array; // Array for GETALL/SETALL + struct seminfo* _buf; // Buffer for IPC_INFO + }; + #endif + + + + // Unit defines an 'open' vme device. In this case the open model // is that of opening an address space (modifier) in a VME crate. *************** *** 100,104 **** typedef struct _Unit { ! usb_dev_handle* s_pHandle; // Handle open on the unit. unsigned char s_AM; // VME Address modifier. } Unit, *pUnit; --- 124,128 ---- typedef struct _Unit { ! unsigned short s_Crate; // Number of the crate. unsigned char s_AM; // VME Address modifier. } Unit, *pUnit; *************** *** 111,117 **** --- 135,155 ---- enum CVMEInterface::AddressMode s_Mode; unsigned char s_Modifier; + } ModifierMap, *pModifierMap; + // Due to the funky way in which we have to handle usb_claim_interface, + // usb_release_interface and its interaction with usb_open/usb_close, + // We will actually do our opens in the Lock and closes in the + // Unlock functions. Therefore we need to keep track of which + // devices the user is actually using (has 'open'). + // This is done with the following structure: + // + typedef struct _CrateInfo { + usb_device_ptr s_pDevice; // Pointer to the device. + usb_dev_handle* s_pHandle; // Pointer to the actual open handle. + unsigned int s_nOpens; // Number of user opens on the crate. + } CrateInfo, *CrateInfoPtr; + // The usb bus is a dynamic entity. On the first open we *************** *** 122,127 **** static bool initialized(false); ! typedef struct usb_device *usb_device_ptr; ! static std::vector<usb_device_ptr> vmeCrates; // Array of crates we found. // Map CVMEInterface::AddressMode -> VME AM's. --- 160,175 ---- static bool initialized(false); ! static std::vector<CrateInfoPtr> vmeCrates; // Array of crates we found. ! ! ! /*! ! This file implements coarse grained VME locking. ! If applications use this, the entire VME subsystem will be controlled ! by a single lock. ! */ ! ! static int semid = -1; // This will be the id of the locking semaphore ! static int semkey= 0x564d4520; // "VME " :-). ! // Map CVMEInterface::AddressMode -> VME AM's. *************** *** 139,142 **** --- 187,277 ---- + // For debugging the API's initial libusb accesses you can modify this.. + // or call WienerUSBVMEInterface::setDebug prior to the first + // open call. + static unsigned debug_level(1); + + + + // Debugging hex dump of words: + + static void hexdumpw(void* p, unsigned nWords) { + unsigned short* pw = (unsigned short*)p; + for(int i =0; i < nWords; i++) { + if ((i % 8) == 0) { + cerr << endl; + } + cerr << hex << " " << *pw << dec; + pw++; + } + cerr << endl << endl; + cerr.flush(); + } + + + /*! + This internal function is used to establish the semaphore: + - If the semaphore exists, it's id is just stored in semid. + - If the semaphore does not exist we try to create it O_EXCL + this is an attempt to deal with any timing holes that may + occur when two programs simultaneously attemp to create the semaphore. + - If the O_EXCL creation succeeds (semaphore does not exist), it is + given in initial value of 1 so that a single process can pass the lock + gate. + - If the O_EXCL creation fails, the process backs off for a while and + then does a semget for an existing semaphore again assuming that on the + second try, all initialization has been complete. + + \throw String + If an error occured on any of the system calls. + + */ + static void + AttachSemaphore() + { + // Retry loop in case anybody makes and then kills it: + + while(1) { + // Try to get the id of an existing semaphore: + + semid = semget(semkey, 0, 0777); // Try to map: + if(semid >= 0) break; // Previously existing!! + if(errno != ENOENT) { + throw + string("AttachSemaphore - semget error unexpected"); + } + // Sempahore does not exist. Try to be the only guy to + // create it: + + semid = semget(semkey, 1, 0777 | IPC_CREAT | IPC_EXCL); + if(semid >= 0) { + // We're the creator... initialize the sempahore, and return. + + union semun data; + data.val = 1; + + int istat = semctl(semid, 0, SETVAL, data); // Allow 1 holder + if(istat < 0) { + throw string("AttachSemaphore - semctl error unexpected"); + } + + break; + } + if(errno != EEXIST) { + throw + string("AttachSemaphore - semget error unexpected"); + } + // The semaphore popped into being between the initial try + // to just attach it and our try to create it. + // The next semget should work, but we want to give + // the creator a chance to initialize the semaphore so + // we don't try to take out a lock on the semaphore before + // it is completely initialized: + + sleep(1); + } + return; + } + // Local function to initialize our static data structures: // *************** *** 150,157 **** --- 285,294 ---- static void Initialize() { usb_init(); + usb_set_debug(debug_level); if(usb_find_busses() < 0) { throw string("Failed to find usb busses"); } if(usb_find_devices() < 0) { + std::cerr << "throwing usb_find_devices failure\n"; throw string("Failed in usb_find_devices"); } *************** *** 165,169 **** if( (aDevice->descriptor.idVendor == USB_WIENER_VENDOR_ID) && (aDevice->descriptor.idProduct == USB_VMUSB_PRODUCT_ID)) { ! vmeCrates.push_back(aDevice); } --- 302,311 ---- if( (aDevice->descriptor.idVendor == USB_WIENER_VENDOR_ID) && (aDevice->descriptor.idProduct == USB_VMUSB_PRODUCT_ID)) { ! CrateInfoPtr info = new CrateInfo; ! info->s_pDevice = aDevice; ! info->s_pHandle = (usb_dev_handle*)NULL; ! info->s_nOpens = 0; ! ! vmeCrates.push_back(info); } *************** *** 197,205 **** throw string("Address modifier is invalid and could not be translated"); } /*! ! Public interface to 'open' a vme crate. What we do is ! do a usb_open on the crate requested, create and fill in a Unit ! structure passing a pointer to that structure as an opaque type. \param nMode --- 339,450 ---- throw string("Address modifier is invalid and could not be translated"); } + /*! + Lock the semaphore. If the semid is -1, the + semaphore is created first. + + \throw string + - Really from AttachSemaphore + - From failures in semop. + */ + void + CVMEInterface::Lock() + { + // If necessary, get the semaphore id.. + + if (semid == -1) AttachSemaphore(); + assert(semid >= 0); // Otherwise attach.. throws. + + struct sembuf buf; + buf.sem_num = 0; // Only one semaphore. + buf.sem_op = -1; // Want to take the semaphore. + buf.sem_flg = SEM_UNDO; // For process exit. + + while (1) { // In case of signal... + int stat = semop(semid, &buf, 1); + + if(stat == 0) break; + + if(errno != EINTR) { // Bad errno: + throw string("CVMEInterface::Lock semop gave bad status"); + } + // On EINTR try again. + } + // Now that I've locked the interface, I can open + // and claim all the crates: + + unsigned int nCrates = vmeCrates.size(); + for (int i =0; i < nCrates; i++) { + CrateInfoPtr p = vmeCrates[i]; + if(p->s_nOpens > 0) { + p->s_pHandle = usb_open(p->s_pDevice); + if(p->s_pHandle) { + usb_claim_interface(p->s_pHandle, 0); + usleep(150); // Seemed to need this earlier. + } else { + cerr << "CVMEInterface::Lock: Failed to open crate " << i << endl; + throw "Crate open failed in CVMEInterface::Lock()"; + } + } + } + return; + } + /*! + Unlock the semaphore. It is a crime to unlock the semaphore if it doesn + not yet exist, since that would be unlocking a semaphore that is not yet + locked. + + \throw string + If the semop operation produced an error. + \throw string + If the semaphore did not yet exist. + */ + void + CVMEInterface::Unlock() + { + if(semid == -1) { + throw string("Attempt to unlock the semaphore before it was created"); + } + + // Take all open interfaces and release/close them. + // We put in a bit of delay since superstition currently says + // they may be needed. + // + + unsigned int nCrates = vmeCrates.size(); + for (int i=0; i < nCrates; i++) { + CrateInfoPtr p = vmeCrates[i]; + if(p->s_pHandle) { + usb_release_interface(p->s_pHandle, 0); + usleep(150); + usb_close(p->s_pHandle); + usleep(150); + p->s_pHandle = (usb_dev_handle*)NULL; + } + } + struct sembuf buf; + buf.sem_num = 0; + buf.sem_op = 1; + buf.sem_flg= SEM_UNDO; // Undoes the locking undo. + + while(1) { // IN case of signal though not likely. + int stat = semop(semid, &buf, 1); + if(stat == 0) break; // Got the job done!! + if(errno != EINTR) { + throw string("CVMEInterface::Unlock semop gave bad status"); + } + // on EINTR try again. + } + return; + } /*! ! Public interface to 'open' a vme crate. ! Create a unit structure and mark the crate open. ! Due to the way that usb_claim_interface/usb_release_interface ! interact with usb_open/usb_close, it is not possible to ! do the usb_open here. We require lock which will open all ! crates and claim them.. The unlock will release and close them. ! The user will get a pointer to an opaque type that contains ! the address modifier and the crate number. \param nMode *************** *** 232,241 **** unsigned char AM = AddressModifier(nMode); // Throws on error. ! // Now try to open the device: ! usb_dev_handle* handle = usb_open(vmeCrates[crate]); ! if(!handle) { ! throw string("Unable to open the cdrate in CVMEInterface::Open"); ! } // Create the unit, fill it in and hand it to the caller. --- 477,486 ---- unsigned char AM = AddressModifier(nMode); // Throws on error. ! // All we do is mark the user interested in the ! // crate.. the open/claim will get done in Lock ! // and the close in Unlock. ! // ! vmeCrates[crate]->s_nOpens++; // Create the unit, fill it in and hand it to the caller. *************** *** 244,261 **** pUnit unit = new Unit; ! unit->s_pHandle = handle; ! unit->s_AM = AM; - usleep(150); return (void*) unit; } /*! Close a VME unit. - - usb_close() is called for the open device. - The Unit structure allocated for the device is destroyed. \param handle The opaque device handle gotten from the Open call. ! \throw string if the usb_close failed. */ void --- 489,507 ---- pUnit unit = new Unit; ! unit->s_Crate = crate; ! unit->s_AM = AM; return (void*) unit; } /*! Close a VME unit. - The Unit structure allocated for the device is destroyed. + - The open count in the vme crate is decremented so that + when the last instance of a Unit pointing to a crate is + closed, Lock will no longer open/claim the unit. \param handle The opaque device handle gotten from the Open call. ! */ void *************** *** 263,272 **** { pUnit p = static_cast<pUnit>(handle); ! if (usb_close(p->s_pHandle) < 0) { ! throw string("usb_close failed, most likely reason is bad handle"); ! } delete p; } /*! Map is unsupported and will throw an exception --- 509,525 ---- { pUnit p = static_cast<pUnit>(handle); ! ! // Actual opens and closes are done by the ! // Lock/Unlock functions. All we do ! // is destroy the user's handle and decrement ! // the count that keeps track of how many times ! // the user opened this vme crate. ! ! vmeCrates[p->s_Crate]->s_nOpens--; delete p; } + + /*! Map is unsupported and will throw an exception *************** *** 286,301 **** } - int CVMEInterface::Read(void* handle, unsigned long nOffset, - void* pBuffer, unsigned long nBytes) { - return WienerUSBVMEInterface::ReadLongs(handle, nOffset, - pBuffer, nBytes/sizeof(long)); - } - int CVMEInterface::Write(void* handle, unsigned long nOffset, void* pBuffer, - unsigned long nBytes) - { - return WienerUSBVMEInterface::WriteLongs(handle, nOffset, pBuffer, - nBytes/sizeof(long)); - } - // Interface specific functions. --- 539,542 ---- *************** *** 328,334 **** { pUnit pHandle = (pUnit)handle; - usb_dev_handle* pDevice = pHandle->s_pHandle; unsigned char aModifier = pHandle->s_AM; // Error checking: The base address must be longword aligned: // and count*4 must be within 0xffc (a safety fudge here). --- 569,576 ---- { pUnit pHandle = (pUnit)handle; unsigned char aModifier = pHandle->s_AM; + + // Error checking: The base address must be longword aligned: // and count*4 must be within 0xffc (a safety fudge here). *************** *** 381,385 **** { pUnit pHandle = (pUnit)handle; - usb_dev_handle* pDevice = pHandle->s_pHandle; unsigned char aModifier = pHandle->s_AM; --- 623,626 ---- *************** *** 431,435 **** { pUnit pHandle = (pUnit)handle; - usb_dev_handle* pDevice = pHandle->s_pHandle; unsigned char aModifier = pHandle->s_AM; unsigned short inBuffer[STACK_MAXIMMEDIATE]; --- 672,675 ---- *************** *** 446,450 **** ! for (int i =0; i<=count; i++) { // The bottom bit of the address determine the data strobes. --- 686,690 ---- ! for (int i =0; i<count; i++) { // The bottom bit of the address determine the data strobes. *************** *** 499,506 **** unsigned long count) { ! // Extract the AM and usb_dev_handle from the handle: pUnit pHandle = (pUnit)handle; - usb_dev_handle* pDevice = pHandle->s_pHandle; unsigned char aModifier = pHandle->s_AM; --- 739,745 ---- unsigned long count) { ! pUnit pHandle = (pUnit)handle; unsigned char aModifier = pHandle->s_AM; *************** *** 560,567 **** unsigned long count) { ! // Extract the AM and usb_dev_handle from the handle: pUnit pHandle = (pUnit)handle; - usb_dev_handle* pDevice = pHandle->s_pHandle; unsigned char aModifier = pHandle->s_AM; --- 799,805 ---- unsigned long count) { ! // Extract the AM and pUnit pHandle = (pUnit)handle; unsigned char aModifier = pHandle->s_AM; *************** *** 618,625 **** unsigned long count) { ! // Extract the usb device handle and address modifier from the opaque handle. pUnit pHandle = (pUnit)handle; - usb_dev_handle* pDevice = pHandle->s_pHandle; unsigned char aModifier = pHandle->s_AM; --- 856,862 ---- unsigned long count) { ! // Extract the address modifier from the opaque handle. pUnit pHandle = (pUnit)handle; unsigned char aModifier = pHandle->s_AM; *************** *** 643,646 **** --- 880,884 ---- for (int i =0; i < count; i++) { unsigned short dstrobes; // The DS0/DS1 mask. + unsigned long datum = *pData++; if ((base & 1) == 0) { // Even bytes *************** *** 650,654 **** dstrobes = MODE_NODS0; } - unsigned long datum = *pData++; *pStack++ = aModifier | dstrobes; *pStack++ = (base & 0xfffffffe) | ADDRESS_LWORD; --- 888,891 ---- *************** *** 877,904 **** pUnit pHandle = (pUnit)handle; ! usb_dev_handle* pDevice = pHandle->s_pHandle; unsigned long* pStack = (unsigned long*)stack; ! // Attempt to claim the interface, retry every USB_CLAIM_RETRYDELAY us if ! // we fail: ! // Note that all examples I can find (few enough), are always ! // claiming interface 0.... seems to me this may not be strictly speaking ! // correct, but I'm not sure what is correct... so we'll do what the rest ! // of the world does. ! // ! #ifdef CLAIMUSB ! while(1) { ! int status = usb_claim_interface(pDevice, 0); ! if (status >= 0) break; // Got it. ! if (status == -EBUSY) { ! usleep(USB_CLAIM_RETRYDELAY); ! } ! else { ! string msg("usbImmediateStackTransaction: Failed to claim interface: "); ! msg += strerror(-status); ! throw msg; ! } } ! #endif // Construct the outpacket and send it... --- 1114,1130 ---- pUnit pHandle = (pUnit)handle; ! usb_dev_handle* pDevice = vmeCrates[pHandle->s_Crate]->s_pHandle; unsigned long* pStack = (unsigned long*)stack; + + // It's an error to try to access the device when + // we haven't locked the VME interface since the + // USB is inherently un-shareable. ! if(!pDevice) { ! cerr << "Vme crate " << pHandle->s_Crate << " accessed without lock!\n"; ! throw "usbImmediateStackTransaction - called with unlocked interface"; } ! ! // Construct the outpacket and send it... *************** *** 910,920 **** (pStack[0]+1)*sizeof(unsigned short)); // Assumes host is little endian int nWritten = usb_bulk_write(pDevice, ENDPOINT_OUT, (char*)pOutPacket, nOutWords*sizeof(unsigned short), WRITE_TIMEOUT); if (nWritten < 0) { - #ifdef CLAIMUSB - usb_release_interface(pDevice, 0); - #endif throw string("usbImmediateStackTransaction - usb_bulk_write failed"); } --- 1136,1146 ---- (pStack[0]+1)*sizeof(unsigned short)); // Assumes host is little endian + if(debug_level) { + hexdumpw(pOutPacket, nOutWords); + } int nWritten = usb_bulk_write(pDevice, ENDPOINT_OUT, (char*)pOutPacket, nOutWords*sizeof(unsigned short), WRITE_TIMEOUT); if (nWritten < 0) { throw string("usbImmediateStackTransaction - usb_bulk_write failed"); } *************** *** 929,946 **** if (nRead < 0) { - #ifdef CLAIMUSB - usb_release_interface(pDevice, 0); - #endif throw string("usbImmediateStackTransaction- usb_bulk_read failed"); } // Copy any input data -> inputBuffer... at most readSize bytes. ! memcpy(inputBuffer, inPacket, (nRead < readSize) ? nRead : readSize); ! // Release the interface ! #ifdef CLAIMUSB ! usb_release_interface(pDevice, 0); ! #endif // Return the result... always nRead so the user knows if they missed something. --- 1155,1171 ---- if (nRead < 0) { throw string("usbImmediateStackTransaction- usb_bulk_read failed"); } // Copy any input data -> inputBuffer... at most readSize bytes. ! if(debug_level) { ! cerr << "Read " << nRead << " bytes\n"; ! hexdumpw(inPacket, nRead/sizeof(short)); ! ! } ! memcpy(inputBuffer, inPacket, (nRead < readSize) ? nRead : readSize); ! // Return the result... always nRead so the user knows if they missed something. *************** *** 948,949 **** --- 1173,1189 ---- return nRead; } + /*! + Set the debug level. + If we have not yet been initialized, this just sets the + debug_level variable. Otherwise, usb_set_debug is called. + + \param level - the new debug level for the usb library. + + */ + void + WienerUSBVMEInterface::setDebug(int level) { + debug_level = level; + if(initialized) { + usb_set_debug(level); + } + } |
|
From: Ron F. <ro...@us...> - 2005-12-29 22:18:36
|
Update of /cvsroot/nscldaq/bufdump In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11466 Modified Files: bufdump.tcl pkgIndex.tcl Added Files: Makefile.am bootstrap configure.in fileplugin.html filterfilter.html kit-linux-x86-MTall.bin kit-win32-MTall.exe Log Message: Initial commit of import and Makefiles that can make starpacks for windows and linux systems. --- NEW FILE: kit-win32-MTall.exe --- (This appears to be a binary file; contents omitted.) --- NEW FILE: kit-linux-x86-MTall.bin --- (This appears to be a binary file; contents omitted.) --- NEW FILE: configure.in --- # Process this file with autoconf to produce a configure script. AC_INIT(bufdump.tcl) # Separate device libraries. AM_INIT_AUTOMAKE(bufdump, 1.0) AC_MSG_CHECKING([operating system ]) AC_CANONICAL_HOST # Checks for programs. AC_PROG_INSTALL AC_PROG_LN_S AC_PATH_PROG(HCDOCBOOK, docbook2dvi, echo) AC_PATH_PROG(HTMLDOCBOOK, docbook2html, echo) AC_PATH_PROG(DVIPDF, dvipdf, echo) AC_PATH_PROG(MANDOCBOOK, xmlto, echo) AC_PATH_PROG(WGET, wget, echo) AC_PATH_PROG(ECHO, echo, echo) case "$host" in i686-pc-linux-gnu) SDXRUNTIME=./kit-linux-x86-MTall.bin chmod a+rx $SDXRUNTIME ;; *) AC_MSG_WARN([We can only run all aspects of make on linux]) SDXRUNTIME=$ECHO ;; esac # # Makefile substitutions: AC_SUBST(HCDOCBOOK) AC_SUBST(DVIPDF) AC_SUBST(MANDOCBOOK) AC_SUBST(HTMLDOCBOOK) AC_SUBST(WGET) AC_SUBST(SDXRUNTIME) # Create output files: AC_OUTPUT(Makefile) --- NEW FILE: bootstrap --- #!/bin/sh find . -name .deps -exec rm -rf {} \; set -x aclocal automake --foreign --add-missing --copy autoconf --- NEW FILE: Makefile.am --- TCLPACKAGES=bufdumpDialogs.tcl bufdumpWidgets.tcl bufferAssembly.tcl \ dataSources.tcl eventData.tcl pkgIndex.tcl HELPFILES=filter.gif open.gif search.gif seqmatch.gif textmatch.gif \ datasource.html file.html fileexit.html fileopen.html \ filepackets.html fileplugin.html filter.html filters.html \ filtersearch.html filtersearchnext.html filterfilter.html \ gui.html help.html intro.html overview.html packets.html \ plugins.html search.html WINRUNTIME=./kit-win32-MTall.exe LINUXRUNTIME=./kit-linux-x86-MTall.bin docs: manpage manual htmldocs manpage: $(MANDOCBOOK) man manpage.xml manual: $(HCDOCBOOK) manual.xml $(DVIPDF) manual.dvi htmldocs: $(HTMLDOCBOOK) -o htmldocs manual.xml cp *.gif htmldocs clean: rm -f bufdump.1 rm -f manual.dvi manual.pdf rm -rf htmldocs rm -f *.gz *.kit starpacks: sdx-toolchain rm -rf tclkit cp $(SDXRUNTIME) tclkit rm -rf bufdump.kit bufdump.vfs ./tclkit sdx.kit qwrap bufdump.tcl ./tclkit sdx.kit unwrap bufdump.kit cp $(TCLPACKAGES) bufdump.vfs/lib mkdir bufdump.vfs/etc cp packets.def bufdump.vfs/etc mkdir bufdump.vfs/help cp $(HELPFILES) bufdump.vfs/help tar czf - bwidgets iwidgets tcllib | (cd bufdump.vfs/lib; tar xzf -) ./tclkit sdx.kit wrap bufdump.kit -runtime $(WINRUNTIME) cp bufdump.kit bufdump.exe ./tclkit sdx.kit wrap bufdump.kit -runtime $(LINUXRUNTIME) cp bufdump.kit bufdump sdx-toolchain: sdx.kit sdx.kit: $(WGET) http://www.equi4.com/pub/sk/sdx.kit Index: pkgIndex.tcl =================================================================== RCS file: /cvsroot/nscldaq/bufdump/pkgIndex.tcl,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** pkgIndex.tcl 29 Dec 2005 19:04:21 -0000 1.1.1.1 --- pkgIndex.tcl 29 Dec 2005 22:17:56 -0000 1.2 *************** *** 9,15 **** # full path name of this file's directory. ! package ifneeded bufdumpDialogs 1.0 [list source [file join $dir searchDialogtest.tcl]]\n[list source [file join $dir bufdumpDialogs.tcl]] package ifneeded bufdumpWidgets 1.0 [list source [file join $dir bufdumpWidgets.tcl]] package ifneeded bufferAssembly 1.0 [list source [file join $dir bufferAssembly.tcl]] ! package ifneeded dataSources 1.0 [list source [file join $dir dataSources.tcl]] ! package ifneeded eventData 1.0 [list source [file join $dir eventData.tcl]] --- 9,15 ---- # full path name of this file's directory. ! package ifneeded bufdumpDialogs 1.0 [list source [file join $dir bufdumpDialogs.tcl]] package ifneeded bufdumpWidgets 1.0 [list source [file join $dir bufdumpWidgets.tcl]] package ifneeded bufferAssembly 1.0 [list source [file join $dir bufferAssembly.tcl]] ! package ifneeded dataSources 1.0 [list source [file join $dir dataSources.tcl]] ! package ifneeded eventData 1.0 [list source [file join $dir eventData.tcl]] --- NEW FILE: fileplugin.html --- <html> <head> <title>File->Add Plugin...</title> </head> <body> <h1>File->Add Plugin...</h1> <p> The <b>File->Plugin</b> command prompts you for a file containing a <a href="plugins.html">buffer formatting plugin</a>. When you accept a file, the contents of that plugin are executed in the Tcl interpreter running the program. </p> <hr /> <p>Please report all errors to http://daqbugs.nscl.msu.edu </p>> </body> </html> --- NEW FILE: filterfilter.html --- <html> <head> <title>Filter->Filter...</title> </head> <body> <h1>Filter->Filter...</h1> <p> The <b>Filter->Filter...</b> command supports the establishment of <a href="filters.html">buffer filters</a>. Buffer filters in conjunction with <a href="search.html">search patterns</a> provide powerful tools to selectively examine data buffer contents. </p> <p> When you select the <b>Filter->Filter...</b> command the filter creation dialog shown below is displayed:<br /> <img src="filter.gif"> <br/> This dialog is divided into three panes: <ol> <li>The top pane allows you to enable filtering by buffer type and select which buffer types will be accepted. You must enable this pane by selecting the <em>Enable Buffer Filtering</em> checkbutton. <ol> <li>Select the buffer types you wish to accept in the left list box and click the right arrow button to transfer them to the right listbox. </li> <li>If there are buffers type in the right listbox you no longer wish to accept, select them and click the left arrow button to return them to the left listbox. </li> </ol> </li> <li>The second frame allows you to specify bit pattern matches within the buffer if no bit patterns are specified, all buffers accepted match. Describing bit pattern matches is done in a manner simlilar to specifying bit patterns for <a href="filtersearch.html">searches</a>: <ol> <li>The row of 'x's at the left of this part of the dialog represent the 16 bits of a binary word. Use the up and down arrow keys to select the desired state for each bit or leave a bit at 'x' if you don't care about its state.</li> <li>Once you have edited a bit pattern, add it to the pattern list by clicking the right arrow button just to the right of the bit pattern.</li> <li>You can remove a bit pattern you no longer want from the list by selecting it and clicking the Remove button at the right of the list.</li> <li>You can re-order a bit pattern upwards or downwards by selecting it and clicking either the up or down arrow buttons to the right of the list. Note that order is only important for bit sequence matches</li> <li>Select the <em>Any</em> radio button to specify a match on any of the patterns in the box. Select the <em>Sequence</em> radio button to specify a match on the ordered sequence of bit patterns specified in the list box. </li> </ol> </li> <li>The bottom frame of the dialog provides 3 buttons: <ul> <li><b>Ok</b> When clicked accepts the filter for application when getting the next buffer from the data source</li> <li><b>Clear</b> clears the filter so that if accepted with <b>Ok</b> all buffers will be accepted.</li> <li><b>Cancel</b> dismisses the dialog box without making any changes to the filter criterion.</li> </ul> </li> </ol> </p> <p> If a bit pattern search is specified, once a matching buffer is found, the first occurance of the bit pattern is located an highlighted as if a search for it had been performed. </p> <center><b>NOTE</b></center> <p> This search is a one-time search. Any previously established search (via <a href="filtersearch.html">Filter->Search...</a>) is not modified and is what will be located via a <a href="filtersearchnext.html">Filter->Search Next</a> </p> <hr /> <p>Please report all errors to http://daqbugs.nscl.msu.edu </p>> </body> </html> Index: bufdump.tcl =================================================================== RCS file: /cvsroot/nscldaq/bufdump/bufdump.tcl,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** bufdump.tcl 29 Dec 2005 19:04:29 -0000 1.1.1.1 --- bufdump.tcl 29 Dec 2005 22:17:56 -0000 1.2 *************** *** 31,37 **** cd $wd ! if {[lsearch -exact $auto_path $here] == -1} { ! set auto_path [concat $here $auto_path] ! } --- 31,39 ---- cd $wd ! #if {[lsearch -exact $auto_path $here] == -1} { ! # set auto_path [concat $here $auto_path] ! #} ! ! *************** *** 39,43 **** package require BWidget package require Iwidgets - package require dataSources package require bufdumpDialogs --- 41,44 ---- *************** *** 76,84 **** # Packets file: ! set packetDefinitionFile [file join $here packets.def] # Help directory: ! set helpDirectory [file join $here bufdumpHelp] --- 77,96 ---- # Packets file: ! # If we are in a starkit, our ! # packet files are in $starkit::topdir/etc ! # and helpfiles $starkit::topdir/help ! # Otherwise they are ../etc ./help ! ! if {[info exists starkit::topdir]} { ! set packetDefinitionFile [file join $starkit::topdir etc packets.def] ! set helpDirectory [file join $starkit::topdir help] ! } else { ! set packetDefinitionFile [file join $here .. etc packets.def] ! set helpDirectory [file join $here help] ! } # Help directory: ! |
|
From: Ron F. <ro...@us...> - 2005-12-29 22:18:20
|
Update of /cvsroot/nscldaq/bufdump/tcllib/crc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11466/tcllib/crc Added Files: cksum.tcl crc16.tcl crc32.tcl crcc.tcl pkgIndex.tcl sum.tcl Log Message: Initial commit of import and Makefiles that can make starpacks for windows and linux systems. --- NEW FILE: pkgIndex.tcl --- if {![package vsatisfies [package provide Tcl] 8.2]} {return} package ifneeded cksum 1.0.1 [list source [file join $dir cksum.tcl]] package ifneeded crc16 1.1 [list source [file join $dir crc16.tcl]] package ifneeded crc32 1.1.1 [list source [file join $dir crc32.tcl]] package ifneeded sum 1.1.0 [list source [file join $dir sum.tcl]] --- NEW FILE: crc16.tcl --- # crc16.tcl -- Copyright (C) 2002 Pat Thoyts <pat...@us...> # # Cyclic Redundancy Check - this is a Tcl implementation of a general # table-driven CRC implementation. This code should be able to generate # the lookup table and implement the correct algorithm for most types # of CRC. CRC-16, CRC-32 and the CCITT version of CRC-16. [1][2][3] # Most transmission CRCs use the CCITT polynomial (including X.25, SDLC # and Kermit). # # [1] http://www.microconsultants.com/tips/crc/crc.txt for the reference # implementation # [2] http://www.embedded.com/internet/0001/0001connect.htm # for another good discussion of why things are the way they are. # [3] "Numerical Recipes in C", Press WH et al. Chapter 20. # # Checks: a crc for the string "123456789" should give: # CRC16: 0xBB3D # CRC-CCITT: 0x29B1 # XMODEM: 0x31C3 # CRC-32: 0xCBF43926 # # eg: crc::crc16 "123456789" # crc::crc-ccitt "123456789" # or crc::crc16 -file tclsh.exe # # Note: # The CCITT CRC can very easily be checked for the accuracy of transmission # as the CRC of the message plus the CRC values will be 0. That is: # % set msg {123456789] # % set crc [crc::crc-ccitt $msg] # % crc::crc-ccitt $msg[binary format S $crc] # 0 # # The same is true of other CRCs but some operate in reverse bit order: # % crc::crc16 $msg[binary format s [crc::crc16 $msg]] # 0 # # ------------------------------------------------------------------------- # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- # $Id: crc16.tcl,v 1.1 2005/12/29 22:18:02 ron-fox Exp $ package require Tcl 8.2; # tcl minimum version namespace eval ::crc { namespace export crc16 crc-ccitt crc-32 variable crc16_version 1.1 # Standard CRC generator polynomials. variable polynomial set polynomial(crc16) [expr {(1<<16) | (1<<15) | (1<<2) | 1}] set polynomial(ccitt) [expr {(1<<16) | (1<<12) | (1<<5) | 1}] set polynomial(crc32) [expr {(1<<32) | (1<<26) | (1<<23) | (1<<22) | (1<<16) | (1<<12) | (1<<11) | (1<<10) | (1<<8) | (1<<7) | (1<<5) | (1<<4) | (1<<2) | (1<<1) | 1}] # Array to hold the generated tables variable table if {![info exists table]} { array set table {}} # calculate the sign bit for the current platform. variable signbit if {![info exists signbit]} { for {set v 1} {$v != 0} {set signbit $v; set v [expr {$v<<1}]} {} } } # ------------------------------------------------------------------------- # Generate a CRC lookup table. # This creates a CRC algorithm lookup table for a 'width' bits checksum # using the 'poly' polynomial for all values of an input byte. # Setting 'reflected' changes the bit order for input bytes. # Returns a list or 255 elements. # # CRC-32: Crc_table 32 $crc::polynomial(crc32) 1 # CRC-16: Crc_table 16 $crc::polynomial(crc16) 1 # CRC16/CCITT: Crc_table 16 $crc::polynomial(ccitt) 0 # proc ::crc::Crc_table {width poly reflected} { set tbl {} if {$width < 32} { set mask [expr {(1 << $width) - 1}] set topbit [expr {1 << ($width - 1)}] } else { set mask 0xffffffff set topbit 0x80000000 } for {set i 0} {$i < 256} {incr i} { if {$reflected} { set r [reflect $i 8] } else { set r $i } set r [expr {$r << ($width - 8)}] for {set k 0} {$k < 8} {incr k} { if {[expr {$r & $topbit}] != 0} { set r [expr {($r << 1) ^ $poly}] } else { set r [expr {$r << 1}] } } if {$reflected} { set r [reflect $r $width] } lappend tbl [expr {$r & $mask}] } return $tbl } # ------------------------------------------------------------------------- # Calculate the CRC checksum for the data in 's' using a precalculated # table. # s the input data # width - the width in bits of the CRC algorithm # table - the name of the variable holding the calculated table # init - the start value (or the last CRC for sequential blocks) # xorout - the final value may be XORd with this value # reflected - a boolean indicating that the bit order is reversed. # For hardware optimised CRC checks, the bits are handled # in transmission order (ie: bit0, bit1, ..., bit7) proc ::crc::Crc {s width table {init 0} {xorout 0} {reflected 0}} { upvar $table tbl variable signbit set signmask [expr {~$signbit>>7}] if {$width < 32} { set mask [expr {(1 << $width) - 1}] set rot [expr {$width - 8}] } else { set mask 0xffffffff set rot 24 } set crc $init binary scan $s c* data foreach {datum} $data { if {$reflected} { set ndx [expr {($crc ^ $datum) & 0xFF}] set lkp [lindex $tbl $ndx] set crc [expr {($lkp ^ ($crc >> 8 & $signmask)) & $mask}] } else { set ndx [expr {(($crc >> $rot) ^ $datum) & 0xFF}] set lkp [lindex $tbl $ndx] set crc [expr {($lkp ^ ($crc << 8 & $signmask)) & $mask}] } } return [expr {$crc ^ $xorout}] } # ------------------------------------------------------------------------- # Reverse the bit ordering for 'b' bits of the input value 'v' proc ::crc::reflect {v b} { set t $v for {set i 0} {$i < $b} {incr i} { set v [expr {($t & 1) ? ($v | (1<<(($b-1)-$i))) : ($v & ~(1<<(($b-1)-$i))) }] set t [expr {$t >> 1}] } return $v } # ------------------------------------------------------------------------- # Description: # Pop the nth element off a list. Used in options processing. # proc ::crc::Pop {varname {nth 0}} { upvar $varname args set r [lindex $args $nth] set args [lreplace $args $nth $nth] return $r } # ------------------------------------------------------------------------- # Specialisation of the general crc procedure to perform the standard CRC16 # checksum proc ::crc::CRC16 {s {seed 0}} { variable table if {![info exists table(crc16)]} { variable polynomial set table(crc16) [Crc_table 16 $polynomial(crc16) 1] } return [Crc $s 16 [namespace current]::table(crc16) $seed 0 1] } # ------------------------------------------------------------------------- # Specialisation of the general crc procedure to perform the CCITT telecoms # flavour of the CRC16 checksum proc ::crc::CRC-CCITT {s {seed 0}} { variable table if {![info exists table(ccitt)]} { variable polynomial set table(ccitt) [Crc_table 16 $polynomial(ccitt) 0] } return [Crc $s 16 [namespace current]::table(ccitt) $seed 0 0] } # ------------------------------------------------------------------------- # Demostrates the parameters used for the 32 bit checksum CRC-32. # This can be used to show the algorithm is working right by comparison with # other crc32 implementations proc ::crc::CRC-32 {s {seed 0xFFFFFFFF}} { variable table if {![info exists table(crc32)]} { variable polynomial set table(crc32) [Crc_table 32 $polynomial(crc32) 1] } return [Crc $s 32 [namespace current]::table(crc32) $seed 0xFFFFFFFF 1] } # ------------------------------------------------------------------------- # User level CRC command. proc ::crc::crc {args} { array set opts [list filename {} channel {} chunksize 4096 \ format %u seed 0 \ impl [namespace origin CRC16]] while {[string match -* [set option [lindex $args 0]]]} { switch -glob -- $option { -fi* { set opts(filename) [Pop args 1] } -cha* { set opts(channel) [Pop args 1] } -chu* { set opts(chunksize) [Pop args 1] } -fo* { set opts(format) [Pop args 1] } -i* { set opts(impl) [uplevel 1 namespace origin [Pop args 1]] } -s* { set opts(seed) [Pop args 1] } -- { Pop args ; break } default { set options [join [lsort [array names opts]] ", -"] return -code error "bad option $option:\ must be one of -$options" } } Pop args } if {$opts(filename) != {}} { set opts(channel) [open $opts(filename) r] fconfigure $opts(channel) -translation binary } if {$opts(channel) != {}} { set r $opts(seed) set trans [fconfigure $opts(channel) -translation] fconfigure $opts(channel) -translation binary while {![eof $opts(channel)]} { set chunk [read $opts(channel) $opts(chunksize)] set r [$opts(impl) $chunk $r] } fconfigure $opts(channel) -translation $trans if {$opts(filename) != {}} { close $opts(channel) } } else { if {[llength $args] != 1} { return -code error "wrong \# args: should be\ \"crc16 ?-format string? ?-seed value? ?-impl procname?\ -file name | data\"" } set r [$opts(impl) [lindex $args 0] $opts(seed)] } return [format $opts(format) $r] } # ------------------------------------------------------------------------- # The user commands. See 'crc' # proc ::crc::crc16 {args} { return [eval [list crc -impl [namespace origin CRC16]] $args] } proc ::crc::crc-ccitt {args} { return [eval [list crc -impl [namespace origin CRC-CCITT] -seed 0xFFFF]\ $args] } proc ::crc::xmodem {args} { return [eval [list crc -impl [namespace origin CRC-CCITT] -seed 0] $args] } proc ::crc::crc-32 {args} { return [eval [list crc -impl [namespace origin CRC-32] -seed 0xFFFFFFFF]\ $args] } # ------------------------------------------------------------------------- package provide crc16 $crc::crc16_version # ------------------------------------------------------------------------- # # Local variables: # mode: tcl # indent-tabs-mode: nil # End: --- NEW FILE: crcc.tcl --- # crcc.tcl - Copyright (C) 2002 Pat Thoyts <pat...@us...> # # Place holder for building a critcl C module for this tcllib module. # # ------------------------------------------------------------------------- # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- # $Id: crcc.tcl,v 1.1 2005/12/29 22:18:02 ron-fox Exp $ package require critcl namespace eval ::crc { variable rcsid {$Id: crcc.tcl,v 1.1 2005/12/29 22:18:02 ron-fox Exp $} } package provide crcc 1.0.0 --- NEW FILE: sum.tcl --- # sum.tcl - Copyright (C) 2002 Pat Thoyts <pat...@us...> # # Provides a Tcl only implementation of the unix sum(1) command. There are # a number of these and they use differing algorithms to get a checksum of # the input data. We provide two: one using the BSD algorithm and the other # using the SysV algorithm. More consistent results across multiple # implementations can be obtained by using cksum(1). # # These commands have been checked against the GNU sum program from the GNU # textutils package version 2.0 to ensure the same results. # # ------------------------------------------------------------------------- # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- # $Id: sum.tcl,v 1.1 2005/12/29 22:18:02 ron-fox Exp $ package require Tcl 8.2; # tcl minimum version catch {package require tcllibc}; # critcl enhancements to tcllib #catch {package require crcc}; # critcl enhanced crc module namespace eval ::crc { variable sum_version 1.1.0 namespace export sum variable uid if {![info exists uid]} { set uid 0 } } # ------------------------------------------------------------------------- # Description: # The SysV algorithm is fairly naive. The byte values are summed and any # overflow is discarded. The lowest 16 bits are returned as the checksum. # Notes: # Input with the same content but different ordering will give the same # result. # proc ::crc::SumSysV {s {seed 0}} { set t $seed binary scan $s c* r foreach n $r { incr t [expr {$n & 0xFF}] } return [expr {$t % 0xFFFF}] } # ------------------------------------------------------------------------- # Description: # This algorithm is similar to the SysV version but includes a bit rotation # step which provides a dependency on the order of the data values. # proc ::crc::SumBsd {s {seed 0}} { set t $seed binary scan $s c* r foreach n $r { set t [expr {($t & 1) ? (($t >> 1) + 0x8000) : ($t >> 1)}] set t [expr {($t + ($n & 0xFF)) & 0xFFFF}] } return $t } # ------------------------------------------------------------------------- if {[package provide critcl] != {}} { namespace eval ::crc { critcl::ccommand SumSysV_c {dummy interp objc objv} { int r = TCL_OK; unsigned int t = 0; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "data ?seed?"); return TCL_ERROR; } if (objc == 3) r = Tcl_GetIntFromObj(interp, objv[2], (int *)&t); if (r == TCL_OK) { int cn, size; unsigned char *data; data = Tcl_GetByteArrayFromObj(objv[1], &size); for (cn = 0; cn < size; cn++) t += data[cn]; } Tcl_SetIntObj(Tcl_GetObjResult(interp), t & 0xFFFF); return r; } critcl::ccommand SumBsd_c {dummy interp objc objv} { int r = TCL_OK; unsigned int t = 0; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "data ?seed?"); return TCL_ERROR; } if (objc == 3) r = Tcl_GetIntFromObj(interp, objv[2], (int *)&t); if (r == TCL_OK) { int cn, size; unsigned char *data; data = Tcl_GetByteArrayFromObj(objv[1], &size); for (cn = 0; cn < size; cn++) { t = (t & 1) ? ((t >> 1) + 0x8000) : (t >> 1); t = (t + data[cn]) & 0xFFFF; } } Tcl_SetIntObj(Tcl_GetObjResult(interp), t & 0xFFFF); return r; } } } # ------------------------------------------------------------------------- # Switch from pure tcl to compiled if available. # if {[info command ::crc::SumBsd_c] == {}} { interp alias {} ::crc::sum-bsd {} ::crc::SumBsd } else { interp alias {} ::crc::sum-bsd {} ::crc::SumBsd_c } if {[info command ::crc::SumSysV_c] == {}} { interp alias {} ::crc::sum-sysv {} ::crc::SumSysV } else { interp alias {} ::crc::sum-sysv {} ::crc::SumSysV_c } # ------------------------------------------------------------------------- # Description: # Pop the nth element off a list. Used in options processing. # proc ::crc::Pop {varname {nth 0}} { upvar $varname args set r [lindex $args $nth] set args [lreplace $args $nth $nth] return $r } # ------------------------------------------------------------------------- # timeout handler for the chunked file handling # This avoids us waiting for ever # proc ::crc::SumTimeout {token} { # FRINK: nocheck variable $token upvar 0 $token state set state(error) "operation timed out" set state(reading) 0 } # ------------------------------------------------------------------------- # fileevent handler for chunked file handling. # proc ::crc::SumChunk {token channel} { # FRINK: nocheck variable $token upvar 0 $token state if {[eof $channel]} { fileevent $channel readable {} set state(reading) 0 } after cancel $state(after) set state(after) [after $state(timeout) \ [list [namespace origin SumTimeout] $token]] set state(result) [$state(algorithm) \ [read $channel $state(chunksize)] \ $state(result)] } # ------------------------------------------------------------------------- # Description: # Provide a Tcl equivalent of the unix sum(1) command. We default to the # BSD algorithm and return a checkum for the input string unless a filename # has been provided. Using sum on a file should give the same results as # the unix sum command with equivalent algorithm. # Options: # -bsd - use the BSD algorithm to calculate the checksum (default) # -sysv - use the SysV algorithm to calculate the checksum # -filename name - return a checksum for the specified file # -format string - return the checksum using this format string # proc ::crc::sum {args} { array set opts [list -filename {} -channel {} -chunksize 4096 \ -timeout 30000 -bsd 1 -sysv 0 -format %u \ algorithm [namespace origin sum-bsd]] while {[string match -* [set option [lindex $args 0]]]} { switch -glob -- $option { -bsd { set opts(-bsd) 1 ; set opts(-sysv) 0 } -sysv { set opts(-bsd) 0 ; set opts(-sysv) 1 } -file* { set opts(-filename) [Pop args 1] } -for* { set opts(-format) [Pop args 1] } -chan* { set opts(-channel) [Pop args 1] } -chunk* { set opts(-chunksize) [Pop args 1] } -time* { set opts(-timeout) [Pop args 1] } -- { Pop args ; break } default { set err [join [lsort [array names opts -*]] ", "] return -code error "bad option $option:\ must be one of $err" } } Pop args } # Set the correct sum algorithm if {$opts(-sysv)} { set opts(algorithm) [namespace origin sum-sysv] } # If a file was given - open it for binary reading. if {$opts(-filename) != {}} { set opts(-channel) [open $opts(-filename) r] fconfigure $opts(-channel) -translation binary } if {$opts(-channel) == {}} { if {[llength $args] != 1} { return -code error "wrong # args: should be \ \"sum ?-bsd|-sysv? ?-format string? ?-chunksize size? \ ?-timeout ms? -file name | -channel chan | data\"" } set r [$opts(algorithm) [lindex $args 0]] } else { # Create a unique token for the event handling variable uid set token [namespace current]::[incr uid] upvar #0 $token tok array set tok [list reading 1 result 0 timeout $opts(-timeout) \ chunksize $opts(-chunksize) \ algorithm $opts(algorithm)] set tok(after) [after $tok(timeout) \ [list [namespace origin SumTimeout] $token]] fileevent $opts(-channel) readable \ [list [namespace origin SumChunk] $token $opts(-channel)] vwait [subst $token](reading) # If we opened the channel we must close it too. if {$opts(-filename) != {}} { close $opts(-channel) } # Extract the result or error message if there was a problem. set r $tok(result) if {[info exists tok(error)]} { return -code error $tok(error) } unset tok } return [format $opts(-format) $r] } # ------------------------------------------------------------------------- package provide sum $::crc::sum_version # ------------------------------------------------------------------------- # Local Variables: # mode: tcl # indent-tabs-mode: nil # End: --- NEW FILE: cksum.tcl --- # cksum.tcl - Copyright (C) 2002 Pat Thoyts <pat...@us...> # # Provides a Tcl only implementation of the unix cksum(1) command. This is # similar to the sum(1) command but the algorithm is better defined and # standardized across multiple platforms by POSIX 1003.2/D11.2 # # This command has been verified against the cksum command from the GNU # textutils package version 2.0 # # ------------------------------------------------------------------------- # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- # $Id: cksum.tcl,v 1.1 2005/12/29 22:18:02 ron-fox Exp $ package require Tcl 8.2; # tcl minimum version namespace eval ::crc { variable cksum_version 1.0.1 namespace export cksum variable cksum_tbl [list 0x0 \ 0x04C11DB7 0x09823B6E 0x0D4326D9 0x130476DC 0x17C56B6B \ 0x1A864DB2 0x1E475005 0x2608EDB8 0x22C9F00F 0x2F8AD6D6 \ 0x2B4BCB61 0x350C9B64 0x31CD86D3 0x3C8EA00A 0x384FBDBD \ 0x4C11DB70 0x48D0C6C7 0x4593E01E 0x4152FDA9 0x5F15ADAC \ 0x5BD4B01B 0x569796C2 0x52568B75 0x6A1936C8 0x6ED82B7F \ 0x639B0DA6 0x675A1011 0x791D4014 0x7DDC5DA3 0x709F7B7A \ 0x745E66CD 0x9823B6E0 0x9CE2AB57 0x91A18D8E 0x95609039 \ 0x8B27C03C 0x8FE6DD8B 0x82A5FB52 0x8664E6E5 0xBE2B5B58 \ 0xBAEA46EF 0xB7A96036 0xB3687D81 0xAD2F2D84 0xA9EE3033 \ 0xA4AD16EA 0xA06C0B5D 0xD4326D90 0xD0F37027 0xDDB056FE \ 0xD9714B49 0xC7361B4C 0xC3F706FB 0xCEB42022 0xCA753D95 \ 0xF23A8028 0xF6FB9D9F 0xFBB8BB46 0xFF79A6F1 0xE13EF6F4 \ 0xE5FFEB43 0xE8BCCD9A 0xEC7DD02D 0x34867077 0x30476DC0 \ 0x3D044B19 0x39C556AE 0x278206AB 0x23431B1C 0x2E003DC5 \ 0x2AC12072 0x128E9DCF 0x164F8078 0x1B0CA6A1 0x1FCDBB16 \ 0x018AEB13 0x054BF6A4 0x0808D07D 0x0CC9CDCA 0x7897AB07 \ 0x7C56B6B0 0x71159069 0x75D48DDE 0x6B93DDDB 0x6F52C06C \ 0x6211E6B5 0x66D0FB02 0x5E9F46BF 0x5A5E5B08 0x571D7DD1 \ 0x53DC6066 0x4D9B3063 0x495A2DD4 0x44190B0D 0x40D816BA \ 0xACA5C697 0xA864DB20 0xA527FDF9 0xA1E6E04E 0xBFA1B04B \ 0xBB60ADFC 0xB6238B25 0xB2E29692 0x8AAD2B2F 0x8E6C3698 \ 0x832F1041 0x87EE0DF6 0x99A95DF3 0x9D684044 0x902B669D \ 0x94EA7B2A 0xE0B41DE7 0xE4750050 0xE9362689 0xEDF73B3E \ 0xF3B06B3B 0xF771768C 0xFA325055 0xFEF34DE2 0xC6BCF05F \ 0xC27DEDE8 0xCF3ECB31 0xCBFFD686 0xD5B88683 0xD1799B34 \ 0xDC3ABDED 0xD8FBA05A 0x690CE0EE 0x6DCDFD59 0x608EDB80 \ 0x644FC637 0x7A089632 0x7EC98B85 0x738AAD5C 0x774BB0EB \ 0x4F040D56 0x4BC510E1 0x46863638 0x42472B8F 0x5C007B8A \ 0x58C1663D 0x558240E4 0x51435D53 0x251D3B9E 0x21DC2629 \ 0x2C9F00F0 0x285E1D47 0x36194D42 0x32D850F5 0x3F9B762C \ 0x3B5A6B9B 0x0315D626 0x07D4CB91 0x0A97ED48 0x0E56F0FF \ 0x1011A0FA 0x14D0BD4D 0x19939B94 0x1D528623 0xF12F560E \ 0xF5EE4BB9 0xF8AD6D60 0xFC6C70D7 0xE22B20D2 0xE6EA3D65 \ 0xEBA91BBC 0xEF68060B 0xD727BBB6 0xD3E6A601 0xDEA580D8 \ 0xDA649D6F 0xC423CD6A 0xC0E2D0DD 0xCDA1F604 0xC960EBB3 \ 0xBD3E8D7E 0xB9FF90C9 0xB4BCB610 0xB07DABA7 0xAE3AFBA2 \ 0xAAFBE615 0xA7B8C0CC 0xA379DD7B 0x9B3660C6 0x9FF77D71 \ 0x92B45BA8 0x9675461F 0x8832161A 0x8CF30BAD 0x81B02D74 \ 0x857130C3 0x5D8A9099 0x594B8D2E 0x5408ABF7 0x50C9B640 \ 0x4E8EE645 0x4A4FFBF2 0x470CDD2B 0x43CDC09C 0x7B827D21 \ 0x7F436096 0x7200464F 0x76C15BF8 0x68860BFD 0x6C47164A \ 0x61043093 0x65C52D24 0x119B4BE9 0x155A565E 0x18197087 \ 0x1CD86D30 0x029F3D35 0x065E2082 0x0B1D065B 0x0FDC1BEC \ 0x3793A651 0x3352BBE6 0x3E119D3F 0x3AD08088 0x2497D08D \ 0x2056CD3A 0x2D15EBE3 0x29D4F654 0xC5A92679 0xC1683BCE \ 0xCC2B1D17 0xC8EA00A0 0xD6AD50A5 0xD26C4D12 0xDF2F6BCB \ 0xDBEE767C 0xE3A1CBC1 0xE760D676 0xEA23F0AF 0xEEE2ED18 \ 0xF0A5BD1D 0xF464A0AA 0xF9278673 0xFDE69BC4 0x89B8FD09 \ 0x8D79E0BE 0x803AC667 0x84FBDBD0 0x9ABC8BD5 0x9E7D9662 \ 0x933EB0BB 0x97FFAD0C 0xAFB010B1 0xAB710D06 0xA6322BDF \ 0xA2F33668 0xBCB4666D 0xB8757BDA 0xB5365D03 0xB1F740B4 ] } # Description: # Calculate a cksum(1) compatible 32 bit checksum for the input data. # # This procedure has been broken into two parts to permit working on # a file in small sections. # proc ::crc::Cksum {s} { set t 0 set l 0 Cksum_chunk s t l return [Cksum_finalize t l] } proc ::crc::Cksum_chunk {data_var sum_var len_var} { variable cksum_tbl upvar $data_var s upvar $sum_var t upvar $len_var l binary scan $s c* r foreach {n} $r { set t [expr {($t << 8) ^ [lindex $cksum_tbl [expr { (($t >> 24) \ ^ ($n & 0xFF)) & 0xFF }]]}] incr l } } proc ::crc::Cksum_finalize {sum_var len_var} { variable cksum_tbl upvar $sum_var t upvar $len_var l for {set i $l} {$i > 0} {set i [expr {$i>>8}]} { set t [expr {($t << 8) \ ^ [lindex $cksum_tbl \ [expr {(($t >> 24) ^ $i) & 0xFF}]]}] } return [expr {~$t & 0xFFFFFFFF}] } # Description: # Provide a Tcl equivalent of the unix cksum(1) command. # Options: # -filename name - return a checksum for the specified file. # -format string - return the checksum using this format string. # -chunksize size - set the chunking read size # proc ::crc::cksum {args} { set filename {} set format %u set chunksize 10240 while {[string match -* [lindex $args 0]]} { switch -glob -- [lindex $args 0] { -fi* { set filename [lindex $args 1] set args [lreplace $args 0 0] } -fo* { set format [lindex $args 1] set args [lreplace $args 0 0] } -ch* - -bu* { set chunksize [lindex $args 1] set args [lreplace $args 0 0] } -- { set args [lreplace $args 0 0] break } default { return -code error "bad option [lindex $args 0]:\ must be -filename or -format" } } set args [lreplace $args 0 0] } if {$filename != {}} { set cksum 0 set cklen 0 set f [open $filename r] fconfigure $f -translation binary while {![eof $f]} { set chunk [read $f $chunksize] Cksum_chunk chunk cksum cklen } close $f set r [Cksum_finalize cksum cklen] } else { if {[llength $args] != 1} { return -code error "wrong # args: should be \ \"cksum ?-format string? -file name | data\"" } set r [Cksum [lindex $args 0]] } return [format $format $r] } # ------------------------------------------------------------------------- package provide cksum $::crc::cksum_version # ------------------------------------------------------------------------- # Local variables: # mode: tcl # indent-tabs-mode: nil # End: --- NEW FILE: crc32.tcl --- # crc32.tcl -- Copyright (C) 2002 Pat Thoyts <pat...@us...> # # CRC32 Cyclic Redundancy Check. # (for algorithm see http://www.rad.com/networks/1994/err_con/crc.htm) # # From http://mini.net/tcl/2259.tcl # Written by Wayland Augur and Pat Thoyts. # # ------------------------------------------------------------------------- # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- # $Id: crc32.tcl,v 1.1 2005/12/29 22:18:02 ron-fox Exp $ namespace eval ::crc { variable crc32_version 1.1.1 namespace export crc32 variable crc32_tbl [list 0x00000000 0x77073096 0xEE0E612C 0x990951BA \ 0x076DC419 0x706AF48F 0xE963A535 0x9E6495A3 \ 0x0EDB8832 0x79DCB8A4 0xE0D5E91E 0x97D2D988 \ 0x09B64C2B 0x7EB17CBD 0xE7B82D07 0x90BF1D91 \ 0x1DB71064 0x6AB020F2 0xF3B97148 0x84BE41DE \ 0x1ADAD47D 0x6DDDE4EB 0xF4D4B551 0x83D385C7 \ 0x136C9856 0x646BA8C0 0xFD62F97A 0x8A65C9EC \ 0x14015C4F 0x63066CD9 0xFA0F3D63 0x8D080DF5 \ 0x3B6E20C8 0x4C69105E 0xD56041E4 0xA2677172 \ 0x3C03E4D1 0x4B04D447 0xD20D85FD 0xA50AB56B \ 0x35B5A8FA 0x42B2986C 0xDBBBC9D6 0xACBCF940 \ 0x32D86CE3 0x45DF5C75 0xDCD60DCF 0xABD13D59 \ 0x26D930AC 0x51DE003A 0xC8D75180 0xBFD06116 \ 0x21B4F4B5 0x56B3C423 0xCFBA9599 0xB8BDA50F \ 0x2802B89E 0x5F058808 0xC60CD9B2 0xB10BE924 \ 0x2F6F7C87 0x58684C11 0xC1611DAB 0xB6662D3D \ 0x76DC4190 0x01DB7106 0x98D220BC 0xEFD5102A \ 0x71B18589 0x06B6B51F 0x9FBFE4A5 0xE8B8D433 \ 0x7807C9A2 0x0F00F934 0x9609A88E 0xE10E9818 \ 0x7F6A0DBB 0x086D3D2D 0x91646C97 0xE6635C01 \ 0x6B6B51F4 0x1C6C6162 0x856530D8 0xF262004E \ 0x6C0695ED 0x1B01A57B 0x8208F4C1 0xF50FC457 \ 0x65B0D9C6 0x12B7E950 0x8BBEB8EA 0xFCB9887C \ 0x62DD1DDF 0x15DA2D49 0x8CD37CF3 0xFBD44C65 \ 0x4DB26158 0x3AB551CE 0xA3BC0074 0xD4BB30E2 \ 0x4ADFA541 0x3DD895D7 0xA4D1C46D 0xD3D6F4FB \ 0x4369E96A 0x346ED9FC 0xAD678846 0xDA60B8D0 \ 0x44042D73 0x33031DE5 0xAA0A4C5F 0xDD0D7CC9 \ 0x5005713C 0x270241AA 0xBE0B1010 0xC90C2086 \ 0x5768B525 0x206F85B3 0xB966D409 0xCE61E49F \ 0x5EDEF90E 0x29D9C998 0xB0D09822 0xC7D7A8B4 \ 0x59B33D17 0x2EB40D81 0xB7BD5C3B 0xC0BA6CAD \ 0xEDB88320 0x9ABFB3B6 0x03B6E20C 0x74B1D29A \ 0xEAD54739 0x9DD277AF 0x04DB2615 0x73DC1683 \ 0xE3630B12 0x94643B84 0x0D6D6A3E 0x7A6A5AA8 \ 0xE40ECF0B 0x9309FF9D 0x0A00AE27 0x7D079EB1 \ 0xF00F9344 0x8708A3D2 0x1E01F268 0x6906C2FE \ 0xF762575D 0x806567CB 0x196C3671 0x6E6B06E7 \ 0xFED41B76 0x89D32BE0 0x10DA7A5A 0x67DD4ACC \ 0xF9B9DF6F 0x8EBEEFF9 0x17B7BE43 0x60B08ED5 \ 0xD6D6A3E8 0xA1D1937E 0x38D8C2C4 0x4FDFF252 \ 0xD1BB67F1 0xA6BC5767 0x3FB506DD 0x48B2364B \ 0xD80D2BDA 0xAF0A1B4C 0x36034AF6 0x41047A60 \ 0xDF60EFC3 0xA867DF55 0x316E8EEF 0x4669BE79 \ 0xCB61B38C 0xBC66831A 0x256FD2A0 0x5268E236 \ 0xCC0C7795 0xBB0B4703 0x220216B9 0x5505262F \ 0xC5BA3BBE 0xB2BD0B28 0x2BB45A92 0x5CB36A04 \ 0xC2D7FFA7 0xB5D0CF31 0x2CD99E8B 0x5BDEAE1D \ 0x9B64C2B0 0xEC63F226 0x756AA39C 0x026D930A \ 0x9C0906A9 0xEB0E363F 0x72076785 0x05005713 \ 0x95BF4A82 0xE2B87A14 0x7BB12BAE 0x0CB61B38 \ 0x92D28E9B 0xE5D5BE0D 0x7CDCEFB7 0x0BDBDF21 \ 0x86D3D2D4 0xF1D4E242 0x68DDB3F8 0x1FDA836E \ 0x81BE16CD 0xF6B9265B 0x6FB077E1 0x18B74777 \ 0x88085AE6 0xFF0F6A70 0x66063BCA 0x11010B5C \ 0x8F659EFF 0xF862AE69 0x616BFFD3 0x166CCF45 \ 0xA00AE278 0xD70DD2EE 0x4E048354 0x3903B3C2 \ 0xA7672661 0xD06016F7 0x4969474D 0x3E6E77DB \ 0xAED16A4A 0xD9D65ADC 0x40DF0B66 0x37D83BF0 \ 0xA9BCAE53 0xDEBB9EC5 0x47B2CF7F 0x30B5FFE9 \ 0xBDBDF21C 0xCABAC28A 0x53B39330 0x24B4A3A6 \ 0xBAD03605 0xCDD70693 0x54DE5729 0x23D967BF \ 0xB3667A2E 0xC4614AB8 0x5D681B02 0x2A6F2B94 \ 0xB40BBE37 0xC30C8EA1 0x5A05DF1B 0x2D02EF8D] # calculate the sign bit for the current platform. variable signbit if {![info exists signbit]} { for {set v 1} {$v != 0} {set signbit $v; set v [expr {$v<<1}]} {} } } # ------------------------------------------------------------------------- # Description: # Calculate the CRC-32 checksum of the input data. # proc ::crc::Crc32_tcl {s {seed 0xFFFFFFFF}} { variable crc32_tbl variable signbit set signmask [expr {~$signbit>>7}] set crcval $seed binary scan $s c* nums foreach {n} $nums { set ndx [expr {($crcval ^ $n) & 0xFF}] set lkp [lindex $crc32_tbl $ndx] set crcval [expr {($lkp ^ ($crcval >> 8 & $signmask)) & 0xFFFFFFFF}] } return [expr {$crcval ^ 0xFFFFFFFF}] } if {[package provide critcl] != {}} { namespace eval ::crc { critcl::ccommand Crc32_c {dummy interp objc objv} { int r = TCL_OK; unsigned long t = 0xFFFFFFFFL; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "data ?seed?"); return TCL_ERROR; } if (objc == 3) r = Tcl_GetLongFromObj(interp, objv[2], (long *)&t); if (r == TCL_OK) { int cn, size, ndx; unsigned char *data; unsigned long lkp; Tcl_Obj *tblPtr, *lkpPtr; tblPtr = Tcl_GetVar2Ex(interp, "::crc::crc32_tbl", NULL, TCL_LEAVE_ERR_MSG ); if (tblPtr == NULL) r = TCL_ERROR; if (r == TCL_OK) data = Tcl_GetByteArrayFromObj(objv[1], &size); for (cn = 0; r == TCL_OK && cn < size; cn++) { ndx = (t ^ data[cn]) & 0xFF; r = Tcl_ListObjIndex(interp, tblPtr, ndx, &lkpPtr); if (r == TCL_OK) r = Tcl_GetLongFromObj(interp, lkpPtr, &lkp); if (r == TCL_OK) t = lkp ^ (t >> 8); } } if (r == TCL_OK) Tcl_SetLongObj(Tcl_GetObjResult(interp), t ^ 0xFFFFFFFF); return r; } } } # Select the Trf using version if Trf is available if {![catch {package require Trf 2.0}]} { # Description: # Use the Trf crc-zlib function to calculate the CRC-32 checksum # and return the correct value according to our byte order. # proc ::crc::Crc32_trf {s {seed 0xFFFFFFFF}} { if {$seed != 0xFFFFFFFF} { return -code error "invalid option: the Trf crc32 command cannot\ accept a seed value" } binary scan [crc-zlib -- $s] i r return $r } interp alias {} ::crc::Crc32 {} ::crc::Crc32_trf } else { interp alias {} ::crc::Crc32 {} ::crc::Crc32_tcl } #crc-zlib -attach $f -mode absorb \ # -read-destination ::R \ # -read-type variable \ # -write-destination ::W \ # -write-type variable \ # -matchflag ::M # ------------------------------------------------------------------------- # Description: # Pop the nth element off a list. Used in options processing. # proc ::crc::Pop {varname {nth 0}} { upvar $varname args set r [lindex $args $nth] set args [lreplace $args $nth $nth] return $r } # ------------------------------------------------------------------------- # Description: # Provide a Tcl implementation of a crc32 checksum similar to the cksum # and sum unix commands. # Options: # -filename name - return a checksum for the specified file. # -format string - return the checksum using this format string. # -seed value - seed the algorithm using value (default is 0xffffffff) # proc ::crc::crc32 {args} { array set opts [list -filename {} -format %u -seed 0xffffffff \ -channel {} -chunksize 4096 -timeout 30000 \ -implementation [namespace origin Crc32]] while {[string match -* [set option [lindex $args 0]]]} { switch -glob -- $option { -file* { set opts(-filename) [Pop args 1] } -for* { set opts(-format) [Pop args 1] } -chan* { set opts(-channel) [Pop args 1] } -chunk* { set opts(-chunksize) [Pop args 1] } -time* { set opts(-timeout) [Pop args 1] } -seed { set opts(-seed) [Pop args 1] } -impl* { set opts(-implementation) \ [uplevel 1 namespace origin [Pop args 1]] } -- { Pop args ; break } default { set err [join [lsort [array names opts -*]] ", "] return -code error "bad option \"$option\": must be $err" } } Pop args } # The Trf implementation doesn't accept an alternative CRC seed so # use the Tcl implementation if this is set (unless the user has # set it to some other impl). if {$opts(-seed) != 0xffffffff \ && [string match [namespace origin Crc32] $opts(-implementation)]} { set opts(-implementation) [namespace origin Crc32_tcl] } # If a file was given - open it if {$opts(-filename) != {}} { set opts(-channel) [open $opts(-filename) r] fconfigure $opts(-channel) -translation binary } if {$opts(-channel) == {}} { if {[llength $args] != 1} { return -code error "wrong # args: should be \ \"crc32 ?-format string? ?-seed value? ?-impl procname?\ -file name | data\"" } set r [$opts(-implementation) [lindex $args 0] $opts(-seed)] } else { set r $opts(-seed) # If we are using Trf - we cannot chunk if {[package provide Trf] != {} \ && [string match [namespace origin Crc32] \ $opts(-implementation)]} { set data [read $opts(-channel)] set r [$opts(-implementation) $data $r] } else { # Process the chunks. We need to undo the final xor # to obtain the seed for the following chunk. Then re-apply # for the final result. while {![eof $opts(-channel)]} { set data [read $opts(-channel) $opts(-chunksize)] set r [$opts(-implementation) $data $r] set r [expr {$r ^ 0xFFFFFFFF}] } set r [expr {$r ^ 0xFFFFFFFF}] } if {$opts(-filename) != {}} { close $opts(-channel) } } return [format $opts(-format) $r] } # ------------------------------------------------------------------------- package provide crc32 $::crc::crc32_version # ------------------------------------------------------------------------- # # Local variables: # mode: tcl # indent-tabs-mode: nil # End: |
|
From: Ron F. <ro...@us...> - 2005-12-29 22:18:20
|
Update of /cvsroot/nscldaq/bufdump/tcllib/exif In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11466/tcllib/exif Added Files: exif.tcl pkgIndex.tcl Log Message: Initial commit of import and Makefiles that can make starpacks for windows and linux systems. --- NEW FILE: exif.tcl --- # EXIF parser in Tcl # Author: Darren New <dn...@sa...> # Translated directly from the Perl version # by Chris Breeze <ch...@br...> # http://www.breezesys.com # See the original comment block, reproduced # at the bottom. # Most of the inline comments about the meanings of fields # are copied verbatim and without understanding from the # original, unless "DNew" is there. # Much of the structure is preserved, except in # makerNote, where I got tired of typing as verbosely # as the original Perl. But thanks for making it so # readable that even someone who doesn't know Perl # could translate it, Chris! ;-) # PLEASE read and understand exif::fieldnames # BEFORE making any changes here! Thanks! # Usage of this version: # exif::analyze $stream ?$thumbnail? # Stream should be an open file handle # rewound to the start. It gets set to # binary mode and is left at EOF or # possibly pointing at image data. # You have to open and close the # stream yourself. # The return is a serialized array # (a la [array get]) with informative # english text about what was found. # Errors in parsing or I/O or whatever # throw errors. # exif::allfields # returns a list of all possible field names. # Added by DNew. Funky implementation. # # New # exif::analyzeFile $filename ?$thumbnail? # # If you find any mistakes here, feel free to correct them # and/or send them to me. I just cribbed this - I don't even # have a camera that puts this kind of info into the file. # LICENSE: Standard BSD License. # There's probably something here I'm using without knowing it. package require Tcl 8.3 package provide exif 1.1.1 ; # first release namespace eval ::exif { namespace export analyze analyzeFile fieldnames variable debug 0 ; # set to 1 for puts of debug trace variable cameraModel ; # used internally to understand options variable jpeg_markers ; # so we only have to do it once variable intel ; # byte order - so we don't have to pass to every read variable cached_fieldnames ; # just what it says array set jpeg_markers { SOF0 \xC0 DHT \xC4 SOI \xD8 EOI \xD9 SOS \xDA DQT \xDB DRI \xDD APP1 \xE1 } } proc ::exif::debug {str} { variable debug if {$debug} {puts $str} } proc ::exif::streq {s1 s2} { return [string equal $s1 $s2] } proc ::exif::analyzeFile {file {thumbnail {}}} { set stream [open $file] set res [analyze $stream $thumbnail] close $stream return $res } proc ::exif::analyze {stream {thumbnail {}}} { variable jpeg_markers array set result {} fconfigure $stream -translation binary -encoding binary while {![eof $stream]} { set ch [read $stream 1] if {1 != [string length $ch]} {error "End of file reached @1"} if {![streq "\xFF" $ch]} {break} ; # skip image data set marker [read $stream 1] if {1 != [string length $marker]} {error "End of file reached @2"} if {[streq $marker $jpeg_markers(SOI)]} { debug "SOI" } elseif {[streq $marker $jpeg_markers(EOI)]} { debug "EOI" } else { set msb [read $stream 1] set lsb [read $stream 1] if {1 != [string length $msb] || 1 != [string length $lsb]} { error "File truncated @1" } scan $msb %c msb ; scan $lsb %c lsb set size [expr {256 * $msb + $lsb}] set data [read $stream [expr {$size-2}]] debug "read [expr {$size - 2}] bytes of data" if {[expr {$size-2}] != [string length $data]} { error "File truncated @2" } if {[streq $marker $jpeg_markers(APP1)]} { debug "APP1\t$size" array set result [app1 $data $thumbnail] } elseif {[streq $marker $jpeg_markers(DQT)]} { debug "DQT\t$size" } elseif {[streq $marker $jpeg_markers(SOF0)]} { debug "SOF0\t$size" } elseif {[streq $marker $jpeg_markers(DHT)]} { debug "DHT\t$size" } elseif {[streq $marker $jpeg_markers(SOS)]} { debug "SOS\t$size" } else { binary scan $marker H* x debug "UNKNOWN MARKER $x" } } } return [array get result] } proc ::exif::app1 {data thumbnail} { variable intel variable cameraModel array set result {} if {![string equal [string range $data 0 5] "Exif\0\0"]} { error "APP1 does not contain EXIF" } debug "Reading EXIF data" set data [string range $data 6 end] set t [string range $data 0 1] if {[streq $t "II"]} { set intel 1 debug "Intel byte alignment" } elseif {[streq $t "MM"]} { set intel 0 debug "Motorola byte alignment" } else { error "Invalid byte alignment: $t" } if {[readShort $data 2]!=0x002A} {error "Invalid tag mark"} set curoffset [readLong $data 4] ; # just called "offset" in the Perl - DNew debug "Offset to first IFD: $curoffset" set numEntries [readShort $data $curoffset] incr curoffset 2 debug "Number of directory entries: $numEntries" for {set i 0} {$i < $numEntries} {incr i} { set head [expr {$curoffset + 12 * $i}] set entry [string range $data $head [expr {$head+11}]] set tag [readShort $entry 0] set format [readShort $entry 2] set components [readLong $entry 4] set offset [readLong $entry 8] set value [readIFDEntry $data $format $components $offset] if {$tag==0x010e} { set result(ImageDescription) $value } elseif {$tag==0x010f} { set result(CameraMake) $value } elseif {$tag==0x0110} { set result(CameraModel) $value set cameraModel $value } elseif {$tag==0x0112} { set result(Orientation) $value } elseif {$tag == 0x011A} { set result(XResolution) $value } elseif {$tag == 0x011B} { set result(YResolution) $value } elseif {$tag == 0x0128} { set result(ResolutionUnit) "unknown" if {$value==2} {set result(ResolutionUnit) "inch"} if {$value==3} {set result(ResolutionUnit) "centimeter"} } elseif {$tag==0x0131} { set result(Software) $value } elseif {$tag==0x0132} { set result(DateTime) $value } elseif {$tag==0x0213} { set result(YCbCrPositioning) "unknown" if {$value==1} {set result(YCbCrPositioning) "Center of pixel array"} if {$value==2} {set result(YCbCrPositioning) "Datum point"} } elseif {$tag==0x8769} { # EXIF sub IFD debug "==CALLING exifSubIFD==" array set result [exifSubIFD $data $offset] } else { debug "Unrecognized entry: Tag=$tag, value=$value" } } set offset [readLong $data [expr {$curoffset + 12 * $numEntries}]] debug "Offset to next IFD: $offset" array set thumb_result [exifSubIFD $data $offset] if {$thumbnail != {}} { set jpg [string range $data \ $thumb_result(JpegIFOffset) \ [expr {$thumb_result(JpegIFOffset) + $thumb_result(JpegIFByteCount) - 1}]] set to [open $thumbnail w] fconfigure $to -translation binary -encoding binary puts $to $jpg close $to #can be used (with a JPG-aware TK) to add the image to the result array #set result(THUMB) [image create photo -file $thumbnail] } return [array get result] } # Extract EXIF sub IFD info proc ::exif::exifSubIFD {data curoffset} { debug "EXIF: offset=$curoffset" set numEntries [readShort $data $curoffset] incr curoffset 2 debug "Number of directory entries: $numEntries" for {set i 0} {$i < $numEntries} {incr i} { set head [expr {$curoffset + 12 * $i}] set entry [string range $data $head [expr {$head+11}]] set tag [readShort $entry 0] set format [readShort $entry 2] set components [readLong $entry 4] set offset [readLong $entry 8] if {$tag==0x9000} { set result(ExifVersion) [string range $entry 8 11] } elseif {$tag==0x9101} { set result(ComponentsConfigured) [format 0x%08x $offset] } elseif {$tag == 0x927C} { array set result [makerNote $data $offset] } elseif {$tag == 0x9286} { # Apparently, this doesn't usually work. set result(UserComment) "$offset - [string range $data $offset [expr {$offset+8}]]" set result(UserComment) [string trim $result(UserComment) "\0"] } elseif {$tag==0xA000} { set result(FlashPixVersion) [string range $entry 8 11] } elseif {$tag==0xA300} { # 3 means digital camera if {$offset == 3} { set result(FileSource) "3 - Digital camera" } else { set result(FileSource) $offset } } else { set value [readIFDEntry $data $format $components $offset] if {$tag==0x829A} { if {0.3 <= $value} { # In seconds... set result(ExposureTime) "$value seconds" } else { set result(ExposureTime) "1/[expr {1.0/$value}] seconds" } } elseif {$tag == 0x829D} { set result(FNumber) $value } elseif {$tag == 0x8827} { # D30 stores ISO here, G1 uses MakerNote Tag 1 field 16 set result(ISOSpeedRatings) $value } elseif {$tag == 0x9003} { set result(DateTimeOriginal) $value } elseif {$tag == 0x9004} { set result(DateTimeDigitized) $value } elseif {$tag == 0x9102} { if {$value == 5} { set result(ImageQuality) "super fine" } elseif {$value == 3} { set result(ImageQuality) "fine" } elseif {$value == 2} { set result(ImageQuality) "normal" } else { set result(CompressedBitsPerPixel) $value } } elseif {$tag == 0x9201} { # Not very accurate, use Exposure time instead. # (That's Chris' comment. I don't know what it means.) set value [expr {pow(2,$value)}] if {$value < 4} { set value [expr {1.0 / $value}] set value [expr {int($value * 10 + 0.5) / 10.0}] } else { set value [expr {int($value + 0.49)}] } set result(ShutterSpeedValue) "$value Hz" } elseif {$tag == 0x9202} { set value [expr {int(pow(sqrt(2.0), $value) * 10 + 0.5) / 10.0}] set result(AperatureValue) $value } elseif {$tag == 0x9204} { set value [compensationFraction $value] set result(ExposureBiasValue) $value } elseif {$tag == 0x9205} { set value [expr {int(pow(sqrt(2.0), $value) * 10 + 0.5) / 10.0}] } elseif {$tag == 0x9206} { # May need calibration set result(SubjectDistance) "$value m" } elseif {$tag == 0x9207} { set result(MeteringMode) "other" if {$value == 0} {set result(MeteringMode) "unknown"} if {$value == 1} {set result(MeteringMode) "average"} if {$value == 2} {set result(MeteringMode) "center weighted average"} if {$value == 3} {set result(MeteringMode) "spot"} if {$value == 4} {set result(MeteringMode) "multi-spot"} if {$value == 5} {set result(MeteringMode) "multi-segment"} if {$value == 6} {set result(MeteringMode) "partial"} } elseif {$tag == 0x9209} { if {$value == 0} { set result(Flash) no } elseif {$value == 1} { set result(Flash) yes } else { set result(Flash) "unknown: $value" } } elseif {$tag == 0x920a} { set result(FocalLength) "$value mm" } elseif {$tag == 0xA001} { set result(ColorSpace) $value } elseif {$tag == 0xA002} { set result(ExifImageWidth) $value } elseif {$tag == 0xA003} { set result(ExifImageHeight) $value } elseif {$tag == 0xA005} { set result(ExifInteroperabilityOffset) $value } elseif {$tag == 0xA20E} { set result(FocalPlaneXResolution) $value } elseif {$tag == 0xA20F} { set result(FocalPlaneYResolution) $value } elseif {$tag == 0xA210} { set result(FocalPlaneResolutionUnit) "none" if {$value == 2} {set result(FocalPlaneResolutionUnit) "inch"} if {$value == 3} {set result(FocalPlaneResolutionUnit) "centimeter"} } elseif {$tag == 0xA217} { # 2 = 1 chip color area sensor set result(SensingMethod) $value } elseif {$tag == 0xA401} { #TJE set result(SensingMethod) "normal" if {$value == 1} {set result(SensingMethod) "custom"} } elseif {$tag == 0xA402} { #TJE set result(ExposureMode) "auto" if {$value == 1} {set result(ExposureMode) "manual"} if {$value == 2} {set result(ExposureMode) "auto bracket"} } elseif {$tag == 0xA403} { #TJE set result(WhiteBalance) "auto" if {$value == 1} {set result(WhiteBalance) "manual"} } elseif {$tag == 0xA404} { # digital zoom not used if number is zero set result(DigitalZoomRatio) "not used" if {$value != 0} {set result(DigitalZoomRatio) $value} } elseif {$tag == 0xA405} { set result(FocalLengthIn35mmFilm) "unknown" if {$value != 0} {set result(FocalLengthIn35mmFilm) $value} } elseif {$tag == 0xA406} { set result(SceneCaptureType) "Standard" if {$value == 1} {set result(SceneCaptureType) "Landscape"} if {$value == 2} {set result(SceneCaptureType) "Portrait"} if {$value == 3} {set result(SceneCaptureType) "Night scene"} } elseif {$tag == 0xA407} { set result(GainControl) "none" if {$value == 1} {set result(GainControl) "Low gain up"} if {$value == 2} {set result(GainControl) "High gain up"} if {$value == 3} {set result(GainControl) "Low gain down"} if {$value == 4} {set result(GainControl) "High gain down"} } elseif {$tag == 0x0103} { #TJE set result(Compression) "unknown" if {$value == 1} {set result(Compression) "none"} if {$value == 6} {set result(Compression) "JPEG"} } elseif {$tag == 0x011A} { #TJE set result(XResolution) $value } elseif {$tag == 0x011B} { #TJE set result(YResolution) $value } elseif {$tag == 0x0128} { #TJE set result(ResolutionUnit) "unknown" if {$value == 1} {set result(ResolutionUnit) "inch"} if {$value == 6} {set result(ResolutionUnit) "cm"} } elseif {$tag == 0x0201} { #TJE set result(JpegIFOffset) $value debug "offset = $value" } elseif {$tag == 0x0202} { #TJE set result(JpegIFByteCount) $value debug "bytecount = $value" } else { error "Unrecognized EXIF Tag: $tag (0x[string toupper [format %x $tag]])" } } } return [array get result] } # Canon proprietary data that I didn't feel like translating to Tcl yet. proc ::exif::makerNote {data curoffset} { variable cameraModel debug "MakerNote: offset=$curoffset" array set result {} set numEntries [readShort $data $curoffset] incr curoffset 2 debug "Number of directory entries: $numEntries" for {set i 0} {$i < $numEntries} {incr i} { set head [expr {$curoffset + 12 * $i}] set entry [string range $data $head [expr {$head+11}]] set tag [readShort $entry 0] set format [readShort $entry 2] set components [readLong $entry 4] set offset [readLong $entry 8] debug "$i)\tTag: $tag, format: $format, components: $components" if {$tag==6} { set value [readIFDEntry $data $format $components $offset] set result(ImageFormat) $value } elseif {$tag==7} { set value [readIFDEntry $data $format $components $offset] set result(FirmwareVersion) $value } elseif {$tag==8} { set value [string range $offset 0 2]-[string range $offset 3 end] set result(ImageNumber) $value } elseif {$tag==9} { set value [readIFDEntry $data $format $components $offset] set result(Owner) $value } elseif {$tag==0x0C} { # camera serial number set msw [expr {($offset >> 16) & 0xFFFF}] set lsw [expr {$offset & 0xFFFF}] set result(CameraSerialNumber) [format %04X%05d $msw $lsw] } elseif {$tag==0x10} { set result(UnknownTag-0x10) $offset } else { if {$format == 3 && 1 < $components} { debug "MakerNote $i: TAG=$tag" catch {unset field} array set field {} for {set j 0} {$j < $components} {incr j} { set field($j) [readShort $data [expr {$offset+2*$j}]] debug "$j : $field($j)" } if {$tag == 1} { if {![string match -nocase "*Pro90*" $cameraModel]} { if {$field(1)==1} { set result(MacroMode) macro } else { set result(MacroMode) normal } } if {0 < $field(2)} { set result(SelfTimer) "[expr {$field(2)/10.0}] seconds" } set result(ImageQuality) [switch $field(3) { 2 {format Normal} 3 {format Fine} 4 {format "CCD Raw"} 5 {format "Super fine"} default {format ""} }] set result(FlashMode) [switch $field(4) { 0 {format off} 1 {format auto} 2 {format on} 3 {format "red eye reduction"} 4 {format "slow synchro"} 5 {format "auto + red eye reduction"} 6 {format "on + red eye reduction"} default {format ""} }] if {$field(5)} { set result(ShootingMode) "Continuous" } else { set result(ShootingMode) "Single frame" } # Field 6 - don't know what it is. set result(AutoFocusMode) [switch $field(7) { 0 {format "One-shot"} 1 {format "AI servo"} 2 {format "AI focus"} 3 - 6 {format "MF"} 5 {format "Continuous"} 4 { # G1: uses field 32 to store single/continuous, # and always sets 7 to 4. if {[info exists field(32)] && $field(32)} { format "Continuous" } else { format "Single" } } default {format unknown} }] # Field 8 and 9 are unknown set result(ImageSize) [switch $field(10) { 0 {format "large"} 1 {format "medium"} 2 {format "small"} default {format "unknown"} }] # Field 11 - easy shooting - see field 20 # Field 12 - unknown set NHL { 0 {format "Normal"} 1 {format "High"} 65536 {format "Low"} default {format "Unknown"} } set result(Contrast) [switch $field(13) $NHL] set result(Saturation) [switch $field(14) $NHL] set result(Sharpness) [switch $field(15) $NHL] set result(ISO) [switch $field(16) { 15 {format Auto} 16 {format 50} 17 {format 100} 18 {format 200} 19 {format 400} default {format "unknown"} }] set result(MeteringMode) [switch $field(17) { 3 {format evaluative} 4 {format partial} 5 {format center-weighted} default {format unknown} }] # Field 18 - unknown set result(AFPoint) [switch -- [expr {$field(19)-0x3000}] { 0 {format none} 1 {format auto-selected} 2 {format right} 3 {format center} 4 {format left} default {format unknown} }] ; # {} if {[info exists field(20)]} { if {$field(20) == 0} { set result(ExposureMode) [switch $field(11) { 0 {format auto} 1 {format manual} 2 {format landscape} 3 {format "fast shutter"} 4 {format "slow shutter"} 5 {format "night scene"} 6 {format "black and white"} 7 {format sepia} 8 {format portrait} 9 {format sports} 10 {format close-up} 11 {format "pan focus"} default {format unknown} }] ; # {} } elseif {$field(20) == 1} { set result(ExposureMode) program } elseif {$field(20) == 2} { set result(ExposureMode) Tv } elseif {$field(20) == 3} { set result(ExposureMode) Av } elseif {$field(20) == 4} { set result(ExposureMode) manual } elseif {$field(20) == 5} { set result(ExposureMode) A-DEP } else { set result(ExposureMode) unknown } } # Field 21 and 22 are unknown # Field 23: max focal len, 24 min focal len, 25 units per mm if {[info exists field(23)] && [info exists field(25)]} { set result(MaxFocalLength) \ "[expr {1.0 * $field(23) / $field(25)}] mm" } if {[info exists field(24)] && [info exists field(25)]} { set result(MinFocalLength) \ "[expr {1.0 * $field(24) / $field(25)}] mm" } # Field 26-28 are unknown. if {[info exists field(29)]} { if {$field(29) & 0x0010} { lappend result(FlashMode) "FP_sync_enabled" } if {$field(29) & 0x0800} { lappend result(FlashMode) "FP_sync_used" } if {$field(29) & 0x2000} { lappend result(FlashMode) "internal_flash" } if {$field(29) & 0x4000} { lappend result(FlashMode) "external_E-TTL" } } if {[info exists field(34)] && \ [string match -nocase "*pro90*" $cameraModel]} { if {$field(34)} { set result(ImageStabilisation) on } else { set result(ImageStabilisation) off } } } elseif {$tag == 4} { set result(WhiteBalance) [switch $field(7) { 0 {format Auto} 1 {format Daylight} 2 {format Cloudy} 3 {format Tungsten} 4 {format Fluorescent} 5 {format Flash} 6 {format Custom} default {format Unknown} }] if {$field(14) & 0x07} { set result(AFPointsUsed) \ [expr {($field(14)>>12) & 0x0F}] if {$field(14)&0x04} { append result(AFPointsUsed) " left" } if {$field(14)&0x02} { append result(AFPointsUsed) " center" } if {$field(14)&0x01} { append result(AFPointsUsed) " right" } } if {[info exists field(15)]} { set v $field(15) if {32768 < $v} {incr v -65536} set v [compensationFraction [expr {$v / 32.0}]] set result(FlashExposureCompensation) $v } if {[info exists field(19)]} { set result(SubjectDistance) "$field(19) m" } } elseif {$tag == 15} { foreach k [array names field] { set func [expr {($field($k) >> 8) & 0xFF}] set v [expr {$field($k) & 0xFF}] if {$func==1 && $v} { set result(LongExposureNoiseReduction) on } elseif {$func==1 && !$v} { set result(LongExposureNoiseReduction) off } elseif {$func==2} { set result(Shutter/AE-Lock) [switch $v { 0 {format "AF/AE lock"} 1 {format "AE lock/AF"} 2 {format "AF/AF lock"} 3 {format "AE+release/AE+AF"} default {format "Unknown"} }] } elseif {$func==3} { if {$v} { set result(MirrorLockup) enable } else { set result(MirrorLockup) disable } } elseif {$func==4} { if {$v} { set result(Tv/AvExposureLevel) "1/3 stop" } else { set result(Tv/AvExposureLevel) "1/2 stop" } } elseif {$func==5} { if {$v} { set result(AFAssistLight) off } else { set result(AFAssistLight) on } } elseif {$func==6} { if {$v} { set result(ShutterSpeedInAVMode) "Fixed 1/200" } else { set result(ShutterSpeedInAVMode) "Auto" } } elseif {$func==7} { set result(AEBSeq/AutoCancel) [switch $v { 0 {format "0, -, + enabled"} 1 {format "0, -, + disabled"} 2 {format "-, 0, + enabled"} 3 {format "-, 0, + disabled"} default {format unknown} }] } elseif {$func==8} { if {$v} { set result(ShutterCurtainSync) "2nd curtain sync" } else { set result(ShutterCurtainSync) "1st curtain sync" } } elseif {$func==9} { set result(LensAFStopButtonFnSwitch) [switch $v { 0 {format "AF stop"} 1 {format "operate AF"} 2 {format "lock AE and start timer"} default {format unknown} }] } elseif {$func==10} { if {$v} { set result(AutoReductionOfFillFlash) disable } else { set result(AutoReductionOfFillFlash) enable } } elseif {$func==11} { if {$v} { set result(MenuButtonReturnPosition) previous } else { set result(MenuButtonReturnPosition) top } } elseif {$func==12} { set result(SetButtonFuncWhenShooting) [switch $v { 0 {format "not assigned"} 1 {format "change quality"} 2 {format "change ISO speed"} 3 {format "select parameters"} default {format unknown} }] } elseif {$func==13} { if {$v} { set result(SensorCleaning) enable } else { set result(SensorCleaning) disable } } elseif {$func==0} { # Discovered by DNew? set result(CameraOwner) $v } else { append result(UnknownCustomFunc) "$func=$v " } } } } else { debug [format "makerNote: Unrecognized TAG: 0x%x" $tag] } } } return [array get result] } proc ::exif::readShort {data offset} { variable intel if {[string length $data] < [expr {$offset+2}]} { error "readShort: end of string reached" } set ch1 [string index $data $offset] set ch2 [string index $data [expr {$offset+1}]] scan $ch1 %c ch1 ; scan $ch2 %c ch2 if {$intel} { return [expr {$ch1 + 256 * $ch2}] } else { return [expr {$ch2 + 256 * $ch1}] } } proc ::exif::readLong {data offset} { variable intel if {[string length $data] < [expr {$offset+4}]} { error "readLong: end of string reached" } set ch1 [string index $data $offset] set ch2 [string index $data [expr {$offset+1}]] set ch3 [string index $data [expr {$offset+2}]] set ch4 [string index $data [expr {$offset+3}]] scan $ch1 %c ch1 ; scan $ch2 %c ch2 scan $ch3 %c ch3 ; scan $ch4 %c ch4 if {$intel} { return [expr {(((($ch4 * 256) + $ch3) * 256) + $ch2) * 256 + $ch1}] } else { return [expr {(((($ch1 * 256) + $ch2) * 256) + $ch3) * 256 + $ch4}] } } proc ::exif::readIFDEntry {data format components offset} { variable intel if {$format == 2} { # ASCII string set value [string range $data $offset [expr {$offset+$components-1}]] return [string trimright $value "\0"] } elseif {$format == 3} { # unsigned short if {!$intel} { set offset [expr {0xFFFF & ($offset >> 16)}] } return $offset } elseif {$format == 4} { # unsigned long return $offset } elseif {$format == 5} { # unsigned rational # This could be messy, if either is >2**31 set numerator [readLong $data $offset] set denominator [readLong $data [expr {$offset + 4}]] return [expr {(1.0*$numerator)/$denominator}] } elseif {$format == 10} { # signed rational # Should work normally, since everything in Tcl is signed set numerator [readLong $data $offset] set denominator [readLong $data [expr {$offset + 4}]] return [expr {(1.0*$numerator)/$denominator}] } else { set x [format %08x $format] error "Invalid IFD entry format: $x" } } proc ::exif::compensationFraction {value} { if {$value==0} {return 0} if {$value < 0} { set result "-" set value [expr {0-$value}] } else { set result "+" } set value [expr {int(0.5 + $value * 6)}] set integer [expr {int($value / 6)}] set sixths [expr {$value % 6}] if {$integer != 0} { append result $integer if {$sixths != 0} { append result " " } } if {$sixths == 2} { append result "1/3" } elseif {$sixths == 3} { append result "1/2" } elseif {$sixths == 4} { append result "2/3" } else { # Added by DNew append result "$sixths/6" } return $result } # This returns the list of all possible fieldnames # that analyze might return. proc ::exif::fieldnames {} { variable cached_fieldnames if {[info exists cached_fieldnames]} { return $cached_fieldnames } # Otherwise, parse the source to find the fieldnames. # Cool, huh? Don'tcha just love Tcl? # Because of this, "result(...)" should only appear # in these functions when "..." is the literal name # of a field to be returned. array set namelist {} foreach proc {analyze app1 exifSubIFD makerNote} { set body [info body ::exif::$proc] foreach line [split $body \n] { if {[regexp {result\(([^)]+)\)} $line junk name]} { set namelist($name) {} } } } set cached_fieldnames [lsort -dictionary [array names namelist]] return $cached_fieldnames } # # # # # # # # # # # # # # # What follows is the original header comments # from the Perl code from which this is # translated. Any changes I made directly # are marked by "DNew". # PERL script to extract EXIF information from JPEGs generated by Canon # digital cameras. # This software is free and you may do anything like with it except sell it. # # Current version: 1.3 # Author: Chris Breeze # email: ch...@br... # Web: http://www.breezesys.com # # Based on experimenting with my G1 and information from: # http://www.ba.wakwak.com/~tsuruzoh/Computer/Digicams/exif-e.html # # Also Canon MakerNote from David Burren's page: # http://www.burren.cx/david/canon.html # # More EXIF info and specs: # http://exif.org # # Warnings: # 1) The Subject distance is unreliable. It seems reasonably accurate # for the G1 but on the D30 it is highly dependent on the lens fitted. # # Perl for Windows is available for free from: # http://www.activestate.com # # History # 11 Jan 2001 # v0.1: Initial version # # 14 Jan 2001 # v0.2: Updated with data from David Burren's page # # 15 Jan 2001 # v0.3: Added more info for D30 (supplied by David Burren) # 1) D30 stores ISO in EXIF tag 0x8827, G1 uses MakerNote 0x1/16 # 2) MakerNote 0x1/10, ImageSize appears to be large, medium, small # 3) D30 allows 1/2 or 1/3 stop exposure compensation # 4) Added D30 custom function details, but can't test them # # 17 Jan 2001 # v1.0 Tidied up AutoFocusMode for G1 vs D30 + added manual auto focus point (D30) # # 18 Jan 2001 # v1.1 Removed some debug code left in by mistake # # 29 Jan 2001 # v1.2 Added flash mode (MakerNote Tag 1, field 4) # # 7 Mar 2001 # v1.3 Added ImageQuality (MakerNote Tag 1, field 3) # # 21 Apr 2001 # v1.4 added ImageStabilisation for Pro90 IS # # 17 Sep 2001 # v1.5 Incorporated D30 improvements from Jim Leonard if {0} { # Trivial usage example set x [exif::fieldnames] puts "fieldnames = $x" set f [open [lindex $argv 0]] array set v [exif::analyze $f] close $f parray v } --- NEW FILE: pkgIndex.tcl --- if {![package vsatisfies [package provide Tcl] 8.3]} {return} package ifneeded exif 1.1.1 [list source [file join $dir exif.tcl]] |
|
From: Ron F. <ro...@us...> - 2005-12-29 22:18:19
|
Update of /cvsroot/nscldaq/bufdump/tcllib/struct1 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11466/tcllib/struct1 Added Files: graph.tcl list.tcl matrix.tcl pkgIndex.tcl pool.tcl pooltest.tcl prioqueue.tcl queue.tcl record.tcl skiplist.tcl stack.tcl struct.tcl tree.tcl Log Message: Initial commit of import and Makefiles that can make starpacks for windows and linux systems. --- NEW FILE: skiplist.tcl --- # skiplist.tcl -- # # Implementation of a skiplist data structure for Tcl. # # To quote the inventor of skip lists, William Pugh: # Skip lists are a probabilistic data structure that seem likely # to supplant balanced trees as the implementation method of # choice for many applications. Skip list algorithms have the # same asymptotic expected time bounds as balanced trees and are # simpler, faster and use less space. # # For more details on how skip lists work, see Pugh, William. Skip # lists: a probabilistic alternative to balanced trees in # Communications of the ACM, June 1990, 33(6) 668-676. Also, see # ftp://ftp.cs.umd.edu/pub/skipLists/ # # Copyright (c) 2000 by Keith Vetter # This software is licensed under a BSD license as described in tcl/tk # license.txt file but with the copyright held by Keith Vetter. # # TODO: # customize key comparison to a user supplied routine namespace eval ::struct {} namespace eval ::struct::skiplist { # Data storage in the skiplist module # ------------------------------- # # For each skiplist, we have the following arrays # state - holds the current level plus some magic constants # nodes - all the nodes in the skiplist, including a dummy header node # counter is used to give a unique name for unnamed skiplists variable counter 0 # Internal constants variable MAXLEVEL 16 variable PROB .5 variable MAXINT [expr {0x7FFFFFFF}] # commands is the list of subcommands recognized by the skiplist variable commands [list \ "destroy" \ "delete" \ "insert" \ "search" \ "size" \ "walk" \ ] # State variables that can be set in the instantiation variable vars [list maxlevel probability] # Only export one command, the one used to instantiate a new skiplist namespace export skiplist } # ::struct::skiplist::skiplist -- # # Create a new skiplist with a given name; if no name is given, use # skiplistX, where X is a number. # # Arguments: # name name of the skiplist; if null, generate one. # # Results: # name name of the skiplist created proc ::struct::skiplist::skiplist {{name ""} args} { set usage "skiplist name ?-maxlevel ##? ?-probability ##?" variable counter if { [llength [info level 0]] == 1 } { incr counter set name "skiplist${counter}" } if { ![string equal [info commands ::$name] ""] } { error "command \"$name\" already exists, unable to create skiplist" } # Handle the optional arguments set more_eval "" for {set i 0} {$i < [llength $args]} {incr i} { set flag [lindex $args $i] incr i if { $i >= [llength $args] } { error "value for \"$flag\" missing: should be \"$usage\"" } set value [lindex $args $i] switch -glob -- $flag { "-maxl*" { set n [catch {set value [expr $value]}] if {$n || $value <= 0} { error "value for the maxlevel option must be greater than 0" } append more_eval "; set state(maxlevel) $value" } "-prob*" { set n [catch {set value [expr $value]}] if {$n || $value <= 0 || $value >= 1} { error "probability must be between 0 and 1" } append more_eval "; set state(prob) $value" } default { error "unknown option \"$flag\": should be \"$usage\"" } } } # Set up the namespace for this skiplist namespace eval ::struct::skiplist::skiplist$name { variable state variable nodes # NB. maxlevel and prob may be overridden by $more_eval at the end set state(maxlevel) $::struct::skiplist::MAXLEVEL set state(prob) $::struct::skiplist::PROB set state(level) 1 set state(cnt) 0 set state(size) 0 set nodes(nil,key) $::struct::skiplist::MAXINT set nodes(header,key) "---" set nodes(header,value) "---" for {set i 1} {$i < $state(maxlevel)} {incr i} { set nodes(header,$i) nil } } $more_eval # Create the command to manipulate the skiplist interp alias {} ::$name {} ::struct::skiplist::SkiplistProc $name return $name } ########################### # Private functions follow # ::struct::skiplist::SkiplistProc -- # # Command that processes all skiplist object commands. # # Arguments: # name name of the skiplist object to manipulate. # args command name and args for the command # # Results: # Varies based on command to perform proc ::struct::skiplist::SkiplistProc {name {cmd ""} args} { # Do minimal args checks here if { [llength [info level 0]] == 2 } { error "wrong # args: should be \"$name option ?arg arg ...?\"" } # Split the args into command and args components if { [llength [info commands ::struct::skiplist::_$cmd]] == 0 } { variable commands set optlist [join $commands ", "] set optlist [linsert $optlist "end-1" "or"] error "bad option \"$cmd\": must be $optlist" } eval [linsert $args 0 ::struct::skiplist::_$cmd $name] } ## ::struct::skiplist::_destroy -- # # Destroy a skiplist, including its associated command and data storage. # # Arguments: # name name of the skiplist. # # Results: # None. proc ::struct::skiplist::_destroy {name} { namespace delete ::struct::skiplist::skiplist$name interp alias {} ::$name {} } # ::struct::skiplist::_search -- # # Searches for a key in a skiplist # # Arguments: # name name of the skiplist. # key key for the node to search for # # Results: # 0 if not found # [list 1 node_value] if found proc ::struct::skiplist::_search {name key} { upvar ::struct::skiplist::skiplist${name}::state state upvar ::struct::skiplist::skiplist${name}::nodes nodes set x header for {set i $state(level)} {$i >= 1} {incr i -1} { while {1} { set fwd $nodes($x,$i) if {$nodes($fwd,key) == $::struct::skiplist::MAXINT} break if {$nodes($fwd,key) >= $key} break set x $fwd } } set x $nodes($x,1) if {$nodes($x,key) == $key} { return [list 1 $nodes($x,value)] } return 0 } # ::struct::skiplist::_insert -- # # Add a node to a skiplist. # # Arguments: # name name of the skiplist. # key key for the node to insert # value value of the node to insert # # Results: # 0 if new node was created # level if existing node was updated proc ::struct::skiplist::_insert {name key value} { upvar ::struct::skiplist::skiplist${name}::state state upvar ::struct::skiplist::skiplist${name}::nodes nodes set x header for {set i $state(level)} {$i >= 1} {incr i -1} { while {1} { set fwd $nodes($x,$i) if {$nodes($fwd,key) == $::struct::skiplist::MAXINT} break if {$nodes($fwd,key) >= $key} break set x $fwd } set update($i) $x } set x $nodes($x,1) # Does the node already exist? if {$nodes($x,key) == $key} { set nodes($x,value) $value return 0 } # Here to insert item incr state(size) set lvl [randomLevel $state(prob) $state(level) $state(maxlevel)] # Did the skip list level increase??? if {$lvl > $state(level)} { for {set i [expr {$state(level) + 1}]} {$i <= $lvl} {incr i} { set update($i) header } set state(level) $lvl } # Create a unique new node name and fill in the key, value parts set x [incr state(cnt)] set nodes($x,key) $key set nodes($x,value) $value for {set i 1} {$i <= $lvl} {incr i} { set nodes($x,$i) $nodes($update($i),$i) set nodes($update($i),$i) $x } return $lvl } # ::struct::skiplist::_delete -- # # Deletes a node from a skiplist # # Arguments: # name name of the skiplist. # key key for the node to delete # # Results: # 1 if we deleted a node # 0 otherwise proc ::struct::skiplist::_delete {name key} { upvar ::struct::skiplist::skiplist${name}::state state upvar ::struct::skiplist::skiplist${name}::nodes nodes set x header for {set i $state(level)} {$i >= 1} {incr i -1} { while {1} { set fwd $nodes($x,$i) if {$nodes($fwd,key) >= $key} break set x $fwd } set update($i) $x } set x $nodes($x,1) # Did we find a node to delete? if {$nodes($x,key) != $key} { return 0 } # Here when we found a node to delete incr state(size) -1 # Unlink this node from all the linked lists that include to it for {set i 1} {$i <= $state(level)} {incr i} { set fwd $nodes($update($i),$i) if {$nodes($fwd,key) != $key} break set nodes($update($i),$i) $nodes($x,$i) } # Delete all traces of this node foreach v [array names nodes($x,*)] { unset nodes($v) } # Fix up the level in case it went down while {$state(level) > 1} { if {! [string equal "nil" $nodes(header,$state(level))]} break incr state(level) -1 } return 1 } # ::struct::skiplist::_size -- # # Returns how many nodes are in the skiplist # # Arguments: # name name of the skiplist. # # Results: # number of nodes in the skiplist proc ::struct::skiplist::_size {name} { upvar ::struct::skiplist::skiplist${name}::state state return $state(size) } # ::struct::skiplist::_walk -- # # Walks a skiplist performing a specified command on each node. # Command is executed at the global level with the actual command # executed is: command key value # # Arguments: # name name of the skiplist. # cmd command to run on each node # # Results: # none. proc ::struct::skiplist::_walk {name cmd} { upvar ::struct::skiplist::skiplist${name}::nodes nodes for {set x $nodes(header,1)} {$x != "nil"} {set x $nodes($x,1)} { # Evaluate the command at this node set cmdcpy $cmd lappend cmdcpy $nodes($x,key) $nodes($x,value) uplevel 2 $cmdcpy } } # ::struct::skiplist::randomLevel -- # # Generates a random level for a new node. We limit it to 1 greater # than the current level. # # Arguments: # prob probability to use in generating level # level current biggest level # maxlevel biggest possible level # # Results: # an integer between 1 and $maxlevel proc ::struct::skiplist::randomLevel {prob level maxlevel} { set lvl 1 while {[expr rand()] < $prob && $lvl < $maxlevel} { incr lvl } if {$lvl > $level} { set lvl [expr {$level + 1}] } return $lvl } # ::struct::skiplist::_dump -- # # Dumps out a skip list. Useful for debugging. # # Arguments: # name name of the skiplist. # # Results: # none. proc ::struct::skiplist::_dump {name} { upvar ::struct::skiplist::skiplist${name}::state state upvar ::struct::skiplist::skiplist${name}::nodes nodes puts "Current level $state(level)" puts "Maxlevel: $state(maxlevel)" puts "Probability: $state(prob)" puts "" puts "NODE KEY FORWARD" for {set x header} {$x != "nil"} {set x $nodes($x,1)} { puts -nonewline [format "%-6s %3s %4s" $x $nodes($x,key) $nodes($x,1)] for {set i 2} {[info exists nodes($x,$i)]} {incr i} { puts -nonewline [format %4s $nodes($x,$i)] } puts "" } } --- NEW FILE: matrix.tcl --- # matrix.tcl -- # # Implementation of a matrix data structure for Tcl. # # Copyright (c) 2001 by Andreas Kupries <and...@us...> # # Heapsort code Copyright (c) 2003 by Edwin A. Suominen <ed...@ee...>, # based on concepts in "Introduction to Algorithms" by Thomas H. Cormen et al. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: matrix.tcl,v 1.1 2005/12/29 22:18:06 ron-fox Exp $ package require Tcl 8.2 namespace eval ::struct {} namespace eval ::struct::matrix { [...2238 lines suppressed...] set largest $i } if { $right < $heapSize && ( !$rev && [lindex $A $right] > [lindex $A $largest] || $rev && [lindex $A $right] < [lindex $A $largest] ) } { set largest $right } if { $largest != $i } { switch $rowCol { r { SwapRows $name $i $largest } c { SwapColumns $name $i $largest } } SortMaxHeapify $name $largest $key $rowCol $heapSize $rev } return } --- NEW FILE: struct.tcl --- package require Tcl 8.2 package provide struct 1.4 source [file join [file dirname [info script]] graph.tcl] source [file join [file dirname [info script]] queue.tcl] source [file join [file dirname [info script]] stack.tcl] source [file join [file dirname [info script]] tree.tcl] source [file join [file dirname [info script]] matrix.tcl] source [file join [file dirname [info script]] pool.tcl] source [file join [file dirname [info script]] record.tcl] source [file join [file dirname [info script]] list.tcl] source [file join [file dirname [info script]] prioqueue.tcl] source [file join [file dirname [info script]] skiplist.tcl] namespace eval ::struct { namespace import -force graph::* namespace import -force queue::* namespace import -force stack::* namespace import -force tree::* namespace import -force matrix::* namespace import -force pool::* namespace import -force record::* namespace import -force list::* namespace import -force prioqueue::* namespace import -force skiplist::* namespace export * } --- NEW FILE: queue.tcl --- # queue.tcl -- # # Queue implementation for Tcl. # # Copyright (c) 1998-2000 by Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: queue.tcl,v 1.1 2005/12/29 22:18:06 ron-fox Exp $ namespace eval ::struct {} namespace eval ::struct::queue { # The queues array holds all of the queues you've made variable queues # counter is used to give a unique name for unnamed queues variable counter 0 # commands is the list of subcommands recognized by the queue variable commands [list \ "clear" \ "destroy" \ "get" \ "peek" \ "put" \ "size" \ ] # Only export one command, the one used to instantiate a new queue namespace export queue } # ::struct::queue::queue -- # # Create a new queue with a given name; if no name is given, use # queueX, where X is a number. # # Arguments: # name name of the queue; if null, generate one. # # Results: # name name of the queue created proc ::struct::queue::queue {{name ""}} { variable queues variable counter if { [llength [info level 0]] == 1 } { incr counter set name "queue${counter}" } if { ![string equal [info commands ::$name] ""] } { error "command \"$name\" already exists, unable to create queue" } # Initialize the queue as empty set queues($name) [list ] # Create the command to manipulate the queue interp alias {} ::$name {} ::struct::queue::QueueProc $name return $name } ########################## # Private functions follow # ::struct::queue::QueueProc -- # # Command that processes all queue object commands. # # Arguments: # name name of the queue object to manipulate. # args command name and args for the command # # Results: # Varies based on command to perform proc ::struct::queue::QueueProc {name {cmd ""} args} { # Do minimal args checks here if { [llength [info level 0]] == 2 } { error "wrong # args: should be \"$name option ?arg arg ...?\"" } # Split the args into command and args components if { [string equal [info commands ::struct::queue::_$cmd] ""] } { variable commands set optlist [join $commands ", "] set optlist [linsert $optlist "end-1" "or"] error "bad option \"$cmd\": must be $optlist" } return [eval [linsert $args 0 ::struct::queue::_$cmd $name]] } # ::struct::queue::_clear -- # # Clear a queue. # # Arguments: # name name of the queue object. # # Results: # None. proc ::struct::queue::_clear {name} { variable queues set queues($name) [list ] return } # ::struct::queue::_destroy -- # # Destroy a queue object by removing it's storage space and # eliminating it's proc. # # Arguments: # name name of the queue object. # # Results: # None. proc ::struct::queue::_destroy {name} { variable queues unset queues($name) interp alias {} ::$name {} return } # ::struct::queue::_get -- # # Get an item from a queue. # # Arguments: # name name of the queue object. # count number of items to get; defaults to 1 # # Results: # item first count items from the queue; if there are not enough # items in the queue, throws an error. proc ::struct::queue::_get {name {count 1}} { variable queues if { $count < 1 } { error "invalid item count $count" } if { $count > [llength $queues($name)] } { error "insufficient items in queue to fill request" } if { $count == 1 } { # Handle this as a special case, so single item gets aren't listified set item [lindex $queues($name) 0] set queues($name) [lreplace $queues($name) 0 0] return $item } # Otherwise, return a list of items set index [expr {$count - 1}] set result [lrange $queues($name) 0 $index] set queues($name) [lreplace $queues($name) 0 $index] return $result } # ::struct::queue::_peek -- # # Retrive the value of an item on the queue without removing it. # # Arguments: # name name of the queue object. # count number of items to peek; defaults to 1 # # Results: # items top count items from the queue; if there are not enough items # to fufill the request, throws an error. proc ::struct::queue::_peek {name {count 1}} { variable queues if { $count < 1 } { error "invalid item count $count" } if { $count > [llength $queues($name)] } { error "insufficient items in queue to fill request" } if { $count == 1 } { # Handle this as a special case, so single item pops aren't listified return [lindex $queues($name) 0] } # Otherwise, return a list of items set index [expr {$count - 1}] return [lrange $queues($name) 0 $index] } # ::struct::queue::_put -- # # Put an item into a queue. # # Arguments: # name name of the queue object # args items to put. # # Results: # None. proc ::struct::queue::_put {name args} { variable queues if { [llength $args] == 0 } { error "wrong # args: should be \"$name put item ?item ...?\"" } foreach item $args { lappend queues($name) $item } return } # ::struct::queue::_size -- # # Return the number of objects on a queue. # # Arguments: # name name of the queue object. # # Results: # count number of items on the queue. proc ::struct::queue::_size {name} { variable queues return [llength $queues($name)] } --- NEW FILE: prioqueue.tcl --- # prioqueue.tcl -- # # Priority Queue implementation for Tcl. # # adapted from queue.tcl # Copyright (c) 2002,2003 Michael Schlenker # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: prioqueue.tcl,v 1.1 2005/12/29 22:18:06 ron-fox Exp $ package require Tcl 8.2 namespace eval ::struct {} namespace eval ::struct::prioqueue { # The queues array holds all of the queues you've made variable queues # counter is used to give a unique name for unnamed queues variable counter 0 # commands is the list of subcommands recognized by the queue variable commands [list \ "clear" \ "destroy" \ "get" \ "peek" \ "put" \ "size" \ "peekpriority" \ ] variable sortopt [list \ "-integer" \ "-real" \ "-ascii" \ "-dictionary" \ ] # this is a simple design decision, that integer and real # are sorted decreasing (-1), and -ascii and -dictionary are sorted -increasing (1) # the values here map to the sortopt list # could be changed to something configurable. variable sortdir [list \ "-1" \ "-1" \ "1" \ "1" \ ] # Only export one command, the one used to instantiate a new queue namespace export prioqueue proc K {x y} {set x} ;# DKF's K combinator } # ::struct::prioqueue::prioqueue -- # # Create a new prioqueue with a given name; if no name is given, use # prioqueueX, where X is a number. # # Arguments: # sorting sorting option for lsort to use, no -command option # defaults to integer # name name of the queue; if null, generate one. # names may not begin with - # # # Results: # name name of the queue created proc ::struct::prioqueue::prioqueue {args} { variable queues variable counter variable queues_sorting variable sortopt # check args if {[llength $args] > 2} { error "wrong # args: should be \"[lindex [info level 0] 0] ?-ascii|-dictionary|-integer|-real? ?name?\"" } if {[llength $args] == 0} { # defaulting to integer priorities set sorting -integer } else { if {[llength $args] == 1} { if {[string match "-*" [lindex $args 0]]==1} { set sorting [lindex $args 0] } else { set sorting -integer set name [lindex $args 0] } } else { if {[llength $args] == 2} { foreach {sorting name} $args {break} } } } # check option (like lsort sorting options without -command) if {[lsearch $sortopt $sorting] == -1} { # if sortoption is unknown, but name is a sortoption we give a better error message if {[info exists name] && [lsearch $sortopt $name]!=-1} { error "wrong argument position: should be \"[lindex [info level 0] 0] ?-ascii|-dictionary|-integer|-real? ?name?\"" } error "unknown sort option \"$sorting\"" } # create name if not given if {![info exists name]} { incr counter set name "prioqueue${counter}" } if { ![string equal [info commands ::$name] ""] } { error "command \"$name\" already exists, unable to create prioqueue" } # Initialize the queue as empty set queues($name) [list ] switch -exact -- $sorting { -integer { set queues_sorting($name) 0} -real { set queues_sorting($name) 1} -ascii { set queues_sorting($name) 2} -dictionary { set queues_sorting($name) 3} } # Create the command to manipulate the queue interp alias {} ::$name {} ::struct::prioqueue::QueueProc $name return $name } ########################## # Private functions follow # ::struct::prioqueue::QueueProc -- # # Command that processes all queue object commands. # # Arguments: # name name of the queue object to manipulate. # args command name and args for the command # # Results: # Varies based on command to perform proc ::struct::prioqueue::QueueProc {name {cmd ""} args} { # Do minimal args checks here if { [llength [info level 0]] == 2 } { error "wrong # args: should be \"$name option ?arg arg ...?\"" } # Split the args into command and args components if { [string equal [info commands ::struct::prioqueue::_$cmd] ""] } { variable commands set optlist [join $commands ", "] set optlist [linsert $optlist "end-1" "or"] error "bad option \"$cmd\": must be $optlist" } return [eval [linsert $args 0 ::struct::prioqueue::_$cmd $name]] } # ::struct::prioqueue::_clear -- # # Clear a queue. # # Arguments: # name name of the queue object. # # Results: # None. proc ::struct::prioqueue::_clear {name} { variable queues set queues($name) [list] return } # ::struct::prioqueue::_destroy -- # # Destroy a queue object by removing it's storage space and # eliminating it's proc. # # Arguments: # name name of the queue object. # # Results: # None. proc ::struct::prioqueue::_destroy {name} { variable queues variable queues_sorting unset queues($name) unset queues_sorting($name) interp alias {} ::$name {} return } # ::struct::prioqueue::_get -- # # Get an item from a queue. # # Arguments: # name name of the queue object. # count number of items to get; defaults to 1 # # Results: # item first count items from the queue; if there are not enough # items in the queue, throws an error. # proc ::struct::prioqueue::_get {name {count 1}} { variable queues if { $count < 1 } { error "invalid item count $count" } if { $count > [llength $queues($name)] } { error "insufficient items in prioqueue to fill request" } if { $count == 1 } { # Handle this as a special case, so single item gets aren't listified set item [lindex [lindex $queues($name) 0] 1] set queues($name) [lreplace [K $queues($name) [set queues($name) ""]] 0 0] return $item } # Otherwise, return a list of items incr count -1 set items [lrange $queues($name) 0 $count] foreach item $items { lappend result [lindex $item 1] } set items "" set queues($name) [lreplace [K $queues($name) [set queues($name) ""]] 0 $count] return $result } # ::struct::prioqueue::_peek -- # # Retrive the value of an item on the queue without removing it. # # Arguments: # name name of the queue object. # count number of items to peek; defaults to 1 # # Results: # items top count items from the queue; if there are not enough items # to fufill the request, throws an error. proc ::struct::prioqueue::_peek {name {count 1}} { variable queues if { $count < 1 } { error "invalid item count $count" } if { $count > [llength $queues($name)] } { error "insufficient items in prioqueue to fill request" } if { $count == 1 } { # Handle this as a special case, so single item pops aren't listified return [lindex [lindex $queues($name) 0] 1] } # Otherwise, return a list of items set index [expr {$count - 1}] foreach item [lrange $queues($name) 0 $index] { lappend result [lindex $item 1] } return $result } # ::struct::prioqueue::_peekpriority -- # # Retrive the priority of an item on the queue without removing it. # # Arguments: # name name of the queue object. # count number of items to peek; defaults to 1 # # Results: # items top count items from the queue; if there are not enough items # to fufill the request, throws an error. proc ::struct::prioqueue::_peekpriority {name {count 1}} { variable queues if { $count < 1 } { error "invalid item count $count" } if { $count > [llength $queues($name)] } { error "insufficient items in prioqueue to fill request" } if { $count == 1 } { # Handle this as a special case, so single item pops aren't listified return [lindex [lindex $queues($name) 0] 0] } # Otherwise, return a list of items set index [expr {$count - 1}] foreach item [lrange $queues($name) 0 $index] { lappend result [lindex $item 0] } return $result } # ::struct::prioqueue::_put -- # # Put an item into a queue. # # Arguments: # name name of the queue object # args list of the form "item1 prio1 item2 prio2 item3 prio3" # # Results: # None. proc ::struct::prioqueue::_put {name args} { variable queues variable queues_sorting variable sortopt variable sortdir if { [llength $args] == 0 || [llength $args] % 2} { error "wrong # args: should be \"$name put item prio ?item prio ...?\"" } # check for prio type before adding switch -exact -- $queues_sorting($name) { 0 { foreach {item prio} $args { if {![string is integer -strict $prio]} { error "priority \"$prio\" is not an integer type value" } } } 1 { foreach {item prio} $args { if {![string is double -strict $prio]} { error "priority \"$prio\" is not a real type value" } } } default { #no restrictions for -ascii and -dictionary } } # sort by priorities set opt [lindex $sortopt $queues_sorting($name)] set dir [lindex $sortdir $queues_sorting($name)] # add only if check has passed foreach {item prio} $args { set new [list $prio $item] set queues($name) [__linsertsorted [K $queues($name) [set queues($name) ""]] $new $opt $dir] } return } # ::struct::prioqueue::_size -- # # Return the number of objects on a queue. # # Arguments: # name name of the queue object. # # Results: # count number of items on the queue. proc ::struct::prioqueue::_size {name} { variable queues return [llength $queues($name)] } # ::struct::prioqueue::__linsertsorted # # Helper proc for inserting into a sorted list. # # proc ::struct::prioqueue::__linsertsorted {list newElement sortopt sortdir} { set cmpcmd __elementcompare${sortopt} set pos -1 set newPrio [lindex $newElement 0] # do a binary search set lower -1 set upper [llength $list] set bound [expr {$upper+1}] set pivot 0 if {$upper > 0} { while {$lower +1 != $upper } { # get the pivot element set pivot [expr {($lower + $upper) / 2}] set element [lindex $list $pivot] set prio [lindex $element 0] # check set test [$cmpcmd $prio $newPrio $sortdir] if {$test == 0} { set pos $pivot set upper $pivot # now break as we need the last item break } elseif {$test > 0 } { # search lower section set upper $pivot set pos -1 } else { # search upper section set lower $pivot set pos $bound } } if {$pos == -1} { # we do an insert before the pivot element set pos $pivot } # loop to the last matching element to # keep a stable insertion order while {[$cmpcmd $prio $newPrio $sortdir]==0} { incr pos if {$pos > [llength $list]} {break} set element [lindex $list $pos] set prio [lindex $element 0] } } else { set pos 0 } # do the insert without copying linsert [K $list [set list ""]] $pos $newElement } # ::struct::prioqueue::__elementcompare # # Compare helpers with the sort options. # # proc ::struct::prioqueue::__elementcompare-integer {prio newPrio sortdir} { return [expr {$prio < $newPrio ? -1*$sortdir : ($prio != $newPrio)*$sortdir}] } proc ::struct::prioqueue::__elementcompare-real {prio newPrio sortdir} { return [expr {$prio < $newPrio ? -1*$sortdir : ($prio != $newPrio)*$sortdir}] } proc ::struct::prioqueue::__elementcompare-ascii {prio newPrio sortdir} { return [expr {[string compare $prio $newPrio]*$sortdir}] } proc ::struct::prioqueue::__elementcompare-dictionary {prio newPrio sortdir} { # need to use lsort to access -dictionary sorting set tlist [lsort -increasing -dictionary [list $prio $newPrio]] set e1 [string equal [lindex $tlist 0] $prio] set e2 [string equal [lindex $tlist 1] $prio] return [expr {$e1 > $e2 ? -1*$sortdir : ($e1 != $e2)*$sortdir}] } --- NEW FILE: tree.tcl --- # tree.tcl -- # # Implementation of a tree data structure for Tcl. # # Copyright (c) 1998-2000 by Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: tree.tcl,v 1.1 2005/12/29 22:18:06 ron-fox Exp $ package require Tcl 8.2 namespace eval ::struct {} namespace eval ::struct::tree { # Data storage in the tree module # ------------------------------- # [...1437 lines suppressed...] # Store attribute data if {[info exists attribute($node)]} { upvar ${name}:: attribute($node) data set attr($node) [array get data] } else { set attr($node) {} } # Build tree structure as nested list. set subtrees [list] foreach c $children($node) { Serialize $name $c sub attr lappend subtrees $sub } set tree [list $node $subtrees] return } --- NEW FILE: graph.tcl --- # graph.tcl -- # # Implementation of a graph data structure for Tcl. # # Copyright (c) 2000 by Andreas Kupries # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: graph.tcl,v 1.1 2005/12/29 22:18:06 ron-fox Exp $ # Create the namespace before determining cgraph vs. tcl # Otherwise the loading 'struct.tcl' may get into trouble # when trying to import commands from them namespace eval ::struct {} namespace eval ::struct::graph {} # Try to load the cgraph package [...2078 lines suppressed...] # set list representing the union of the argument lists. proc ::struct::graph::Union {args} { switch -- [llength $args] { 0 { return {} } 1 { return [lindex $args 0] } default { foreach set $args { foreach e $set { set tmp($e) . } } return [array names tmp] } } } --- NEW FILE: record.tcl --- #============================================================ # ::struct::record -- # # Implements a container data structure similar to a 'C' # structure. It hides the ugly details about keeping the # data organized by using a combination of arrays, lists # and namespaces. # # Each record definition is kept in a master array # (_recorddefn) under the ::struct::record namespace. Each # instance of a record is kept within a separate namespace # for each record definition. Hence, instances of # the same record definition are managed under the # same namespace. This avoids possible collisions, and # also limits one big global array mechanism. # # Copyright (c) 2002 by Brett Schwarz # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # This code may be distributed under the same terms as Tcl. # # $Id: record.tcl,v 1.1 2005/12/29 22:18:06 ron-fox Exp $ # #============================================================ # #### FIX ERROR MESSAGES SO THEY MAKE SENSE (Wrong args) namespace eval ::struct {} namespace eval ::struct::record { ## ## array of lists that holds the ## definition (variables) for each ## record ## ## _recorddefn(some_record) var1 var2 var3 ... ## variable _recorddefn ## ## holds the count for each record ## in cases where the instance is ## automatically generated ## ## _count(some_record) 0 ## variable _count ## ## array that holds the defining record's ## name for each instances ## ## _defn(some_instances) name_of_defining_record ## variable _defn ## ## This holds the defaults for a record definition. ## If no default is given for a member of a record, ## then the value is assigned to the empty string ## variable _defaults ## ## These are the possible sub commands ## variable commands set commands [list define delete exists show] ## ## This keeps track of the level that we are in ## when handling nested records. This is kind of ## a hack, and probably can be handled better ## set _level 0 namespace export record } #------------------------------------------------------------ # ::struct::record::record -- # # main command used to access the other sub commands # # Arguments: # cmd_ The sub command (i.e. define, show, delete, exists) # args arguments to pass to the sub command # # Results: # none returned #------------------------------------------------------------ # proc ::struct::record::record {cmd_ args} { variable commands if {[lsearch $commands $cmd_] < 0} { error "Sub command \"$cmd_\" is not recognized. Must be [join $commands ,]" } set cmd_ [string totitle "$cmd_"] return [uplevel 1 ::struct::record::${cmd_} $args] }; # end proc ::struct::record::record #------------------------------------------------------------ # ::struct::record::Define -- # # Used to define a record # # Arguments: # defn_ the name of the record definition # vars_ the variables of the record (as a list) # args instances to be create during definition # # Results: # Returns the name of the definition during successful # creation. #------------------------------------------------------------ # proc ::struct::record::Define {defn_ vars_ args} { variable _recorddefn variable _count variable _defaults set defn_ [Qualify $defn_] if {[info exists _recorddefn($defn_)]} { error "Record definition $defn_ already exists" } if {[lsearch [info commands] $defn_] >= 0} { error "Structure definition name can not be a Tcl command name" } set _defaults($defn_) [list] set _recorddefn($defn_) [list] ## ## Loop through the members of the record ## definition ## foreach V $vars_ { set len [llength $V] set D "" ## ## 2 --> there is a default value ## assigned to the member ## ## 3 --> there is a nested record ## definition given as a member ## if {$len == 2} { set D [lindex $V 1] set V [lindex $V 0] } elseif {$len == 3} { if {![string match "record" "[lindex $V 0]"]} { Delete record $defn_ error "$V is a Bad member for record definition definition creation aborted." } set new [lindex $V 1] set new [Qualify $new] ## ## Right now, there can not be circular records ## so, we abort the creation ## if {[string match "$defn_" "$new"]} { Delete record $defn_ error "Can not have circular records. Structure was not created." } ## ## Will take care of the nested record later ## We just join by :: because this is how it ## use to be declared, so the parsing code ## is already there. ## set V [join [lrange $V 1 2] "::"] } lappend _recorddefn($defn_) $V lappend _defaults($defn_) $D } uplevel #0 [list interp alias {} $defn_ {} ::struct::record::Create $defn_] set _count($defn_) 0 namespace eval ::struct::record${defn_} { variable values variable instances set instances [list] } ## ## If there were args given (instances), then ## create them now ## foreach A $args { uplevel 1 [list ::struct::record::Create $defn_ $A] } return $defn_ }; # end proc ::struct::record::Define #------------------------------------------------------------ # ::struct::record::Create -- # # Creates an instance of a record definition # # Arguments: # defn_ the name of the record definition # inst_ the name of the instances to create # args values to set to the record's members # # Results: # Returns the name of the instance for a successful creation #------------------------------------------------------------ # proc ::struct::record::Create {defn_ inst_ args} { variable _recorddefn variable _count variable _defn variable _defaults variable _level set inst_ [Qualify "$inst_"] ## ## test to see if the record ## definition has been defined yet ## if {![info exists _recorddefn($defn_)]} { error "Structure $defn_ does not exist" } ## ## if there was no argument given, ## then assume that the record ## variable is automatically ## generated ## if {[string match "[Qualify #auto]" "$inst_"]} { set c $_count($defn_) set inst_ [format "%s%s" ${defn_} $_count($defn_)] incr _count($defn_) } ## ## Test to see if this instance is already ## created. This avoids any collisions with ## previously created instances ## if {[info exists _defn($inst_)]} { incr _count($defn_) -1 error "Instances $inst_ already exists" } set _defn($inst_) $defn_ ## ## Initialize record variables to ## defaults ## uplevel #0 [list interp alias {} ${inst_} {} ::struct::record::Cmd $inst_] set cnt 0 foreach V $_recorddefn($defn_) D $_defaults($defn_) { set [Ns $inst_]values($inst_,$V) $D ## ## Test to see if there is a nested record ## if {[regexp -- {([\w]*)::([\w]*)} $V m def inst]} { if {$_level == 0} { set _level 2 } ## ## This is to guard against if the creation ## had failed, that there isn't any ## lingering variables/alias around ## set def [Qualify $def $_level] if {![info exists _recorddefn($def)]} { Delete inst "$inst_" return } ## ## evaluate the nested record. If there ## were values for the variables passed ## in, then we assume that the value for ## this nested record is a list ## corresponding the the nested list's ## variables, and so we pass that to ## the nested record's instantiation. ## We then get rid of those args for later ## processing. ## set cnt_plus [expr {$cnt + 1}] set mem [lindex $args $cnt] if {![string match "" "$mem"]} { if {![string match "-$inst" "$mem"]} { Delete inst "$inst_" error "$inst is not a member of $defn_" } } incr _level set narg [lindex $args $cnt_plus] eval [linsert $narg 0 Create $def ${inst_}.${inst}] set args [lreplace $args $cnt $cnt_plus] } else { uplevel #0 [list interp alias {} ${inst_}.$V {} ::struct::record::Access $defn_ $inst_ $V] incr cnt 2 } }; # end foreach variable lappend [Ns $inst_]instances $inst_ foreach {k v} $args { Access $defn_ $inst_ [string trimleft "$k" -] $v }; # end foreach arg set _level 0 return $inst_ }; # end proc ::struct::record::Create #------------------------------------------------------------ # ::struct::record::Access -- # # Provides a common proc to access the variables # from the aliases create for each variable in the record # # Arguments: # defn_ the name of the record to access # inst_ the name of the instance to create # var_ the variable of the record to access # args a value to set to var_ (if any) # # Results: # Returns the value of the record member (var_) #------------------------------------------------------------ # proc ::struct::record::Access {defn_ inst_ var_ args} { variable _recorddefn variable _defn set i [lsearch $_recorddefn($defn_) $var_] if {$i < 0} { error "$var_ does not exist in record $defn_" } if {![info exists _defn($inst_)]} { error "$inst_ does not exist" } if {[set idx [lsearch $args "="]] >= 0} { set args [lreplace $args $idx $idx] } ## ## If a value was given, then set it ## if {[llength $args] != 0} { set val_ [lindex $args 0] set [Ns $inst_]values($inst_,$var_) $val_ } return [set [Ns $inst_]values($inst_,$var_)] }; # end proc ::struct::record::Access #------------------------------------------------------------ # ::struct::record::Cmd -- # # Used to process the set/get requests. # # Arguments: # inst_ the record instance name # args For 'get' this is the record members to # retrieve. For 'set' this is a member/value # pair. # # Results: # For 'set' returns the empty string. For 'get' it returns # the member values. #------------------------------------------------------------ # proc ::struct::record::Cmd {inst_ args} { variable _defn set result [list] set len [llength $args] if {$len <= 1} {return [Show values "$inst_"]} set cmd [lindex $args 0] if {[string match "cget" "$cmd"]} { set cnt 0 foreach k [lrange $args 1 end] { if {[catch {set r [${inst_}.[string trimleft ${k} -]]} err]} { error "Bad option \"$k\"" } lappend result $r incr cnt } if {$cnt == 1} {set result [lindex $result 0]} return $result } elseif {[string match "config*" "$cmd"]} { set L [lrange $args 1 end] foreach {k v} $L { ${inst_}.[string trimleft ${k} -] $v } } else { error "Wrong argument. must be \"object cget|configure args\"" } return [list] }; # end proc ::struct::record::Cmd #------------------------------------------------------------ # ::struct::record::Ns -- # # This just constructs a fully qualified namespace for a # particular instance. # # Arguments; # inst_ instance to construct the namespace for. # # Results: # Returns the fully qualified namespace for the instance #------------------------------------------------------------ # proc ::struct::record::Ns {inst_} { variable _defn if {[catch {set ret $_defn($inst_)} err]} { return $inst_ } return [format "%s%s%s" "::struct::record" $ret "::"] }; # end proc ::struct::record::Ns #------------------------------------------------------------ # ::struct::record::Show -- # # Display info about the record that exist # # Arguments: # what_ subcommand # record_ record or instance to process # # Results: # if what_ = record, then return list of records # definition names. # if what_ = members, then return list of members # or members of the record. # if what_ = instance, then return a list of instances # with record definition of record_ # if what_ = values, then it will return the values # for a particular instance #------------------------------------------------------------ # proc ::struct::record::Show {what_ {record_ ""}} { variable _recorddefn variable _defn variable _defaults ## ## We just prepend :: to the record_ argument ## if {![string match "::*" "$record_"]} {set record_ "::$record_"} if {[string match "record*" "$what_"]} { return [lsort [array names _recorddefn]] } elseif {[string match "mem*" "$what_"]} { if {[string match "" "$record_"] || ![info exists _recorddefn($record_)]} { error "Bad arguments while accessing members. Bad record name" } set res [list] set cnt 0 foreach m $_recorddefn($record_) { set def [lindex $_defaults($record_) $cnt] if {[regexp -- {([\w]+)::([\w]+)} $m m d i]} { lappend res [list record $d $i] } elseif {![string match "" "$def"]} { lappend res [list $m $def] } else { lappend res $m } incr cnt } return $res } elseif {[string match "inst*" "$what_"]} { if {![info exists ::struct::record${record_}::instances]} { return [list] } return [lsort [set ::struct::record${record_}::instances]] } elseif {[string match "val*" "$what_"]} { set ns $_defn($record_) if {[string match "" "$record_"] || ([lsearch [set [Ns $record_]instances] $record_] < 0)} { error "Wrong arguments to values. Bad instance name" } set ret [list] foreach k $_recorddefn($ns) { set v [set [Ns $record_]values($record_,$k)] if {[regexp -- {([\w]*)::([\w]*)} $k m def inst]} { set v [::struct::record::Show values ${record_}.${inst}] } lappend ret -[namespace tail $k] $v } return $ret } return [list] }; # end proc ::struct::record::Show #------------------------------------------------------------ # ::struct::record::Delete -- # # Deletes a record instance or a record definition # # Arguments: # sub_ what to delete. Either 'instance' or 'record' # item_ the specific record instance or definition # delete. # # Returns: # none # #------------------------------------------------------------ # proc ::struct::record::Delete {sub_ item_} { variable _recorddefn variable _defn variable _count variable _defaults ## ## We just semi-blindly prepend :: to the record_ argument ## if {![string match "::*" "$item_"]} {set item_ "::$item_"} switch -- $sub_ { instance - instances - inst { if {[Exists instance $item_]} { set ns $_defn($item_) foreach A [info commands ${item_}.*] { Delete inst $A } catch { foreach {k v} [array get [Ns $item_]values $item_,*] { unset [Ns $item_]values($k) } set i [lsearch [set [Ns $item_]instances] $item_] set [Ns $item_]instances [lreplace [set [Ns $item_]instances] $i $i] unset _defn($item_) } incr _count($ns) -1 } else { #error "$item_ is not a instance" } } record - records { ## ## Delete the instances for this ## record ## foreach I [Show instance "$item_"] { catch {Delete instance "$I"} } catch { unset _recorddefn($item_) unset _defaults($item_) unset _count($item_) namespace delete ::struct::record${item_} } } default { error "Wrong arguments to delete" } }; # end switch catch { uplevel #0 [list interp alias {} $item_ {}]} return }; # end proc ::struct::record::Delete #------------------------------------------------------------ # ::struct::record::Exists -- # # Tests whether a record definition or record # instance exists. # # Arguments: # sub_ what to test. Either 'instance' or 'record' # item_ the specific record instance or definition # that needs to be tested. # # Tests to see if a particular instance exists # #------------------------------------------------------------ # proc ::struct::record::Exists {sub_ item_} { switch -glob -- $sub_ { inst* { if {([lsearch ::[Ns $item_]instances $item_] >=0) || [llength [info commands ::${item_}.*]]} { return 1 } else { return 0 } } record { set item_ "::$item_" if {[info exists _recorddefn($item_)] || [llength [info commands ${item_}]]} { return 1 } else { return 0 } } default { error "Wrong arguments. Must be exists record|instance target" } }; # end switch }; # end proc ::struct::record::Exists #------------------------------------------------------------ # ::struct::record::Qualify -- # # Contructs the qualified name of the calling scope. This # defaults to 2 levels since there is an extra proc call in # between. # # Arguments: # item_ the command that needs to be qualified # level_ how many levels to go up (default = 2) # # Results: # the item_ passed in fully qualified # #------------------------------------------------------------ # proc ::struct::record::Qualify {item_ {level_ 2}} { if {![string match "::*" "$item_"]} { set ns [uplevel $level_ [list namespace current]] if {![string match "::" "$ns"]} { append ns "::" } set item_ "$ns${item_}" } return "$item_" }; # end proc ::struct::record::Qualify --- NEW FILE: pooltest.tcl --- # pooltest.tcl source [file join [file dirname [info script]] pool.tcl] namespace import pool::* pool CarPool CarPool add Toyota Volkswagen Chrysler Trabant CarPool request item -prefer Trabant -allocID me proc poolinfo {} { puts "Current pool size: [CarPool info cursize]" puts "Maximum pool size: [CarPool info maxsize]" puts "Free items: [CarPool info freeitems]" if { [CarPool info cursize] > 0 } { set sep_line [string repeat - 40] puts "Allocation info:\ \nnr. item allocID (-1 = free)" puts $sep_line set i 0 foreach {item state} [CarPool info allocstate] { puts "[incr i] $item $state" } puts $sep_line } return } poolinfo set failedtests {} # Exercise all error cases proc MatchErrMsg {errid errmsg} { global failedtests set pattern [format $::pool::Errors($errid) * *] if { ![string match $pattern $errmsg] } { puts "$errid: failed \ \nPattern: $pattern \ \nError message: $errmsg" lappend failedtests $errid } else { puts "$errid: passed" } } proc VARNAME_EXISTS {} { set ::pool::existvar 1 catch {pool::create existvar} errmsg MatchErrMsg [info level 0] $errmsg unset ::pool::existvar } proc DUPLICATE_POOLNAME {} { catch {pool::create CarPool} errmsg MatchErrMsg [info level 0] $errmsg } proc NONINT_REQSIZE {} { catch {pool::create CarPool noninteger} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool maxsize noninteger} errmsg MatchErrMsg [info level 0] $errmsg } proc UNKNOWN_POOL {} { catch {pool::destroy NonExistentPool} errmsg MatchErrMsg [info level 0] $errmsg } proc BAD_SUBCMD {} { catch {CarPool badsubcommand whateverargs} errmsg MatchErrMsg [info level 0] $errmsg } proc SOME_ITEMS_NOT_FREE {} { catch {CarPool clear} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool destroy} errmsg MatchErrMsg [info level 0] $errmsg } proc DUPLICATE_ITEM_IN_ARGS {} { catch {CarPool add Toyota duplicatecar someothercar somestrangecar duplicatecar} errmsg MatchErrMsg [info level 0] $errmsg } proc FORBIDDEN_ALLOCID {} { catch {CarPool request car -allocID -1} errmsg MatchErrMsg [info level 0] $errmsg } proc ITEM_ALREADY_IN_POOL {} { catch {CarPool add Toyota} errmsg MatchErrMsg [info level 0] $errmsg } proc ITEM_STILL_ALLOCATED {} { catch {CarPool remove Trabant} errmsg MatchErrMsg [info level 0] $errmsg } proc ITEM_NOT_ALLOCATED {} { catch {CarPool release Toyota} errmsg MatchErrMsg [info level 0] $errmsg } proc ITEM_NOT_IN_POOL {} { catch {CarPool info allocID Buggy} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool request item -prefer Buggy} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool release Buggy} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool remove Buggy} errmsg MatchErrMsg [info level 0] $errmsg } proc EXCEED_MAXSIZE {} { catch {CarPool add 1 2 3 4 5 6 7} errmsg MatchErrMsg [info level 0] $errmsg } proc INVALID_POOLSIZE {} { catch {CarPool maxsize [expr {[CarPool info cursize] - 1}] } errmsg MatchErrMsg [info level 0] $errmsg } proc WRONG_INFO_TYPE {} { catch {CarPool info wronginfotype} errmsg MatchErrMsg [info level 0] $errmsg } proc UNKNOWN_ARG {} { catch {CarPool clear unknownarg} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool request item Toyota unknownarg} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool destroy unknownarg} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool remove Toyota unknownarg} errmsg MatchErrMsg [info level 0] $errmsg } proc WRONG_NARGS {} { catch {CarPool add} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool info cursize oneargtoomany} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool info allocID} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool info allocID Trabant oneargtoomany} errmsg MatchErrMsg [info level 0] $errmsg catch {CarPool request item Toyota -prefer me} errmsg MatchErrMsg [info level 0] $errmsg } puts "TESTING ERROR CASES:\n" foreach errid [array names pool::Errors] { if { [llength [::info procs $errid]] } { eval $errid } } puts {} if { [llength $failedtests] } { puts "The following tests failed:" foreach errid $failedtests { puts $errid } } else { puts "All tests passed." } # EOF pooltest.tcl --- NEW FILE: stack.tcl --- # stack.tcl -- # # Stack implementation for Tcl. # # Copyright (c) 1998-2000 by Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: stack.tcl,v 1.1 2005/12/29 22:18:06 ron-fox Exp $ namespace eval ::struct {} namespace eval ::struct::stack { # The stacks array holds all of the stacks you've made variable stacks # counter is used to give a unique name for unnamed stacks variable counter 0 # commands is the list of subcommands recognized by the stack variable commands [list \ "clear" \ "destroy" \ "peek" \ "pop" \ "push" \ "rotate" \ "size" \ ] # Only export one command, the one used to instantiate a new stack namespace export stack } # ::struct::stack::stack -- # # Create a new stack with a given name; if no name is given, use # stackX, where X is a number. # # Arguments: # name name of the stack; if null, generate one. # # Results: # name name of the stack created proc ::struct::stack::stack {{name ""}} { variable stacks variable counter if { [llength [info level 0]] == 1 } { incr counter set name "stack${counter}" } if { ![string equal [info commands ::$name] ""] } { error "command \"$name\" already exists, unable to create stack" } set stacks($name) [list ] # Create the command to manipulate the stack interp alias {} ::$name {} ::struct::stack::StackProc $name return $name } ########################## # Private functions follow # ::struct::stack::StackProc -- # # Command that processes all stack object commands. # # Arguments: # name name of the stack object to manipulate. # args command name and args for the command # # Results: # Varies based on command to perform proc ::struct::stack::StackProc {name cmd args} { # Split the args into command and args components if { [lsearch -exact $::struct::stack::commands $cmd] == -1 } { set optlist [join $::struct::stack::commands ", "] set optlist [linsert $optlist "end-1" "or"] error "bad option \"$cmd\": must be $optlist" } eval [linsert $args 0 ::struct::stack::_$cmd $name] } # ::struct::stack::_clear -- # # Clear a stack. # # Arguments: # name name of the stack object. # # Results: # None. proc ::struct::stack::_clear {name} { set ::struct::stack::stacks($name) [list ] return } # ::struct::stack::_destroy -- # # Destroy a stack object by removing it's storage space and # eliminating it's proc. # # Arguments: # name name of the stack object. # # Results: # None. proc ::struct::stack::_destroy {name} { unset ::struct::stack::stacks($name) interp alias {} ::$name {} return } # ::struct::stack::_peek -- # # Retrive the value of an item on the stack without popping it. # # Arguments: # name name of the stack object. # count number of items to pop; defaults to 1 # # Results: # items top count items from the stack; if there are not enough items # ... [truncated message content] |
1 message has been excluded from this view by a project administrator.