util/yc.tcl

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