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-2003
   7 # See the file LICENSE for details.
   8 #
   9 # $Id: yaz-comp,v 1.5 2003-05-06 10:06:43 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 opt && 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 opt && odr_ok(o);"
 518     } else {
 519         lappend l "\tif (!odr_constructed_begin (o, p, $tagtype, $tag, name))"
 520         lappend l "\t\treturn opt && odr_ok(o);"
 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\t*p = 0;"
 527         lappend l "\t\treturn 0;"
 528         lappend l "\t\}"
 529     }
 530     lappend l "\treturn"
 531     while {1} {
 532         set p [lindex [asnName $name] 0]
 533         asnMod ltag limplicit ltagtype
 534         set t [asnType $p]
 535
 536         set uName { }
 537         if {[info exists inf(unionmap,$inf(module),$name,$p)]} {
 538             set uName $inf(unionmap,$inf(module),$name,$p)
 539         }
 540
 541         if {![string compare $t Simple]} {
 542             if {[string compare $uName { }]} {
 543                 set enumName $uName
 544             } else {
 545                 set enumName $name
 546             }
 547             asnEnum $enumName j
 548             set opt [asnOptional]
 549             if {![string length $ltag]} {
 550                 lappend l "\t\t[lindex $tname 0](o, &(*p)->$p, $opt, \"$p\") &&"
 551             } elseif {$limplicit} {
 552                 lappend l "\t\todr_implicit_tag (o, [lindex $tname 0],"
 553                 lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
 554             } else {
 555                 lappend l "\t\todr_explicit_tag (o, [lindex $tname 0],"
 556                 lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
 557             }
 558             set dec "\t[lindex $tname 1] *$p;"
 559         } elseif {![string compare $t SequenceOf] && [string length $uName] &&\
 560                       (![string length $ltag] || $limplicit)} {
 561             set u [asnType $p]
 562
 563             if {[llength $uName] < 2} {
 564                 set uName [list num_$p $p]
 565             }
 566             if {[string length $ltag]} {
 567                 if {!$limplicit} {
 568                     asnError explicittag
 569                 }
 570                 lappend l "\t\todr_implicit_settag (o, $ltagtype, $ltag) &&"
 571             }
 572             switch -- $u {
 573                 Simple {
 574                     asnEnum $name j
 575                     set tmpa "odr_sequence_of(o, (Odr_fun) [lindex $tname 0], &(*p)->$p,"
 576                     set tmpb "&(*p)->[lindex $uName 0], \"$p\")"
 577                     lappend j "\tint [lindex $uName 0];"
 578                     set dec "\t[lindex $tname 1] **[lindex $uName 1];"
 579                 }
 580                 default {
 581                     set subName [mapName ${name}_$level]
 582                     asnSub $subName $u {} {} 0 {}
 583
 584                     set tmpa "odr_sequence_of(o, (Odr_fun) $inf(fprefix)$subName, &(*p)->$p,"
 585                     set tmpb "&(*p)->[lindex $uName 0], \"$p\")"
 586                     lappend j "\tint [lindex $uName 0];"
 587                     set dec "\t$inf(vprefix)$subName **[lindex $uName 1];"
 588                     incr level
 589                 }
 590             }
 591             set opt [asnOptional]
 592             if {$opt} {
 593                 lappend l "\t\t($tmpa"
 594                 lappend l "\t\t  $tmpb || odr_ok(o)) &&"
 595             } else {
 596                 lappend l "\t\t$tmpa"
 597                 lappend l "\t\t  $tmpb &&"
 598             }
 599         } elseif {!$nchoice && ![string compare $t Choice] && \
 600                       [string length $uName]} {
 601             if {[llength $uName] < 3} {
 602                 set uName [list which u $name]
 603                 incr nchoice
 604             }
 605             lappend j "\tint [lindex $uName 0];"
 606             lappend j "\tunion \{"
 607             lappend v "\tstatic Odr_arm arm\[\] = \{"
 608             asnArm $name [lindex $uName 2] v j
 609             lappend v "\t\};"
 610             set dec "\t\} [lindex $uName 1];"
 611             set opt [asnOptional]
 612             set oa {}
 613             set ob {}
 614             if {[string length $ltag]} {
 615                 if {$limplicit} {
 616                     lappend l "\t\todr_implicit_settag (o, $ltagtype, $ltag) &&"
 617                     if {$opt} {
 618                         asnWarning "optional handling missing in CHOICE in SEQUENCE"
 619                         asnWarning " set unionmap($inf(module),$name,$p) to {}"
 620                     }
 621                 } else {
 622                     if {$opt} {
 623                         set la "(("
 624                     } else {
 625                         set la ""
 626                     }
 627                     lappend l "\t\t${la}odr_constructed_begin (o, &(*p)->[lindex $uName 1], $ltagtype, $ltag, \"$p\") &&"
 628                 }
 629             } else {
 630                 if {$opt} {
 631                     set oa "("
 632                     set ob " || odr_ok(o))"
 633                 }
 634             }
 635             lappend l "\t\t${oa}odr_choice (o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], 0)${ob} &&"
 636             if {[string length $ltag]} {
 637                 if {!$limplicit} {
 638                     if {$opt} {
 639                         set lb ") || odr_ok(o))"
 640                     } else {
 641                         set lb ""
 642                     }
 643                     lappend l "\t\todr_constructed_end (o)${lb} &&"
 644                 }
 645             }
 646         } else {
 647             set subName [mapName ${name}_$level]
 648             asnSub $subName $t {} {} 0 {}
 649             set opt [asnOptional]
 650             if {![string length $ltag]} {
 651                 lappend l "\t\t$inf(fprefix)${subName} (o, &(*p)->$p, $opt, \"$p\") &&"
 652             } elseif {$limplicit} {
 653                 lappend l "\t\todr_implicit_tag (o, $inf(fprefix)${subName},"
 654                 lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
 655             } else {
 656                 lappend l "\t\todr_explicit_tag (o, $inf(fprefix)${subName},"
 657                 lappend l "\t\t\t&(*p)->$p, $ltagtype, $ltag, $opt, \"$p\") &&"
 658             }
 659             set dec "\t$inf(vprefix)${subName} *$p;"
 660             incr level
 661         }
 662         if {$opt} {
 663             lappend j "$dec /* OPT */"
 664         } else {
 665             lappend j $dec
 666         }
 667         if {[string compare $type ,]} break
 668     }
 669     lappend j "\}"
 670     if {[string length $tag] && !$implicit} {
 671         lappend l "\t\todr_sequence_end (o) &&"
 672         lappend l "\t\todr_constructed_end (o);"
 673     } else {
 674         lappend l "\t\todr_sequence_end (o);"
 675     }
 676     if {[string compare $type \}]} {
 677         asnError "Missing \} got $type '$val'"
 678     }
 679     lex
 680     if {[info exists v]} {
 681         set l [concat $v $l]
 682     }
 683     return [list [join $l \n] [join $j \n]]
 684 }
 685
 686 # asnOf: parses "SEQUENCE/SET OF type" and generates C code.
 687 # On entry,
 688 #   $name is the type we are defining
 689 #   $tag tag
 690 #   $implicit
 691 # Returns,
 692 #   {c-code, h-code}
 693 proc asnOf {name tag implicit tagtype isset} {
 694     global inf
 695
 696     if {$isset} {
 697         set func odr_set_of
 698     } else {
 699         set func odr_sequence_of
 700     }
 701
 702     if {[info exists inf(unionmap,$inf(module),$name)]} {
 703         set numName $inf(unionmap,$inf(module),$name)
 704     } else {
 705         set numName {num elements}
 706     }
 707
 708     lappend j "struct $inf(vprefix)$name \{"
 709     lappend j "\tint [lindex $numName 0];"
 710
 711     lappend l "\tif (!odr_initmember (o, p, sizeof(**p)))"
 712     lappend l "\t\treturn opt && odr_ok(o);"
 713     if {[string length $tag]} {
 714         if {$implicit} {
 715             lappend l "\todr_implicit_settag (o, $tagtype, $tag);"
 716         } else {
 717             asnWarning "Constructed SEQUENCE/SET OF not handled"
 718         }
 719     }
 720     set t [asnType $name]
 721     switch -- $t {
 722         Simple {
 723             asnEnum $name j
 724             lappend l "\tif ($func (o, (Odr_fun) [lindex $tname 0], &(*p)->[lindex $numName 1],"
 725             lappend l "\t\t&(*p)->[lindex $numName 0], name))"
 726             lappend j "\t[lindex $tname 1] **[lindex $numName 1];"
 727         }
 728         default {
 729             set subName [mapName ${name}_s]
 730             lappend l "\tif ($func (o, (Odr_fun) $inf(fprefix)$subName, &(*p)->[lindex $numName 1],"
 731             lappend l "\t\t&(*p)->[lindex $numName 0], name))"
 732             lappend j "\t$inf(vprefix)$subName **[lindex $numName 1];"
 733             asnSub $subName $t {} {} 0 {}
 734         }
 735     }
 736     lappend j "\}"
 737     lappend l "\t\treturn 1;"
 738     lappend l "\t*p = 0;"
 739     lappend l "\treturn opt && odr_ok(o);"
 740     return [list [join $l \n] [join $j \n]]
 741 }
 742
 743 # asnArm: parses c-list in choice
 744 proc asnArm {name defname lx jx} {
 745     global type val inf
 746
 747     upvar $lx l
 748     upvar $jx j
 749     while {1} {
 750         set pq [asnName $name]
 751         set p [lindex $pq 0]
 752         set q [lindex $pq 1]
 753         if {![string length $q]} {
 754             set q $p
 755             set p ${defname}_$p
 756         }
 757         asnMod ltag limplicit ltagtype
 758         set t [asnType $q]
 759
 760         lappend enums "$inf(dprefix)$p"
 761         if {![string compare $t Simple]} {
 762             asnEnum $name j
 763             if {![string length $ltag]} {
 764                 lappend l "\t\t\{-1, -1, -1, $inf(dprefix)$p,"
 765                 lappend l "\t\t (Odr_fun) [lindex $tname 0], \"$q\"\},"
 766             } elseif {$limplicit} {
 767                 lappend l "\t\t\{ODR_IMPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
 768                 lappend l "\t\t(Odr_fun) [lindex $tname 0], \"$q\"\},"
 769             } else {
 770                 lappend l "\t\t\{ODR_EXPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
 771                 lappend l "\t\t(Odr_fun) [lindex $tname 0], \"$q\"\},"
 772             }
 773             lappend j "\t\t[lindex $tname 1] *$q;"
 774         } else {
 775             set subName [mapName ${name}_$q]
 776             if {![string compare $inf(dprefix)${name}_$q \
 777                                  $inf(vprefix)$subName]} {
 778                 set po [string toupper [string index $q 0]][string \
 779                                                             range $q 1 end]
 780                 set subName [mapName ${name}${po}]
 781             }
 782             asnSub $subName $t $tname {} 0 {}
 783             if {![string length $ltag]} {
 784                 lappend l "\t\t\{-1, -1, -1, $inf(dprefix)$p,"
 785                 lappend l "\t\t (Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
 786             } elseif {$limplicit} {
 787                 lappend l "\t\t\{ODR_IMPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
 788                 lappend l "\t\t(Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
 789             } else {
 790                 lappend l "\t\t\{ODR_EXPLICIT, $ltagtype, $ltag, $inf(dprefix)$p,"
 791                 lappend l "\t\t(Odr_fun) $inf(fprefix)$subName, \"$q\"\},"
 792             }
 793             lappend j "\t\t$inf(vprefix)$subName *$q;"
 794         }
 795         if {[string compare $type ,]} break
 796     }
 797     if {[string compare $type \}]} {
 798         asnError "Missing \} got $type '$val'"
 799     }
 800     lex
 801     set level 1
 802     foreach e $enums {
 803         lappend j "#define $e $level"
 804         incr level
 805     }
 806     lappend l "\t\t\{-1, -1, -1, -1, (Odr_fun) 0, 0\}"
 807 }
 808
 809 # asnChoice: parses "CHOICE {c-list}" and generates C code.
 810 # On entry,
 811 #   $name is the type we are defining
 812 #   $tag tag
 813 #   $implicit
 814 # Returns,
 815 #   {c-code, h-code}
 816 proc asnChoice {name tag implicit tagtype} {
 817     global type val inf
 818
 819     if {[info exists inf(unionmap,$inf(module),$name)]} {
 820         set uName $inf(unionmap,$inf(module),$name)
 821     } else {
 822         set uName [list which u $name]
 823     }
 824
 825     lappend j "struct $inf(vprefix)$name \{"
 826     lappend j "\tint [lindex $uName 0];"
 827     lappend j "\tunion \{"
 828     lappend l "\tstatic Odr_arm arm\[\] = \{"
 829     asnArm $name [lindex $uName 2] l j
 830     lappend j "\t\} [lindex $uName 1];"
 831     lappend j "\}"
 832     lappend l "\t\};"
 833     if {![string length $tag]} {
 834         lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
 835         lappend l "\t\treturn opt && odr_ok(o);"
 836         lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name))"
 837     } elseif {$implicit} {
 838         lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
 839         lappend l "\t\treturn opt && odr_ok(o);"
 840         lappend l "\todr_implicit_settag(o, $tagtype, $tag);"
 841         lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name))"
 842     } else {
 843         lappend l "\tif (!*p && o->direction != ODR_DECODE)"
 844         lappend l "\t\treturn opt;"
 845         lappend l "\tif (!odr_constructed_begin(o, p, $tagtype, $tag, 0))"
 846         lappend l "\t\treturn opt && odr_ok(o);"
 847         lappend l "\tif (!odr_initmember(o, p, sizeof(**p)))"
 848         lappend l "\t\treturn opt && odr_ok(o);"
 849         lappend l "\tif (odr_choice(o, arm, &(*p)->[lindex $uName 1], &(*p)->[lindex $uName 0], name) &&"
 850         lappend l "\t\todr_constructed_end(o))"
 851     }
 852     lappend l "\t\treturn 1;"
 853     lappend l "\t*p = 0;"
 854     lappend l "\treturn opt && odr_ok(o);"
 855     return [list [join $l \n] [join $j \n]]
 856 }
 857
 858 # asnImports: parses i-list in "IMPORTS {i-list}"
 859 # On return inf(import,..)-array is updated.
 860 # inf(import,"module") is a list of {C-handler, C-type} elements.
 861 # The {C-handler, C-type} is compatible with the $tname as is used by the
 862 # asnType procedure to solve external references.
 863 proc asnImports {} {
 864     global type val inf file
 865
 866     while {1} {
 867         if {[string compare $type n]} {
 868             asnError "Missing name in IMPORTS list"
 869         }
 870         lappend nam $val
 871         lex
 872         if {![string compare $type n] && ![string compare $val FROM]} {
 873             lex
 874
 875             if {[info exists inf(filename,$val)]} {
 876                 set fname $inf(filename,$val)
 877             } else {
 878                 set fname $val
 879             }
 880             puts $file(outh) "\#include <$inf(h-dir)${fname}.h>"
 881
 882             if {[info exists inf(prefix,$val)]} {
 883                 set prefix $inf(prefix,$val)
 884             } else {
 885                 set prefix $inf(prefix)
 886             }
 887             foreach n $nam {
 888                 if {[info exists inf(map,$val,$n)]} {
 889                     set v $inf(map,$val,$n)
 890                 } else {
 891                     set v $n
 892                 }
 893                 set w [join [split $v -] _]
 894                 set inf(imports,$n) [list [lindex $prefix 0]$w \
 895                                           [lindex $prefix 1]$w]
 896             }
 897             unset nam
 898             lex
 899             if {[string compare $type n]} break
 900         } elseif {![string compare $type ,]} {
 901             lex
 902         } else break
 903     }
 904     if {[string compare $type \;]} {
 905         asnError "Missing ; after IMPORTS list - got $type '$val'"
 906     }
 907     lex
 908 }
 909
 910 # asnExports: parses e-list in "EXPORTS {e-list}"
 911 # This function does nothing with elements in the list.
 912 proc asnExports {} {
 913     global type val inf
 914
 915     while {1} {
 916         if {[string compare $type n]} {
 917             asnError "Missing name in EXPORTS list"
 918         }
 919         set inf(exports,$val) 1
 920         lex
 921         if {[string compare $type ,]} break
 922         lex
 923     }
 924     if {[string compare $type \;]} {
 925         asnError "Missing ; after EXPORTS list - got $type ($val)"
 926     }
 927     lex
 928 }
 929
 930 # asnModuleBody: parses a module specification and generates C code.
 931 # Exports lists, imports lists, and type definitions are handled;
 932 # other things are silently ignored.
 933 proc asnModuleBody {} {
 934     global type val file inf
 935
 936     if {[info exists inf(prefix,$inf(module))]} {
 937         set prefix $inf(prefix,$inf(module))
 938     } else {
 939         set prefix $inf(prefix)
 940     }
 941     set inf(fprefix) [lindex $prefix 0]
 942     set inf(vprefix) [lindex $prefix 1]
 943     set inf(dprefix) [lindex $prefix 2]
 944     if {[llength $prefix] > 3} {
 945         set inf(cprefix) [lindex $prefix 3]
 946     } else {
 947         set inf(cprefix) {YAZ_EXPORT }
 948     }
 949
 950     if {$inf(verbose)} {
 951         puts "Module $inf(module), $inf(lineno)"
 952     }
 953
 954     set defblock 0
 955     if {[info exists inf(init,$inf(module),c)]} {
 956         puts $file(outc) $inf(init,$inf(module),c)
 957     }
 958     if {[info exists inf(init,$inf(module),h)]} {
 959         puts $file(outh) "\#ifdef __cplusplus"
 960         puts $file(outh) "extern \"C\" \{"
 961         puts $file(outh) "\#endif"
 962         set defblock 1
 963         puts $file(outh) $inf(init,$inf(module),h)
 964     }
 965     if {[info exists inf(init,$inf(module),p)]} {
 966         puts $file(outp) $inf(init,$inf(module),p)
 967     }
 968
 969     while {[string length $type]} {
 970         if {[string compare $type n]} {
 971             lex
 972             continue
 973         }
 974         if {![string compare $val END]} {
 975             break
 976         } elseif {![string compare $val EXPORTS]} {
 977             lex
 978             asnExports
 979         } elseif {![string compare $val IMPORTS]} {
 980             if {$defblock} {
 981                 puts $file(outh) "\#ifdef __cplusplus"
 982                 puts $file(outh) "\}"
 983                 puts $file(outh) "\#endif"
 984                 set defblock 0
 985             }
 986             lex
 987             asnImports
 988         } else {
 989             if {!$defblock} {
 990                 puts $file(outh) "\#ifdef __cplusplus"
 991                 puts $file(outh) "extern \"C\" \{"
 992                 puts $file(outh) "\#endif"
 993                 set defblock 1
 994             }
 995             set inf(asndef) $inf(nodef)
 996             set oval $val
 997             lex
 998             if {![string compare $type :]} {
 999                 lex
1000                 asnDef $oval
1001                 set inf(asndef) 0
1002             } elseif {![string compare $type n]} {
1003                 lex
1004                 if {[string length $type]} {
1005                     lex
1006                 }
1007             }
1008         }
1009     }
1010     if {$defblock} {
1011         puts $file(outh) "\#ifdef __cplusplus"
1012         puts $file(outh) "\}"
1013         puts $file(outh) "\#endif"
1014         set defblock 0
1015     }
1016     foreach x [array names inf imports,*] {
1017         unset inf($x)
1018     }
1019 }
1020
1021 # asnTagDefault: parses TagDefault section
1022 proc asnTagDefault {} {
1023     global type val inf file
1024
1025     set inf(implicit-tags) 0
1026     while {[string length $type]} {
1027         if {[lex-name-move EXPLICIT]} {
1028             lex
1029             set inf(implicit-tags) 0
1030         } elseif {[lex-name-move  IMPLICIT]} {
1031             lex
1032             set inf(implicit-tags) 1
1033         } else {
1034             break
1035         }
1036     }
1037 }
1038
1039 # asnModules: parses a collection of module specifications.
1040 # Depending on the module pattern, $inf(moduleP), a module is either
1041 # skipped or processed.
1042 proc asnModules {} {
1043     global type val inf file yc_version
1044
1045     set inf(nodef) 0
1046     set inf(asndef) 0
1047     lex
1048     while {![string compare $type n]} {
1049         set inf(module) $val
1050         if {[info exists inf(moduleP)] && ![string match $inf(moduleP) $val]} {
1051             if {$inf(verbose)} {
1052                 puts "Skipping $id"
1053             }
1054             while {![lex-name-move END]} {
1055                 lex
1056             }
1057         } else {
1058             set inf(nodef) 1
1059             set inf(asndef) 1
1060
1061             while {![lex-name-move DEFINITIONS]} {
1062                 lex
1063                 if {![string length $type]} return
1064             }
1065             if {[info exists inf(filename,$inf(module))]} {
1066                 set fname $inf(filename,$inf(module))
1067             } else {
1068                 set fname $inf(module)
1069             }
1070             set ppname [join [split $fname -] _]
1071
1072             if {![info exists inf(c-file)]} {
1073                 set inf(c-file) ${fname}.c
1074             }
1075             set file(outc) [open $inf(c-file) w]
1076
1077             if {![info exists inf(h-file)]} {
1078                 set inf(h-file) ${fname}.h
1079             }
1080             set file(outh) [open $inf(h-path)/$inf(h-dir)$inf(h-file) w]
1081
1082             if {0} {
1083                 if {![info exists inf(p-file)]} {
1084                     set inf(p-file) ${fname}-p.h
1085                 }
1086                 set file(outp) [open $inf(h-path)/$inf(h-dir)$inf(p-file) w]
1087             }
1088
1089             set greeting {Generated automatically by the YAZ ASN.1 Compiler}
1090
1091             puts $file(outc) "/* ${greeting} ${yc_version} */"
1092             puts $file(outc) "/* Module-C: $inf(module) */"
1093             puts $file(outc) {}
1094
1095             puts $file(outh) "/* ${greeting} ${yc_version} */"
1096             puts $file(outh) "/* Module-H $inf(module) */"
1097             puts $file(outh) {}
1098
1099             if {[info exists file(outp)]} {
1100                 puts $file(outp) "/* ${greeting} ${yc_version} */"
1101                 puts $file(outp) "/* Module-P: $inf(module) */"
1102                 puts $file(outp) {}
1103             }
1104
1105             if {[info exists inf(p-file)]} {
1106                 puts $file(outc) "\#include <$inf(h-dir)$inf(p-file)>"
1107             } else {
1108                 puts $file(outc) "\#include <$inf(h-dir)$inf(h-file)>"
1109             }
1110             puts $file(outh) "\#ifndef ${ppname}_H"
1111             puts $file(outh) "\#define ${ppname}_H"
1112             puts $file(outh) {}
1113             puts $file(outh) "\#include <yaz/odr.h>"
1114
1115             if {[info exists file(outp)]} {
1116                 puts $file(outp) "\#ifndef ${ppname}_P_H"
1117                 puts $file(outp) "\#define ${ppname}_P_H"
1118                 puts $file(outp) {}
1119                 puts $file(outp) "\#include <$inf(h-dir)$inf(h-file)>"
1120
1121             }
1122
1123             asnTagDefault
1124             if {[string compare $type :]} {
1125                 asnError "::= expected got $type '$val'"
1126             }
1127             lex
1128             if {![lex-name-move BEGIN]} {
1129                 asnError "BEGIN expected"
1130             }
1131             asnModuleBody
1132             lex
1133
1134             if {[info exists file(outp)]} {
1135                 set f $file(outp)
1136             } else {
1137                 set f $file(outh)
1138             }
1139             puts $f "\#ifdef __cplusplus"
1140             puts $f "extern \"C\" \{"
1141             puts $f "\#endif"
1142             for {set i 1} {$i < $inf(nodef)} {incr i} {
1143                 puts $f $inf(var,$i)
1144                 if {[info exists inf(asn,$i)]} {
1145                     if {0} {
1146                         puts $f "/*"
1147                         foreach comment $inf(asn,$i) {
1148                             puts $f $comment
1149                         }
1150                         puts $f " */"
1151                     }
1152                     unset inf(asn,$i)
1153                 }
1154                 unset inf(var,$i)
1155                 puts $f {}
1156             }
1157             puts $f "\#ifdef __cplusplus"
1158             puts $f "\}"
1159             puts $f "\#endif"
1160
1161             if {[info exists inf(body,$inf(module),h)]} {
1162                 puts $file(outh) $inf(body,$inf(module),h)
1163             }
1164             if {[info exists inf(body,$inf(module),c)]} {
1165                 puts $file(outc) $inf(body,$inf(module),c)
1166             }
1167             if {[info exists inf(body,$inf(module),p)]} {
1168                 if {[info exists file(outp)]} {
1169                     puts $file(outp) $inf(body,$inf(module),p)
1170                 }
1171             }
1172             puts $file(outh) "\#endif"
1173             if {[info exists file(outp)]} {
1174                 puts $file(outp) "\#endif"
1175             }
1176             foreach f [array names file] {
1177                 close $file($f)
1178             }
1179             unset inf(c-file)
1180             unset inf(h-file)
1181             catch {unset inf(p-file)}
1182         }
1183     }
1184 }
1185
1186 # asnFile: parses an ASN.1 specification file as specified in $inf(iname).
1187 proc asnFile {} {
1188     global inf file
1189
1190     if {$inf(verbose) > 1} {
1191         puts "Reading ASN.1 file $inf(iname)"
1192     }
1193     set inf(str) {}
1194     set inf(lineno) 0
1195     set inf(inf) [open $inf(iname) r]
1196
1197     asnModules
1198
1199 }
1200
1201 # The following procedures are invoked by the asnType function.
1202 # Each procedure takes the form: asnBasic<TYPE> and they must return
1203 # two elements: the C function handler and the C type.
1204 # On entry upvar $name is the type we are defining and global, $inf(module), is
1205 # the current module name.
1206
1207 proc asnBasicEXTERNAL {} {
1208     return {odr_external {Odr_external}}
1209 }
1210
1211 proc asnBasicINTEGER {} {
1212     return {odr_integer {int}}
1213 }
1214
1215 proc asnBasicENUMERATED {} {
1216     return {odr_enum {int}}
1217 }
1218
1219 proc asnBasicNULL {} {
1220     return {odr_null {Odr_null}}
1221 }
1222
1223 proc asnBasicBOOLEAN {} {
1224     return {odr_bool {bool_t}}
1225 }
1226
1227 proc asnBasicOCTET {} {
1228     global type val
1229     lex-name-move STRING
1230     return {odr_octetstring {Odr_oct}}
1231 }
1232
1233 proc asnBasicBIT {} {
1234     global type val
1235     lex-name-move STRING
1236     return {odr_bitstring {Odr_bitmask}}
1237 }
1238
1239 proc asnBasicOBJECT {} {
1240     global type val
1241     lex-name-move IDENTIFIER
1242     return {odr_oid {Odr_oid}}
1243 }
1244
1245 proc asnBasicGeneralString {} {
1246     return {odr_generalstring char}
1247 }
1248
1249 proc asnBasicVisibleString {} {
1250     return {odr_visiblestring char}
1251 }
1252
1253 proc asnBasicGeneralizedTime {} {
1254     return {odr_generalizedtime char}
1255 }
1256
1257 proc asnBasicANY {} {
1258     upvar name name
1259     global inf
1260     return [list $inf(fprefix)ANY_$name void]
1261 }
1262
1263 # userDef: reads user definitions file $name
1264 proc userDef {name} {
1265     global inf
1266
1267     if {$inf(verbose) > 1} {
1268         puts "Reading definitions file $name"
1269     }
1270     source $name
1271
1272     if {[info exists default-prefix]} {
1273         set inf(prefix) ${default-prefix}
1274     }
1275     if {[info exists h-path]} {
1276         set inf(h-path) ${h-path}
1277     }
1278     foreach m [array names prefix] {
1279         set inf(prefix,$m) $prefix($m)
1280     }
1281     foreach m [array names body] {
1282         set inf(body,$m) $body($m)
1283     }
1284     foreach m [array names init] {
1285         set inf(init,$m) $init($m)
1286     }
1287     foreach m [array names filename] {
1288         set inf(filename,$m) $filename($m)
1289     }
1290     foreach m [array names map] {
1291         set inf(map,$m) $map($m)
1292     }
1293     foreach m [array names membermap] {
1294         set inf(membermap,$m) $membermap($m)
1295     }
1296     foreach m [array names unionmap] {
1297         set inf(unionmap,$m) $unionmap($m)
1298     }
1299 }
1300
1301 set inf(verbose) 0
1302 set inf(prefix) {yc_ Yc_ YC_}
1303 set inf(h-path) .
1304 set inf(h-dir) ""
1305
1306 # Parse command line
1307 set l [llength $argv]
1308 set i 0
1309 while {$i < $l} {
1310     set arg [lindex $argv $i]
1311     switch -glob -- $arg {
1312         -v {
1313             incr inf(verbose)
1314         }
1315         -c {
1316             set p [string range $arg 2 end]
1317             if {![string length $p]} {
1318                  set p [lindex $argv [incr i]]
1319              }
1320             set inf(c-file) $p
1321         }
1322         -I* {
1323             set p [string range $arg 2 end]
1324             if {![string length $p]} {
1325                  set p [lindex $argv [incr i]]
1326              }
1327             set inf(h-path) $p
1328         }
1329         -i* {
1330             set p [string range $arg 2 end]
1331             if {![string length $p]} {
1332                  set p [lindex $argv [incr i]]
1333             }
1334             set inf(h-dir) [string trim $p \\/]/
1335         }
1336         -h* {
1337             set p [string range $arg 2 end]
1338             if {![string length $p]} {
1339                  set p [lindex $argv [incr i]]
1340              }
1341             set inf(h-file) $p
1342         }
1343         -p* {
1344             set p [string range $arg 2 end]
1345             if {![string length $p]} {
1346                 set p [lindex $argv [incr i]]
1347             }
1348             set inf(p-file) $p
1349         }
1350         -d* {
1351             set p [string range $arg 2 end]
1352             if {![string length $p]} {
1353                 set p [lindex $argv [incr i]]
1354             }
1355             userDef $p
1356         }
1357         -m* {
1358             set p [string range $arg 2 end]
1359             if {![string length $p]} {
1360                 set p [lindex $argv [incr i]]
1361             }
1362             set inf(moduleP) $p
1363         }
1364         -x* {
1365             set p [string range $arg 2 end]
1366             if {![string length $p]} {
1367                 set p [lindex $argv [incr i]]
1368             }
1369             if {[llength $p] == 1} {
1370                 set inf(prefix) [list [string tolower $p] \
1371                                      [string toupper $p] [string toupper $p]]
1372             } elseif {[llength $p] == 3} {
1373                 set inf(prefix) $p
1374             } else {
1375                 puts [llength $p]
1376                 exit 1
1377             }
1378         }
1379         default {
1380             set inf(iname) $arg
1381         }
1382     }
1383     incr i
1384 }
1385
1386 if {![info exists inf(iname)]} {
1387     puts "YAZ ASN.1 Compiler ${yc_version}"
1388     puts -nonewline "Usage: ${argv0}"
1389     puts { [-v] [-c cfile] [-h hfile] [-p hfile] [-d dfile] [-I path]}
1390     puts {    [-x prefix] [-m module] file}
1391     exit 1
1392 }
1393
1394 asnFile