util/yaz-asncomp

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