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