src/charconv.tcl

   1 #!/bin/sh
   2 # the next line restarts using tclsh \
   3 if [ -f /usr/local/bin/tclsh8.4 ]; then exec tclsh8.4 "$0" "$@"; else exec tclsh "$0" "$@"; fi
   4 #
   5 # $Id: charconv.tcl,v 1.16 2006-05-23 09:43:37 mike Exp $
   6
   7 proc usage {} {
   8     puts {charconv.tcl: [-p prefix] [-s split] [-o ofile] file ... }
   9     exit 1
  10 }
  11
  12 proc preamble_trie {ofilehandle ifiles ofile} {
  13     set f $ofilehandle
  14
  15     set totype {unsigned }
  16
  17     puts $f "/** \\file $ofile"
  18     puts $f "    \\brief Character conversion, generated from [lindex $ifiles 0]"
  19     puts $f ""
  20     puts $f "    Generated automatically by charconv.tcl"
  21     puts $f "*/"
  22     puts $f "\#include <string.h>"
  23     puts $f "
  24         struct yaz_iconv_trie_flat {
  25             char from\[6\];
  26             unsigned combining : 1;
  27             $totype to : 24;
  28         };
  29         struct yaz_iconv_trie_dir {
  30             int ptr : 15;
  31             unsigned combining : 1;
  32             $totype to : 24;
  33         };
  34
  35         struct yaz_iconv_trie {
  36             struct yaz_iconv_trie_flat *flat;
  37             struct yaz_iconv_trie_dir *dir;
  38         };
  39     "
  40     puts $f {
  41         static unsigned long lookup(struct yaz_iconv_trie **ptrs, int ptr, unsigned char *inp,
  42                                     size_t inbytesleft, size_t *no_read, int *combining)
  43         {
  44             struct yaz_iconv_trie *t = (ptr > 0) ? ptrs[ptr-1] : 0;
  45             if (!t || inbytesleft < 1)
  46                 return 0;
  47             if (t->dir)
  48             {
  49                 size_t ch = inp[0] & 0xff;
  50                 unsigned long code =
  51                 lookup(ptrs, t->dir[ch].ptr, inp+1, inbytesleft-1, no_read, combining);
  52                 if (code)
  53                 {
  54                     (*no_read)++;
  55                     return code;
  56                 }
  57                 if (t->dir[ch].to)
  58                 {
  59                     code = t->dir[ch].to;
  60                     *combining = t->dir[ch].combining;
  61                     *no_read = 1;
  62                     return code;
  63                 }
  64             }
  65             else
  66             {
  67                 struct yaz_iconv_trie_flat *flat = t->flat;
  68                 while (flat->to)
  69                 {
  70                     size_t len = strlen(flat->from);
  71                     if (len <= inbytesleft)
  72                     {
  73                         if (memcmp(flat->from, inp, len) == 0)
  74                         {
  75                             *no_read = len;
  76                             *combining = flat->combining;
  77                             return flat->to;
  78                         }
  79                     }
  80                     flat++;
  81                 }
  82             }
  83             return 0;
  84         }
  85     }
  86 }
  87
  88 proc reset_trie {} {
  89     global trie
  90
  91     foreach x [array names trie] {
  92         unset trie($x)
  93     }
  94
  95     set trie(no) 1
  96     set trie(size) 0
  97     set trie(max) 0
  98     set trie(split) 50
  99     set trie(prefix) {}
 100 }
 101
 102 proc ins_trie {from to combining codename} {
 103     global trie
 104     if {![info exists trie(no)]} {
 105         set trie(no) 1
 106         set trie(size) 0
 107         set trie(max) 0
 108     }
 109     if {$trie(max) < $to} {
 110         set trie(max) $to
 111     }
 112     incr trie(size)
 113     ins_trie_r [split $from] $to $combining $codename 0
 114 }
 115
 116 proc split_trie {this} {
 117     global trie
 118     set trie($this,type) d
 119     foreach e $trie($this,content) {
 120         set from [lindex $e 0]
 121         set to [lindex $e 1]
 122         set combining [lindex $e 2]
 123         set codename [lindex $e 3]
 124
 125         set ch [lindex $from 0]
 126         set rest [lrange $from 1 end]
 127
 128         if {[llength $rest]} {
 129             if {![info exist trie($this,ptr,$ch)]} {
 130                 set trie($this,ptr,$ch) $trie(no)
 131                 incr trie(no)
 132             }
 133             ins_trie_r $rest $to $combining $codename $trie($this,ptr,$ch)
 134         } else {
 135             set trie($this,to,$ch) $to
 136             set trie($this,combining,$ch) $combining
 137             set trie($this,codename,$ch) $codename
 138         }
 139     }
 140     set trie($this,content) missing
 141 }
 142
 143 proc ins_trie_r {from to combining codename this} {
 144     global trie
 145
 146     if {![info exist trie($this,type)]} {
 147         set trie($this,type) f
 148     }
 149     if {$trie($this,type) == "f"} {
 150         lappend trie($this,content) [list $from $to $combining $codename]
 151
 152         # split ?
 153         if {[llength $trie($this,content)] > $trie(split)} {
 154             split_trie $this
 155             return [ins_trie_r $from $to $combining $codename $this]
 156         }
 157     } else {
 158         set ch [lindex $from 0]
 159         set rest [lrange $from 1 end]
 160
 161         if {[llength $rest]} {
 162             if {![info exist trie($this,ptr,$ch)]} {
 163                 set trie($this,ptr,$ch) $trie(no)
 164                 incr trie(no)
 165             }
 166             ins_trie_r $rest $to $combining $codename $trie($this,ptr,$ch)
 167         } else {
 168             set trie($this,to,$ch) $to
 169             set trie($this,combining,$ch) $combining
 170             set trie($this,codename,$ch) $codename
 171         }
 172     }
 173 }
 174
 175 proc dump_trie {ofilehandle} {
 176     global trie
 177
 178     set f $ofilehandle
 179
 180     puts $f "/* TRIE: size $trie(size) */"
 181
 182     set this $trie(no)
 183     while { [incr this -1] >= 0 } {
 184         puts $f "/* PAGE $this */"
 185         if {$trie($this,type) == "f"} {
 186             puts $f "struct yaz_iconv_trie_flat $trie(prefix)page${this}_flat\[\] = \{"
 187             foreach m $trie($this,content) {
 188                 puts -nonewline $f "  \{\""
 189                 foreach d [lindex $m 0] {
 190                     puts -nonewline $f "\\x$d"
 191                 }
 192                 puts -nonewline $f "\", [lindex $m 2], 0x[lindex $m 1]"
 193                 set v [lindex $m 3]
 194                 puts $f "\}, /* $v */"
 195             }
 196             puts $f "  \{\"\", 0\}"
 197             puts $f "\};"
 198             puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
 199             puts $f "  $trie(prefix)page${this}_flat, 0"
 200             puts $f "\};"
 201         } else {
 202             puts $f "struct yaz_iconv_trie_dir $trie(prefix)page${this}_dir\[256\] = \{"
 203             for {set i 0} {$i < 256} {incr i} {
 204                 puts -nonewline $f "  \{"
 205                 set ch [format %02X $i]
 206                 set null 1
 207                 if {[info exist trie($this,ptr,$ch)]} {
 208                     puts -nonewline $f "[expr $trie($this,ptr,$ch)+1], "
 209                     set null 0
 210                 } else {
 211                     puts -nonewline $f "0, "
 212                 }
 213                 if {[info exist trie($this,combining,$ch)]} {
 214                     puts -nonewline $f "$trie($this,combining,$ch), "
 215                 } else {
 216                     puts -nonewline $f "0, "
 217                 }
 218                 if {[info exist trie($this,to,$ch)]} {
 219                     puts -nonewline $f "0x$trie($this,to,$ch)\}"
 220                     set null 0
 221                 } else {
 222                     puts -nonewline $f "0\}"
 223                 }
 224                 if {[info exist trie($this,codename,$ch)]} {
 225                     set v $trie($this,codename,$ch)
 226                     puts -nonewline $f " /* $v */"
 227                 }
 228                 if {$i < 255} {
 229                     puts $f ","
 230                 } else {
 231                     puts $f ""
 232                 }
 233             }
 234             puts $f "\};"
 235             puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
 236             puts $f "  0, $trie(prefix)page${this}_dir"
 237             puts $f "\};"
 238         }
 239     }
 240
 241     puts $f "struct yaz_iconv_trie *$trie(prefix)ptrs \[\] = {"
 242     for {set this 0} {$this < $trie(no)} {incr this} {
 243         puts $f " &$trie(prefix)page$this,"
 244     }
 245     puts $f "0, };"
 246     puts $f ""
 247
 248     puts $f "unsigned long yaz_$trie(prefix)_conv
 249             (unsigned char *inp, size_t inbytesleft, size_t *no_read, int *combining)
 250         {
 251             unsigned long code;
 252
 253             code = lookup($trie(prefix)ptrs, 1, inp, inbytesleft, no_read, combining);
 254             if (!code)
 255             {
 256                 *no_read = 1;
 257             }
 258             return code;
 259         }
 260     "
 261 }
 262
 263 proc readfile {fname ofilehandle prefix omits reverse} {
 264     global trie
 265
 266     set marc_lines 0
 267     set ucs_lines 0
 268     set utf_lines 0
 269     set codename_lines 0
 270     set lineno 0
 271     set f [open $fname r]
 272     set tablenumber x
 273     set combining 0
 274     set codename {}
 275     while {1} {
 276         incr lineno
 277         set cnt [gets $f line]
 278         if {$cnt < 0} {
 279             break
 280         }
 281         if {[regexp {<entitymap>} $line s]} {
 282             reset_trie
 283             set trie(prefix) "${prefix}"
 284         } elseif {[regexp {</entitymap>} $line s]} {
 285             dump_trie $ofilehandle
 286         } elseif {[regexp {<character hex="([^\"]*)".*<unientity>([0-9A-Fa-f]*)</unientity>} $line s hex ucs]} {
 287             ins_trie $hex $ucs $combining {}
 288             unset hex
 289         } elseif {[regexp {<codeTable .*number="([0-9]+)"} $line s tablenumber]} {
 290             reset_trie
 291             set trie(prefix) "${prefix}_$tablenumber"
 292             set combining 0
 293         } elseif {[regexp {</codeTable>} $line s]} {
 294             if {[lsearch $omits $tablenumber] == -1} {
 295                 dump_trie $ofilehandle
 296             }
 297         } elseif {[regexp {</code>} $line s]} {
 298             if {[string length $ucs]} {
 299                 if {$reverse} {
 300                     for {set i 0} {$i < [string length $utf]} {incr i 2} {
 301                         lappend hex [string range $utf $i [expr $i+1]]
 302                     }
 303                     # puts "ins_trie $hex $marc
 304                     ins_trie $hex $marc $combining $codename
 305                     unset hex
 306                 } else {
 307                     for {set i 0} {$i < [string length $marc]} {incr i 2} {
 308                         lappend hex [string range $marc $i [expr $i+1]]
 309                     }
 310                     # puts "ins_trie $hex $ucs"
 311                     ins_trie $hex $ucs $combining $codename
 312                     unset hex
 313                 }
 314             }
 315             set marc {}
 316             set uni {}
 317             set codename {}
 318             set combining 0
 319         } elseif {[regexp {<marc>([0-9A-Fa-f]*)</marc>} $line s marc]} {
 320             incr marc_lines
 321         } elseif {[regexp {<name>(.*)</name>} $line s codename]} {
 322             incr codename_lines
 323         } elseif {[regexp {<name>(.*)} $line s codename]} {
 324             incr codename_lines
 325             incr lineno
 326             set cnt [gets $f line]
 327             if {$cnt < 0} {
 328                 break
 329             }
 330             if {[regexp {(.*)</name>} $line s codename_ex]} {
 331                 set codename "${codename} ${codename_ex}"
 332             }
 333         } elseif {[regexp {<isCombining>true</isCombining>} $line s]} {
 334             set combining 1
 335         } elseif {[regexp {<ucs>([0-9A-Fa-f]*)</ucs>} $line s ucs]} {
 336             incr ucs_lines
 337         } elseif {[regexp {<utf-8>([0-9A-Fa-f]*)</utf-8>} $line s utf]} {
 338             incr utf_lines
 339         }
 340     }
 341     close $f
 342 }
 343
 344 set verbose 0
 345 set ifile {}
 346 set ofile out.c
 347 set prefix {c}
 348 set reverse_map 0
 349 # Parse command line
 350 set l [llength $argv]
 351 set i 0
 352 set omits {}
 353 while {$i < $l} {
 354     set arg [lindex $argv $i]
 355     switch -glob -- $arg {
 356         -v {
 357             incr verbose
 358         }
 359         -s {
 360             if {[string length $arg]} {
 361                 set arg [lindex $argv [incr i]]
 362             }
 363             set trie(split) $arg
 364         }
 365         -p {
 366             if {[string length $arg]} {
 367                 set arg [lindex $argv [incr i]]
 368             }
 369             set prefix $arg
 370         }
 371         -o {
 372             if {[string length $arg]} {
 373                 set arg [lindex $argv [incr i]]
 374             }
 375             set ofile $arg
 376         }
 377         -O {
 378             if {[string length $arg]} {
 379                 set arg [lindex $argv [incr i]]
 380             }
 381             lappend omits $arg
 382         }
 383         -r {
 384             set reverse_map 1
 385         }
 386         default {
 387             lappend ifiles $arg
 388         }
 389     }
 390     incr i
 391 }
 392 if {![info exists ifiles]} {
 393     puts "charconv.tcl: missing input file(s)"
 394     usage
 395 }
 396
 397 set ofilehandle [open $ofile w]
 398 preamble_trie $ofilehandle $ifiles $ofile
 399
 400 foreach ifile $ifiles {
 401     readfile $ifile $ofilehandle $prefix $omits $reverse_map
 402 }
 403 close $ofilehandle
 404
 405