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