util/yc.tcl

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