util/yaz-comp

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