util/yaz-comp

   1 #!/bin/sh
   2 # the next line restarts using tclsh \
   3 exec tclsh "$0" "$@"
   4 #
   5 # yaz-comp: ASN.1 Compiler for YAZ
   6 # (c) Index Data 1996-2000
   7 # See the file LICENSE for details.
   8 #
   9 # $Log: yaz-comp,v $
  10 # Revision 1.2  2001-02-21 13:46:54  adam
  11 # C++ fixes.
  12 #
  13 # Revision 1.1  2000/03/02 08:48:20  adam
  14 # Renamed ASN.1 compiler to yaz-comp (used to be yc.tcl).
  15 #
  16 # Revision 1.6  2000/02/10 13:44:02  adam
  17 # Tcl command clock not used if unavailable (Tcl7.4 and earlier).
  18 #
  19 # Revision 1.5  2000/01/15 09:18:42  adam
  20 # Bug fix: some elements where treated as OPTIONAL when they shouldn't.
  21 #
  22 # Revision 1.4  1999/12/16 23:36:19  adam
  23 # Implemented ILL protocol. Minor updates ASN.1 compiler.
  24 #
  25 # Revision 1.3  1999/11/30 13:47:12  adam
  26 # Improved installation. Moved header files to include/yaz.
  27 #
  28 # Revision 1.2  1999/06/09 09:43:11  adam
  29 # Added option -I and variable h-path to specify path for header files.
  30 #
  31 # Revision 1.1  1999/06/08 10:10:16  adam
  32 # New sub directory zutil. Moved YAZ Compiler to be part of YAZ tree.
  33 #
  34 # Revision 1.8  1999/04/20 10:37:04  adam
  35 # Updated for ODR - added name parameter.
  36 #
  37 # Revision 1.7  1998/04/03 14:44:20  adam
  38 # Small fix.
  39 #
  40 # Revision 1.6  1998/04/03 13:21:17  adam
  41 # Yet another fix.
  42 #
  43 # Revision 1.5  1998/04/03 12:48:17  adam
  44 # Fixed bug: missed handling of constructed tags for CHOICE.
  45 #
  46 # Revision 1.4  1998/03/31 15:47:45  adam
  47 # First compiled ASN.1 code for YAZ.
  48 #
  49 # Revision 1.3  1998/03/23 17:13:20  adam
  50 # Implemented SET OF and ENUM. The Compiler now eats ILL (ISO10161) and
  51 # LDAP (RFC1777).
  52 #
  53 # Revision 1.2  1997/10/07 10:31:01  adam
  54 # Added facility to specify tag type (CONTEXT, APPLICATION, ...).
  55 #
  56 # Revision 1.1.1.1  1996/10/31 14:04:40  adam
  57 # First version of the compiler for YAZ.
  58 #
  59 #
  60
  61 set yc_version 0.3
  62
  63 # Syntax for the ASN.1 supported:
  64 # file   -> file module
  65 #         | module
  66 # module -> name skip DEFINITIONS ::= mbody END
  67 # mbody  -> EXPORTS { nlist }
  68 #         | IMPORTS { imlist }
  69 #         | name ::= tmt
  70 #         | skip
  71 # tmt    -> tag mod type
  72 # type   -> SEQUENCE { sqlist }
  73 #         | SEQUENCE OF type
  74 #         | CHOICE { chlist }
  75 #         | basic enlist
  76 #
  77 # basic  -> INTEGER
  78 #         | BOOLEAN
  79 #         | OCTET STRING
  80 #         | BIT STRING
  81 #         | EXTERNAL
  82 #         | name
  83 # sqlist -> sqlist , name tmt opt
  84 #         | name tmt opt
  85 # chlist -> chlist , name tmt
  86 #         | name tmt
  87 # enlist -> enlist , name (n)
  88 #         | name (n)
  89 # imlist -> nlist FROM name
  90 #           imlist nlist FROM name
  91 # nlist  -> name
  92 #         | nlist , name
  93 # mod   -> IMPLICIT | EXPLICIT | e
  94 # tag   -> [tagtype n] | [n] | e
  95 # opt   -> OPTIONAL | e
  96 #
  97 # name    identifier/token
  98 # e       epsilon/empty
  99 # skip    one token skipped
 100 # n       number
 101 # tagtype APPLICATION, CONTEXT, etc.
 102
 103 # lex: moves input file pointer and returns type of token.
 104 # The globals $type and $val are set. $val holds name if token
 105 # is normal identifier name.
 106 # sets global var type to one of:
 107 #     {}     eof-of-file
 108 #     \{     left curly brace
 109 #     \}     right curly brace
 110 #     ,      comma
 111 #     ;      semicolon
 112 #     (      (n)
 113 #     [      [n]
 114 #     :      ::=
 115 #     n      other token n
 116 proc lex {} {
 117     global inf val type
 118     while {![string length $inf(str)]} {
 119         incr inf(lineno)
 120         set inf(cnt) [gets $inf(inf) inf(str)]
 121         if {$inf(cnt) < 0} {
 122             set type {}
 123             return {}
 124         }
 125         lappend inf(asn,$inf(asndef)) $inf(str)
 126         set l [string first -- $inf(str)]
 127         if {$l >= 0} {
 128             incr l -1
 129             set inf(str) [string range $inf(str) 0 $l]
 130         }
 131         set inf(str) [string trim $inf(str)]
 132     }
 133     set s [string index $inf(str) 0]
 134     set type $s
 135     set val {}
 136     switch -- $s {
 137         \{ { }
 138         \} { }
 139         ,  { }
 140         ;  { }
 141         \(  { }
 142         \)  { }
 143         \[ { regexp {^\[[ ]*(.+)[ ]*\]} $inf(str) s val }
 144         :  { regexp {^::=} $inf(str) s }
 145         default {
 146              regexp "^\[^,\t :\{\}();\]+" $inf(str) s
 147              set type n
 148              set val $s
 149            }
 150     }
 151     set off [string length $s]
 152     set inf(str) [string trim [string range $inf(str) $off end]]
 153     return $type
 154 }
 155
 156 # lex-expect: move pointer and expect token $t
 157 proc lex-expect {t} {
 158     global type val
 159     lex
 160     if {[string compare $t $type]} {
 161         asnError "Got $type '$val', expected $t"
 162     }
 163 }
 164
 165 # lex-name-move: see if token is $name; moves pointer and returns
 166 # 1 if it is; returns 0 otherwise.
 167 proc lex-name-move {name} {
 168     global type val
 169     if {![string compare $type n] && ![string compare $val $name]} {
 170         lex
 171         return 1
 172     }
 173     return 0
 174 }
 175
 176 # asnError: Report error and die
 177 proc asnError {msg} {
 178     global inf
 179
 180     puts "Error in line $inf(lineno) in module $inf(module)"
 181     puts " $msg"
 182     error
 183     exit 1
 184 }
 185
 186 # asnWarning: Report warning and return
 187 proc asnWarning {msg} {
 188     global inf
 189
 190     puts "Warning in line $inf(lineno) in module $inf(module)"
 191     puts " $msg"
 192 }
 193
 194 # asnEnum: parses enumerated list - { name1 (n), name2 (n), ... }
 195 # Uses $name as prefix. If there really is a list, $lx holds the C
 196 # preprocessor definitions on return; otherwise lx isn't set.
 197 proc asnEnum {name lx} {
 198     global type val inf
 199
 200     if {[string compare $type \{]} return
 201     upvar $lx l
 202     while {1} {
 203         set pq [asnName $name]
 204         set id [lindex $pq 0]
 205         set id ${name}_$id
 206         lex-expect n
 207         lappend l "#define $inf(dprefix)$id $val"
 208         lex-expect ")"
 209         lex
 210         if {[string compare $type ,]} break
 211     }
 212     if {[string compare $type \}]} {
 213         asnError "Missing \} in enum list got $type '$val'"
 214     }
 215     lex
 216 }
 217
 218 # asnMod: parses tag and modifier.
 219 # $xtag and $ximplicit holds tag and implicit-indication on return.
 220 # $xtag is empty if no tag was specified. $ximplicit is 1 on implicit
 221 # tagging; 0 otherwise.
 222 proc asnMod {xtag ximplicit xtagtype} {
 223     global type val inf
 224
 225     upvar $xtag tag
 226     upvar $ximplicit implicit
 227     upvar $xtagtype tagtype
 228
 229     set tag {}
 230     set tagtype {}
 231     if {![string compare $type \[]} {
 232         if {[regexp {^([a-zA-Z]+)[ ]+([0-9]+)$} $val x tagtype tag]} {
 233             set tagtype ODR_$tagtype
 234         } elseif {[regexp {^([0-9]+)$} $val x tag]} {
 235             set tagtype ODR_CONTEXT
 236         } else {
 237             asnError "bad tag specification: $val"
 238         }
 239         lex
 240     }
 241     set implicit $inf(implicit-tags)
 242     if {![string compare $type n]} {
 243         if {![string compare $val EXPLICIT]} {
 244             lex
 245             set implicit 0
 246         } elseif {![string compare $val IMPLICIT]} {
 247             lex
 248             set implicit 1
 249         }
 250     }
 251 }
 252
 253 # asnName: moves pointer and expects name. Returns C-validated name.
 254 proc asnName {name} {
 255     global val inf
 256     lex-expect n
 257     if {[info exists inf(membermap,$inf(module),$name,$val)]} {
 258             set nval $inf(membermap,$inf(module),$name,$val)
 259         if {$inf(verbose)} {
 260             puts " mapping member $name,$val to $nval"
 261         }
 262         if {![string match {[A-Z]*} $val]} {
 263             lex
 264         }
 265     } else {
 266         set nval $val
 267         if {![string match {[A-Z]*} $val]} {
 268             lex
 269         }
 270     }
 271     return [join [split $nval -] _]
 272 }
 273
 274 # asnOptional: parses optional modifier. Returns 1 if OPTIONAL was
 275 # specified; 0 otherwise.
 276 proc asnOptional {} {
 277     global type val
 278     if {[lex-name-move OPTIONAL]} {
 279         return 1
 280     } elseif {[lex-name-move DEFAULT]} {
 281         lex
 282         return 0
 283     }
 284     return 0
 285 }
 286
 287 # asnSizeConstraint: parses the optional SizeConstraint.
 288 # Currently not used for anything.
 289 proc asnSizeConstraint {} {
 290     global type val
 291     if {[lex-name-move SIZE]} {
 292         asnSubtypeSpec
 293     }
 294 }
 295
 296 # asnSubtypeSpec: parses the SubtypeSpec ...
 297 # Currently not used for anything. We now it's balanced however, i.e.
 298 # (... ( ... ) .. )
 299 proc asnSubtypeSpec {} {
 300     global type val
 301
 302     if {[string compare $type "("]} {
 303         return
 304     }
 305     lex
 306     set level 1
 307     while {$level > 0} {
 308         if {![string compare $type "("]} {
 309             incr level
 310         } elseif {![string compare $type ")"]} {
 311             incr level -1
 312         }
 313         lex
 314     }
 315 }
 316
 317 # asnType: parses ASN.1 type.
 318 # On entry $name should hold the name we are currently defining.
 319 # Returns type indicator:
 320 #   SequenceOf     SEQUENCE OF
 321 #   Sequence       SEQUENCE
 322 #   SetOf          SET OF
 323 #   Set            SET
 324 #   Choice         CHOICE
 325 #   Simple         Basic types.
 326 #   In this casecalling procedure's $tname variable is a list holding:
 327 #        {C-Function C-Type} if the type is IMPORTed or ODR defined.
 328 #      or
 329 #        {C-Function C-Type 1} if the type should be defined in this module
 330 proc asnType {name} {
 331     global type val inf
 332     upvar tname tname
 333
 334     set tname {}
 335     if {[string compare $type n]} {
 336         asnError "Expects type specifier, but got $type"
 337     }
 338     set v $val
 339     lex
 340     switch -- $v {
 341         SEQUENCE {
 342             asnSizeConstraint
 343             if {[lex-name-move OF]} {
 344                 asnSubtypeSpec
 345                 return SequenceOf
 346             } else {
 347                 asnSubtypeSpec
 348                 return Sequence
 349             }
 350         }
 351         SET {
 352             asnSizeConstraint
 353             if {[lex-name-move OF]} {
 354                 asnSubtypeSpec
 355                 return SetOf
 356             } else {
 357                 asnSubtypeSpec
 358                 return Set
 359             }
 360         }
 361         CHOICE {
 362             asnSubtypeSpec
 363             return Choice
 364         }
 365     }
 366     if {[string length [info commands asnBasic$v]]} {
 367         set tname [asnBasic$v]
 368     } else {
 369         if {[info exists inf(map,$inf(module),$v)]} {
 370             set v $inf(map,$inf(module),$v)
 371         }
 372         if {[info exists inf(imports,$v)]} {
 373             set tname $inf(imports,$v)
 374         } else {
 375             set w [join [split $v -] _]
 376             set tname [list $inf(fprefix)$w $inf(vprefix)$w 1]
 377         }
 378     }
 379     if {[lex-name-move DEFINED]} {
 380         if {[lex-name-move BY]} {
 381             lex
 382         }
 383     }
 384     asnSubtypeSpec
 385     return Simple
 386 }
 387
 388 proc mapName {name} {
 389     global inf
 390     if {[info exists inf(map,$inf(module),$name)]} {
 391         set name $inf(map,$inf(module),$name)
 392         if {$inf(verbose)} {
 393             puts -nonewline " $name ($inf(lineno))"
 394             puts " mapping to $name"
 395         }
 396     } else {
 397         if {$inf(verbose)} {
 398             puts " $name ($inf(lineno))"
 399         }
 400     }
 401     return $name
 402 }
 403
 404 # asnDef: parses type definition (top-level) and generates C code
 405 # On entry $name holds the type we are defining.
 406 proc asnDef {name} {
 407     global inf file
 408
 409     set name [mapName $name]
 410     if {[info exist inf(defined,$inf(fprefix)$name)]} {
 411         incr inf(definedl,$name)
 412         if {$inf(verbose) > 1} {
 413             puts "set map($inf(module),$name) $name$inf(definedl,$name)"
 414         }
 415     } else {
 416         set inf(definedl,$name) 0
 417     }
 418     set mname [join [split $name -] _]
 419     asnMod tag implicit tagtype
 420     set t [asnType $mname]
 421     asnSub $mname $t $tname $tag $implicit $tagtype
 422 }
 423
 424
 425 # asnSub: parses type and generates C-code
 426 # On entry,
 427 #   $name holds the type we are defining.
 428 #   $t is the type returned by the asnType procedure.
 429 #   $tname is the $tname set by the asnType procedure.
 430 #   $tag is the tag as returned by asnMod
 431 #   $implicit is the implicit indicator as returned by asnMod
 432 proc asnSub {name t tname tag implicit tagtype} {
 433     global file inf
 434
 435     set ignore 0
 436     set defname defined,$inf(fprefix)$name
 437     if {[info exist inf($defname)]} {
 438         asnWarning "$name already defined in line $inf($defname)"
 439         set ignore 1
 440     }
 441     set inf($defname) $inf(lineno)
 442     switch -- $t {
 443         Sequence   { set l [asnSequence $name $tag $implicit $tagtype] }
 444         SequenceOf { set l [asnOf $name $tag $implicit $tagtype 0] }
 445         SetOf      { set l [asnOf $name $tag $implicit $tagtype 1] }
 446         Choice     { set l [asnChoice $name $tag $implicit $tagtype] }
 447         Simple     { set l [asnSimple $name $tname $tag $implicit $tagtype] }
 448         default    { asnError "switch asnType case not handled" }
 449     }
 450     if {$ignore} return
 451
 452     puts $file(outc) {}
 453     puts $file(outc) "int $inf(fprefix)$name (ODR o, $inf(vprefix)$name **p, int opt, const char *name)"
 454     puts $file(outc) \{
 455     puts $file(outc) [lindex $l 0]
 456     puts $file(outc) \}
 457     set ok 1
 458     set fdef "$inf(cprefix)int $inf(fprefix)$name (ODR o, $inf(vprefix)$name **p, int opt, const char *name);"
 459     switch -- $t {
 460         Simple {
 461             set decl "typedef [lindex $l 1] $inf(vprefix)$name;"
 462             if {![string compare [lindex $tname 2] 1]} {
 463                 if {![info exist inf(defined,[lindex $tname 0])]} {
 464                     set ok 0
 465                 }
 466             }
 467             set inf(var,$inf(nodef)) [join [lindex $l 2] \n]
 468             incr inf(nodef)
 469         }
 470         default {
 471             set decl "typedef struct $inf(vprefix)$name $inf(vprefix)$name;"
 472             set inf(var,$inf(nodef)) "[lindex $l 1];"
 473             incr inf(nodef)
 474         }
 475     }
 476     if {$ok} {
 477         puts $file(outh) {}
 478         puts $file(outh) $decl
 479         puts $file(outh) $fdef
 480         asnForwardTypes $name
 481     } else {
 482         lappend inf(forward,code,[lindex $tname 0]) {} $decl $fdef
 483         lappend inf(forward,ref,[lindex $tname 0]) $name
 484     }
 485 }
 486
 487 proc asnForwardTypes {name} {
 488     global inf file
 489
 490     if {![info exists inf(forward,code,$inf(fprefix)$name)]} {
 491         return 0
 492     }
 493     foreach r $inf(forward,code,$inf(fprefix)$name) {
 494         puts $file(outh) $r
 495     }
 496     unset inf(forward,code,$inf(fprefix)$name)
 497
 498     while {[info exists inf(forward,ref,$inf(fprefix)$name)]} {
 499         set n $inf(forward,ref,$inf(fprefix)$name)
 500         set m [lrange $n 1 end]
 501         if {[llength $m]} {
 502             set inf(forward,ref,$inf(fprefix)$name) $m
 503         } else {
 504             unset inf(forward,ref,$inf(fprefix)$name)
 505         }
 506         asnForwardTypes [lindex $n 0]
 507     }
 508 }
 509
 510 # asnSimple: parses simple type definition and generates C code
 511 # On entry,
 512 #   $name is the name we are defining
 513 #   $tname is the tname as returned by asnType
 514 #   $tag is the tag as returned by asnMod
 515 #   $implicit is the implicit indicator as returned by asnMod
 516 # Returns,
 517 #   {c-code, h-code}
 518 # Note: Doesn't take care of enum lists yet.
 519 proc asnSimple {name tname tag implicit tagtype} {
 520     global inf
 521
 522     set j "[lindex $tname 1] "
 523
 524     if {[info exists inf(unionmap,$inf(module),$name)]} {
 525         set uName $inf(unionmap,$inf(module),$name)
 526     } else {
 527         set uName $name
 528     }
 529
 530     asnEnum $uName jj
 531     if {![string length $tag]} {
 532         set l "\treturn [lindex $tname 0] (o, p, opt, name);"
 533     } elseif {$implicit} {
 534         set l \
 535   "\treturn odr_implicit_tag (o, [lindex $tname 0], p, $tagtype, $tag, opt, name);"
 536     } else {
 537         set l \
 538   "\treturn odr_explicit_tag (o, [lindex $tname 0], p, $tagtype, $tag, opt, name);" \
 539     }
 540     if {[info exists jj]} {
 541         return [list $l $j $jj]
 542     } else {
 543         return [list $l $j]
 544     }
 545 }
 546
 547 # asnSequence: parses "SEQUENCE { s-list }" and generates C code.
 548 # On entry,
 549 #   $name is the type we are defining
 550 #   $tag tag
 551 #   $implicit
 552 # Returns,
 553 #   {c-code, h-code}
 554 proc asnSequence {name tag implicit tagtype} {
 555     global val type inf
 556
 557     lappend j "struct $inf(vprefix)$name \{"
 558     set level 0
 559     set nchoice 0
 560     if {![string length $tag]} {
 561         lappend l "\tif (!odr_sequence_begin (o, p, sizeof(**p), name))"
 562         lappend l "\t\treturn opt && odr_ok (o);"
 563     } elseif {$implicit} {
 564         lappend l "\tif (!odr_implicit_settag (o, $tagtype, $tag) ||"
 565         lappend l "\t\t!odr_sequence_begin (o, p, sizeof(**p), name))"
 566         lappend l "\t\treturn opt && odr_ok(o);"
 567     } else {
 568         lappend l "\tif (!odr_constructed_begin (o, p, $tagtype, $tag, name))"
 569         lappend l "\t\treturn opt && odr_ok(o);"
 570         lappend l "\tif (o->direction == ODR_DECODE)"
 571         lappend l "\t\t*p = ($inf(vprefix)$name *) odr_malloc (o, sizeof(**p));"
 572
 573         lappend l "\tif (!odr_sequence_begin (o, p, sizeof(**p), 0))"
 574         lappend l "\t\{"
 575         lappend l "\t\t*p = 0;"
 576         lappend l "\t\treturn 0;"
 577         lappend l "\t\}"
 578     }
 579     lappend l "\treturn"
 580     while {1} {
 581         set p [lindex [asnName $name] 0]
 582         asnMod ltag limplicit ltagtype
 583         set t [asnType $p]
 584
 585         set uName { }
 586         if {[info exists inf(unionmap,$inf(module),$name,$p)]} {
 587             set uName $inf(unionmap,$inf(module),$name,$p)
 588         }
 589
 590         if {![string compare $t Simple]} {
 591             if {[string compare $uName { }]} {
 592                 set enumName $uName
 593             } else {
 594                 set enumName $name
 595             }
 596             asnEnum $enumName j
 597             set opt [asnOptional]
 598             if {![string length $ltag]} {
 599                 lappend l "\t\t[lindex $tname 0](o, &(*p)->$p, $opt, \"$p\") &&"
 600             } elseif {$limplicit} {
 601                 lappend l "\t\todr_implicit_tag (o, [lindex $tname 0],"
 602                 lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
 603             } else {
 604                 lappend l "\t\todr_explicit_tag (o, [lindex $tname 0],"
 605                 lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
 606             }
 607             set dec "\t[lindex $tname 1] *$p;"
 608         } elseif {![string compare $t SequenceOf] && [string length $uName] &&\
 609                       (![string length $ltag] || $limplicit)} {
 610             set u [asnType $p]
 611
 612             if {[llength $uName] < 2} {
 613                 set uName [list num_$p $p]
 614             }
 615             if {[string length $ltag]} {
 616                 if {!$limplicit} {
 617                     asnError explicittag
 618                 }
 619                 lappend l "\t\todr_implicit_settag (o, $ltagtype, $ltag) &&"
 620             }
 621             switch -- $u {
 622                 Simple {
 623                     asnEnum $name j
 624                     set tmpa "odr_sequence_of(o, (Odr_fun) [lindex $tname 0], &(*p)->$p,"
 625                     set tmpb "&(*p)->[lindex $uName 0], \"$p\")"
 626                     lappend j "\tint [lindex $uName 0];"
 627                     set dec "\t[lindex $tname 1] **[lindex $uName 1];"
 628                 }
 629                 default {
 630                     set subName [mapName ${name}_$level]
 631                     asnSub $subName $u {} {} 0 {}
 632
 633                     set tmpa "odr_sequence_of(o, (Odr_fun) $inf(fprefix)$subName, &(*p)->$p,"
 634                     set tmpb "&(*p)->[lindex $uName 0], \"$p\")"
 635                     lappend j "\tint [lindex $uName 0];"
 636                     set dec "\t$inf(vprefix)$subName **[lindex $uName 1];"
 637                     incr level
 638                 }
 639             }
 640             set opt [asnOptional]
 641             if {$opt} {
 642                 lappend l "\t\t($tmpa"
 643                 lappend l "\t\t  $tmpb || odr_ok(o)) &&"
 644             } else {
 645                 lappend l "\t\t$tmpa"
 646                 lappend l "\t\t  $tmpb &&"
 647             }
 648         } elseif {!$nchoice && ![string compare $t Choice] && \
 649                       [string length $uName]} {
 650             if {[llength $uName] < 3} {
 651                 set uName [list which u $name]
 652                 incr nchoice
 653             }
 654             lappend j "\tint [lindex $uName 0];"
 655             lappend j "\tunion \{"
 656             lappend v "\tstatic Odr_arm arm\[\] = \{"
 657             asnArm $name [lindex $uName 2] v j
 658             lappend v "\t\};"
 659             set dec "\t\} [lindex $uName 1];"
 660             set opt [asnOptional]
 661             set oa {}
 662             set ob {}
 663             if {[string length $ltag]} {
 664                 if {$limplicit} {
 665                     lappend l "\t\todr_implicit_settag (o, $ltagtype, $ltag) &&"
 666                     if {$opt} {
 667                         asnWarning "optional handling missing in CHOICE in SEQUENCE"
 668                         asnWarning " set unionmap($inf(module),$name,$p) to {}"
 669                     }
 670                 } else {
 671                     if {$opt} {
 672                         set la "(("
 673                     } else {
 674                         set la ""
 675                     }
 676                     lappend l "\t\t${la}odr_constructed_begin (o, &(*p)->[lindex $uName 1], $ltagtype, $ltag, \"$p\") &&"
 677                 }
 678             } else {
 679                 if {$opt} {
 680                     set oa "("
 681                     set ob " || odr_ok(o))"
 682                 }
 683             }
 684             lappend l "\t\t${oa}odr_choice (o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], 0)${ob} &&"
 685             if {[string length $ltag]} {
 686                 if {!$limplicit} {
 687                     if {$opt} {
 688                         set lb ") || odr_ok(o))"
 689                     } else {
 690                         set lb ""
 691                     }
 692                     lappend l "\t\todr_constructed_end (o)${lb} &&"
 693                 }
 694             }
 695         } else {
 696             set subName [mapName ${name}_$level]
 697             asnSub $subName $t {} {} 0 {}
 698             set opt [asnOptional]
 699             if {![string length $ltag]} {
 700                 lappend l "\t\t$inf(fprefix)${subName} (o, &(*p)->$p, $opt, \"$p\") &&"
 701             } elseif {$limplicit} {
 702                 lappend l "\t\todr_implicit_tag (o, $inf(fprefix)${subName},"
 703                 lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
 704             } else {
 705                 lappend l "\t\todr_explicit_tag (o, $inf(fprefix)${subName},"
 706                 lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
 707             }
 708             set dec "\t$inf(vprefix)${subName} *$p;"
 709             incr level
 710         }
 711         if {$opt} {
 712             lappend j "$dec /* OPT */"
 713         } else {
 714             lappend j $dec
 715         }
 716         if {[string compare $type ,]} break
 717     }
 718     lappend j "\}"
 719     if {[string length $tag] && !$implicit} {
 720         lappend l "\t\todr_sequence_end (o) &&"
 721         lappend l "\t\todr_constructed_end (o);"
 722     } else {
 723         lappend l "\t\todr_sequence_end (o);"
 724     }
 725     if {[string compare $type \}]} {
 726         asnError "Missing \} got $type '$val'"
 727     }
 728     lex
 729     if {[info exists v]} {
 730         set l [concat $v $l]
 731     }
 732     return [list [join $l \n] [join $j \n]]
 733 }
 734
 735 # asnOf: parses "SEQUENCE/SET OF type" and generates C code.
 736 # On entry,
 737 #   $name is the type we are defining
 738 #   $tag tag
 739 #   $implicit
 740 # Returns,
 741 #   {c-code, h-code}
 742 proc asnOf {name tag implicit tagtype isset} {
 743     global inf
 744
 745     if {$isset} {
 746         set func odr_set_of
 747     } else {
 748         set func odr_sequence_of
 749     }
 750
 751     if {[info exists inf(unionmap,$inf(module),$name)]} {
 752         set numName $inf(unionmap,$inf(module),$name)
 753     } else {
 754         set numName {num elements}
 755     }
 756
 757     lappend j "struct $inf(vprefix)$name \{"
 758     lappend j "\tint [lindex $numName 0];"
 759
 760     lappend l "\tif (!odr_initmember (o, p, sizeof(**p)))"
 761     lappend l "\t\treturn opt && odr_ok(o);"
 762     if {[string length $tag]} {
 763         if {$implicit} {
 764             lappend l "\todr_implicit_settag (o, $tagtype, $tag);"
 765         } else {
 766             asnWarning "Constructed SEQUENCE/SET OF not handled"
 767         }
 768     }
 769     set t [asnType $name]
 770     switch -- $t {
 771         Simple {
 772             asnEnum $name j
 773             lappend l "\tif ($func (o, (Odr_fun) [lindex $tname 0], &(*p)->[lindex $numName 1],"
 774             lappend l "\t\t&(*p)->[lindex $numName 0], name))"
 775             lappend j "\t[lindex $tname 1] **[lindex $numName 1];"
 776         }
 777         default {
 778             set subName [mapName ${name}_s]
 779             lappend l "\tif ($func (o, (Odr_fun) $inf(fprefix)$subName, &(*p)->[lindex $numName 1],"
 780             lappend l "\t\t&(*p)->[lindex $numName 0], name))"
 781             lappend j "\t$inf(vprefix)$subName **[lindex $numName 1];"
 782             asnSub $subName $t {} {} 0 {}
 783         }
 784     }
 785     lappend j "\}"
 786     lappend l "\t\treturn 1;"
 787     lappend l "\t*p = 0;"
 788     lappend l "\treturn opt && odr_ok(o);"
 789     return [list [join $l \n] [join $j \n]]
 790 }
 791
 792 # asnArm: parses c-list in choice
 793 proc asnArm {name defname lx jx} {
 794     global type val inf
 795
 796     upvar $lx l
 797     upvar $jx j
 798     while {1} {
 799         set pq [asnName $name]
 800         set p [lindex $pq 0]
 801         set q [lindex $pq 1]
 802         if {![string length $q]} {
 803             set q $p
 804             set p ${defname}_$p
 805         }
 806         asnMod ltag limplicit ltagtype
 807         set t [asnType $q]
 808
 809         lappend enums "$inf(dprefix)$p"
 810         if {![string compare $t Simple]} {
 811             asnEnum $name j
 812             if {![string length $ltag]} {
 813                 lappend l "\t\t\{-1, -1, -1, $inf(dprefix)$p,"
 814                 lappend l "\t\t (Odr_fun) [lindex $tname 0], \"$q\"\},"
 815             } elseif {$limplicit} {
 816                 lappend l "\t\t\{ODR_IMPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
 817                 lappend l "\t\t(Odr_fun) [lindex $tname 0], \"$q\"\},"
 818             } else {
 819                 lappend l "\t\t\{ODR_EXPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
 820                 lappend l "\t\t(Odr_fun) [lindex $tname 0], \"$q\"\},"
 821             }
 822             lappend j "\t\t[lindex $tname 1] *$q;"
 823         } else {
 824             set subName [mapName ${name}_$q]
 825             if {![string compare $inf(dprefix)${name}_$q \
 826                                  $inf(vprefix)$subName]} {
 827                 set po [string toupper [string index $q 0]][string \
 828                                                             range $q 1 end]
 829                 set subName [mapName ${name}${po}]
 830             }
 831             asnSub $subName $t $tname {} 0 {}
 832             if {![string length $ltag]} {
 833                 lappend l "\t\t\{-1, -1, -1, $inf(dprefix)$p,"
 834                 lappend l "\t\t (Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
 835             } elseif {$limplicit} {
 836                 lappend l "\t\t\{ODR_IMPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
 837                 lappend l "\t\t(Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
 838             } else {
 839                 lappend l "\t\t\{ODR_EXPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
 840                 lappend l "\t\t(Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
 841             }
 842             lappend j "\t\t$inf(vprefix)$subName *$q;"
 843         }
 844         if {[string compare $type ,]} break
 845     }
 846     if {[string compare $type \}]} {
 847         asnError "Missing \} got $type '$val'"
 848     }
 849     lex
 850     set level 1
 851     foreach e $enums {
 852         lappend j "#define $e $level"
 853         incr level
 854     }
 855     lappend l "\t\t\{-1, -1, -1, -1, (Odr_fun) 0, 0\}"
 856 }
 857
 858 # asnChoice: parses "CHOICE {c-list}" and generates C code.
 859 # On entry,
 860 #   $name is the type we are defining
 861 #   $tag tag
 862 #   $implicit
 863 # Returns,
 864 #   {c-code, h-code}
 865 proc asnChoice {name tag implicit tagtype} {
 866     global type val inf
 867
 868     if {[info exists inf(unionmap,$inf(module),$name)]} {
 869         set uName $inf(unionmap,$inf(module),$name)
 870     } else {
 871         set uName [list which u $name]
 872     }
 873
 874     lappend j "struct $inf(vprefix)$name \{"
 875     lappend j "\tint [lindex $uName 0];"
 876     lappend j "\tunion \{"
 877     lappend l "\tstatic Odr_arm arm\[\] = \{"
 878     asnArm $name [lindex $uName 2] l j
 879     lappend j "\t\} [lindex $uName 1];"
 880     lappend j "\}"
 881     lappend l "\t\};"
 882     if {![string length $tag]} {
 883         lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
 884         lappend l "\t\treturn opt && odr_ok(o);"
 885         lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name))"
 886     } elseif {$implicit} {
 887         lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
 888         lappend l "\t\treturn opt && odr_ok(o);"
 889         lappend l "\todr_implicit_settag(o, $tagtype, $tag);"
 890         lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name))"
 891     } else {
 892         lappend l "\tif (!*p && o->direction != ODR_DECODE)"
 893         lappend l "\t\treturn opt;"
 894         lappend l "\tif (!odr_constructed_begin(o, p, $tagtype, $tag, 0))"
 895         lappend l "\t\treturn opt && odr_ok(o);"
 896         lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
 897         lappend l "\t\treturn opt && odr_ok(o);"
 898         lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name) &&"
 899         lappend l "\t\todr_constructed_end(o))"
 900     }
 901     lappend l "\t\treturn 1;"
 902     lappend l "\t*p = 0;"
 903     lappend l "\treturn opt && odr_ok(o);"
 904     return [list [join $l \n] [join $j \n]]
 905 }
 906
 907 # asnImports: parses i-list in "IMPORTS {i-list}"
 908 # On return inf(import,..)-array is updated.
 909 # inf(import,"module") is a list of {C-handler, C-type} elements.
 910 # The {C-handler, C-type} is compatible with the $tname as is used by the
 911 # asnType procedure to solve external references.
 912 proc asnImports {} {
 913     global type val inf file
 914
 915     while {1} {
 916         if {[string compare $type n]} {
 917             asnError "Missing name in IMPORTS list"
 918         }
 919         lappend nam $val
 920         lex
 921         if {![string compare $type n] && ![string compare $val FROM]} {
 922             lex
 923
 924             if {[info exists inf(filename,$val)]} {
 925                 set fname $inf(filename,$val)
 926             } else {
 927                 set fname $val
 928             }
 929             puts $file(outh) "\#include <$inf(h-dir)${fname}.h>"
 930
 931             if {[info exists inf(prefix,$val)]} {
 932                 set prefix $inf(prefix,$val)
 933             } else {
 934                 set prefix $inf(prefix)
 935             }
 936             foreach n $nam {
 937                 if {[info exists inf(map,$val,$n)]} {
 938                     set v $inf(map,$val,$n)
 939                 } else {
 940                     set v $n
 941                 }
 942                 set w [join [split $v -] _]
 943                 set inf(imports,$n) [list [lindex $prefix 0]$w \
 944                                           [lindex $prefix 1]$w]
 945             }
 946             unset nam
 947             lex
 948             if {[string compare $type n]} break
 949         } elseif {![string compare $type ,]} {
 950             lex
 951         } else break
 952     }
 953     if {[string compare $type \;]} {
 954         asnError "Missing ; after IMPORTS list - got $type '$val'"
 955     }
 956     lex
 957 }
 958
 959 # asnExports: parses e-list in "EXPORTS {e-list}"
 960 # This function does nothing with elements in the list.
 961 proc asnExports {} {
 962     global type val inf
 963
 964     while {1} {
 965         if {[string compare $type n]} {
 966             asnError "Missing name in EXPORTS list"
 967         }
 968         set inf(exports,$val) 1
 969         lex
 970         if {[string compare $type ,]} break
 971         lex
 972     }
 973     if {[string compare $type \;]} {
 974         asnError "Missing ; after EXPORTS list - got $type ($val)"
 975     }
 976     lex
 977 }
 978
 979 # asnModuleBody: parses a module specification and generates C code.
 980 # Exports lists, imports lists, and type definitions are handled;
 981 # other things are silently ignored.
 982 proc asnModuleBody {} {
 983     global type val file inf
 984
 985     if {[info exists inf(prefix,$inf(module))]} {
 986         set prefix $inf(prefix,$inf(module))
 987     } else {
 988         set prefix $inf(prefix)
 989     }
 990     set inf(fprefix) [lindex $prefix 0]
 991     set inf(vprefix) [lindex $prefix 1]
 992     set inf(dprefix) [lindex $prefix 2]
 993     if {[llength $prefix] > 3} {
 994         set inf(cprefix) [lindex $prefix 3]
 995     } else {
 996         set inf(cprefix) {YAZ_EXPORT }
 997     }
 998
 999     if {$inf(verbose)} {
1000         puts "Module $inf(module), $inf(lineno)"
1001     }
1002
1003     set defblock 0
1004     if {[info exists inf(init,$inf(module),c)]} {
1005         puts $file(outc) $inf(init,$inf(module),c)
1006     }
1007     if {[info exists inf(init,$inf(module),h)]} {
1008         puts $file(outh) "\#ifdef __cplusplus"
1009         puts $file(outh) "extern \"C\" \{"
1010         puts $file(outh) "\#endif"
1011         set defblock 1
1012         puts $file(outh) $inf(init,$inf(module),h)
1013     }
1014     if {[info exists inf(init,$inf(module),p)]} {
1015         puts $file(outp) $inf(init,$inf(module),p)
1016     }
1017
1018     while {[string length $type]} {
1019         if {[string compare $type n]} {
1020             lex
1021             continue
1022         }
1023         if {![string compare $val END]} {
1024             break
1025         } elseif {![string compare $val EXPORTS]} {
1026             lex
1027             asnExports
1028         } elseif {![string compare $val IMPORTS]} {
1029             if {$defblock} {
1030                 puts $file(outh) "\#ifdef __cplusplus"
1031                 puts $file(outh) "\}"
1032                 puts $file(outh) "\#endif"
1033                 set defblock 0
1034             }
1035             lex
1036             asnImports
1037         } else {
1038             if {!$defblock} {
1039                 puts $file(outh) "\#ifdef __cplusplus"
1040                 puts $file(outh) "extern \"C\" \{"
1041                 puts $file(outh) "\#endif"
1042                 set defblock 1
1043             }
1044             set inf(asndef) $inf(nodef)
1045             set oval $val
1046             lex
1047             if {![string compare $type :]} {
1048                 lex
1049                 asnDef $oval
1050                 set inf(asndef) 0
1051             } elseif {![string compare $type n]} {
1052                 lex
1053                 if {[string length $type]} {
1054                     lex
1055                 }
1056             }
1057         }
1058     }
1059     if {$defblock} {
1060         puts $file(outh) "\#ifdef __cplusplus"
1061         puts $file(outh) "\}"
1062         puts $file(outh) "\#endif"
1063         set defblock 0
1064     }
1065     foreach x [array names inf imports,*] {
1066         unset inf($x)
1067     }
1068 }
1069
1070 # asnTagDefault: parses TagDefault section
1071 proc asnTagDefault {} {
1072     global type val inf file
1073
1074     set inf(implicit-tags) 0
1075     while {[string length $type]} {
1076         if {[lex-name-move EXPLICIT]} {
1077             lex
1078             set inf(implicit-tags) 0
1079         } elseif {[lex-name-move  IMPLICIT]} {
1080             lex
1081             set inf(implicit-tags) 1
1082         } else {
1083             break
1084         }
1085     }
1086 }
1087
1088 # asnModules: parses a collection of module specifications.
1089 # Depending on the module pattern, $inf(moduleP), a module is either
1090 # skipped or processed.
1091 proc asnModules {} {
1092     global type val inf file yc_version
1093
1094     set inf(nodef) 0
1095     set inf(asndef) 0
1096     lex
1097     while {![string compare $type n]} {
1098         set inf(module) $val
1099         if {[info exists inf(moduleP)] && ![string match $inf(moduleP) $val]} {
1100             if {$inf(verbose)} {
1101                 puts "Skipping $id"
1102             }
1103             while {![lex-name-move END]} {
1104                 lex
1105             }
1106         } else {
1107             set inf(nodef) 1
1108             set inf(asndef) 1
1109
1110             while {![lex-name-move DEFINITIONS]} {
1111                 lex
1112                 if {![string length $type]} return
1113             }
1114             if {[info exists inf(filename,$inf(module))]} {
1115                 set fname $inf(filename,$inf(module))
1116             } else {
1117                 set fname $inf(module)
1118             }
1119             set ppname [join [split $fname -] _]
1120
1121             if {![info exists inf(c-file)]} {
1122                 set inf(c-file) ${fname}.c
1123             }
1124             set file(outc) [open $inf(c-file) w]
1125
1126             if {![info exists inf(h-file)]} {
1127                 set inf(h-file) ${fname}.h
1128             }
1129             set file(outh) [open $inf(h-path)/$inf(h-dir)$inf(h-file) w]
1130
1131             if {0} {
1132                 if {![info exists inf(p-file)]} {
1133                     set inf(p-file) ${fname}-p.h
1134                 }
1135                 set file(outp) [open $inf(h-path)/$inf(h-dir)$inf(p-file) w]
1136             }
1137
1138             set greeting {Generated automatically by the YAZ ASN.1 Compiler}
1139
1140             puts $file(outc) "/* ${greeting} ${yc_version} */"
1141             puts $file(outc) "/* Module-C: $inf(module) */"
1142             puts $file(outc) {}
1143
1144             puts $file(outh) "/* ${greeting} ${yc_version} */"
1145             puts $file(outh) "/* Module-H $inf(module) */"
1146             puts $file(outh) {}
1147
1148             if {[info exists file(outp)]} {
1149                 puts $file(outp) "/* ${greeting} ${yc_version} */"
1150                 puts $file(outp) "/* Module-P: $inf(module) */"
1151                 puts $file(outp) {}
1152             }
1153
1154             if {[info exists inf(p-file)]} {
1155                 puts $file(outc) "\#include <$inf(h-dir)$inf(p-file)>"
1156             } else {
1157                 puts $file(outc) "\#include <$inf(h-dir)$inf(h-file)>"
1158             }
1159             puts $file(outh) "\#ifndef ${ppname}_H"
1160             puts $file(outh) "\#define ${ppname}_H"
1161             puts $file(outh) {}
1162             puts $file(outh) "\#include <$inf(h-dir)odr.h>"
1163
1164             if {[info exists file(outp)]} {
1165                 puts $file(outp) "\#ifndef ${ppname}_P_H"
1166                 puts $file(outp) "\#define ${ppname}_P_H"
1167                 puts $file(outp) {}
1168                 puts $file(outp) "\#include <$inf(h-dir)$inf(h-file)>"
1169
1170             }
1171
1172             asnTagDefault
1173             if {[string compare $type :]} {
1174                 asnError "::= expected got $type '$val'"
1175             }
1176             lex
1177             if {![lex-name-move BEGIN]} {
1178                 asnError "BEGIN expected"
1179             }
1180             asnModuleBody
1181             lex
1182
1183             if {[info exists file(outp)]} {
1184                 set f $file(outp)
1185             } else {
1186                 set f $file(outh)
1187             }
1188             puts $f "\#ifdef __cplusplus"
1189             puts $f "extern \"C\" \{"
1190             puts $f "\#endif"
1191             for {set i 1} {$i < $inf(nodef)} {incr i} {
1192                 puts $f $inf(var,$i)
1193                 if {[info exists inf(asn,$i)]} {
1194                     if {0} {
1195                         puts $f "/*"
1196                         foreach comment $inf(asn,$i) {
1197                             puts $f $comment
1198                         }
1199                         puts $f " */"
1200                     }
1201                     unset inf(asn,$i)
1202                 }
1203                 unset inf(var,$i)
1204                 puts $f {}
1205             }
1206             puts $f "\#ifdef __cplusplus"
1207             puts $f "\}"
1208             puts $f "\#endif"
1209
1210             if {[info exists inf(body,$inf(module),h)]} {
1211                 puts $file(outh) $inf(body,$inf(module),h)
1212             }
1213             if {[info exists inf(body,$inf(module),c)]} {
1214                 puts $file(outc) $inf(body,$inf(module),c)
1215             }
1216             if {[info exists inf(body,$inf(module),p)]} {
1217                 if {[info exists file(outp)]} {
1218                     puts $file(outp) $inf(body,$inf(module),p)
1219                 }
1220             }
1221             puts $file(outh) "\#endif"
1222             if {[info exists file(outp)]} {
1223                 puts $file(outp) "\#endif"
1224             }
1225             foreach f [array names file] {
1226                 close $file($f)
1227             }
1228             unset inf(c-file)
1229             unset inf(h-file)
1230             catch {unset inf(p-file)}
1231         }
1232     }
1233 }
1234
1235 # asnFile: parses an ASN.1 specification file as specified in $inf(iname).
1236 proc asnFile {} {
1237     global inf file
1238
1239     if {$inf(verbose) > 1} {
1240         puts "Reading ASN.1 file $inf(iname)"
1241     }
1242     set inf(str) {}
1243     set inf(lineno) 0
1244     set inf(inf) [open $inf(iname) r]
1245
1246     asnModules
1247
1248 }
1249
1250 # The following procedures are invoked by the asnType function.
1251 # Each procedure takes the form: asnBasic<TYPE> and they must return
1252 # two elements: the C function handler and the C type.
1253 # On entry upvar $name is the type we are defining and global, $inf(module), is
1254 # the current module name.
1255
1256 proc asnBasicEXTERNAL {} {
1257     return {odr_external {Odr_external}}
1258 }
1259
1260 proc asnBasicINTEGER {} {
1261     return {odr_integer {int}}
1262 }
1263
1264 proc asnBasicENUMERATED {} {
1265     return {odr_enum {int}}
1266 }
1267
1268 proc asnBasicNULL {} {
1269     return {odr_null {Odr_null}}
1270 }
1271
1272 proc asnBasicBOOLEAN {} {
1273     return {odr_bool {bool_t}}
1274 }
1275
1276 proc asnBasicOCTET {} {
1277     global type val
1278     lex-name-move STRING
1279     return {odr_octetstring {Odr_oct}}
1280 }
1281
1282 proc asnBasicBIT {} {
1283     global type val
1284     lex-name-move STRING
1285     return {odr_bitstring {Odr_bitmask}}
1286 }
1287
1288 proc asnBasicOBJECT {} {
1289     global type val
1290     lex-name-move IDENTIFIER
1291     return {odr_oid {Odr_oid}}
1292 }
1293
1294 proc asnBasicGeneralString {} {
1295     return {odr_generalstring char}
1296 }
1297
1298 proc asnBasicVisibleString {} {
1299     return {odr_visiblestring char}
1300 }
1301
1302 proc asnBasicGeneralizedTime {} {
1303     return {odr_generalizedtime char}
1304 }
1305
1306 proc asnBasicANY {} {
1307     upvar name name
1308     global inf
1309     return [list $inf(fprefix)ANY_$name void]
1310 }
1311
1312 # userDef: reads user definitions file $name
1313 proc userDef {name} {
1314     global inf
1315
1316     if {$inf(verbose) > 1} {
1317         puts "Reading definitions file $name"
1318     }
1319     source $name
1320
1321     if {[info exists default-prefix]} {
1322         set inf(prefix) ${default-prefix}
1323     }
1324     if {[info exists h-path]} {
1325         set inf(h-path) ${h-path}
1326     }
1327     foreach m [array names prefix] {
1328         set inf(prefix,$m) $prefix($m)
1329     }
1330     foreach m [array names body] {
1331         set inf(body,$m) $body($m)
1332     }
1333     foreach m [array names init] {
1334         set inf(init,$m) $init($m)
1335     }
1336     foreach m [array names filename] {
1337         set inf(filename,$m) $filename($m)
1338     }
1339     foreach m [array names map] {
1340         set inf(map,$m) $map($m)
1341     }
1342     foreach m [array names membermap] {
1343         set inf(membermap,$m) $membermap($m)
1344     }
1345     foreach m [array names unionmap] {
1346         set inf(unionmap,$m) $unionmap($m)
1347     }
1348 }
1349
1350 set inf(verbose) 0
1351 set inf(prefix) {yc_ Yc_ YC_}
1352 set inf(h-path) .
1353 set inf(h-dir) ""
1354
1355 # Parse command line
1356 set l [llength $argv]
1357 set i 0
1358 while {$i < $l} {
1359     set arg [lindex $argv $i]
1360     switch -glob -- $arg {
1361         -v {
1362             incr inf(verbose)
1363         }
1364         -c {
1365             set p [string range $arg 2 end]
1366             if {![string length $p]} {
1367                  set p [lindex $argv [incr i]]
1368              }
1369             set inf(c-file) $p
1370         }
1371         -I* {
1372             set p [string range $arg 2 end]
1373             if {![string length $p]} {
1374                  set p [lindex $argv [incr i]]
1375              }
1376             set inf(h-path) $p
1377         }
1378         -i* {
1379             set p [string range $arg 2 end]
1380             if {![string length $p]} {
1381                  set p [lindex $argv [incr i]]
1382             }
1383             set inf(h-dir) [string trim $p \\/]/
1384         }
1385         -h* {
1386             set p [string range $arg 2 end]
1387             if {![string length $p]} {
1388                  set p [lindex $argv [incr i]]
1389              }
1390             set inf(h-file) $p
1391         }
1392         -p* {
1393             set p [string range $arg 2 end]
1394             if {![string length $p]} {
1395                 set p [lindex $argv [incr i]]
1396             }
1397             set inf(p-file) $p
1398         }
1399         -d* {
1400             set p [string range $arg 2 end]
1401             if {![string length $p]} {
1402                 set p [lindex $argv [incr i]]
1403             }
1404             userDef $p
1405         }
1406         -m* {
1407             set p [string range $arg 2 end]
1408             if {![string length $p]} {
1409                 set p [lindex $argv [incr i]]
1410             }
1411             set inf(moduleP) $p
1412         }
1413         -x* {
1414             set p [string range $arg 2 end]
1415             if {![string length $p]} {
1416                 set p [lindex $argv [incr i]]
1417             }
1418             if {[llength $p] == 1} {
1419                 set inf(prefix) [list [string tolower $p] \
1420                                      [string toupper $p] [string toupper $p]]
1421             } elseif {[llength $p] == 3} {
1422                 set inf(prefix) $p
1423             } else {
1424                 puts [llength $p]
1425                 exit 1
1426             }
1427         }
1428         default {
1429             set inf(iname) $arg
1430         }
1431     }
1432     incr i
1433 }
1434
1435 if {![info exists inf(iname)]} {
1436     puts "YAZ ASN.1 Compiler ${yc_version}"
1437     puts -nonewline "Usage: ${argv0}"
1438     puts { [-v] [-c cfile] [-h hfile] [-p hfile] [-d dfile] [-I path]}
1439     puts {    [-x prefix] [-m module] file}
1440     exit 1
1441 }
1442
1443 asnFile