util/yaz-asncomp

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