Possible compatibility problems with earlier versions marked with '*'.
-For ILL, fixed tagging problem for member requester-CHECKED-IN in
-type Requester-Optional-Messages-Type.
+Added configure option --enable-comp/disable-comp to control use
+of YAZ ASN.1 compiler. Use --disable-comp to use the old *coders
+located in sub directory asn.
+
+YAZ ASN.1 compiler renamed to yaz-comp in sub directory. It's installed
+in ${exec_prefix}/bin along with the other programs yaz-client and
+yaz-ztest.
+
+GNU automake used to maintain makefiles.
Added several OID's.
Changed retrieval module so that we can load records with no abstract
-syntax defined. Tagpaths in these records are fully composed of string tags.
+syntax defined. Tagpaths in these records are fully composed of string
+tags.
Implemented ISO ILL protocol. Refer to stuff in sub directory ill.
ac_default_prefix=/usr/local
# Any additions from configure.in:
ac_help="$ac_help
- --disable-yc use old encoders, i.e. disable YAZ ASN.1 Compiler"
+ --disable-comp use old encoders, i.e. disable the YAZ ASN.1 Compiler"
ac_help="$ac_help
--enable-tcpd enable TCP wrapper for server if available"
ac_help="$ac_help
-# Check whether --enable-yc or --disable-yc was given.
-if test "${enable_yc+set}" = set; then
- enableval="$enable_yc"
+# Check whether --enable-comp or --disable-comp was given.
+if test "${enable_comp+set}" = set; then
+ enableval="$enable_comp"
:
else
- enable_yc=yes
+ enable_comp=yes
fi
-if test "$enable_yc" = "yes"; then
+if test "$enable_comp" = "yes"; then
ASNMODULE="z39.50"
ILLMODULE="ill"
ILLLIB=../ill/libill.a
dnl YAZ Toolkit
dnl (c) Index Data 1994-2000
dnl See the file LICENSE for details.
-dnl $Id: configure.in,v 1.21 2000-03-01 11:15:31 adam Exp $
+dnl $Id: configure.in,v 1.22 2000-03-02 08:48:20 adam Exp $
AC_INIT(include/yaz/yaz-version.h)
AM_INIT_AUTOMAKE(yaz, 1.6)
dnl
DOCMODULE="doc"
fi
dnl
-dnl ----- YC: The Yaz Compiler
+dnl ----- yaz-comp: The Yaz Compiler
AC_SUBST(ASNMODULE)
AC_SUBST(ILLMODULE)
AC_SUBST(ILLLIB)
-AC_ARG_ENABLE(yc,[ --disable-yc use old encoders, i.e. disable YAZ ASN.1 Compiler], , enable_yc=yes)
-if test "$enable_yc" = "yes"; then
+AC_ARG_ENABLE(comp,[ --disable-comp use old encoders, i.e. disable the YAZ ASN.1 Compiler], , enable_comp=yes)
+if test "$enable_comp" = "yes"; then
ASNMODULE="z39.50"
ILLMODULE="ill"
ILLLIB=../ill/libill.a
<article>
<title>YAZ User's Guide and Reference
<author><htmlurl url="http://www.indexdata.dk/" name="Index Data">, <tt><htmlurl url="mailto:info@indexdata.dk" name="info@indexdata.dk"></>
-<date>$Revision: 1.4 $
+<date>$Revision: 1.5 $
<abstract>
This document is the programmer's guide and reference to the YAZ
package. YAZ is a compact toolkit that provides access to the
"system" installation. The prefix is <tt>/usr/local</tt> if not
specified.
-<tag><tt>-</tt><tt>-enable-yc </tt></tag> YAZ will be built using
+<tag><tt>-</tt><tt>-enable-comp </tt></tag> YAZ will be built using
the ASN.1 compiler for YAZ (default). If you wish to use the
-old decoders (in sub directory asn) use <tt>--disable-yc</tt> instead.
+old decoders (in sub directory asn) use <tt>--disable-comp</tt> instead.
<tag><tt>-</tt><tt>-enable-threads</tt></tag> YAZ will be built using
POSIX threads. Specifically, <tt>_REENTRANT</tt> will be defined
-## $Id: Makefile.am,v 1.3 2000-02-29 14:13:44 adam Exp $
+## $Id: Makefile.am,v 1.4 2000-03-02 08:48:20 adam Exp $
INCLUDES=-I../include
libill_a_SOURCES=ill-core.c item-req.c ill-get.c
-ill-core.c ../include/yaz/ill-core.h: ill.tcl ill9702.asn ../util/yc.tcl
- ../util/yc.tcl -d ill.tcl -i yaz -I ../include $(YCFLAGS) ill9702.asn
+ill-core.c ../include/yaz/ill-core.h: ill.tcl ill9702.asn ../util/yaz-comp
+ ../util/yaz-comp -d ill.tcl -i yaz -I ../include $(YCFLAGS) ill9702.asn
-item-req.c ../include/yaz/item-req.h: ill.tcl item-req.asn ../util/yc.tcl
- ../util/yc.tcl -d ill.tcl -i yaz -I ../include $(YCFLAGS) item-req.asn
+item-req.c ../include/yaz/item-req.h: ill.tcl item-req.asn ../util/yaz-comp
+ ../util/yaz-comp -d ill.tcl -i yaz -I ../include $(YCFLAGS) item-req.asn
maintainer-clean-generic clean mostlyclean distclean maintainer-clean
-ill-core.c ../include/yaz/ill-core.h: ill.tcl ill9702.asn ../util/yc.tcl
- ../util/yc.tcl -d ill.tcl -i yaz -I ../include $(YCFLAGS) ill9702.asn
+ill-core.c ../include/yaz/ill-core.h: ill.tcl ill9702.asn ../util/yaz-comp
+ ../util/yaz-comp -d ill.tcl -i yaz -I ../include $(YCFLAGS) ill9702.asn
-item-req.c ../include/yaz/item-req.h: ill.tcl item-req.asn ../util/yc.tcl
- ../util/yc.tcl -d ill.tcl -i yaz -I ../include $(YCFLAGS) item-req.asn
+item-req.c ../include/yaz/item-req.h: ill.tcl item-req.asn ../util/yaz-comp
+ ../util/yaz-comp -d ill.tcl -i yaz -I ../include $(YCFLAGS) item-req.asn
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
-/* YC 0.2 Wed Mar 01 14:46:59 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ISO-10161-ILL-1 */
#include <yaz/ill-core.h>
-/* YC 0.2 Wed Mar 01 14:47:01 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: Z39.50-extendedService-ItemOrder-ItemRequest-1 */
#include <yaz/item-req.h>
-/* YC 0.2: Wed Mar 01 14:46:59 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ISO-10161-ILL-1 */
#ifndef ill_core_H
-/* YC 0.2: Wed Mar 01 14:47:01 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H Z39.50-extendedService-ItemOrder-ItemRequest-1 */
#ifndef item_req_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H AccessControlFormat-des-1 */
#ifndef z_accdes1_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H AccessControlFormat-prompt-1 */
#ifndef z_accform1_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H AccessControlFormat-krb-1 */
#ifndef z_acckrb1_H
-/* YC 0.2: Wed Mar 01 10:28:10 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H Z39-50-APDU-1995 */
#ifndef z_core_H
-/* YC 0.2: Wed Mar 01 10:28:13 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H UserInfoFormat-dateTime */
#ifndef z_date_H
-/* YC 0.2: Wed Mar 01 10:28:11 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H DiagnosticFormatDiag1 */
#ifndef z_diag1_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ElementSpecificationFormat-eSpec-1 */
#ifndef z_espec1_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H RecordSyntax-ESTaskPackage */
#ifndef z_estask_H
-/* YC 0.2: Wed Mar 01 10:28:11 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H RecordSyntax-explain */
#ifndef z_exp_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H RecordSyntax-generic */
#ifndef z_grs_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H RecordSyntax-opac */
#ifndef z_opac_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ResourceReport-Format-Resource-1 */
#ifndef z_rrf1_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ResourceReport-Format-Resource-2 */
#ifndef z_rrf2_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H RecordSyntax-summary */
#ifndef z_sum_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H RecordSyntax-SUTRS */
#ifndef z_sutrs_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H UserInfoFormat-searchResult-1 */
#ifndef z_uifr1_H
-/* YC 0.2: Wed Mar 01 10:28:13 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ResourceReport-Format-Universe-1 */
#ifndef z_univ_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ESFormat-ExportInvocation */
#ifndef zes_expi_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ESFormat-ExportSpecification */
#ifndef zes_exps_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ESFormat-ItemOrder */
#ifndef zes_order_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ESFormat-PersistentQuery */
#ifndef zes_pquery_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ESFormat-PeriodicQuerySchedule */
#ifndef zes_psched_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ESFormat-PersistentResultSet */
#ifndef zes_pset_H
-/* YC 0.2: Tue Feb 29 15:20:49 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ESFormat-Update */
#ifndef zes_update_H
-/* YC 0.2: Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-H ESFormat-Update0 */
#ifndef zes_update0_H
## Copyright (C) 1994-2000, Index Data
## All rights reserved.
-## $Id: Makefile.am,v 1.3 2000-02-29 13:44:55 adam Exp $
+## $Id: Makefile.am,v 1.4 2000-03-02 08:48:20 adam Exp $
noinst_LIBRARIES = libutil.a
-EXTRA_DIST=yc.tcl
+
+bin_SCRIPTS=yaz-comp
INCLUDES=-I../include
have_sgml2txt = @have_sgml2txt@
noinst_LIBRARIES = libutil.a
-EXTRA_DIST = yc.tcl
+
+bin_SCRIPTS = yaz-comp
INCLUDES = -I../include
libutil_a_OBJECTS = options.o log.o marcdisp.o oid.o wrbuf.o nmemsdup.o \
xmalloc.o readconf.o tpath.o nmem.o matchstr.o atoin.o
AR = ar
+SCRIPTS = $(bin_SCRIPTS)
+
CFLAGS = @CFLAGS@
COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
CCLD = $(CC)
$(AR) cru libutil.a $(libutil_a_OBJECTS) $(libutil_a_LIBADD)
$(RANLIB) libutil.a
+install-binSCRIPTS: $(bin_SCRIPTS)
+ @$(NORMAL_INSTALL)
+ $(mkinstalldirs) $(DESTDIR)$(bindir)
+ @list='$(bin_SCRIPTS)'; for p in $$list; do \
+ if test -f $$p; then \
+ echo " $(INSTALL_SCRIPT) $$p $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`"; \
+ $(INSTALL_SCRIPT) $$p $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`; \
+ else if test -f $(srcdir)/$$p; then \
+ echo " $(INSTALL_SCRIPT) $(srcdir)/$$p $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`"; \
+ $(INSTALL_SCRIPT) $(srcdir)/$$p $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`; \
+ else :; fi; fi; \
+ done
+
+uninstall-binSCRIPTS:
+ @$(NORMAL_UNINSTALL)
+ list='$(bin_SCRIPTS)'; for p in $$list; do \
+ rm -f $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`; \
+ done
+
tags: TAGS
ID: $(HEADERS) $(SOURCES) $(LISP)
check: check-am
installcheck-am:
installcheck: installcheck-am
-install-exec-am:
+install-exec-am: install-binSCRIPTS
install-exec: install-exec-am
install-data-am:
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
install: install-am
-uninstall-am:
+uninstall-am: uninstall-binSCRIPTS
uninstall: uninstall-am
-all-am: Makefile $(LIBRARIES)
+all-am: Makefile $(LIBRARIES) $(SCRIPTS)
all-redirect: all-am
install-strip:
$(MAKE) $(AM_MAKEFLAGS) AM_INSTALL_PROGRAM_FLAGS=-s install
installdirs:
+ $(mkinstalldirs) $(DESTDIR)$(bindir)
mostlyclean-generic:
.PHONY: mostlyclean-noinstLIBRARIES distclean-noinstLIBRARIES \
clean-noinstLIBRARIES maintainer-clean-noinstLIBRARIES \
mostlyclean-compile distclean-compile clean-compile \
-maintainer-clean-compile tags mostlyclean-tags distclean-tags \
-clean-tags maintainer-clean-tags distdir mostlyclean-depend \
-distclean-depend clean-depend maintainer-clean-depend info-am info \
-dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
-install-exec install-data-am install-data install-am install \
-uninstall-am uninstall all-redirect all-am all installdirs \
-mostlyclean-generic distclean-generic clean-generic \
-maintainer-clean-generic clean mostlyclean distclean maintainer-clean
+maintainer-clean-compile uninstall-binSCRIPTS install-binSCRIPTS tags \
+mostlyclean-tags distclean-tags clean-tags maintainer-clean-tags \
+distdir mostlyclean-depend distclean-depend clean-depend \
+maintainer-clean-depend info-am info dvi-am dvi check check-am \
+installcheck-am installcheck install-exec-am install-exec \
+install-data-am install-data install-am install uninstall-am uninstall \
+all-redirect all-am all installdirs mostlyclean-generic \
+distclean-generic clean-generic maintainer-clean-generic clean \
+mostlyclean distclean maintainer-clean
# Tell versions [3.59,3.63) of GNU make to not export all variables.
--- /dev/null
+#!/bin/sh
+# the next line restarts using tclsh \
+exec tclsh "$0" "$@"
+#
+# yaz-comp: ASN.1 Compiler for YAZ
+# (c) Index Data 1996-2000
+# See the file LICENSE for details.
+#
+# $Log: yaz-comp,v $
+# Revision 1.1 2000-03-02 08:48:20 adam
+# Renamed ASN.1 compiler to yaz-comp (used to be yc.tcl).
+#
+# Revision 1.6 2000/02/10 13:44:02 adam
+# Tcl command clock not used if unavailable (Tcl7.4 and earlier).
+#
+# Revision 1.5 2000/01/15 09:18:42 adam
+# Bug fix: some elements where treated as OPTIONAL when they shouldn't.
+#
+# Revision 1.4 1999/12/16 23:36:19 adam
+# Implemented ILL protocol. Minor updates ASN.1 compiler.
+#
+# Revision 1.3 1999/11/30 13:47:12 adam
+# Improved installation. Moved header files to include/yaz.
+#
+# Revision 1.2 1999/06/09 09:43:11 adam
+# Added option -I and variable h-path to specify path for header files.
+#
+# Revision 1.1 1999/06/08 10:10:16 adam
+# New sub directory zutil. Moved YAZ Compiler to be part of YAZ tree.
+#
+# Revision 1.8 1999/04/20 10:37:04 adam
+# Updated for ODR - added name parameter.
+#
+# Revision 1.7 1998/04/03 14:44:20 adam
+# Small fix.
+#
+# Revision 1.6 1998/04/03 13:21:17 adam
+# Yet another fix.
+#
+# Revision 1.5 1998/04/03 12:48:17 adam
+# Fixed bug: missed handling of constructed tags for CHOICE.
+#
+# Revision 1.4 1998/03/31 15:47:45 adam
+# First compiled ASN.1 code for YAZ.
+#
+# Revision 1.3 1998/03/23 17:13:20 adam
+# Implemented SET OF and ENUM. The Compiler now eats ILL (ISO10161) and
+# LDAP (RFC1777).
+#
+# Revision 1.2 1997/10/07 10:31:01 adam
+# Added facility to specify tag type (CONTEXT, APPLICATION, ...).
+#
+# Revision 1.1.1.1 1996/10/31 14:04:40 adam
+# First version of the compiler for YAZ.
+#
+#
+
+set yc_version 0.3
+
+# Syntax for the ASN.1 supported:
+# file -> file module
+# | module
+# module -> name skip DEFINITIONS ::= mbody END
+# mbody -> EXPORTS { nlist }
+# | IMPORTS { imlist }
+# | name ::= tmt
+# | skip
+# tmt -> tag mod type
+# type -> SEQUENCE { sqlist }
+# | SEQUENCE OF type
+# | CHOICE { chlist }
+# | basic enlist
+#
+# basic -> INTEGER
+# | BOOLEAN
+# | OCTET STRING
+# | BIT STRING
+# | EXTERNAL
+# | name
+# sqlist -> sqlist , name tmt opt
+# | name tmt opt
+# chlist -> chlist , name tmt
+# | name tmt
+# enlist -> enlist , name (n)
+# | name (n)
+# imlist -> nlist FROM name
+# imlist nlist FROM name
+# nlist -> name
+# | nlist , name
+# mod -> IMPLICIT | EXPLICIT | e
+# tag -> [tagtype n] | [n] | e
+# opt -> OPTIONAL | e
+#
+# name identifier/token
+# e epsilon/empty
+# skip one token skipped
+# n number
+# tagtype APPLICATION, CONTEXT, etc.
+
+# lex: moves input file pointer and returns type of token.
+# The globals $type and $val are set. $val holds name if token
+# is normal identifier name.
+# sets global var type to one of:
+# {} eof-of-file
+# \{ left curly brace
+# \} right curly brace
+# , comma
+# ; semicolon
+# ( (n)
+# [ [n]
+# : ::=
+# n other token n
+proc lex {} {
+ global inf val type
+ while {![string length $inf(str)]} {
+ incr inf(lineno)
+ set inf(cnt) [gets $inf(inf) inf(str)]
+ if {$inf(cnt) < 0} {
+ set type {}
+ return {}
+ }
+ lappend inf(asn,$inf(asndef)) $inf(str)
+ set l [string first -- $inf(str)]
+ if {$l >= 0} {
+ incr l -1
+ set inf(str) [string range $inf(str) 0 $l]
+ }
+ set inf(str) [string trim $inf(str)]
+ }
+ set s [string index $inf(str) 0]
+ set type $s
+ set val {}
+ switch -- $s {
+ \{ { }
+ \} { }
+ , { }
+ ; { }
+ \( { }
+ \) { }
+ \[ { regexp {^\[[ ]*(.+)[ ]*\]} $inf(str) s val }
+ : { regexp {^::=} $inf(str) s }
+ default {
+ regexp "^\[^,\t :\{\}();\]+" $inf(str) s
+ set type n
+ set val $s
+ }
+ }
+ set off [string length $s]
+ set inf(str) [string trim [string range $inf(str) $off end]]
+ return $type
+}
+
+# lex-expect: move pointer and expect token $t
+proc lex-expect {t} {
+ global type val
+ lex
+ if {[string compare $t $type]} {
+ asnError "Got $type '$val', expected $t"
+ }
+}
+
+# lex-name-move: see if token is $name; moves pointer and returns
+# 1 if it is; returns 0 otherwise.
+proc lex-name-move {name} {
+ global type val
+ if {![string compare $type n] && ![string compare $val $name]} {
+ lex
+ return 1
+ }
+ return 0
+}
+
+# asnError: Report error and die
+proc asnError {msg} {
+ global inf
+
+ puts "Error in line $inf(lineno) in module $inf(module)"
+ puts " $msg"
+ error
+ exit 1
+}
+
+# asnWarning: Report warning and return
+proc asnWarning {msg} {
+ global inf
+
+ puts "Warning in line $inf(lineno) in module $inf(module)"
+ puts " $msg"
+}
+
+# asnEnum: parses enumerated list - { name1 (n), name2 (n), ... }
+# Uses $name as prefix. If there really is a list, $lx holds the C
+# preprocessor definitions on return; otherwise lx isn't set.
+proc asnEnum {name lx} {
+ global type val inf
+
+ if {[string compare $type \{]} return
+ upvar $lx l
+ while {1} {
+ set pq [asnName $name]
+ set id [lindex $pq 0]
+ set id ${name}_$id
+ lex-expect n
+ lappend l "#define $inf(dprefix)$id $val"
+ lex-expect ")"
+ lex
+ if {[string compare $type ,]} break
+ }
+ if {[string compare $type \}]} {
+ asnError "Missing \} in enum list got $type '$val'"
+ }
+ lex
+}
+
+# asnMod: parses tag and modifier.
+# $xtag and $ximplicit holds tag and implicit-indication on return.
+# $xtag is empty if no tag was specified. $ximplicit is 1 on implicit
+# tagging; 0 otherwise.
+proc asnMod {xtag ximplicit xtagtype} {
+ global type val inf
+
+ upvar $xtag tag
+ upvar $ximplicit implicit
+ upvar $xtagtype tagtype
+
+ set tag {}
+ set tagtype {}
+ if {![string compare $type \[]} {
+ if {[regexp {^([a-zA-Z]+)[ ]+([0-9]+)$} $val x tagtype tag]} {
+ set tagtype ODR_$tagtype
+ } elseif {[regexp {^([0-9]+)$} $val x tag]} {
+ set tagtype ODR_CONTEXT
+ } else {
+ asnError "bad tag specification: $val"
+ }
+ lex
+ }
+ set implicit $inf(implicit-tags)
+ if {![string compare $type n]} {
+ if {![string compare $val EXPLICIT]} {
+ lex
+ set implicit 0
+ } elseif {![string compare $val IMPLICIT]} {
+ lex
+ set implicit 1
+ }
+ }
+}
+
+# asnName: moves pointer and expects name. Returns C-validated name.
+proc asnName {name} {
+ global val inf
+ lex-expect n
+ if {[info exists inf(membermap,$inf(module),$name,$val)]} {
+ set nval $inf(membermap,$inf(module),$name,$val)
+ if {$inf(verbose)} {
+ puts " mapping member $name,$val to $nval"
+ }
+ lex
+ } else {
+ set nval $val
+ if {![string match {[A-Z]*} $val]} {
+ lex
+ }
+ }
+ return [join [split $nval -] _]
+}
+
+# asnOptional: parses optional modifier. Returns 1 if OPTIONAL was
+# specified; 0 otherwise.
+proc asnOptional {} {
+ global type val
+ if {[lex-name-move OPTIONAL]} {
+ return 1
+ } elseif {[lex-name-move DEFAULT]} {
+ lex
+ return 0
+ }
+ return 0
+}
+
+# asnSizeConstraint: parses the optional SizeConstraint.
+# Currently not used for anything.
+proc asnSizeConstraint {} {
+ global type val
+ if {[lex-name-move SIZE]} {
+ asnSubtypeSpec
+ }
+}
+
+# asnSubtypeSpec: parses the SubtypeSpec ...
+# Currently not used for anything. We now it's balanced however, i.e.
+# (... ( ... ) .. )
+proc asnSubtypeSpec {} {
+ global type val
+
+ if {[string compare $type "("]} {
+ return
+ }
+ lex
+ set level 1
+ while {$level > 0} {
+ if {![string compare $type "("]} {
+ incr level
+ } elseif {![string compare $type ")"]} {
+ incr level -1
+ }
+ lex
+ }
+}
+
+# asnType: parses ASN.1 type.
+# On entry $name should hold the name we are currently defining.
+# Returns type indicator:
+# SequenceOf SEQUENCE OF
+# Sequence SEQUENCE
+# SetOf SET OF
+# Set SET
+# Choice CHOICE
+# Simple Basic types.
+# In this casecalling procedure's $tname variable is a list holding:
+# {C-Function C-Type} if the type is IMPORTed or ODR defined.
+# or
+# {C-Function C-Type 1} if the type should be defined in this module
+proc asnType {name} {
+ global type val inf
+ upvar tname tname
+
+ set tname {}
+ if {[string compare $type n]} {
+ asnError "Expects type specifier, but got $type"
+ }
+ set v $val
+ lex
+ switch -- $v {
+ SEQUENCE {
+ asnSizeConstraint
+ if {[lex-name-move OF]} {
+ asnSubtypeSpec
+ return SequenceOf
+ } else {
+ asnSubtypeSpec
+ return Sequence
+ }
+ }
+ SET {
+ asnSizeConstraint
+ if {[lex-name-move OF]} {
+ asnSubtypeSpec
+ return SetOf
+ } else {
+ asnSubtypeSpec
+ return Set
+ }
+ }
+ CHOICE {
+ asnSubtypeSpec
+ return Choice
+ }
+ }
+ if {[string length [info commands asnBasic$v]]} {
+ set tname [asnBasic$v]
+ } else {
+ if {[info exists inf(map,$inf(module),$v)]} {
+ set v $inf(map,$inf(module),$v)
+ }
+ if {[info exists inf(imports,$v)]} {
+ set tname $inf(imports,$v)
+ } else {
+ set w [join [split $v -] _]
+ set tname [list $inf(fprefix)$w $inf(vprefix)$w 1]
+ }
+ }
+ if {[lex-name-move DEFINED]} {
+ if {[lex-name-move BY]} {
+ lex
+ }
+ }
+ asnSubtypeSpec
+ return Simple
+}
+
+proc mapName {name} {
+ global inf
+ if {[info exists inf(map,$inf(module),$name)]} {
+ set name $inf(map,$inf(module),$name)
+ if {$inf(verbose)} {
+ puts -nonewline " $name ($inf(lineno))"
+ puts " mapping to $name"
+ }
+ } else {
+ if {$inf(verbose)} {
+ puts " $name ($inf(lineno))"
+ }
+ }
+ return $name
+}
+
+# asnDef: parses type definition (top-level) and generates C code
+# On entry $name holds the type we are defining.
+proc asnDef {name} {
+ global inf file
+
+ set name [mapName $name]
+ if {[info exist inf(defined,$inf(fprefix)$name)]} {
+ incr inf(definedl,$name)
+ if {$inf(verbose) > 1} {
+ puts "set map($inf(module),$name) $name$inf(definedl,$name)"
+ }
+ } else {
+ set inf(definedl,$name) 0
+ }
+ set mname [join [split $name -] _]
+ asnMod tag implicit tagtype
+ set t [asnType $mname]
+ asnSub $mname $t $tname $tag $implicit $tagtype
+}
+
+
+# asnSub: parses type and generates C-code
+# On entry,
+# $name holds the type we are defining.
+# $t is the type returned by the asnType procedure.
+# $tname is the $tname set by the asnType procedure.
+# $tag is the tag as returned by asnMod
+# $implicit is the implicit indicator as returned by asnMod
+proc asnSub {name t tname tag implicit tagtype} {
+ global file inf
+
+ set ignore 0
+ set defname defined,$inf(fprefix)$name
+ if {[info exist inf($defname)]} {
+ asnWarning "$name already defined in line $inf($defname)"
+ set ignore 1
+ }
+ set inf($defname) $inf(lineno)
+ switch -- $t {
+ Sequence { set l [asnSequence $name $tag $implicit $tagtype] }
+ SequenceOf { set l [asnOf $name $tag $implicit $tagtype 0] }
+ SetOf { set l [asnOf $name $tag $implicit $tagtype 1] }
+ Choice { set l [asnChoice $name $tag $implicit $tagtype] }
+ Simple { set l [asnSimple $name $tname $tag $implicit $tagtype] }
+ default { asnError "switch asnType case not handled" }
+ }
+ if {$ignore} return
+
+ puts $file(outc) {}
+ puts $file(outc) "int $inf(fprefix)$name (ODR o, $inf(vprefix)$name **p, int opt, const char *name)"
+ puts $file(outc) \{
+ puts $file(outc) [lindex $l 0]
+ puts $file(outc) \}
+ set ok 1
+ set fdef "$inf(cprefix)int $inf(fprefix)$name (ODR o, $inf(vprefix)$name **p, int opt, const char *name);"
+ switch -- $t {
+ Simple {
+ set decl "typedef [lindex $l 1] $inf(vprefix)$name;"
+ if {![string compare [lindex $tname 2] 1]} {
+ if {![info exist inf(defined,[lindex $tname 0])]} {
+ set ok 0
+ }
+ }
+ set inf(var,$inf(nodef)) [join [lindex $l 2] \n]
+ incr inf(nodef)
+ }
+ default {
+ set decl "typedef struct $inf(vprefix)$name $inf(vprefix)$name;"
+ set inf(var,$inf(nodef)) "[lindex $l 1];"
+ incr inf(nodef)
+ }
+ }
+ if {$ok} {
+ puts $file(outh) {}
+ puts $file(outh) $decl
+ puts $file(outh) $fdef
+ asnForwardTypes $name
+ } else {
+ lappend inf(forward,code,[lindex $tname 0]) {} $decl $fdef
+ lappend inf(forward,ref,[lindex $tname 0]) $name
+ }
+}
+
+proc asnForwardTypes {name} {
+ global inf file
+
+ if {![info exists inf(forward,code,$inf(fprefix)$name)]} {
+ return 0
+ }
+ foreach r $inf(forward,code,$inf(fprefix)$name) {
+ puts $file(outh) $r
+ }
+ unset inf(forward,code,$inf(fprefix)$name)
+
+ while {[info exists inf(forward,ref,$inf(fprefix)$name)]} {
+ set n $inf(forward,ref,$inf(fprefix)$name)
+ set m [lrange $n 1 end]
+ if {[llength $m]} {
+ set inf(forward,ref,$inf(fprefix)$name) $m
+ } else {
+ unset inf(forward,ref,$inf(fprefix)$name)
+ }
+ asnForwardTypes [lindex $n 0]
+ }
+}
+
+# asnSimple: parses simple type definition and generates C code
+# On entry,
+# $name is the name we are defining
+# $tname is the tname as returned by asnType
+# $tag is the tag as returned by asnMod
+# $implicit is the implicit indicator as returned by asnMod
+# Returns,
+# {c-code, h-code}
+# Note: Doesn't take care of enum lists yet.
+proc asnSimple {name tname tag implicit tagtype} {
+ global inf
+
+ set j "[lindex $tname 1] "
+
+ if {[info exists inf(unionmap,$inf(module),$name)]} {
+ set uName $inf(unionmap,$inf(module),$name)
+ } else {
+ set uName $name
+ }
+
+ asnEnum $uName jj
+ if {![string length $tag]} {
+ set l "\treturn [lindex $tname 0] (o, p, opt, name);"
+ } elseif {$implicit} {
+ set l \
+ "\treturn odr_implicit_tag (o, [lindex $tname 0], p, $tagtype, $tag, opt, name);"
+ } else {
+ set l \
+ "\treturn odr_explicit_tag (o, [lindex $tname 0], p, $tagtype, $tag, opt, name);" \
+ }
+ if {[info exists jj]} {
+ return [list $l $j $jj]
+ } else {
+ return [list $l $j]
+ }
+}
+
+# asnSequence: parses "SEQUENCE { s-list }" and generates C code.
+# On entry,
+# $name is the type we are defining
+# $tag tag
+# $implicit
+# Returns,
+# {c-code, h-code}
+proc asnSequence {name tag implicit tagtype} {
+ global val type inf
+
+ lappend j "struct $inf(vprefix)$name \{"
+ set level 0
+ set nchoice 0
+ if {![string length $tag]} {
+ lappend l "\tif (!odr_sequence_begin (o, p, sizeof(**p), name))"
+ lappend l "\t\treturn opt && odr_ok (o);"
+ } elseif {$implicit} {
+ lappend l "\tif (!odr_implicit_settag (o, $tagtype, $tag) ||"
+ lappend l "\t\t!odr_sequence_begin (o, p, sizeof(**p), name))"
+ lappend l "\t\treturn opt && odr_ok(o);"
+ } else {
+ lappend l "\tif (!odr_constructed_begin (o, p, $tagtype, $tag, name))"
+ lappend l "\t\treturn opt && odr_ok(o);"
+ lappend l "\tif (o->direction == ODR_DECODE)"
+ lappend l "\t\t*p = odr_malloc (o, sizeof(**p));"
+
+ lappend l "\tif (!odr_sequence_begin (o, p, sizeof(**p), 0))"
+ lappend l "\t\{"
+ lappend l "\t\t*p = 0;"
+ lappend l "\t\treturn 0;"
+ lappend l "\t\}"
+ }
+ lappend l "\treturn"
+ while {1} {
+ set p [lindex [asnName $name] 0]
+ asnMod ltag limplicit ltagtype
+ set t [asnType $p]
+
+ set uName { }
+ if {[info exists inf(unionmap,$inf(module),$name,$p)]} {
+ set uName $inf(unionmap,$inf(module),$name,$p)
+ }
+
+ if {![string compare $t Simple]} {
+ if {[string compare $uName { }]} {
+ set enumName $uName
+ } else {
+ set enumName $name
+ }
+ asnEnum $enumName j
+ set opt [asnOptional]
+ if {![string length $ltag]} {
+ lappend l "\t\t[lindex $tname 0](o, &(*p)->$p, $opt, \"$p\") &&"
+ } elseif {$limplicit} {
+ lappend l "\t\todr_implicit_tag (o, [lindex $tname 0],"
+ lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
+ } else {
+ lappend l "\t\todr_explicit_tag (o, [lindex $tname 0],"
+ lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
+ }
+ set dec "\t[lindex $tname 1] *$p;"
+ } elseif {![string compare $t SequenceOf] && [string length $uName] &&\
+ (![string length $ltag] || $limplicit)} {
+ set u [asnType $p]
+
+ if {[llength $uName] < 2} {
+ set uName [list num_$p $p]
+ }
+ if {[string length $ltag]} {
+ if {!$limplicit} {
+ asnError explicittag
+ }
+ lappend l "\t\todr_implicit_settag (o, $ltagtype, $ltag) &&"
+ }
+ switch -- $u {
+ Simple {
+ asnEnum $name j
+ set tmpa "odr_sequence_of(o, (Odr_fun) [lindex $tname 0], &(*p)->$p,"
+ set tmpb "&(*p)->[lindex $uName 0], \"$p\")"
+ lappend j "\tint [lindex $uName 0];"
+ set dec "\t[lindex $tname 1] **[lindex $uName 1];"
+ }
+ default {
+ set subName [mapName ${name}_$level]
+ asnSub $subName $u {} {} 0 {}
+
+ set tmpa "odr_sequence_of(o, (Odr_fun) $inf(fprefix)$subName, &(*p)->$p,"
+ set tmpb "&(*p)->[lindex $uName 0], \"$p\")"
+ lappend j "\tint [lindex $uName 0];"
+ set dec "\t$inf(vprefix)$subName **[lindex $uName 1];"
+ incr level
+ }
+ }
+ set opt [asnOptional]
+ if {$opt} {
+ lappend l "\t\t($tmpa"
+ lappend l "\t\t $tmpb || odr_ok(o)) &&"
+ } else {
+ lappend l "\t\t$tmpa"
+ lappend l "\t\t $tmpb &&"
+ }
+ } elseif {!$nchoice && ![string compare $t Choice] && \
+ [string length $uName]} {
+ if {[llength $uName] < 3} {
+ set uName [list which u $name]
+ incr nchoice
+ }
+ lappend j "\tint [lindex $uName 0];"
+ lappend j "\tunion \{"
+ lappend v "\tstatic Odr_arm arm\[\] = \{"
+ asnArm $name [lindex $uName 2] v j
+ lappend v "\t\};"
+ set dec "\t\} [lindex $uName 1];"
+ set opt [asnOptional]
+ set oa {}
+ set ob {}
+ if {[string length $ltag]} {
+ if {$limplicit} {
+ lappend l "\t\todr_implicit_settag (o, $ltagtype, $ltag) &&"
+ if {$opt} {
+ asnWarning "optional handling missing in CHOICE in SEQUENCE"
+ asnWarning " set unionmap($inf(module),$name,$p) to {}"
+ }
+ } else {
+ if {$opt} {
+ set la "(("
+ } else {
+ set la ""
+ }
+ lappend l "\t\t${la}odr_constructed_begin (o, &(*p)->[lindex $uName 1], $ltagtype, $ltag, \"$p\") &&"
+ }
+ } else {
+ if {$opt} {
+ set oa "("
+ set ob " || odr_ok(o))"
+ }
+ }
+ lappend l "\t\t${oa}odr_choice (o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], 0)${ob} &&"
+ if {[string length $ltag]} {
+ if {!$limplicit} {
+ if {$opt} {
+ set lb ") || odr_ok(o))"
+ } else {
+ set lb ""
+ }
+ lappend l "\t\todr_constructed_end (o)${lb} &&"
+ }
+ }
+ } else {
+ set subName [mapName ${name}_$level]
+ asnSub $subName $t {} {} 0 {}
+ set opt [asnOptional]
+ if {![string length $ltag]} {
+ lappend l "\t\t$inf(fprefix)${subName} (o, &(*p)->$p, $opt, \"$p\") &&"
+ } elseif {$limplicit} {
+ lappend l "\t\todr_implicit_tag (o, $inf(fprefix)${subName},"
+ lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
+ } else {
+ lappend l "\t\todr_explicit_tag (o, $inf(fprefix)${subName},"
+ lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
+ }
+ set dec "\t$inf(vprefix)${subName} *$p;"
+ incr level
+ }
+ if {$opt} {
+ lappend j "$dec /* OPT */"
+ } else {
+ lappend j $dec
+ }
+ if {[string compare $type ,]} break
+ }
+ lappend j "\}"
+ if {[string length $tag] && !$implicit} {
+ lappend l "\t\todr_sequence_end (o) &&"
+ lappend l "\t\todr_constructed_end (o);"
+ } else {
+ lappend l "\t\todr_sequence_end (o);"
+ }
+ if {[string compare $type \}]} {
+ asnError "Missing \} got $type '$val'"
+ }
+ lex
+ if {[info exists v]} {
+ set l [concat $v $l]
+ }
+ return [list [join $l \n] [join $j \n]]
+}
+
+# asnOf: parses "SEQUENCE/SET OF type" and generates C code.
+# On entry,
+# $name is the type we are defining
+# $tag tag
+# $implicit
+# Returns,
+# {c-code, h-code}
+proc asnOf {name tag implicit tagtype isset} {
+ global inf
+
+ if {$isset} {
+ set func odr_set_of
+ } else {
+ set func odr_sequence_of
+ }
+
+ if {[info exists inf(unionmap,$inf(module),$name)]} {
+ set numName $inf(unionmap,$inf(module),$name)
+ } else {
+ set numName {num elements}
+ }
+
+ lappend j "struct $inf(vprefix)$name \{"
+ lappend j "\tint [lindex $numName 0];"
+
+ lappend l "\tif (!odr_initmember (o, p, sizeof(**p)))"
+ lappend l "\t\treturn opt && odr_ok(o);"
+ if {[string length $tag]} {
+ if {$implicit} {
+ lappend l "\todr_implicit_settag (o, $tagtype, $tag);"
+ } else {
+ asnWarning "Constructed SEQUENCE/SET OF not handled"
+ }
+ }
+ set t [asnType $name]
+ switch -- $t {
+ Simple {
+ asnEnum $name j
+ lappend l "\tif ($func (o, (Odr_fun) [lindex $tname 0], &(*p)->[lindex $numName 1],"
+ lappend l "\t\t&(*p)->[lindex $numName 0], name))"
+ lappend j "\t[lindex $tname 1] **[lindex $numName 1];"
+ }
+ default {
+ set subName [mapName ${name}_s]
+ lappend l "\tif ($func (o, (Odr_fun) $inf(fprefix)$subName, &(*p)->[lindex $numName 1],"
+ lappend l "\t\t&(*p)->[lindex $numName 0], name))"
+ lappend j "\t$inf(vprefix)$subName **[lindex $numName 1];"
+ asnSub $subName $t {} {} 0 {}
+ }
+ }
+ lappend j "\}"
+ lappend l "\t\treturn 1;"
+ lappend l "\t*p = 0;"
+ lappend l "\treturn opt && odr_ok(o);"
+ return [list [join $l \n] [join $j \n]]
+}
+
+# asnArm: parses c-list in choice
+proc asnArm {name defname lx jx} {
+ global type val inf
+
+ upvar $lx l
+ upvar $jx j
+ while {1} {
+ set pq [asnName $name]
+ set p [lindex $pq 0]
+ set q [lindex $pq 1]
+ if {![string length $q]} {
+ set q $p
+ set p ${defname}_$p
+ }
+ asnMod ltag limplicit ltagtype
+ set t [asnType $q]
+
+ lappend enums "$inf(dprefix)$p"
+ if {![string compare $t Simple]} {
+ asnEnum $name j
+ if {![string length $ltag]} {
+ lappend l "\t\t\{-1, -1, -1, $inf(dprefix)$p,"
+ lappend l "\t\t (Odr_fun) [lindex $tname 0], \"$q\"\},"
+ } elseif {$limplicit} {
+ lappend l "\t\t\{ODR_IMPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
+ lappend l "\t\t(Odr_fun) [lindex $tname 0], \"$q\"\},"
+ } else {
+ lappend l "\t\t\{ODR_EXPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
+ lappend l "\t\t(Odr_fun) [lindex $tname 0], \"$q\"\},"
+ }
+ lappend j "\t\t[lindex $tname 1] *$q;"
+ } else {
+ set subName [mapName ${name}_$q]
+ if {![string compare $inf(dprefix)${name}_$q \
+ $inf(vprefix)$subName]} {
+ set po [string toupper [string index $q 0]][string \
+ range $q 1 end]
+ set subName [mapName ${name}${po}]
+ }
+ asnSub $subName $t $tname {} 0 {}
+ if {![string length $ltag]} {
+ lappend l "\t\t\{-1, -1, -1, $inf(dprefix)$p,"
+ lappend l "\t\t (Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
+ } elseif {$limplicit} {
+ lappend l "\t\t\{ODR_IMPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
+ lappend l "\t\t(Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
+ } else {
+ lappend l "\t\t\{ODR_EXPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
+ lappend l "\t\t(Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
+ }
+ lappend j "\t\t$inf(vprefix)$subName *$q;"
+ }
+ if {[string compare $type ,]} break
+ }
+ if {[string compare $type \}]} {
+ asnError "Missing \} got $type '$val'"
+ }
+ lex
+ set level 1
+ foreach e $enums {
+ lappend j "#define $e $level"
+ incr level
+ }
+ lappend l "\t\t\{-1, -1, -1, -1, (Odr_fun) 0, 0\}"
+}
+
+# asnChoice: parses "CHOICE {c-list}" and generates C code.
+# On entry,
+# $name is the type we are defining
+# $tag tag
+# $implicit
+# Returns,
+# {c-code, h-code}
+proc asnChoice {name tag implicit tagtype} {
+ global type val inf
+
+ if {[info exists inf(unionmap,$inf(module),$name)]} {
+ set uName $inf(unionmap,$inf(module),$name)
+ } else {
+ set uName [list which u $name]
+ }
+
+ lappend j "struct $inf(vprefix)$name \{"
+ lappend j "\tint [lindex $uName 0];"
+ lappend j "\tunion \{"
+ lappend l "\tstatic Odr_arm arm\[\] = \{"
+ asnArm $name [lindex $uName 2] l j
+ lappend j "\t\} [lindex $uName 1];"
+ lappend j "\}"
+ lappend l "\t\};"
+ if {![string length $tag]} {
+ lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
+ lappend l "\t\treturn opt && odr_ok(o);"
+ lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name))"
+ } elseif {$implicit} {
+ lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
+ lappend l "\t\treturn opt && odr_ok(o);"
+ lappend l "\todr_implicit_settag(o, $tagtype, $tag);"
+ lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name))"
+ } else {
+ lappend l "\tif (!*p && o->direction != ODR_DECODE)"
+ lappend l "\t\treturn opt;"
+ lappend l "\tif (!odr_constructed_begin(o, p, $tagtype, $tag, 0))"
+ lappend l "\t\treturn opt && odr_ok(o);"
+ lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
+ lappend l "\t\treturn opt && odr_ok(o);"
+ lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name) &&"
+ lappend l "\t\todr_constructed_end(o))"
+ }
+ lappend l "\t\treturn 1;"
+ lappend l "\t*p = 0;"
+ lappend l "\treturn opt && odr_ok(o);"
+ return [list [join $l \n] [join $j \n]]
+}
+
+# asnImports: parses i-list in "IMPORTS {i-list}"
+# On return inf(import,..)-array is updated.
+# inf(import,"module") is a list of {C-handler, C-type} elements.
+# The {C-handler, C-type} is compatible with the $tname as is used by the
+# asnType procedure to solve external references.
+proc asnImports {} {
+ global type val inf file
+
+ while {1} {
+ if {[string compare $type n]} {
+ asnError "Missing name in IMPORTS list"
+ }
+ lappend nam $val
+ lex
+ if {![string compare $type n] && ![string compare $val FROM]} {
+ lex
+
+ if {[info exists inf(filename,$val)]} {
+ set fname $inf(filename,$val)
+ } else {
+ set fname $val
+ }
+ puts $file(outh) "\#include <$inf(h-dir)${fname}.h>"
+
+ if {[info exists inf(prefix,$val)]} {
+ set prefix $inf(prefix,$val)
+ } else {
+ set prefix $inf(prefix)
+ }
+ foreach n $nam {
+ if {[info exists inf(map,$val,$n)]} {
+ set v $inf(map,$val,$n)
+ } else {
+ set v $n
+ }
+ set w [join [split $v -] _]
+ set inf(imports,$n) [list [lindex $prefix 0]$w \
+ [lindex $prefix 1]$w]
+ }
+ unset nam
+ lex
+ if {[string compare $type n]} break
+ } elseif {![string compare $type ,]} {
+ lex
+ } else break
+ }
+ if {[string compare $type \;]} {
+ asnError "Missing ; after IMPORTS list - got $type '$val'"
+ }
+ lex
+}
+
+# asnExports: parses e-list in "EXPORTS {e-list}"
+# This function does nothing with elements in the list.
+proc asnExports {} {
+ global type val inf
+
+ while {1} {
+ if {[string compare $type n]} {
+ asnError "Missing name in EXPORTS list"
+ }
+ set inf(exports,$val) 1
+ lex
+ if {[string compare $type ,]} break
+ lex
+ }
+ if {[string compare $type \;]} {
+ asnError "Missing ; after EXPORTS list - got $type ($val)"
+ }
+ lex
+}
+
+# asnModuleBody: parses a module specification and generates C code.
+# Exports lists, imports lists, and type definitions are handled;
+# other things are silently ignored.
+proc asnModuleBody {} {
+ global type val file inf
+
+ if {[info exists inf(prefix,$inf(module))]} {
+ set prefix $inf(prefix,$inf(module))
+ } else {
+ set prefix $inf(prefix)
+ }
+ set inf(fprefix) [lindex $prefix 0]
+ set inf(vprefix) [lindex $prefix 1]
+ set inf(dprefix) [lindex $prefix 2]
+ if {[llength $prefix] > 3} {
+ set inf(cprefix) [lindex $prefix 3]
+ } else {
+ set inf(cprefix) {YAZ_EXPORT }
+ }
+
+ if {$inf(verbose)} {
+ puts "Module $inf(module), $inf(lineno)"
+ }
+
+ set defblock 0
+ if {[info exists inf(init,$inf(module),c)]} {
+ puts $file(outc) $inf(init,$inf(module),c)
+ }
+ if {[info exists inf(init,$inf(module),h)]} {
+ puts $file(outh) "\#ifdef __cplusplus"
+ puts $file(outh) "extern \"C\" \{"
+ puts $file(outh) "\#endif"
+ set defblock 1
+ puts $file(outh) $inf(init,$inf(module),h)
+ }
+ if {[info exists inf(init,$inf(module),p)]} {
+ puts $file(outp) $inf(init,$inf(module),p)
+ }
+
+ while {[string length $type]} {
+ if {[string compare $type n]} {
+ lex
+ continue
+ }
+ if {![string compare $val END]} {
+ break
+ } elseif {![string compare $val EXPORTS]} {
+ lex
+ asnExports
+ } elseif {![string compare $val IMPORTS]} {
+ if {$defblock} {
+ puts $file(outh) "\#ifdef __cplusplus"
+ puts $file(outh) "\}"
+ puts $file(outh) "\#endif"
+ set defblock 0
+ }
+ lex
+ asnImports
+ } else {
+ if {!$defblock} {
+ puts $file(outh) "\#ifdef __cplusplus"
+ puts $file(outh) "extern \"C\" \{"
+ puts $file(outh) "\#endif"
+ set defblock 1
+ }
+ set inf(asndef) $inf(nodef)
+ set oval $val
+ lex
+ if {![string compare $type :]} {
+ lex
+ asnDef $oval
+ set inf(asndef) 0
+ } elseif {![string compare $type n]} {
+ lex
+ if {[string length $type]} {
+ lex
+ }
+ }
+ }
+ }
+ if {$defblock} {
+ puts $file(outh) "\#ifdef __cplusplus"
+ puts $file(outh) "\}"
+ puts $file(outh) "\#endif"
+ set defblock 0
+ }
+ foreach x [array names inf imports,*] {
+ unset inf($x)
+ }
+}
+
+# asnTagDefault: parses TagDefault section
+proc asnTagDefault {} {
+ global type val inf file
+
+ set inf(implicit-tags) 0
+ while {[string length $type]} {
+ if {[lex-name-move EXPLICIT]} {
+ lex
+ set inf(implicit-tags) 0
+ } elseif {[lex-name-move IMPLICIT]} {
+ lex
+ set inf(implicit-tags) 1
+ } else {
+ break
+ }
+ }
+}
+
+# asnModules: parses a collection of module specifications.
+# Depending on the module pattern, $inf(moduleP), a module is either
+# skipped or processed.
+proc asnModules {} {
+ global type val inf file yc_version
+
+ set inf(nodef) 0
+ set inf(asndef) 0
+ lex
+ while {![string compare $type n]} {
+ set inf(module) $val
+ if {[info exists inf(moduleP)] && ![string match $inf(moduleP) $val]} {
+ if {$inf(verbose)} {
+ puts "Skipping $id"
+ }
+ while {![lex-name-move END]} {
+ lex
+ }
+ } else {
+ set inf(nodef) 1
+ set inf(asndef) 1
+
+ while {![lex-name-move DEFINITIONS]} {
+ lex
+ if {![string length $type]} return
+ }
+ if {[info exists inf(filename,$inf(module))]} {
+ set fname $inf(filename,$inf(module))
+ } else {
+ set fname $inf(module)
+ }
+ set ppname [join [split $fname -] _]
+
+ if {![info exists inf(c-file)]} {
+ set inf(c-file) ${fname}.c
+ }
+ set file(outc) [open $inf(c-file) w]
+
+ if {![info exists inf(h-file)]} {
+ set inf(h-file) ${fname}.h
+ }
+ set file(outh) [open $inf(h-path)/$inf(h-dir)$inf(h-file) w]
+
+ if {0} {
+ if {![info exists inf(p-file)]} {
+ set inf(p-file) ${fname}-p.h
+ }
+ set file(outp) [open $inf(h-path)/$inf(h-dir)$inf(p-file) w]
+ }
+
+ set greeting {Generated automatically by the YAZ ASN.1 Compiler}
+
+ puts $file(outc) "/* ${greeting} ${yc_version} */"
+ puts $file(outc) "/* Module-C: $inf(module) */"
+ puts $file(outc) {}
+
+ puts $file(outh) "/* ${greeting} ${yc_version} */"
+ puts $file(outh) "/* Module-H $inf(module) */"
+ puts $file(outh) {}
+
+ if {[info exists file(outp)]} {
+ puts $file(outp) "/* ${greeting} ${yc_version} */"
+ puts $file(outp) "/* Module-P: $inf(module) */"
+ puts $file(outp) {}
+ }
+
+ if {[info exists inf(p-file)]} {
+ puts $file(outc) "\#include <$inf(h-dir)$inf(p-file)>"
+ } else {
+ puts $file(outc) "\#include <$inf(h-dir)$inf(h-file)>"
+ }
+ puts $file(outh) "\#ifndef ${ppname}_H"
+ puts $file(outh) "\#define ${ppname}_H"
+ puts $file(outh) {}
+ puts $file(outh) "\#include <$inf(h-dir)odr.h>"
+
+ if {[info exists file(outp)]} {
+ puts $file(outp) "\#ifndef ${ppname}_P_H"
+ puts $file(outp) "\#define ${ppname}_P_H"
+ puts $file(outp) {}
+ puts $file(outp) "\#include <$inf(h-dir)$inf(h-file)>"
+
+ }
+
+ asnTagDefault
+ if {[string compare $type :]} {
+ asnError "::= expected got $type '$val'"
+ }
+ lex
+ if {![lex-name-move BEGIN]} {
+ asnError "BEGIN expected"
+ }
+ asnModuleBody
+ lex
+
+ if {[info exists file(outp)]} {
+ set f $file(outp)
+ } else {
+ set f $file(outh)
+ }
+ puts $f "\#ifdef __cplusplus"
+ puts $f "extern \"C\" \{"
+ puts $f "\#endif"
+ for {set i 1} {$i < $inf(nodef)} {incr i} {
+ puts $f $inf(var,$i)
+ if {[info exists inf(asn,$i)]} {
+ if {0} {
+ puts $f "/*"
+ foreach comment $inf(asn,$i) {
+ puts $f $comment
+ }
+ puts $f " */"
+ }
+ unset inf(asn,$i)
+ }
+ unset inf(var,$i)
+ puts $f {}
+ }
+ puts $f "\#ifdef __cplusplus"
+ puts $f "\}"
+ puts $f "\#endif"
+
+ if {[info exists inf(body,$inf(module),h)]} {
+ puts $file(outh) $inf(body,$inf(module),h)
+ }
+ if {[info exists inf(body,$inf(module),c)]} {
+ puts $file(outc) $inf(body,$inf(module),c)
+ }
+ if {[info exists inf(body,$inf(module),p)]} {
+ if {[info exists file(outp)]} {
+ puts $file(outp) $inf(body,$inf(module),p)
+ }
+ }
+ puts $file(outh) "\#endif"
+ if {[info exists file(outp)]} {
+ puts $file(outp) "\#endif"
+ }
+ foreach f [array names file] {
+ close $file($f)
+ }
+ unset inf(c-file)
+ unset inf(h-file)
+ catch {unset inf(p-file)}
+ }
+ }
+}
+
+# asnFile: parses an ASN.1 specification file as specified in $inf(iname).
+proc asnFile {} {
+ global inf file
+
+ if {$inf(verbose) > 1} {
+ puts "Reading ASN.1 file $inf(iname)"
+ }
+ set inf(str) {}
+ set inf(lineno) 0
+ set inf(inf) [open $inf(iname) r]
+
+ asnModules
+
+}
+
+# The following procedures are invoked by the asnType function.
+# Each procedure takes the form: asnBasic<TYPE> and they must return
+# two elements: the C function handler and the C type.
+# On entry upvar $name is the type we are defining and global, $inf(module), is
+# the current module name.
+
+proc asnBasicEXTERNAL {} {
+ return {odr_external {Odr_external}}
+}
+
+proc asnBasicINTEGER {} {
+ return {odr_integer {int}}
+}
+
+proc asnBasicENUMERATED {} {
+ return {odr_enum {int}}
+}
+
+proc asnBasicNULL {} {
+ return {odr_null {Odr_null}}
+}
+
+proc asnBasicBOOLEAN {} {
+ return {odr_bool {bool_t}}
+}
+
+proc asnBasicOCTET {} {
+ global type val
+ lex-name-move STRING
+ return {odr_octetstring {Odr_oct}}
+}
+
+proc asnBasicBIT {} {
+ global type val
+ lex-name-move STRING
+ return {odr_bitstring {Odr_bitmask}}
+}
+
+proc asnBasicOBJECT {} {
+ global type val
+ lex-name-move IDENTIFIER
+ return {odr_oid {Odr_oid}}
+}
+
+proc asnBasicGeneralString {} {
+ return {odr_generalstring char}
+}
+
+proc asnBasicVisibleString {} {
+ return {odr_visiblestring char}
+}
+
+proc asnBasicGeneralizedTime {} {
+ return {odr_generalizedtime char}
+}
+
+proc asnBasicANY {} {
+ upvar name name
+ global inf
+ return [list $inf(fprefix)ANY_$name void]
+}
+
+# userDef: reads user definitions file $name
+proc userDef {name} {
+ global inf
+
+ if {$inf(verbose) > 1} {
+ puts "Reading definitions file $name"
+ }
+ source $name
+
+ if {[info exists default-prefix]} {
+ set inf(prefix) ${default-prefix}
+ }
+ if {[info exists h-path]} {
+ set inf(h-path) ${h-path}
+ }
+ foreach m [array names prefix] {
+ set inf(prefix,$m) $prefix($m)
+ }
+ foreach m [array names body] {
+ set inf(body,$m) $body($m)
+ }
+ foreach m [array names init] {
+ set inf(init,$m) $init($m)
+ }
+ foreach m [array names filename] {
+ set inf(filename,$m) $filename($m)
+ }
+ foreach m [array names map] {
+ set inf(map,$m) $map($m)
+ }
+ foreach m [array names membermap] {
+ set inf(membermap,$m) $membermap($m)
+ }
+ foreach m [array names unionmap] {
+ set inf(unionmap,$m) $unionmap($m)
+ }
+}
+
+set inf(verbose) 0
+set inf(prefix) {yc_ Yc_ YC_}
+set inf(h-path) .
+set inf(h-dir) ""
+
+# Parse command line
+set l [llength $argv]
+set i 0
+while {$i < $l} {
+ set arg [lindex $argv $i]
+ switch -glob -- $arg {
+ -v {
+ incr inf(verbose)
+ }
+ -c {
+ set p [string range $arg 2 end]
+ if {![string length $p]} {
+ set p [lindex $argv [incr i]]
+ }
+ set inf(c-file) $p
+ }
+ -I* {
+ set p [string range $arg 2 end]
+ if {![string length $p]} {
+ set p [lindex $argv [incr i]]
+ }
+ set inf(h-path) $p
+ }
+ -i* {
+ set p [string range $arg 2 end]
+ if {![string length $p]} {
+ set p [lindex $argv [incr i]]
+ }
+ set inf(h-dir) [string trim $p \\/]/
+ }
+ -h* {
+ set p [string range $arg 2 end]
+ if {![string length $p]} {
+ set p [lindex $argv [incr i]]
+ }
+ set inf(h-file) $p
+ }
+ -p* {
+ set p [string range $arg 2 end]
+ if {![string length $p]} {
+ set p [lindex $argv [incr i]]
+ }
+ set inf(p-file) $p
+ }
+ -d* {
+ set p [string range $arg 2 end]
+ if {![string length $p]} {
+ set p [lindex $argv [incr i]]
+ }
+ userDef $p
+ }
+ -m* {
+ set p [string range $arg 2 end]
+ if {![string length $p]} {
+ set p [lindex $argv [incr i]]
+ }
+ set inf(moduleP) $p
+ }
+ -x* {
+ set p [string range $arg 2 end]
+ if {![string length $p]} {
+ set p [lindex $argv [incr i]]
+ }
+ if {[llength $p] == 1} {
+ set inf(prefix) [list [string tolower $p] \
+ [string toupper $p] [string toupper $p]]
+ } elseif {[llength $p] == 3} {
+ set inf(prefix) $p
+ } else {
+ puts [llength $p]
+ exit 1
+ }
+ }
+ default {
+ set inf(iname) $arg
+ }
+ }
+ incr i
+}
+
+if {![info exists inf(iname)]} {
+ puts "YAZ ASN.1 Compiler ${yc_version}"
+ puts -nonewline "Usage: ${argv0}"
+ puts { [-v] [-c cfile] [-h hfile] [-p hfile] [-d dfile] [-I path]}
+ puts { [-x prefix] [-m module] file}
+ exit 1
+}
+
+asnFile
+++ /dev/null
-#!/bin/sh
-# the next line restarts using tclsh \
-exec tclsh "$0" "$@"
-#
-# YC: ASN.1 Compiler for YAZ
-# (c) Index Data 1996-2000
-# See the file LICENSE for details.
-#
-# $Log: yc.tcl,v $
-# Revision 1.6 2000-02-10 13:44:02 adam
-# Tcl command clock not used if unavailable (Tcl7.4 and earlier).
-#
-# Revision 1.5 2000/01/15 09:18:42 adam
-# Bug fix: some elements where treated as OPTIONAL when they shouldn't.
-#
-# Revision 1.4 1999/12/16 23:36:19 adam
-# Implemented ILL protocol. Minor updates ASN.1 compiler.
-#
-# Revision 1.3 1999/11/30 13:47:12 adam
-# Improved installation. Moved header files to include/yaz.
-#
-# Revision 1.2 1999/06/09 09:43:11 adam
-# Added option -I and variable h-path to specify path for header files.
-#
-# Revision 1.1 1999/06/08 10:10:16 adam
-# New sub directory zutil. Moved YAZ Compiler to be part of YAZ tree.
-#
-# Revision 1.8 1999/04/20 10:37:04 adam
-# Updated for ODR - added name parameter.
-#
-# Revision 1.7 1998/04/03 14:44:20 adam
-# Small fix.
-#
-# Revision 1.6 1998/04/03 13:21:17 adam
-# Yet another fix.
-#
-# Revision 1.5 1998/04/03 12:48:17 adam
-# Fixed bug: missed handling of constructed tags for CHOICE.
-#
-# Revision 1.4 1998/03/31 15:47:45 adam
-# First compiled ASN.1 code for YAZ.
-#
-# Revision 1.3 1998/03/23 17:13:20 adam
-# Implemented SET OF and ENUM. The Compiler now eats ILL (ISO10161) and
-# LDAP (RFC1777).
-#
-# Revision 1.2 1997/10/07 10:31:01 adam
-# Added facility to specify tag type (CONTEXT, APPLICATION, ...).
-#
-# Revision 1.1.1.1 1996/10/31 14:04:40 adam
-# First version of the compiler for YAZ.
-#
-#
-
-set yc_version 0.2
-
-# Syntax for the ASN.1 supported:
-# file -> file module
-# | module
-# module -> name skip DEFINITIONS ::= mbody END
-# mbody -> EXPORTS { nlist }
-# | IMPORTS { imlist }
-# | name ::= tmt
-# | skip
-# tmt -> tag mod type
-# type -> SEQUENCE { sqlist }
-# | SEQUENCE OF type
-# | CHOICE { chlist }
-# | basic enlist
-#
-# basic -> INTEGER
-# | BOOLEAN
-# | OCTET STRING
-# | BIT STRING
-# | EXTERNAL
-# | name
-# sqlist -> sqlist , name tmt opt
-# | name tmt opt
-# chlist -> chlist , name tmt
-# | name tmt
-# enlist -> enlist , name (n)
-# | name (n)
-# imlist -> nlist FROM name
-# imlist nlist FROM name
-# nlist -> name
-# | nlist , name
-# mod -> IMPLICIT | EXPLICIT | e
-# tag -> [tagtype n] | [n] | e
-# opt -> OPTIONAL | e
-#
-# name identifier/token
-# e epsilon/empty
-# skip one token skipped
-# n number
-# tagtype APPLICATION, CONTEXT, etc.
-
-# lex: moves input file pointer and returns type of token.
-# The globals $type and $val are set. $val holds name if token
-# is normal identifier name.
-# sets global var type to one of:
-# {} eof-of-file
-# \{ left curly brace
-# \} right curly brace
-# , comma
-# ; semicolon
-# ( (n)
-# [ [n]
-# : ::=
-# n other token n
-proc lex {} {
- global inf val type
- while {![string length $inf(str)]} {
- incr inf(lineno)
- set inf(cnt) [gets $inf(inf) inf(str)]
- if {$inf(cnt) < 0} {
- set type {}
- return {}
- }
- lappend inf(asn,$inf(asndef)) $inf(str)
- set l [string first -- $inf(str)]
- if {$l >= 0} {
- incr l -1
- set inf(str) [string range $inf(str) 0 $l]
- }
- set inf(str) [string trim $inf(str)]
- }
- set s [string index $inf(str) 0]
- set type $s
- set val {}
- switch -- $s {
- \{ { }
- \} { }
- , { }
- ; { }
- \( { }
- \) { }
- \[ { regexp {^\[[ ]*(.+)[ ]*\]} $inf(str) s val }
- : { regexp {^::=} $inf(str) s }
- default {
- regexp "^\[^,\t :\{\}();\]+" $inf(str) s
- set type n
- set val $s
- }
- }
- set off [string length $s]
- set inf(str) [string trim [string range $inf(str) $off end]]
- return $type
-}
-
-# lex-expect: move pointer and expect token $t
-proc lex-expect {t} {
- global type val
- lex
- if {[string compare $t $type]} {
- asnError "Got $type '$val', expected $t"
- }
-}
-
-# lex-name-move: see if token is $name; moves pointer and returns
-# 1 if it is; returns 0 otherwise.
-proc lex-name-move {name} {
- global type val
- if {![string compare $type n] && ![string compare $val $name]} {
- lex
- return 1
- }
- return 0
-}
-
-# asnError: Report error and die
-proc asnError {msg} {
- global inf
-
- puts "Error in line $inf(lineno) in module $inf(module)"
- puts " $msg"
- error
- exit 1
-}
-
-# asnWarning: Report warning and return
-proc asnWarning {msg} {
- global inf
-
- puts "Warning in line $inf(lineno) in module $inf(module)"
- puts " $msg"
-}
-
-# asnEnum: parses enumerated list - { name1 (n), name2 (n), ... }
-# Uses $name as prefix. If there really is a list, $lx holds the C
-# preprocessor definitions on return; otherwise lx isn't set.
-proc asnEnum {name lx} {
- global type val inf
-
- if {[string compare $type \{]} return
- upvar $lx l
- while {1} {
- set pq [asnName $name]
- set id [lindex $pq 0]
- set id ${name}_$id
- lex-expect n
- lappend l "#define $inf(dprefix)$id $val"
- lex-expect ")"
- lex
- if {[string compare $type ,]} break
- }
- if {[string compare $type \}]} {
- asnError "Missing \} in enum list got $type '$val'"
- }
- lex
-}
-
-# asnMod: parses tag and modifier.
-# $xtag and $ximplicit holds tag and implicit-indication on return.
-# $xtag is empty if no tag was specified. $ximplicit is 1 on implicit
-# tagging; 0 otherwise.
-proc asnMod {xtag ximplicit xtagtype} {
- global type val inf
-
- upvar $xtag tag
- upvar $ximplicit implicit
- upvar $xtagtype tagtype
-
- set tag {}
- set tagtype {}
- if {![string compare $type \[]} {
- if {[regexp {^([a-zA-Z]+)[ ]+([0-9]+)$} $val x tagtype tag]} {
- set tagtype ODR_$tagtype
- } elseif {[regexp {^([0-9]+)$} $val x tag]} {
- set tagtype ODR_CONTEXT
- } else {
- asnError "bad tag specification: $val"
- }
- lex
- }
- set implicit $inf(implicit-tags)
- if {![string compare $type n]} {
- if {![string compare $val EXPLICIT]} {
- lex
- set implicit 0
- } elseif {![string compare $val IMPLICIT]} {
- lex
- set implicit 1
- }
- }
-}
-
-# asnName: moves pointer and expects name. Returns C-validated name.
-proc asnName {name} {
- global val inf
- lex-expect n
- if {[info exists inf(membermap,$inf(module),$name,$val)]} {
- set nval $inf(membermap,$inf(module),$name,$val)
- if {$inf(verbose)} {
- puts " mapping member $name,$val to $nval"
- }
- lex
- } else {
- set nval $val
- if {![string match {[A-Z]*} $val]} {
- lex
- }
- }
- return [join [split $nval -] _]
-}
-
-# asnOptional: parses optional modifier. Returns 1 if OPTIONAL was
-# specified; 0 otherwise.
-proc asnOptional {} {
- global type val
- if {[lex-name-move OPTIONAL]} {
- return 1
- } elseif {[lex-name-move DEFAULT]} {
- lex
- return 0
- }
- return 0
-}
-
-# asnSizeConstraint: parses the optional SizeConstraint.
-# Currently not used for anything.
-proc asnSizeConstraint {} {
- global type val
- if {[lex-name-move SIZE]} {
- asnSubtypeSpec
- }
-}
-
-# asnSubtypeSpec: parses the SubtypeSpec ...
-# Currently not used for anything. We now it's balanced however, i.e.
-# (... ( ... ) .. )
-proc asnSubtypeSpec {} {
- global type val
-
- if {[string compare $type "("]} {
- return
- }
- lex
- set level 1
- while {$level > 0} {
- if {![string compare $type "("]} {
- incr level
- } elseif {![string compare $type ")"]} {
- incr level -1
- }
- lex
- }
-}
-
-# asnType: parses ASN.1 type.
-# On entry $name should hold the name we are currently defining.
-# Returns type indicator:
-# SequenceOf SEQUENCE OF
-# Sequence SEQUENCE
-# SetOf SET OF
-# Set SET
-# Choice CHOICE
-# Simple Basic types.
-# In this casecalling procedure's $tname variable is a list holding:
-# {C-Function C-Type} if the type is IMPORTed or ODR defined.
-# or
-# {C-Function C-Type 1} if the type should be defined in this module
-proc asnType {name} {
- global type val inf
- upvar tname tname
-
- set tname {}
- if {[string compare $type n]} {
- asnError "Expects type specifier, but got $type"
- }
- set v $val
- lex
- switch -- $v {
- SEQUENCE {
- asnSizeConstraint
- if {[lex-name-move OF]} {
- asnSubtypeSpec
- return SequenceOf
- } else {
- asnSubtypeSpec
- return Sequence
- }
- }
- SET {
- asnSizeConstraint
- if {[lex-name-move OF]} {
- asnSubtypeSpec
- return SetOf
- } else {
- asnSubtypeSpec
- return Set
- }
- }
- CHOICE {
- asnSubtypeSpec
- return Choice
- }
- }
- if {[string length [info commands asnBasic$v]]} {
- set tname [asnBasic$v]
- } else {
- if {[info exists inf(map,$inf(module),$v)]} {
- set v $inf(map,$inf(module),$v)
- }
- if {[info exists inf(imports,$v)]} {
- set tname $inf(imports,$v)
- } else {
- set w [join [split $v -] _]
- set tname [list $inf(fprefix)$w $inf(vprefix)$w 1]
- }
- }
- if {[lex-name-move DEFINED]} {
- if {[lex-name-move BY]} {
- lex
- }
- }
- asnSubtypeSpec
- return Simple
-}
-
-proc mapName {name} {
- global inf
- if {[info exists inf(map,$inf(module),$name)]} {
- set name $inf(map,$inf(module),$name)
- if {$inf(verbose)} {
- puts -nonewline " $name ($inf(lineno))"
- puts " mapping to $name"
- }
- } else {
- if {$inf(verbose)} {
- puts " $name ($inf(lineno))"
- }
- }
- return $name
-}
-
-# asnDef: parses type definition (top-level) and generates C code
-# On entry $name holds the type we are defining.
-proc asnDef {name} {
- global inf file
-
- set name [mapName $name]
- if {[info exist inf(defined,$inf(fprefix)$name)]} {
- incr inf(definedl,$name)
- if {$inf(verbose) > 1} {
- puts "set map($inf(module),$name) $name$inf(definedl,$name)"
- }
- } else {
- set inf(definedl,$name) 0
- }
- set mname [join [split $name -] _]
- asnMod tag implicit tagtype
- set t [asnType $mname]
- asnSub $mname $t $tname $tag $implicit $tagtype
-}
-
-
-# asnSub: parses type and generates C-code
-# On entry,
-# $name holds the type we are defining.
-# $t is the type returned by the asnType procedure.
-# $tname is the $tname set by the asnType procedure.
-# $tag is the tag as returned by asnMod
-# $implicit is the implicit indicator as returned by asnMod
-proc asnSub {name t tname tag implicit tagtype} {
- global file inf
-
- set ignore 0
- set defname defined,$inf(fprefix)$name
- if {[info exist inf($defname)]} {
- asnWarning "$name already defined in line $inf($defname)"
- set ignore 1
- }
- set inf($defname) $inf(lineno)
- switch -- $t {
- Sequence { set l [asnSequence $name $tag $implicit $tagtype] }
- SequenceOf { set l [asnOf $name $tag $implicit $tagtype 0] }
- SetOf { set l [asnOf $name $tag $implicit $tagtype 1] }
- Choice { set l [asnChoice $name $tag $implicit $tagtype] }
- Simple { set l [asnSimple $name $tname $tag $implicit $tagtype] }
- default { asnError "switch asnType case not handled" }
- }
- if {$ignore} return
-
- puts $file(outc) {}
- puts $file(outc) "int $inf(fprefix)$name (ODR o, $inf(vprefix)$name **p, int opt, const char *name)"
- puts $file(outc) \{
- puts $file(outc) [lindex $l 0]
- puts $file(outc) \}
- set ok 1
- set fdef "$inf(cprefix)int $inf(fprefix)$name (ODR o, $inf(vprefix)$name **p, int opt, const char *name);"
- switch -- $t {
- Simple {
- set decl "typedef [lindex $l 1] $inf(vprefix)$name;"
- if {![string compare [lindex $tname 2] 1]} {
- if {![info exist inf(defined,[lindex $tname 0])]} {
- set ok 0
- }
- }
- set inf(var,$inf(nodef)) [join [lindex $l 2] \n]
- incr inf(nodef)
- }
- default {
- set decl "typedef struct $inf(vprefix)$name $inf(vprefix)$name;"
- set inf(var,$inf(nodef)) "[lindex $l 1];"
- incr inf(nodef)
- }
- }
- if {$ok} {
- puts $file(outh) {}
- puts $file(outh) $decl
- puts $file(outh) $fdef
- asnForwardTypes $name
- } else {
- lappend inf(forward,code,[lindex $tname 0]) {} $decl $fdef
- lappend inf(forward,ref,[lindex $tname 0]) $name
- }
-}
-
-proc asnForwardTypes {name} {
- global inf file
-
- if {![info exists inf(forward,code,$inf(fprefix)$name)]} {
- return 0
- }
- foreach r $inf(forward,code,$inf(fprefix)$name) {
- puts $file(outh) $r
- }
- unset inf(forward,code,$inf(fprefix)$name)
-
- while {[info exists inf(forward,ref,$inf(fprefix)$name)]} {
- set n $inf(forward,ref,$inf(fprefix)$name)
- set m [lrange $n 1 end]
- if {[llength $m]} {
- set inf(forward,ref,$inf(fprefix)$name) $m
- } else {
- unset inf(forward,ref,$inf(fprefix)$name)
- }
- asnForwardTypes [lindex $n 0]
- }
-}
-
-# asnSimple: parses simple type definition and generates C code
-# On entry,
-# $name is the name we are defining
-# $tname is the tname as returned by asnType
-# $tag is the tag as returned by asnMod
-# $implicit is the implicit indicator as returned by asnMod
-# Returns,
-# {c-code, h-code}
-# Note: Doesn't take care of enum lists yet.
-proc asnSimple {name tname tag implicit tagtype} {
- global inf
-
- set j "[lindex $tname 1] "
-
- if {[info exists inf(unionmap,$inf(module),$name)]} {
- set uName $inf(unionmap,$inf(module),$name)
- } else {
- set uName $name
- }
-
- asnEnum $uName jj
- if {![string length $tag]} {
- set l "\treturn [lindex $tname 0] (o, p, opt, name);"
- } elseif {$implicit} {
- set l \
- "\treturn odr_implicit_tag (o, [lindex $tname 0], p, $tagtype, $tag, opt, name);"
- } else {
- set l \
- "\treturn odr_explicit_tag (o, [lindex $tname 0], p, $tagtype, $tag, opt, name);" \
- }
- if {[info exists jj]} {
- return [list $l $j $jj]
- } else {
- return [list $l $j]
- }
-}
-
-# asnSequence: parses "SEQUENCE { s-list }" and generates C code.
-# On entry,
-# $name is the type we are defining
-# $tag tag
-# $implicit
-# Returns,
-# {c-code, h-code}
-proc asnSequence {name tag implicit tagtype} {
- global val type inf
-
- lappend j "struct $inf(vprefix)$name \{"
- set level 0
- set nchoice 0
- if {![string length $tag]} {
- lappend l "\tif (!odr_sequence_begin (o, p, sizeof(**p), name))"
- lappend l "\t\treturn opt && odr_ok (o);"
- } elseif {$implicit} {
- lappend l "\tif (!odr_implicit_settag (o, $tagtype, $tag) ||"
- lappend l "\t\t!odr_sequence_begin (o, p, sizeof(**p), name))"
- lappend l "\t\treturn opt && odr_ok(o);"
- } else {
- lappend l "\tif (!odr_constructed_begin (o, p, $tagtype, $tag, name))"
- lappend l "\t\treturn opt && odr_ok(o);"
- lappend l "\tif (o->direction == ODR_DECODE)"
- lappend l "\t\t*p = odr_malloc (o, sizeof(**p));"
-
- lappend l "\tif (!odr_sequence_begin (o, p, sizeof(**p), 0))"
- lappend l "\t\{"
- lappend l "\t\t*p = 0;"
- lappend l "\t\treturn 0;"
- lappend l "\t\}"
- }
- lappend l "\treturn"
- while {1} {
- set p [lindex [asnName $name] 0]
- asnMod ltag limplicit ltagtype
- set t [asnType $p]
-
- set uName { }
- if {[info exists inf(unionmap,$inf(module),$name,$p)]} {
- set uName $inf(unionmap,$inf(module),$name,$p)
- }
-
- if {![string compare $t Simple]} {
- if {[string compare $uName { }]} {
- set enumName $uName
- } else {
- set enumName $name
- }
- asnEnum $enumName j
- set opt [asnOptional]
- if {![string length $ltag]} {
- lappend l "\t\t[lindex $tname 0](o, &(*p)->$p, $opt, \"$p\") &&"
- } elseif {$limplicit} {
- lappend l "\t\todr_implicit_tag (o, [lindex $tname 0],"
- lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
- } else {
- lappend l "\t\todr_explicit_tag (o, [lindex $tname 0],"
- lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
- }
- set dec "\t[lindex $tname 1] *$p;"
- } elseif {![string compare $t SequenceOf] && [string length $uName] &&\
- (![string length $ltag] || $limplicit)} {
- set u [asnType $p]
-
- if {[llength $uName] < 2} {
- set uName [list num_$p $p]
- }
- if {[string length $ltag]} {
- if {!$limplicit} {
- asnError explicittag
- }
- lappend l "\t\todr_implicit_settag (o, $ltagtype, $ltag) &&"
- }
- switch -- $u {
- Simple {
- asnEnum $name j
- set tmpa "odr_sequence_of(o, (Odr_fun) [lindex $tname 0], &(*p)->$p,"
- set tmpb "&(*p)->[lindex $uName 0], \"$p\")"
- lappend j "\tint [lindex $uName 0];"
- set dec "\t[lindex $tname 1] **[lindex $uName 1];"
- }
- default {
- set subName [mapName ${name}_$level]
- asnSub $subName $u {} {} 0 {}
-
- set tmpa "odr_sequence_of(o, (Odr_fun) $inf(fprefix)$subName, &(*p)->$p,"
- set tmpb "&(*p)->[lindex $uName 0], \"$p\")"
- lappend j "\tint [lindex $uName 0];"
- set dec "\t$inf(vprefix)$subName **[lindex $uName 1];"
- incr level
- }
- }
- set opt [asnOptional]
- if {$opt} {
- lappend l "\t\t($tmpa"
- lappend l "\t\t $tmpb || odr_ok(o)) &&"
- } else {
- lappend l "\t\t$tmpa"
- lappend l "\t\t $tmpb &&"
- }
- } elseif {!$nchoice && ![string compare $t Choice] && \
- [string length $uName]} {
- if {[llength $uName] < 3} {
- set uName [list which u $name]
- incr nchoice
- }
- lappend j "\tint [lindex $uName 0];"
- lappend j "\tunion \{"
- lappend v "\tstatic Odr_arm arm\[\] = \{"
- asnArm $name [lindex $uName 2] v j
- lappend v "\t\};"
- set dec "\t\} [lindex $uName 1];"
- set opt [asnOptional]
- set oa {}
- set ob {}
- if {[string length $ltag]} {
- if {$limplicit} {
- lappend l "\t\todr_implicit_settag (o, $ltagtype, $ltag) &&"
- if {$opt} {
- asnWarning "optional handling missing in CHOICE in SEQUENCE"
- asnWarning " set unionmap($inf(module),$name,$p) to {}"
- }
- } else {
- if {$opt} {
- set la "(("
- } else {
- set la ""
- }
- lappend l "\t\t${la}odr_constructed_begin (o, &(*p)->[lindex $uName 1], $ltagtype, $ltag, \"$p\") &&"
- }
- } else {
- if {$opt} {
- set oa "("
- set ob " || odr_ok(o))"
- }
- }
- lappend l "\t\t${oa}odr_choice (o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], 0)${ob} &&"
- if {[string length $ltag]} {
- if {!$limplicit} {
- if {$opt} {
- set lb ") || odr_ok(o))"
- } else {
- set lb ""
- }
- lappend l "\t\todr_constructed_end (o)${lb} &&"
- }
- }
- } else {
- set subName [mapName ${name}_$level]
- asnSub $subName $t {} {} 0 {}
- set opt [asnOptional]
- if {![string length $ltag]} {
- lappend l "\t\t$inf(fprefix)${subName} (o, &(*p)->$p, $opt, \"$p\") &&"
- } elseif {$limplicit} {
- lappend l "\t\todr_implicit_tag (o, $inf(fprefix)${subName},"
- lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
- } else {
- lappend l "\t\todr_explicit_tag (o, $inf(fprefix)${subName},"
- lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
- }
- set dec "\t$inf(vprefix)${subName} *$p;"
- incr level
- }
- if {$opt} {
- lappend j "$dec /* OPT */"
- } else {
- lappend j $dec
- }
- if {[string compare $type ,]} break
- }
- lappend j "\}"
- if {[string length $tag] && !$implicit} {
- lappend l "\t\todr_sequence_end (o) &&"
- lappend l "\t\todr_constructed_end (o);"
- } else {
- lappend l "\t\todr_sequence_end (o);"
- }
- if {[string compare $type \}]} {
- asnError "Missing \} got $type '$val'"
- }
- lex
- if {[info exists v]} {
- set l [concat $v $l]
- }
- return [list [join $l \n] [join $j \n]]
-}
-
-# asnOf: parses "SEQUENCE/SET OF type" and generates C code.
-# On entry,
-# $name is the type we are defining
-# $tag tag
-# $implicit
-# Returns,
-# {c-code, h-code}
-proc asnOf {name tag implicit tagtype isset} {
- global inf
-
- if {$isset} {
- set func odr_set_of
- } else {
- set func odr_sequence_of
- }
-
- if {[info exists inf(unionmap,$inf(module),$name)]} {
- set numName $inf(unionmap,$inf(module),$name)
- } else {
- set numName {num elements}
- }
-
- lappend j "struct $inf(vprefix)$name \{"
- lappend j "\tint [lindex $numName 0];"
-
- lappend l "\tif (!odr_initmember (o, p, sizeof(**p)))"
- lappend l "\t\treturn opt && odr_ok(o);"
- if {[string length $tag]} {
- if {$implicit} {
- lappend l "\todr_implicit_settag (o, $tagtype, $tag);"
- } else {
- asnWarning "Constructed SEQUENCE/SET OF not handled"
- }
- }
- set t [asnType $name]
- switch -- $t {
- Simple {
- asnEnum $name j
- lappend l "\tif ($func (o, (Odr_fun) [lindex $tname 0], &(*p)->[lindex $numName 1],"
- lappend l "\t\t&(*p)->[lindex $numName 0], name))"
- lappend j "\t[lindex $tname 1] **[lindex $numName 1];"
- }
- default {
- set subName [mapName ${name}_s]
- lappend l "\tif ($func (o, (Odr_fun) $inf(fprefix)$subName, &(*p)->[lindex $numName 1],"
- lappend l "\t\t&(*p)->[lindex $numName 0], name))"
- lappend j "\t$inf(vprefix)$subName **[lindex $numName 1];"
- asnSub $subName $t {} {} 0 {}
- }
- }
- lappend j "\}"
- lappend l "\t\treturn 1;"
- lappend l "\t*p = 0;"
- lappend l "\treturn opt && odr_ok(o);"
- return [list [join $l \n] [join $j \n]]
-}
-
-# asnArm: parses c-list in choice
-proc asnArm {name defname lx jx} {
- global type val inf
-
- upvar $lx l
- upvar $jx j
- while {1} {
- set pq [asnName $name]
- set p [lindex $pq 0]
- set q [lindex $pq 1]
- if {![string length $q]} {
- set q $p
- set p ${defname}_$p
- }
- asnMod ltag limplicit ltagtype
- set t [asnType $q]
-
- lappend enums "$inf(dprefix)$p"
- if {![string compare $t Simple]} {
- asnEnum $name j
- if {![string length $ltag]} {
- lappend l "\t\t\{-1, -1, -1, $inf(dprefix)$p,"
- lappend l "\t\t (Odr_fun) [lindex $tname 0], \"$q\"\},"
- } elseif {$limplicit} {
- lappend l "\t\t\{ODR_IMPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
- lappend l "\t\t(Odr_fun) [lindex $tname 0], \"$q\"\},"
- } else {
- lappend l "\t\t\{ODR_EXPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
- lappend l "\t\t(Odr_fun) [lindex $tname 0], \"$q\"\},"
- }
- lappend j "\t\t[lindex $tname 1] *$q;"
- } else {
- set subName [mapName ${name}_$q]
- if {![string compare $inf(dprefix)${name}_$q \
- $inf(vprefix)$subName]} {
- set po [string toupper [string index $q 0]][string \
- range $q 1 end]
- set subName [mapName ${name}${po}]
- }
- asnSub $subName $t $tname {} 0 {}
- if {![string length $ltag]} {
- lappend l "\t\t\{-1, -1, -1, $inf(dprefix)$p,"
- lappend l "\t\t (Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
- } elseif {$limplicit} {
- lappend l "\t\t\{ODR_IMPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
- lappend l "\t\t(Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
- } else {
- lappend l "\t\t\{ODR_EXPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
- lappend l "\t\t(Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
- }
- lappend j "\t\t$inf(vprefix)$subName *$q;"
- }
- if {[string compare $type ,]} break
- }
- if {[string compare $type \}]} {
- asnError "Missing \} got $type '$val'"
- }
- lex
- set level 1
- foreach e $enums {
- lappend j "#define $e $level"
- incr level
- }
- lappend l "\t\t\{-1, -1, -1, -1, (Odr_fun) 0, 0\}"
-}
-
-# asnChoice: parses "CHOICE {c-list}" and generates C code.
-# On entry,
-# $name is the type we are defining
-# $tag tag
-# $implicit
-# Returns,
-# {c-code, h-code}
-proc asnChoice {name tag implicit tagtype} {
- global type val inf
-
- if {[info exists inf(unionmap,$inf(module),$name)]} {
- set uName $inf(unionmap,$inf(module),$name)
- } else {
- set uName [list which u $name]
- }
-
- lappend j "struct $inf(vprefix)$name \{"
- lappend j "\tint [lindex $uName 0];"
- lappend j "\tunion \{"
- lappend l "\tstatic Odr_arm arm\[\] = \{"
- asnArm $name [lindex $uName 2] l j
- lappend j "\t\} [lindex $uName 1];"
- lappend j "\}"
- lappend l "\t\};"
- if {![string length $tag]} {
- lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
- lappend l "\t\treturn opt && odr_ok(o);"
- lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name))"
- } elseif {$implicit} {
- lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
- lappend l "\t\treturn opt && odr_ok(o);"
- lappend l "\todr_implicit_settag(o, $tagtype, $tag);"
- lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name))"
- } else {
- lappend l "\tif (!*p && o->direction != ODR_DECODE)"
- lappend l "\t\treturn opt;"
- lappend l "\tif (!odr_constructed_begin(o, p, $tagtype, $tag, 0))"
- lappend l "\t\treturn opt && odr_ok(o);"
- lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
- lappend l "\t\treturn opt && odr_ok(o);"
- lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name) &&"
- lappend l "\t\todr_constructed_end(o))"
- }
- lappend l "\t\treturn 1;"
- lappend l "\t*p = 0;"
- lappend l "\treturn opt && odr_ok(o);"
- return [list [join $l \n] [join $j \n]]
-}
-
-# asnImports: parses i-list in "IMPORTS {i-list}"
-# On return inf(import,..)-array is updated.
-# inf(import,"module") is a list of {C-handler, C-type} elements.
-# The {C-handler, C-type} is compatible with the $tname as is used by the
-# asnType procedure to solve external references.
-proc asnImports {} {
- global type val inf file
-
- while {1} {
- if {[string compare $type n]} {
- asnError "Missing name in IMPORTS list"
- }
- lappend nam $val
- lex
- if {![string compare $type n] && ![string compare $val FROM]} {
- lex
-
- if {[info exists inf(filename,$val)]} {
- set fname $inf(filename,$val)
- } else {
- set fname $val
- }
- puts $file(outh) "\#include <$inf(h-dir)${fname}.h>"
-
- if {[info exists inf(prefix,$val)]} {
- set prefix $inf(prefix,$val)
- } else {
- set prefix $inf(prefix)
- }
- foreach n $nam {
- if {[info exists inf(map,$val,$n)]} {
- set v $inf(map,$val,$n)
- } else {
- set v $n
- }
- set w [join [split $v -] _]
- set inf(imports,$n) [list [lindex $prefix 0]$w \
- [lindex $prefix 1]$w]
- }
- unset nam
- lex
- if {[string compare $type n]} break
- } elseif {![string compare $type ,]} {
- lex
- } else break
- }
- if {[string compare $type \;]} {
- asnError "Missing ; after IMPORTS list - got $type '$val'"
- }
- lex
-}
-
-# asnExports: parses e-list in "EXPORTS {e-list}"
-# This function does nothing with elements in the list.
-proc asnExports {} {
- global type val inf
-
- while {1} {
- if {[string compare $type n]} {
- asnError "Missing name in EXPORTS list"
- }
- set inf(exports,$val) 1
- lex
- if {[string compare $type ,]} break
- lex
- }
- if {[string compare $type \;]} {
- asnError "Missing ; after EXPORTS list - got $type ($val)"
- }
- lex
-}
-
-# asnModuleBody: parses a module specification and generates C code.
-# Exports lists, imports lists, and type definitions are handled;
-# other things are silently ignored.
-proc asnModuleBody {} {
- global type val file inf
-
- if {[info exists inf(prefix,$inf(module))]} {
- set prefix $inf(prefix,$inf(module))
- } else {
- set prefix $inf(prefix)
- }
- set inf(fprefix) [lindex $prefix 0]
- set inf(vprefix) [lindex $prefix 1]
- set inf(dprefix) [lindex $prefix 2]
- if {[llength $prefix] > 3} {
- set inf(cprefix) [lindex $prefix 3]
- } else {
- set inf(cprefix) {YAZ_EXPORT }
- }
-
- if {$inf(verbose)} {
- puts "Module $inf(module), $inf(lineno)"
- }
-
- set defblock 0
- if {[info exists inf(init,$inf(module),c)]} {
- puts $file(outc) $inf(init,$inf(module),c)
- }
- if {[info exists inf(init,$inf(module),h)]} {
- puts $file(outh) "\#ifdef __cplusplus"
- puts $file(outh) "extern \"C\" \{"
- puts $file(outh) "\#endif"
- set defblock 1
- puts $file(outh) $inf(init,$inf(module),h)
- }
- if {[info exists inf(init,$inf(module),p)]} {
- puts $file(outp) $inf(init,$inf(module),p)
- }
-
- while {[string length $type]} {
- if {[string compare $type n]} {
- lex
- continue
- }
- if {![string compare $val END]} {
- break
- } elseif {![string compare $val EXPORTS]} {
- lex
- asnExports
- } elseif {![string compare $val IMPORTS]} {
- if {$defblock} {
- puts $file(outh) "\#ifdef __cplusplus"
- puts $file(outh) "\}"
- puts $file(outh) "\#endif"
- set defblock 0
- }
- lex
- asnImports
- } else {
- if {!$defblock} {
- puts $file(outh) "\#ifdef __cplusplus"
- puts $file(outh) "extern \"C\" \{"
- puts $file(outh) "\#endif"
- set defblock 1
- }
- set inf(asndef) $inf(nodef)
- set oval $val
- lex
- if {![string compare $type :]} {
- lex
- asnDef $oval
- set inf(asndef) 0
- } elseif {![string compare $type n]} {
- lex
- if {[string length $type]} {
- lex
- }
- }
- }
- }
- if {$defblock} {
- puts $file(outh) "\#ifdef __cplusplus"
- puts $file(outh) "\}"
- puts $file(outh) "\#endif"
- set defblock 0
- }
- foreach x [array names inf imports,*] {
- unset inf($x)
- }
-}
-
-# asnTagDefault: parses TagDefault section
-proc asnTagDefault {} {
- global type val inf file
-
- set inf(implicit-tags) 0
- while {[string length $type]} {
- if {[lex-name-move EXPLICIT]} {
- lex
- set inf(implicit-tags) 0
- } elseif {[lex-name-move IMPLICIT]} {
- lex
- set inf(implicit-tags) 1
- } else {
- break
- }
- }
-}
-
-# asnModules: parses a collection of module specifications.
-# Depending on the module pattern, $inf(moduleP), a module is either
-# skipped or processed.
-proc asnModules {} {
- global type val inf file yc_version
-
- set inf(nodef) 0
- set inf(asndef) 0
- lex
- while {![string compare $type n]} {
- set inf(module) $val
- if {[info exists inf(moduleP)] && ![string match $inf(moduleP) $val]} {
- if {$inf(verbose)} {
- puts "Skipping $id"
- }
- while {![lex-name-move END]} {
- lex
- }
- } else {
- set inf(nodef) 1
- set inf(asndef) 1
-
- while {![lex-name-move DEFINITIONS]} {
- lex
- if {![string length $type]} return
- }
- if {[info exists inf(filename,$inf(module))]} {
- set fname $inf(filename,$inf(module))
- } else {
- set fname $inf(module)
- }
- set ppname [join [split $fname -] _]
-
- if {![info exists inf(c-file)]} {
- set inf(c-file) ${fname}.c
- }
- set file(outc) [open $inf(c-file) w]
-
- if {![info exists inf(h-file)]} {
- set inf(h-file) ${fname}.h
- }
- set file(outh) [open $inf(h-path)/$inf(h-dir)$inf(h-file) w]
-
- if {0} {
- if {![info exists inf(p-file)]} {
- set inf(p-file) ${fname}-p.h
- }
- set file(outp) [open $inf(h-path)/$inf(h-dir)$inf(p-file) w]
- }
-
- set md ""
- catch {set md [clock format [clock seconds]]}
-
- puts $file(outc) "/* YC ${yc_version} $md */"
- puts $file(outc) "/* Module-C: $inf(module) */"
- puts $file(outc) {}
-
- puts $file(outh) "/* YC ${yc_version}: $md */"
- puts $file(outh) "/* Module-H $inf(module) */"
- puts $file(outh) {}
-
- if {[info exists file(outp)]} {
- puts $file(outp) "/* YC ${yc_version}: $md */"
- puts $file(outp) "/* Module-P: $inf(module) */"
- puts $file(outp) {}
- }
-
- if {[info exists inf(p-file)]} {
- puts $file(outc) "\#include <$inf(h-dir)$inf(p-file)>"
- } else {
- puts $file(outc) "\#include <$inf(h-dir)$inf(h-file)>"
- }
- puts $file(outh) "\#ifndef ${ppname}_H"
- puts $file(outh) "\#define ${ppname}_H"
- puts $file(outh) {}
- puts $file(outh) "\#include <$inf(h-dir)odr.h>"
-
- if {[info exists file(outp)]} {
- puts $file(outp) "\#ifndef ${ppname}_P_H"
- puts $file(outp) "\#define ${ppname}_P_H"
- puts $file(outp) {}
- puts $file(outp) "\#include <$inf(h-dir)$inf(h-file)>"
-
- }
-
- asnTagDefault
- if {[string compare $type :]} {
- asnError "::= expected got $type '$val'"
- }
- lex
- if {![lex-name-move BEGIN]} {
- asnError "BEGIN expected"
- }
- asnModuleBody
- lex
-
- if {[info exists file(outp)]} {
- set f $file(outp)
- } else {
- set f $file(outh)
- }
- puts $f "\#ifdef __cplusplus"
- puts $f "extern \"C\" \{"
- puts $f "\#endif"
- for {set i 1} {$i < $inf(nodef)} {incr i} {
- puts $f $inf(var,$i)
- if {[info exists inf(asn,$i)]} {
- if {0} {
- puts $f "/*"
- foreach comment $inf(asn,$i) {
- puts $f $comment
- }
- puts $f " */"
- }
- unset inf(asn,$i)
- }
- unset inf(var,$i)
- puts $f {}
- }
- puts $f "\#ifdef __cplusplus"
- puts $f "\}"
- puts $f "\#endif"
-
- if {[info exists inf(body,$inf(module),h)]} {
- puts $file(outh) $inf(body,$inf(module),h)
- }
- if {[info exists inf(body,$inf(module),c)]} {
- puts $file(outc) $inf(body,$inf(module),c)
- }
- if {[info exists inf(body,$inf(module),p)]} {
- if {[info exists file(outp)]} {
- puts $file(outp) $inf(body,$inf(module),p)
- }
- }
- puts $file(outh) "\#endif"
- if {[info exists file(outp)]} {
- puts $file(outp) "\#endif"
- }
- foreach f [array names file] {
- close $file($f)
- }
- unset inf(c-file)
- unset inf(h-file)
- catch {unset inf(p-file)}
- }
- }
-}
-
-# asnFile: parses an ASN.1 specification file as specified in $inf(iname).
-proc asnFile {} {
- global inf file
-
- if {$inf(verbose) > 1} {
- puts "Reading ASN.1 file $inf(iname)"
- }
- set inf(str) {}
- set inf(lineno) 0
- set inf(inf) [open $inf(iname) r]
-
- asnModules
-
-}
-
-# The following procedures are invoked by the asnType function.
-# Each procedure takes the form: asnBasic<TYPE> and they must return
-# two elements: the C function handler and the C type.
-# On entry upvar $name is the type we are defining and global, $inf(module), is
-# the current module name.
-
-proc asnBasicEXTERNAL {} {
- return {odr_external {Odr_external}}
-}
-
-proc asnBasicINTEGER {} {
- return {odr_integer {int}}
-}
-
-proc asnBasicENUMERATED {} {
- return {odr_enum {int}}
-}
-
-proc asnBasicNULL {} {
- return {odr_null {Odr_null}}
-}
-
-proc asnBasicBOOLEAN {} {
- return {odr_bool {bool_t}}
-}
-
-proc asnBasicOCTET {} {
- global type val
- lex-name-move STRING
- return {odr_octetstring {Odr_oct}}
-}
-
-proc asnBasicBIT {} {
- global type val
- lex-name-move STRING
- return {odr_bitstring {Odr_bitmask}}
-}
-
-proc asnBasicOBJECT {} {
- global type val
- lex-name-move IDENTIFIER
- return {odr_oid {Odr_oid}}
-}
-
-proc asnBasicGeneralString {} {
- return {odr_generalstring char}
-}
-
-proc asnBasicVisibleString {} {
- return {odr_visiblestring char}
-}
-
-proc asnBasicGeneralizedTime {} {
- return {odr_generalizedtime char}
-}
-
-proc asnBasicANY {} {
- upvar name name
- global inf
- return [list $inf(fprefix)ANY_$name void]
-}
-
-# userDef: reads user definitions file $name
-proc userDef {name} {
- global inf
-
- if {$inf(verbose) > 1} {
- puts "Reading definitions file $name"
- }
- source $name
-
- if {[info exists default-prefix]} {
- set inf(prefix) ${default-prefix}
- }
- if {[info exists h-path]} {
- set inf(h-path) ${h-path}
- }
- foreach m [array names prefix] {
- set inf(prefix,$m) $prefix($m)
- }
- foreach m [array names body] {
- set inf(body,$m) $body($m)
- }
- foreach m [array names init] {
- set inf(init,$m) $init($m)
- }
- foreach m [array names filename] {
- set inf(filename,$m) $filename($m)
- }
- foreach m [array names map] {
- set inf(map,$m) $map($m)
- }
- foreach m [array names membermap] {
- set inf(membermap,$m) $membermap($m)
- }
- foreach m [array names unionmap] {
- set inf(unionmap,$m) $unionmap($m)
- }
-}
-
-set inf(verbose) 0
-set inf(prefix) {yc_ Yc_ YC_}
-set inf(h-path) .
-set inf(h-dir) ""
-
-# Parse command line
-set l [llength $argv]
-set i 0
-while {$i < $l} {
- set arg [lindex $argv $i]
- switch -glob -- $arg {
- -v {
- incr inf(verbose)
- }
- -c {
- set p [string range $arg 2 end]
- if {![string length $p]} {
- set p [lindex $argv [incr i]]
- }
- set inf(c-file) $p
- }
- -I* {
- set p [string range $arg 2 end]
- if {![string length $p]} {
- set p [lindex $argv [incr i]]
- }
- set inf(h-path) $p
- }
- -i* {
- set p [string range $arg 2 end]
- if {![string length $p]} {
- set p [lindex $argv [incr i]]
- }
- set inf(h-dir) [string trim $p \\/]/
- }
- -h* {
- set p [string range $arg 2 end]
- if {![string length $p]} {
- set p [lindex $argv [incr i]]
- }
- set inf(h-file) $p
- }
- -p* {
- set p [string range $arg 2 end]
- if {![string length $p]} {
- set p [lindex $argv [incr i]]
- }
- set inf(p-file) $p
- }
- -d* {
- set p [string range $arg 2 end]
- if {![string length $p]} {
- set p [lindex $argv [incr i]]
- }
- userDef $p
- }
- -m* {
- set p [string range $arg 2 end]
- if {![string length $p]} {
- set p [lindex $argv [incr i]]
- }
- set inf(moduleP) $p
- }
- -x* {
- set p [string range $arg 2 end]
- if {![string length $p]} {
- set p [lindex $argv [incr i]]
- }
- if {[llength $p] == 1} {
- set inf(prefix) [list [string tolower $p] \
- [string toupper $p] [string toupper $p]]
- } elseif {[llength $p] == 3} {
- set inf(prefix) $p
- } else {
- puts [llength $p]
- exit 1
- }
- }
- default {
- set inf(iname) $arg
- }
- }
- incr i
-}
-
-if {![info exists inf(iname)]} {
- puts "YAZ ASN.1 Compiler ${yc_version}"
- puts -nonewline "Usage: ${argv0}"
- puts { [-v] [-c cfile] [-h hfile] [-p hfile] [-d dfile] [-I path]}
- puts { [-x prefix] [-m module] file}
- exit 1
-}
-
-asnFile
# Makefile.mak - makefile for MS NMAKE
-# $Id: makefile,v 1.13 2000-02-28 11:13:03 adam Exp $
+# $Id: makefile,v 1.14 2000-03-02 08:48:21 adam Exp $
#
# Programmed by
# HL: Heikki Levanto, Index Data
# TCL
TCL="C:\Program Files\Tcl\bin\tclsh82.exe"
-COMMON_TCL_OPTIONS= ..\util\yc.tcl -I$(INCLDIR) -i yaz
+COMMON_TCL_OPTIONS= ..\util\yaz-comp -I$(INCLDIR) -i yaz
# Final opt variables
!if $(DEBUG)
###########################################################
#
# $Log: makefile,v $
-# Revision 1.13 2000-02-28 11:13:03 adam
+# Revision 1.14 2000-03-02 08:48:21 adam
+# Renamed ASN.1 compiler to yaz-comp (used to be yc.tcl).
+#
+# Revision 1.13 2000/02/28 11:13:03 adam
# Removed odr_priv.obj.
#
# Revision 1.12 2000/01/06 11:27:16 adam
/usr/bin/yaz-client
/usr/bin/yaz-ztest
/usr/bin/yaz-config
+/usr/bin/yaz-comp
/usr/lib/libyaz.a
/usr/include/yaz
/usr/share/yaz/doc
-## $Id: Makefile.am,v 1.1 2000-02-28 12:28:34 adam Exp $
+## $Id: Makefile.am,v 1.2 2000-03-02 08:48:21 adam Exp $
INCLUDES=-I../include
z-rrf1.c z-rrf2.c z-sum.c z-sutrs.c \
zes-expi.c zes-exps.c zes-order.c zes-pquery.c zes-psched.c \
zes-pset.c zes-update0.c \
- ../include/yaz/z-accdes1.h: z.tcl z3950v3.asn ../util/yc.tcl
- ../util/yc.tcl -d z.tcl -i yaz -I ../include $(YCFLAGS) z3950v3.asn
+ ../include/yaz/z-accdes1.h: z.tcl z3950v3.asn ../util/yaz-comp
+ ../util/yaz-comp -d z.tcl -i yaz -I ../include $(YCFLAGS) z3950v3.asn
-z-date.c ../include/yaz/z-date.h: z.tcl datetime.asn ../util/yc.tcl
- ../util/yc.tcl -d z.tcl -i yaz -I ../include $(YCFLAGS) datetime.asn
+z-date.c ../include/yaz/z-date.h: z.tcl datetime.asn ../util/yaz-comp
+ ../util/yaz-comp -d z.tcl -i yaz -I ../include $(YCFLAGS) datetime.asn
-z-univ.c ../include/yaz/z-univ.h: z.tcl univres.asn
- ../util/yc.tcl -d z.tcl -i yaz -I ../include $(YCFLAGS) univres.asn
+z-univ.c ../include/yaz/z-univ.h: z.tcl univres.asn ../util/yaz-comp
+ ../util/yaz-comp -d z.tcl -i yaz -I ../include $(YCFLAGS) univres.asn
-zes-update.c ../include/yaz/zes-update.h: z.tcl esupdate.asn
- ../util/yc.tcl -d z.tcl -i yaz -I ../include $(YCFLAGS) esupdate.asn
+zes-update.c ../include/yaz/zes-update.h: z.tcl esupdate.asn ../util/yaz-comp
+ ../util/yaz-comp -d z.tcl -i yaz -I ../include $(YCFLAGS) esupdate.asn
z-rrf1.c z-rrf2.c z-sum.c z-sutrs.c \
zes-expi.c zes-exps.c zes-order.c zes-pquery.c zes-psched.c \
zes-pset.c zes-update0.c \
- ../include/yaz/z-accdes1.h: z.tcl z3950v3.asn ../util/yc.tcl
- ../util/yc.tcl -d z.tcl -i yaz -I ../include $(YCFLAGS) z3950v3.asn
+ ../include/yaz/z-accdes1.h: z.tcl z3950v3.asn ../util/yaz-comp
+ ../util/yaz-comp -d z.tcl -i yaz -I ../include $(YCFLAGS) z3950v3.asn
-z-date.c ../include/yaz/z-date.h: z.tcl datetime.asn ../util/yc.tcl
- ../util/yc.tcl -d z.tcl -i yaz -I ../include $(YCFLAGS) datetime.asn
+z-date.c ../include/yaz/z-date.h: z.tcl datetime.asn ../util/yaz-comp
+ ../util/yaz-comp -d z.tcl -i yaz -I ../include $(YCFLAGS) datetime.asn
-z-univ.c ../include/yaz/z-univ.h: z.tcl univres.asn
- ../util/yc.tcl -d z.tcl -i yaz -I ../include $(YCFLAGS) univres.asn
+z-univ.c ../include/yaz/z-univ.h: z.tcl univres.asn ../util/yaz-comp
+ ../util/yaz-comp -d z.tcl -i yaz -I ../include $(YCFLAGS) univres.asn
-zes-update.c ../include/yaz/zes-update.h: z.tcl esupdate.asn
- ../util/yc.tcl -d z.tcl -i yaz -I ../include $(YCFLAGS) esupdate.asn
+zes-update.c ../include/yaz/zes-update.h: z.tcl esupdate.asn ../util/yaz-comp
+ ../util/yaz-comp -d z.tcl -i yaz -I ../include $(YCFLAGS) esupdate.asn
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
-/* YC 0.2 Tue Feb 29 16:45:07 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: AccessControlFormat-des-1 */
#include <yaz/z-accdes1.h>
-/* YC 0.2 Tue Feb 29 16:45:07 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: AccessControlFormat-prompt-1 */
#include <yaz/z-accform1.h>
-/* YC 0.2 Tue Feb 29 16:45:07 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: AccessControlFormat-krb-1 */
#include <yaz/z-acckrb1.h>
-/* YC 0.2 Tue Feb 29 16:45:06 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: Z39-50-APDU-1995 */
#include <yaz/z-core.h>
-/* YC 0.2 Tue Feb 29 16:45:14 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: UserInfoFormat-dateTime */
#include <yaz/z-date.h>
-/* YC 0.2 Tue Feb 29 16:45:06 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: DiagnosticFormatDiag1 */
#include <yaz/z-diag1.h>
-/* YC 0.2 Tue Feb 29 16:45:07 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ElementSpecificationFormat-eSpec-1 */
#include <yaz/z-espec1.h>
-/* YC 0.2 Tue Feb 29 16:45:07 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: RecordSyntax-ESTaskPackage */
#include <yaz/z-estask.h>
-/* YC 0.2 Tue Feb 29 16:45:06 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: RecordSyntax-explain */
#include <yaz/z-exp.h>
-/* YC 0.2 Tue Feb 29 16:45:07 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: RecordSyntax-generic */
#include <yaz/z-grs.h>
-/* YC 0.2 Tue Feb 29 16:45:06 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: RecordSyntax-opac */
#include <yaz/z-opac.h>
-/* YC 0.2 Tue Feb 29 16:45:07 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ResourceReport-Format-Resource-1 */
#include <yaz/z-rrf1.h>
-/* YC 0.2 Tue Feb 29 16:45:07 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ResourceReport-Format-Resource-2 */
#include <yaz/z-rrf2.h>
-/* YC 0.2 Tue Feb 29 16:45:06 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: RecordSyntax-summary */
#include <yaz/z-sum.h>
-/* YC 0.2 Tue Feb 29 16:45:06 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: RecordSyntax-SUTRS */
#include <yaz/z-sutrs.h>
-/* YC 0.2 Tue Feb 29 16:45:07 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: UserInfoFormat-searchResult-1 */
#include <yaz/z-uifr1.h>
-/* YC 0.2 Tue Feb 29 16:45:14 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ResourceReport-Format-Universe-1 */
#include <yaz/z-univ.h>
-/* YC 0.2 Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ESFormat-ExportInvocation */
#include <yaz/zes-expi.h>
-/* YC 0.2 Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ESFormat-ExportSpecification */
#include <yaz/zes-exps.h>
-/* YC 0.2 Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ESFormat-ItemOrder */
#include <yaz/zes-order.h>
-/* YC 0.2 Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ESFormat-PersistentQuery */
#include <yaz/zes-pquery.h>
-/* YC 0.2 Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ESFormat-PeriodicQuerySchedule */
#include <yaz/zes-psched.h>
-/* YC 0.2 Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ESFormat-PersistentResultSet */
#include <yaz/zes-pset.h>
-/* YC 0.2 Tue Feb 29 15:20:49 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ESFormat-Update */
#include <yaz/zes-update.h>
-/* YC 0.2 Wed Mar 01 10:28:12 CET 2000 */
+/* Generated automatically by the YAZ ASN.1 Compiler 0.3 */
/* Module-C: ESFormat-Update0 */
#include <yaz/zes-update0.h>
projects / yaz-moved-to-github.git / commitdiff