util/yc.tcl

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