From: Adam Dickmeiss Date: Tue, 27 May 2003 21:12:22 +0000 (+0000) Subject: YAZ ASN.1 compiler renamed from yaz-comp to yaz-asncomp X-Git-Tag: YAZ.2.0.3~28 X-Git-Url: http://sru.miketaylor.org.uk/?a=commitdiff_plain;h=92887fb8af4d8697f6569d6a6756860fea5f4b84;p=yaz-moved-to-github.git YAZ ASN.1 compiler renamed from yaz-comp to yaz-asncomp --- diff --git a/CHANGELOG b/CHANGELOG index bda7466..dc0947c 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,7 @@ Possible compatibility problems with earlier versions marked with '*'. +YAZ ASN.1 compiler renamed from yaz-comp to yaz-asncomp + New ODR utility, odr_getelement, which returns name of element for which encoding/decoding failed. diff --git a/debian/changelog b/debian/changelog index ef770ac..7214119 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,8 +2,9 @@ yaz (2.0.2-3) unstable; urgency=low * SRW support for YAZ client. * Minor updates to documenation Makefiles. + * Man page yaz-comp.1. - -- Adam Dickmeiss Mon, 19 May 2003 23:41:59 +0200 + -- Adam Dickmeiss Tue, 27 May 2003 15:50:53 +0200 yaz (2.0.2-2) unstable; urgency=low diff --git a/debian/rules b/debian/rules index d40d8a3..ce2a7fc 100755 --- a/debian/rules +++ b/debian/rules @@ -87,7 +87,7 @@ binary-indep: build install binary-arch: build install dh_testdir dh_testroot - dh_movefiles -p libyaz-dev usr/share/aclocal usr/lib/*.a usr/lib/*.la usr/lib/*.so usr/include usr/bin/yaz-config usr/bin/yaz-comp usr/share/yaz + dh_movefiles -p libyaz-dev usr/share/aclocal usr/lib/*.a usr/lib/*.la usr/lib/*.so usr/include usr/bin/yaz-config usr/bin/yaz-asncomp usr/share/yaz dh_movefiles -p yaz usr/bin dh_movefiles -p libyaz usr/lib dh_installexamples -p libyaz-dev @@ -107,7 +107,7 @@ binary-arch: build install dh_installdeb -p yaz dh_installman -p libyaz-dev doc/yaz-config.8 - dh_undocumented -p libyaz-dev yaz-comp.1 + dh_installman -p libyaz-dev doc/yaz-asncomp.1 dh_installman -p libyaz doc/yaz.7 dh_installman -p yaz doc/yaz-client.1 doc/yaz-ztest.8 doc/zoomsh.1 dh_installman -p yaz doc/yaz-client-ssl.1 doc/yaz-ztest-ssl.8 @@ -125,7 +125,7 @@ binary-arch: build install dh_gencontrol -p libyaz-dev dh_md5sums -p libyaz-dev - + dh_gencontrol -p yaz dh_md5sums -p yaz diff --git a/doc/Makefile.am b/doc/Makefile.am index 46800e3..b29a7ec 100644 --- a/doc/Makefile.am +++ b/doc/Makefile.am @@ -1,4 +1,4 @@ -## $Id: Makefile.am,v 1.46 2003-05-27 12:45:23 adam Exp $ +## $Id: Makefile.am,v 1.47 2003-05-27 21:12:22 adam Exp $ docdir=$(datadir)/doc/@PACKAGE@ @@ -24,9 +24,9 @@ HTMLFILES = \ zoom.records.html zoom.resultsets.html zoom.scan.html MANFILES=yaz-client.1 yaz-client-ssl.1 yaz-ztest.8 \ - yaz-ztest-ssl.8 yaz-config.8 yaz.7 zoomsh.1 yaz-comp.1 + yaz-ztest-ssl.8 yaz-config.8 yaz.7 zoomsh.1 yaz-asncomp.1 REFFILES=yaz-client.sgml yaz-ztest.sgml yaz-config.sgml \ - yaz-man.sgml zoomsh.sgml + yaz-man.sgml zoomsh.sgml yaz-asncomp.sgml SUPPORTFILES=yazhtml.dsl yazphp.dsl yazprint.dsl tkl.xsl xml.dcl id.eps \ apilayer.obj @@ -60,8 +60,8 @@ yaz-ztest-ssl.8: yaz-client-ssl.1: ln -s yaz-client.1 yaz-client-ssl.1 -yaz-comp.1: yaz-comp.sgml - docbook2man $(srcdir)/yaz-comp.sgml +yaz-asncomp.1: yaz-asncomp.sgml + docbook2man $(srcdir)/yaz-asncomp.sgml $(HTMLFILES): $(XMLFILES) jade -E14 -D $(srcdir) -d yazhtml.dsl -t sgml $(srcdir)/xml.dcl yaz.xml diff --git a/doc/yaz-asncomp.sgml b/doc/yaz-asncomp.sgml new file mode 100644 index 0000000..f39207f --- /dev/null +++ b/doc/yaz-asncomp.sgml @@ -0,0 +1,254 @@ + + + + + yaz-asncomp + 1 + + + + yaz-asncomp + YAZ ASN.1 compiler + + + + + yaz-asncomp + + + + + + + + + filename + + + + DESCRIPTION + + yaz-asncomp is an ASN.1 compiler that + reads an ASN.1 specification in filename + and produces C/C++ definitions and BER encoders/decoders for it. + + + The produced C/C++ code and header files uses the ODR module of YAZ + which is a library that encodes/decodes/prints BER packages. + yaz-asncomp allows you to specify name of + resulting source via options. Alternatively, you can specify + a DEFINISIONS file, which provides customized output to + many output files - if the ASN.1 specification file consists + of many modules. + + + This utility is written in Tcl. Any version of Tcl should work. + + + + OPTIONS + + -v + + + + Makes the ASN.1 compiler print more verbose about the + various stages of operations. + + + + + -c + cfile + + Specifies the name of the C/C++ file with encoders/decoders. + + + + -h + hfile + + Specifies the name of header file with definitions. + + + + -p + pfile + + Specifies the name of the a private header file with + definitions. By default all definitions are put + in header file (option -h). + + + + -d + dfile + + Specifies the name of a definitions file. + + + + -I + iout + + Specifies first part of directory in which header files + are written. + + + + -i + idir + + Specifies second part of directory in which header files + are written. + + + + -m + module + + Specifies that ASN.1 compiler should only process the + module given. If this option is not specified, + all modules in the ASN.1 file are processed. + + + + + + DEFINITIONS FILE + + The definitions file is really a Tcl script but follows + traditional rules for Shell like configuration files. + That is # denotes the beginning of a comment. Definitions + are line oriented. The definitions files usually consists of + a series of variable assignments of the form: + + + set name value + + + Available variables are: + + + default-prefix + + Sets prefix for names in the produced output. + The value consists of three tokens: C function prefix, + C typedef prefix and preprocessor prefix respectively. + + + + prefix(module) + + This value sets prefix values for module + module. + The value has same form as default-prefix. + + + + filename(module) + + Specifies filename for C/header file for module + module. + + + + init(module,h) + + Code fragment to be put in first part of public header for module + module. + + + + body(module,h) + + Code fragment to be put in last part of public header for module + module (trailer). + + + + init(module,c) + + Code fragment to be put in first part of C based encoder/decoder for + module module. + + + + body(module,c) + + Code fragment to be put in last part of C based encoder/decoder for + module module (trailer). + + + + map(module,name) + + Maps ASN.1 type in module module + of name to value. + + + + membermap(module,name,member) + + Maps member member in SEQUENCE/CHOICE of + name in module + module to value. + The value consists of one or two tokens. + First token is name of C preprocessor part. Second token + is resulting C member name. If second token is omitted + the value (one token) is both preprocessor part and + C struct,union. + + + + unionmap(module,name,member) + + Maps member member in CHOICE of + name in module + module to value. + Value consists of to or three tokens. The first token + is name of the integer in the union that + is used as selector for the union itself. + The second token is name of the union. + The third token overrides the name of the CHOICE member; + if omitted the member name is used. + + + + + + FILES + + /usr/share/yaz/z39.50/z.tcl + + + /usr/share/yaz/z39.50/*.asn + + + SEE ALSO + + + yaz + 7 + + + Section "The ODR Module" in the YAZ manual. + + + + + diff --git a/doc/yaz-comp.sgml b/doc/yaz-comp.sgml deleted file mode 100644 index 7d27727..0000000 --- a/doc/yaz-comp.sgml +++ /dev/null @@ -1,228 +0,0 @@ - - - - - yaz-comp - 1 - - - - yaz-comp - YAZ ASN.1 compiler - - - - - yaz-comp - - - - - - - - - asn-file - - - - DESCRIPTION - - yaz-comp is an ASN.1 compiler that - reads an ASN.1 specification and produces C/C++ definitions - and encoders/decoders for it. - - - - OPTIONS - - -v - - - - Makes the ASN.1 compiler print more verbose about the - various stages of operations. - - - - - -c - cfile - - Specifies the name of the C/C++ file with encoders/decoders. - - - -c - cfile - - Specifies the name of the C/C++ file with encoders/decoders. - - - -c - cfile - - Specifies the name of the C/C++ file with encoders/decoders. - - - -h - hfile - - Specifies the name of header file with definitions. - - - -p - pfile - - Specifies the name of the a private header file with - definitions. By default all definitions are put - in header file (option -h). - - - -d - dfile - - Specifies the name of a definitions file. - - - -I - iout - - Specifies first part of directory in which header files - are written. - - - -i - idir - - Specifies second part of directory in which header files - are written. - - - -m - module - - Specifies that ASN.1 compiler should only process the - module given. If this option is not specified, - all modules in the ASN.1 file are processed. - - - - - DEFINITIONS FILE - - The definitions file is really a Tcl script but follows - traditional rules for Shell like configuration files. - That is # denotes the beginning of a comment. Definitions - are line oriented. The definitions files usually consists of - a series of variable assignments of the form: - - - set name value - - - Available variables are: - - - default-prefix - - Sets prefix for names in the produced output. - The value consists of three tokens: C function prefix, - C typedef prefix and preprocessor prefix respectively. - - - prefix(module) - - This value sets prefix values for module - module. - The value has same form as default-prefix. - - - filename(module) - - Specifies filename for C/header file for module - module. - - - init(module,h) - - Code fragment to be put in first part of public header for module - module. - - - body(module,h) - - Code fragment to be put in last part of public header for module - module (trailer). - - - init(module,c) - - Code fragment to be put in first part of C encoder/decoder for - module module. - - - body(module,c) - - Code fragment to be put in last part of C encoder/decoder for - module module (trailer). - - - map(module,name) - - Maps ASN.1 type in module module - of name to value. - - - membermap(module,name,member) - - Maps member member in SEQUENCE of - name in module - module to value. - - - unionmap(module,name,member) - - Maps member member in CHOICE of - name in module - module to value. - Value consists of three tokens. - - - - - - FILES - - /usr/share/yaz/z39.50/z.tcl - - - /usr/share/yaz/z39.50/*.asn - - - SEE ALSO - - - yaz - 7 - - - Section "Generic server" in the YAZ manual. - - - - - diff --git a/ill/Makefile.am b/ill/Makefile.am index c3b0490..f9db5ae 100644 --- a/ill/Makefile.am +++ b/ill/Makefile.am @@ -1,4 +1,4 @@ -## $Id: Makefile.am,v 1.9 2002-09-11 21:25:57 adam Exp $ +## $Id: Makefile.am,v 1.10 2003-05-27 21:12:22 adam Exp $ AM_CPPFLAGS=-I$(top_srcdir)/include @@ -12,10 +12,10 @@ libill_la_SOURCES=ill-core.c item-req.c ill-get.c $(srcdir)/ill-core.c \ $(top_srcdir)/include/yaz/ill-core.h: \ -$(srcdir)/ill.tcl $(srcdir)/ill9702.asn $(top_srcdir)/util/yaz-comp - cd $(srcdir); ../util/yaz-comp -d ill.tcl -i yaz -I ../include $(YCFLAGS) ill9702.asn +$(srcdir)/ill.tcl $(srcdir)/ill9702.asn $(top_srcdir)/util/yaz-asncomp + cd $(srcdir); ../util/yaz-asncomp -d ill.tcl -i yaz -I ../include $(YCFLAGS) ill9702.asn $(srcdir)/item-req.c \ $(top_srcdir)/include/yaz/item-req.h: \ -$(srcdir)/ill.tcl $(srcdir)/item-req.asn $(top_srcdir)/util/yaz-comp - cd $(srcdir); ../util/yaz-comp -d ill.tcl -i yaz -I ../include $(YCFLAGS) item-req.asn +$(srcdir)/ill.tcl $(srcdir)/item-req.asn $(top_srcdir)/util/yaz-asncomp + cd $(srcdir); ../util/yaz-asncomp -d ill.tcl -i yaz -I ../include $(YCFLAGS) item-req.asn diff --git a/odr/Makefile.am b/odr/Makefile.am index eb074bc..2b5b78c 100644 --- a/odr/Makefile.am +++ b/odr/Makefile.am @@ -1,4 +1,4 @@ -## $Id: Makefile.am,v 1.9 2003-05-20 19:55:29 adam Exp $ +## $Id: Makefile.am,v 1.10 2003-05-27 21:12:22 adam Exp $ noinst_LTLIBRARIES = libodr.la @@ -14,8 +14,8 @@ tstodr_LDADD = libodr.la ../util/libutil.la tstodr_SOURCES = tstodr.c tstodrcodec.c tstodrcodec.h # Rule for generating codecs for our small ASN.1 spec -tstodrcodec.c tstodrcodec.h: $(srcdir)/tstodr.asn $(top_srcdir)/util/yaz-comp - cd $(srcdir); $(top_srcdir)/util/yaz-comp tstodr.asn +tstodrcodec.c tstodrcodec.h: $(srcdir)/tstodr.asn $(top_srcdir)/util/yaz-asncomp + cd $(srcdir); $(top_srcdir)/util/yaz-asncomp tstodr.asn libodr_la_SOURCES = odr_bool.c ber_bool.c ber_len.c ber_tag.c odr_util.c \ odr_null.c ber_null.c odr_int.c ber_int.c odr_tag.c odr_cons.c \ diff --git a/util/Makefile.am b/util/Makefile.am index 3d72fc8..4536b48 100644 --- a/util/Makefile.am +++ b/util/Makefile.am @@ -1,6 +1,6 @@ ## Copyright (C) 1994-2003, Index Data ## All rights reserved. -## $Id: Makefile.am,v 1.19 2003-05-22 22:44:50 adam Exp $ +## $Id: Makefile.am,v 1.20 2003-05-27 21:12:23 adam Exp $ noinst_LTLIBRARIES = libutil.la @@ -8,9 +8,9 @@ check_PROGRAMS = tsticonv tstnmem tstmatchstr tstwrbuf TESTS = $(check_PROGRAMS) -bin_SCRIPTS = yaz-comp +bin_SCRIPTS = yaz-asncomp -EXTRA_DIST = yaz-comp cvs-date.tcl charconv.tcl charconv.sgm +EXTRA_DIST = yaz-asncomp cvs-date.tcl charconv.tcl charconv.sgm AM_CPPFLAGS=-I$(top_srcdir)/include diff --git a/util/yaz-asncomp b/util/yaz-asncomp new file mode 100755 index 0000000..3e6bf21 --- /dev/null +++ b/util/yaz-asncomp @@ -0,0 +1,1395 @@ +#!/bin/sh +# the next line restarts using tclsh \ +exec tclsh "$0" "$@" +# +# yaz-comp: ASN.1 Compiler for YAZ +# (c) Index Data 1996-2003 +# See the file LICENSE for details. +# +# $Id: yaz-asncomp,v 1.1 2003-05-27 21:12:23 adam Exp $ +# + +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" + } + if {![string match {[A-Z]*} $val]} { + 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 odr_missing(o, opt, name) && 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 odr_missing(o, opt, name);" + } else { + lappend l "\tif (!odr_constructed_begin (o, p, $tagtype, $tag, name))" + lappend l "\t\treturn odr_missing(o, opt, name);" + lappend l "\tif (o->direction == ODR_DECODE)" + lappend l "\t\t*p = ($inf(vprefix)$name *) 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 odr_missing(o, opt, name);" + 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 odr_missing(o, opt, name);" + 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 odr_missing(o, opt, name);" + 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 odr_missing(o, opt, name);" + 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 odr_missing(o, opt, name);" + lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))" + lappend l "\t\treturn odr_missing(o, opt, name);" + 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 odr_missing(o, opt, name);" + 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 " + + 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 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 "Usage:" + puts -nonewline ${argv0} + puts { [-v] [-c cfile] [-h hfile] [-p hfile] [-d dfile] [-I iout] [-i idir]} + puts { [-m module] file} + exit 1 +} + +asnFile diff --git a/util/yaz-comp b/util/yaz-comp deleted file mode 100755 index 247b607..0000000 --- a/util/yaz-comp +++ /dev/null @@ -1,1394 +0,0 @@ -#!/bin/sh -# the next line restarts using tclsh \ -exec tclsh "$0" "$@" -# -# yaz-comp: ASN.1 Compiler for YAZ -# (c) Index Data 1996-2003 -# See the file LICENSE for details. -# -# $Id: yaz-comp,v 1.6 2003-05-20 19:55:30 adam Exp $ -# - -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" - } - if {![string match {[A-Z]*} $val]} { - 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 odr_missing(o, opt, name) && 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 odr_missing(o, opt, name);" - } else { - lappend l "\tif (!odr_constructed_begin (o, p, $tagtype, $tag, name))" - lappend l "\t\treturn odr_missing(o, opt, name);" - lappend l "\tif (o->direction == ODR_DECODE)" - lappend l "\t\t*p = ($inf(vprefix)$name *) 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 odr_missing(o, opt, name);" - 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 odr_missing(o, opt, name);" - 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 odr_missing(o, opt, name);" - 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 odr_missing(o, opt, name);" - 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 odr_missing(o, opt, name);" - lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))" - lappend l "\t\treturn odr_missing(o, opt, name);" - 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 odr_missing(o, opt, name);" - 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 " - - 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 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 diff --git a/win/makefile b/win/makefile index ecf69bc..ddc1d5c 100644 --- a/win/makefile +++ b/win/makefile @@ -1,6 +1,6 @@ # Copyright (C) 1994-2003, Index Data # All rights reserved. -# $Id: makefile,v 1.56 2003-05-23 10:41:26 adam Exp $ +# $Id: makefile,v 1.57 2003-05-27 21:12:23 adam Exp $ # # Programmed by # HL: Heikki Levanto, Index Data @@ -220,7 +220,7 @@ CQL2PQF_LINK_OPTIONS = /subsystem:console CQL2XCQL_LINK_OPTIONS = /subsystem:console -COMMON_TCL_OPTIONS= ..\util\yaz-comp -I$(INCLDIR) -i yaz +COMMON_TCL_OPTIONS= ..\util\yaz-asncomp -I$(INCLDIR) -i yaz # Final opt variables !if $(DEBUG) @@ -929,7 +929,10 @@ $(ILL_OBJS): $(ILL_CORE_FILES) $(ITEM_REQ_FILES) ########################################################### # # $Log: makefile,v $ -# Revision 1.56 2003-05-23 10:41:26 adam +# Revision 1.57 2003-05-27 21:12:23 adam +# YAZ ASN.1 compiler renamed from yaz-comp to yaz-asncomp +# +# Revision 1.56 2003/05/23 10:41:26 adam # WIN32 updates # # Revision 1.55 2003/02/18 21:27:53 adam diff --git a/yaz.spec.in b/yaz.spec.in index ce50f85..234e7a9 100644 --- a/yaz.spec.in +++ b/yaz.spec.in @@ -67,12 +67,13 @@ rm -fr ${RPM_BUILD_ROOT} %files -n lib%{name}-devel /usr/bin/yaz-config -/usr/bin/yaz-comp +/usr/bin/yaz-asncomp /usr/include/yaz /usr/lib/*.so /usr/lib/*.a /usr/lib/*.la /usr/share/aclocal/yaz.m4 +/usr/share/man/man1/yaz-asncomp.* /usr/share/man/man8/yaz-config.* /usr/share/doc/yaz /usr/share/yaz/z39.50 diff --git a/z39.50/Makefile.am b/z39.50/Makefile.am index d7f70ec..a3eacfb 100644 --- a/z39.50/Makefile.am +++ b/z39.50/Makefile.am @@ -1,4 +1,4 @@ -## $Id: Makefile.am,v 1.12 2002-12-05 12:07:00 adam Exp $ +## $Id: Makefile.am,v 1.13 2003-05-27 21:12:23 adam Exp $ AM_CPPFLAGS=-I$(top_srcdir)/include @@ -9,8 +9,8 @@ tabdata_DATA=datetime.asn esupdate.asn univres.asn z3950v3.asn z.tcl \ esadmin.asn charneg-3.asn mterm2.asn EXTRA_DIST=$(tabdata_DATA) -YAZCOMP = $(top_srcdir)/util/yaz-comp -YAZCOMPLINE = ../util/yaz-comp -d z.tcl -i yaz -I../include $(YCFLAGS) +YAZCOMP = $(top_srcdir)/util/yaz-asncomp +YAZCOMPLINE = ../util/yaz-asncomp -d z.tcl -i yaz -I../include $(YCFLAGS) libz39_50_la_SOURCES = z-accdes1.c z-accform1.c z-acckrb1.c z-core.c \ z-diag1.c z-espec1.c z-estask.c z-exp.c z-grs.c z-mterm2.c z-opac.c \