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