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