util/yaz-asncomp

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