util/yaz-asncomp

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