src/charconv.tcl

   1 #!/bin/sh
   2 # the next line restats using tclsh \
   3 exec tclsh "$0" "$@"
   4 #
   5 # $Id: charconv.tcl,v 1.2 2004-03-15 23:14:40 adam Exp $
   6
   7 proc usage {} {
   8     puts {charconv.tcl: [-p prefix] [-s split] [-o ofile] file ... }
   9     exit 1
  10 }
  11
  12 proc ins_trie {from to} {
  13     global trie
  14     if {![info exists trie(no)]} {
  15         set trie(no) 1
  16         set trie(size) 0
  17         set trie(max) 0
  18     }
  19     if {$trie(max) < $to} {
  20         set trie(max) $to
  21     }
  22     incr trie(size)
  23     ins_trie_r [split $from] $to 0
  24 }
  25
  26 proc split_trie {this} {
  27     global trie
  28     set trie($this,type) d
  29     foreach e $trie($this,content) {
  30         set from [lindex $e 0]
  31         set to [lindex $e 1]
  32
  33         set ch [lindex $from 0]
  34         set rest [lrange $from 1 end]
  35
  36         if {[llength $rest]} {
  37             if {![info exist trie($this,ptr,$ch)]} {
  38                 set trie($this,ptr,$ch) $trie(no)
  39                 incr trie(no)
  40             }
  41             ins_trie_r $rest $to $trie($this,ptr,$ch)
  42         } else {
  43             set trie($this,to,$ch) $to
  44         }
  45     }
  46     set trie($this,content) missing
  47 }
  48
  49 proc ins_trie_r {from to this} {
  50     global trie
  51
  52     if {![info exist trie($this,type)]} {
  53         set trie($this,type) f
  54     }
  55     if {$trie($this,type) == "f"} {
  56         lappend trie($this,content) [list $from $to]
  57
  58         # split ?
  59         if {[llength $trie($this,content)] > $trie(split)} {
  60             split_trie $this
  61             return [ins_trie_r $from $to $this]
  62         }
  63     } else {
  64         set ch [lindex $from 0]
  65         set rest [lrange $from 1 end]
  66
  67         if {[llength $rest]} {
  68             if {![info exist trie($this,ptr,$ch)]} {
  69                 set trie($this,ptr,$ch) $trie(no)
  70                 incr trie(no)
  71             }
  72             ins_trie_r $rest $to $trie($this,ptr,$ch)
  73         } else {
  74             set trie($this,to,$ch) $to
  75         }
  76     }
  77 }
  78
  79 proc dump_trie {ofile} {
  80     global trie
  81
  82     set f [open $ofile w]
  83
  84     if {[string length $trie(max)] > 4} {
  85         set totype int
  86     } else {
  87         set totype {unsigned short}
  88     }
  89
  90     puts $f "/* TRIE: size $trie(size) */"
  91     puts $f "\#include <string.h>"
  92     puts $f "
  93         struct yaz_iconv_trie_flat {
  94             char *from;
  95             $totype to;
  96         };
  97         struct yaz_iconv_trie_dir {
  98             struct yaz_iconv_trie *ptr;
  99             $totype to;
 100         };
 101
 102         struct yaz_iconv_trie {
 103             struct yaz_iconv_trie_flat *flat;
 104             struct yaz_iconv_trie_dir *dir;
 105         };
 106     "
 107
 108     set this $trie(no)
 109     while { [incr this -1] >= 0 } {
 110         puts $f "/* PAGE $this */"
 111         if {$trie($this,type) == "f"} {
 112             puts $f "struct yaz_iconv_trie_flat $trie(prefix)page${this}_flat\[\] = \{"
 113             foreach m $trie($this,content) {
 114                 puts -nonewline $f "  \{\""
 115                 foreach d [lindex $m 0] {
 116                     puts -nonewline $f "\\x$d"
 117                 }
 118                 puts -nonewline $f "\", 0x[lindex $m 1]"
 119                 puts $f "\},"
 120             }
 121             puts $f "  \{0, 0\}"
 122             puts $f "\};"
 123             puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
 124             puts $f "  $trie(prefix)page${this}_flat, 0"
 125             puts $f "\};"
 126         } else {
 127             puts $f "struct yaz_iconv_trie_dir $trie(prefix)page${this}_dir\[256\] = \{"
 128             for {set i 0} {$i < 256} {incr i} {
 129                 puts -nonewline $f "  \{"
 130                 set ch [format %02X $i]
 131                 set null 1
 132                 if {[info exist trie($this,ptr,$ch)]} {
 133                     puts -nonewline $f "&$trie(prefix)page$trie($this,ptr,$ch), "
 134                     set null 0
 135                 } else {
 136                     puts -nonewline $f "0, "
 137                 }
 138                 if {[info exist trie($this,to,$ch)]} {
 139                     puts -nonewline $f "0x$trie($this,to,$ch)\}"
 140                     set null 0
 141                 } else {
 142                     puts -nonewline $f "0\}"
 143                 }
 144                 if {!$null} {
 145                     puts -nonewline $f " /* $ch */"
 146                 }
 147                 if {$i < 255} {
 148                     puts $f ","
 149                 } else {
 150                     puts $f ""
 151                 }
 152             }
 153             puts $f "\};"
 154             puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
 155             puts $f "  0, $trie(prefix)page${this}_dir"
 156             puts $f "\};"
 157         }
 158     }
 159     puts $f {
 160         static unsigned long lookup(struct yaz_iconv_trie *t, unsigned char *inp,
 161                                     size_t inbytesleft, size_t *no_read)
 162         {
 163             if (!t || inbytesleft < 1)
 164             return 0;
 165             if (t->dir)
 166             {
 167                 size_t ch = inp[0] & 0xff;
 168                 unsigned long code =
 169                 lookup(t->dir[ch].ptr, inp+1, inbytesleft-1, no_read);
 170                 if (code)
 171                 {
 172                     (*no_read)++;
 173                     return code;
 174                 }
 175                 if (t->dir[ch].to)
 176                 {
 177                     code = t->dir[ch].to;
 178                     *no_read = 1;
 179                     return code;
 180                 }
 181             }
 182             else
 183             {
 184                 struct yaz_iconv_trie_flat *flat = t->flat;
 185                 while (flat->from)
 186                 {
 187                     size_t len = strlen(flat->from);
 188                     if (len <= inbytesleft)
 189                     {
 190                         if (memcmp(flat->from, inp, len) == 0)
 191                         {
 192                             *no_read = len;
 193                             return flat->to;
 194                         }
 195                     }
 196                     flat++;
 197                 }
 198             }
 199             return 0;
 200         }
 201
 202     }
 203     puts $f "unsigned long yaz_$trie(prefix)_conv
 204             (unsigned char *inp, size_t inbytesleft, size_t *no_read)
 205         {
 206             unsigned long code;
 207
 208             code = lookup(&$trie(prefix)page0, inp, inbytesleft, no_read);
 209             if (!code)
 210             {
 211                 *no_read = 1;
 212                 code = *inp;
 213             }
 214             return code;
 215         }
 216     "
 217     close $f
 218 }
 219
 220 proc readfile {fname} {
 221     set lineno 0
 222     set f [open $fname r]
 223     while {1} {
 224         incr lineno
 225         set cnt [gets $f line]
 226         if {$cnt < 0} {
 227             break
 228         }
 229         set hex {}
 230         set uni {}
 231         regexp {<character hex="([^\"]*)".*<unientity>([0-9A-Z]*)</unientity>} $line s hex uni
 232         # puts "$lineno hex=$hex uni=$uni $line"
 233         if {[string length $uni]} {
 234             ins_trie $hex $uni
 235         }
 236     }
 237     close $f
 238 }
 239
 240 set verbose 0
 241 set ifile {}
 242 set ofile out.c
 243 set trie(split) 40
 244 set trie(prefix) {}
 245 # Parse command line
 246 set l [llength $argv]
 247 set i 0
 248 while {$i < $l} {
 249     set arg [lindex $argv $i]
 250     switch -glob -- $arg {
 251         -v {
 252             incr verbose
 253         }
 254         -s {
 255             if {[string length $arg]} {
 256                 set arg [lindex $argv [incr i]]
 257             }
 258             set trie(split) $arg
 259         }
 260         -p {
 261             if {[string length $arg]} {
 262                 set arg [lindex $argv [incr i]]
 263             }
 264             set trie(prefix) $arg
 265         }
 266         -o {
 267             if {[string length $arg]} {
 268                 set arg [lindex $argv [incr i]]
 269             }
 270             set ofile $arg
 271         }
 272         default {
 273             lappend ifiles $arg
 274         }
 275     }
 276     incr i
 277 }
 278 if {![info exists ifiles]} {
 279     puts "charconv.tcl: missing input file(s)"
 280     usage
 281 }
 282 foreach ifile $ifiles {
 283     readfile $ifile
 284 }
 285
 286 dump_trie $ofile