2 # $Id: charconv.tcl,v 1.21 2008-01-06 13:02:48 adam Exp $
5 puts {charconv.tcl: [-p prefix] [-s split] [-o ofile] file ... }
9 proc preamble_trie {ofilehandle ifiles ofile} {
12 set totype {unsigned }
14 puts $f "/** \\file $ofile"
15 puts $f " \\brief Character conversion, generated from [lindex $ifiles 0]"
17 puts $f " Generated automatically by charconv.tcl"
19 puts $f "\#include <string.h>"
21 struct yaz_iconv_trie_flat {
23 unsigned combining : 1;
26 struct yaz_iconv_trie_dir {
28 unsigned combining : 1;
32 struct yaz_iconv_trie {
33 struct yaz_iconv_trie_flat *flat;
34 struct yaz_iconv_trie_dir *dir;
38 static unsigned long lookup(struct yaz_iconv_trie **ptrs, int ptr, unsigned char *inp,
39 size_t inbytesleft, size_t *no_read, int *combining, unsigned mask, int boffset)
41 struct yaz_iconv_trie *t = (ptr > 0) ? ptrs[ptr-1] : 0;
42 if (!t || inbytesleft < 1)
46 size_t ch = (inp[0] & mask) + boffset;
48 lookup(ptrs, t->dir[ch].ptr, inp+1, inbytesleft-1, no_read, combining, mask, boffset);
57 *combining = t->dir[ch].combining;
64 struct yaz_iconv_trie_flat *flat = t->flat;
67 size_t len = strlen(flat->from);
68 if (len <= inbytesleft)
71 for (i = 0; i < len; i++)
73 if (((unsigned char *) flat->from)[i] != (inp[i] & mask) + boffset)
79 *combining = flat->combining;
94 foreach x [array names trie] {
105 proc ins_trie {from to combining codename} {
107 if {![info exists trie(no)]} {
112 if {$trie(max) < $to} {
116 ins_trie_r [split $from] $to $combining $codename 0
119 proc split_trie {this} {
121 set trie($this,type) d
122 foreach e $trie($this,content) {
123 set from [lindex $e 0]
125 set combining [lindex $e 2]
126 set codename [lindex $e 3]
128 set ch [lindex $from 0]
129 set rest [lrange $from 1 end]
131 if {[llength $rest]} {
132 if {![info exist trie($this,ptr,$ch)]} {
133 set trie($this,ptr,$ch) $trie(no)
136 ins_trie_r $rest $to $combining $codename $trie($this,ptr,$ch)
138 set trie($this,to,$ch) $to
139 set trie($this,combining,$ch) $combining
140 set trie($this,codename,$ch) $codename
143 set trie($this,content) missing
146 proc ins_trie_r {from to combining codename this} {
149 if {![info exist trie($this,type)]} {
150 set trie($this,type) f
152 if {$trie($this,type) == "f"} {
154 if {[info exists trie($this,content)]} {
155 foreach e $trie($this,content) {
156 set efrom [lindex $e 0]
157 if { $efrom == $from } {
163 lappend trie($this,content) [list $from $to $combining $codename]
167 if {[llength $trie($this,content)] > $trie(split)} {
169 return [ins_trie_r $from $to $combining $codename $this]
172 set ch [lindex $from 0]
173 set rest [lrange $from 1 end]
175 if {[llength $rest]} {
176 if {![info exist trie($this,ptr,$ch)]} {
177 set trie($this,ptr,$ch) $trie(no)
180 ins_trie_r $rest $to $combining $codename $trie($this,ptr,$ch)
182 if {![info exist trie($this,to,$ch)]} {
183 set trie($this,to,$ch) $to
184 set trie($this,combining,$ch) $combining
185 set trie($this,codename,$ch) $codename
191 proc dump_trie {ofilehandle} {
196 puts $f "/* TRIE: size $trie(size) */"
199 while { [incr this -1] >= 0 } {
200 puts $f "/* PAGE $this */"
201 if {$trie($this,type) == "f"} {
202 puts $f "struct yaz_iconv_trie_flat $trie(prefix)page${this}_flat\[\] = \{"
203 foreach m $trie($this,content) {
204 puts -nonewline $f " \{\""
205 foreach d [lindex $m 0] {
206 puts -nonewline $f "\\x$d"
208 puts -nonewline $f "\", [lindex $m 2], 0x[lindex $m 1]"
210 puts $f "\}, /* $v */"
212 puts $f " \{\"\", 0\}"
214 puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
215 puts $f " $trie(prefix)page${this}_flat, 0"
218 puts $f "struct yaz_iconv_trie_dir $trie(prefix)page${this}_dir\[256\] = \{"
219 for {set i 0} {$i < 256} {incr i} {
220 puts -nonewline $f " \{"
221 set ch [format %02X $i]
223 if {[info exist trie($this,ptr,$ch)]} {
224 puts -nonewline $f "[expr $trie($this,ptr,$ch)+1], "
227 puts -nonewline $f "0, "
229 if {[info exist trie($this,combining,$ch)]} {
230 puts -nonewline $f "$trie($this,combining,$ch), "
232 puts -nonewline $f "0, "
234 if {[info exist trie($this,to,$ch)]} {
235 puts -nonewline $f "0x$trie($this,to,$ch)\}"
238 puts -nonewline $f "0\}"
240 if {[info exist trie($this,codename,$ch)]} {
241 set v $trie($this,codename,$ch)
242 puts -nonewline $f " /* $v */"
251 puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
252 puts $f " 0, $trie(prefix)page${this}_dir"
257 puts $f "struct yaz_iconv_trie *$trie(prefix)ptrs \[\] = {"
258 for {set this 0} {$this < $trie(no)} {incr this} {
259 puts $f " &$trie(prefix)page$this,"
264 puts $f "unsigned long yaz_$trie(prefix)_conv
265 (unsigned char *inp, size_t inbytesleft, size_t *no_read, int *combining, unsigned mask, int boffset)
269 code = lookup($trie(prefix)ptrs, 1, inp, inbytesleft, no_read, combining, mask, boffset);
279 proc readfile {fname ofilehandle prefix omits reverse} {
288 set f [open $fname r]
295 set cnt [gets $f line]
299 if {[regexp {</characterSet>} $line s]} {
300 dump_trie $ofilehandle
301 } elseif {[regexp {<characterSet .*ISOcode="([0-9A-Fa-f]+)"} $line s tablenumber]} {
303 set trie(prefix) "${prefix}_$tablenumber"
305 } elseif {[regexp {</code>} $line s]} {
306 if {[string length $ucs]} {
308 for {set i 0} {$i < [string length $utf]} {incr i 2} {
309 lappend hex [string range $utf $i [expr $i+1]]
311 # puts "ins_trie $hex $marc
312 ins_trie $hex $marc $combining $codename
316 for {set i 0} {$i < [string length $marc]} {incr i 2} {
317 lappend hex [string range $marc $i [expr $i+1]]
319 # puts "ins_trie $hex $ucs"
320 ins_trie $hex $ucs $combining $codename
324 if {$reverse && [string length $marc]} {
325 for {set i 0} {$i < [string length $altutf]} {incr i 2} {
326 lappend hex [string range $altutf $i [expr $i+1]]
328 if {[info exists hex]} {
329 ins_trie $hex $marc $combining $codename
338 } elseif {[regexp {<marc>([0-9A-Fa-f]*)</marc>} $line s marc]} {
340 } elseif {[regexp {<name>(.*)</name>} $line s codename]} {
342 } elseif {[regexp {<name>(.*)} $line s codename]} {
345 set cnt [gets $f line]
349 if {[regexp {(.*)</name>} $line s codename_ex]} {
350 set codename "${codename} ${codename_ex}"
352 } elseif {[regexp {<isCombining>true</isCombining>} $line s]} {
354 } elseif {[regexp {<ucs>([0-9A-Fa-f]*)</ucs>} $line s ucs]} {
356 } elseif {[regexp {<utf-8>([0-9A-Fa-f]*)</utf-8>} $line s utf]} {
358 } elseif {[regexp {<altutf-8>([0-9A-Fa-f]*)</altutf-8>} $line s altutf]} {
371 set l [llength $argv]
375 set arg [lindex $argv $i]
376 switch -glob -- $arg {
381 if {[string length $arg]} {
382 set arg [lindex $argv [incr i]]
387 if {[string length $arg]} {
388 set arg [lindex $argv [incr i]]
393 if {[string length $arg]} {
394 set arg [lindex $argv [incr i]]
399 if {[string length $arg]} {
400 set arg [lindex $argv [incr i]]
413 if {![info exists ifiles]} {
414 puts "charconv.tcl: missing input file(s)"
418 set ofilehandle [open $ofile w]
419 preamble_trie $ofilehandle $ifiles $ofile
421 foreach ifile $ifiles {
422 readfile $ifile $ofilehandle $prefix $omits $reverse_map