src/charconv.tcl

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