4 puts {charconv.tcl: [-p prefix] [-s split] [-o ofile] file ... }
8 proc preamble_trie {ofilehandle ifiles ofile} {
11 set totype {unsigned }
13 puts $f "/** \\file $ofile"
14 puts $f " \\brief Character conversion, generated from [lindex $ifiles 0]"
16 puts $f " Generated automatically by charconv.tcl"
18 puts $f "\#include <string.h>"
20 struct yaz_iconv_trie_flat {
22 unsigned combining : 1;
25 struct yaz_iconv_trie_dir {
27 unsigned combining : 1;
31 struct yaz_iconv_trie {
32 struct yaz_iconv_trie_flat *flat;
33 struct yaz_iconv_trie_dir *dir;
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)
40 struct yaz_iconv_trie *t = (ptr > 0) ? ptrs[ptr-1] : 0;
41 if (!t || inbytesleft < 1)
45 size_t ch = (inp[0] & mask) + boffset;
47 lookup(ptrs, t->dir[ch].ptr, inp+1, inbytesleft-1, no_read, combining, mask, boffset);
56 *combining = t->dir[ch].combining;
63 struct yaz_iconv_trie_flat *flat = t->flat;
66 size_t len = strlen(flat->from);
67 if (len <= inbytesleft)
70 for (i = 0; i < len; i++)
72 if (((unsigned char *) flat->from)[i] != (inp[i] & mask) + boffset)
78 *combining = flat->combining;
93 foreach x [array names trie] {
104 proc ins_trie {from to combining codename} {
106 if {![info exists trie(no)]} {
111 if {$trie(max) < $to} {
115 ins_trie_r [split $from] $to $combining $codename 0
118 proc split_trie {this} {
120 set trie($this,type) d
121 foreach e $trie($this,content) {
122 set from [lindex $e 0]
124 set combining [lindex $e 2]
125 set codename [lindex $e 3]
127 set ch [lindex $from 0]
128 set rest [lrange $from 1 end]
130 if {[llength $rest]} {
131 if {![info exist trie($this,ptr,$ch)]} {
132 set trie($this,ptr,$ch) $trie(no)
135 ins_trie_r $rest $to $combining $codename $trie($this,ptr,$ch)
137 set trie($this,to,$ch) $to
138 set trie($this,combining,$ch) $combining
139 set trie($this,codename,$ch) $codename
142 set trie($this,content) missing
145 proc ins_trie_r {from to combining codename this} {
148 if {![info exist trie($this,type)]} {
149 set trie($this,type) f
151 if {$trie($this,type) == "f"} {
153 if {[info exists trie($this,content)]} {
154 foreach e $trie($this,content) {
155 set efrom [lindex $e 0]
156 if { $efrom == $from } {
162 lappend trie($this,content) [list $from $to $combining $codename]
166 if {[llength $trie($this,content)] > $trie(split)} {
168 return [ins_trie_r $from $to $combining $codename $this]
171 set ch [lindex $from 0]
172 set rest [lrange $from 1 end]
174 if {[llength $rest]} {
175 if {![info exist trie($this,ptr,$ch)]} {
176 set trie($this,ptr,$ch) $trie(no)
179 ins_trie_r $rest $to $combining $codename $trie($this,ptr,$ch)
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
190 proc dump_trie {ofilehandle} {
195 puts $f "/* TRIE: size $trie(size) */"
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"
207 puts -nonewline $f "\", [lindex $m 2], 0x[lindex $m 1]"
209 puts $f "\}, /* $v */"
211 puts $f " \{\"\", 0\}"
213 puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
214 puts $f " $trie(prefix)page${this}_flat, 0"
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]
222 if {[info exist trie($this,ptr,$ch)]} {
223 puts -nonewline $f "[expr $trie($this,ptr,$ch)+1], "
226 puts -nonewline $f "0, "
228 if {[info exist trie($this,combining,$ch)]} {
229 puts -nonewline $f "$trie($this,combining,$ch), "
231 puts -nonewline $f "0, "
233 if {[info exist trie($this,to,$ch)]} {
234 puts -nonewline $f "0x$trie($this,to,$ch)\}"
237 puts -nonewline $f "0\}"
239 if {[info exist trie($this,codename,$ch)]} {
240 set v $trie($this,codename,$ch)
241 puts -nonewline $f " /* $v */"
250 puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
251 puts $f " 0, $trie(prefix)page${this}_dir"
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,"
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)
268 code = lookup($trie(prefix)ptrs, 1, inp, inbytesleft, no_read, combining, mask, boffset);
278 proc readfile {fname ofilehandle prefix omits reverse} {
287 set f [open $fname r]
294 set cnt [gets $f line]
298 if {[regexp {</characterSet>} $line s]} {
299 dump_trie $ofilehandle
300 } elseif {[regexp {<characterSet .*ISOcode="([0-9A-Fa-f]+)"} $line s tablenumber]} {
302 set trie(prefix) "${prefix}_$tablenumber"
304 } elseif {[regexp {</code>} $line s]} {
305 if {[string length $ucs]} {
307 for {set i 0} {$i < [string length $utf]} {incr i 2} {
308 lappend hex [string range $utf $i [expr $i+1]]
310 # puts "ins_trie $hex $marc
311 ins_trie $hex $marc $combining $codename
315 for {set i 0} {$i < [string length $marc]} {incr i 2} {
316 lappend hex [string range $marc $i [expr $i+1]]
318 # puts "ins_trie $hex $ucs"
319 ins_trie $hex $ucs $combining $codename
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]]
327 if {[info exists hex]} {
328 ins_trie $hex $marc $combining $codename
337 } elseif {[regexp {<marc>([0-9A-Fa-f]*)</marc>} $line s marc]} {
339 } elseif {[regexp {<name>(.*)</name>} $line s codename]} {
341 } elseif {[regexp {<name>(.*)} $line s codename]} {
344 set cnt [gets $f line]
348 if {[regexp {(.*)</name>} $line s codename_ex]} {
349 set codename "${codename} ${codename_ex}"
351 } elseif {[regexp {<isCombining>true</isCombining>} $line s]} {
353 } elseif {[regexp {<ucs>([0-9A-Fa-f]*)</ucs>} $line s ucs]} {
355 } elseif {[regexp {<utf-8>([0-9A-Fa-f]*)</utf-8>} $line s utf]} {
357 } elseif {[regexp {<altutf-8>([0-9A-Fa-f]*)</altutf-8>} $line s altutf]} {
370 set l [llength $argv]
374 set arg [lindex $argv $i]
375 switch -glob -- $arg {
380 if {[string length $arg]} {
381 set arg [lindex $argv [incr i]]
386 if {[string length $arg]} {
387 set arg [lindex $argv [incr i]]
392 if {[string length $arg]} {
393 set arg [lindex $argv [incr i]]
398 if {[string length $arg]} {
399 set arg [lindex $argv [incr i]]
412 if {![info exists ifiles]} {
413 puts "charconv.tcl: missing input file(s)"
417 set ofilehandle [open $ofile w]
418 preamble_trie $ofilehandle $ifiles $ofile
420 foreach ifile $ifiles {
421 readfile $ifile $ofilehandle $prefix $omits $reverse_map