src/charconv.tcl

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