2 # the next line restats using tclsh \
5 # $Id: charconv.tcl,v 1.1 2003-10-27 12:21:30 adam Exp $
8 puts {charconv.tcl: [-p prefix] [-s split] [-o ofile] file ... }
12 proc ins_trie {from to} {
14 if {![info exists trie(no)]} {
19 ins_trie_r [split $from] $to 0
22 proc split_trie {this} {
24 set trie($this,type) d
25 foreach e $trie($this,content) {
26 set from [lindex $e 0]
29 set ch [lindex $from 0]
30 set rest [lrange $from 1 end]
32 if {[llength $rest]} {
33 if {![info exist trie($this,ptr,$ch)]} {
34 set trie($this,ptr,$ch) $trie(no)
37 ins_trie_r $rest $to $trie($this,ptr,$ch)
39 set trie($this,to,$ch) $to
42 set trie($this,content) missing
45 proc ins_trie_r {from to this} {
48 if {![info exist trie($this,type)]} {
49 set trie($this,type) f
51 if {$trie($this,type) == "f"} {
52 lappend trie($this,content) [list $from $to]
55 if {[llength $trie($this,content)] > $trie(split)} {
57 return [ins_trie_r $from $to $this]
60 set ch [lindex $from 0]
61 set rest [lrange $from 1 end]
63 if {[llength $rest]} {
64 if {![info exist trie($this,ptr,$ch)]} {
65 set trie($this,ptr,$ch) $trie(no)
68 ins_trie_r $rest $to $trie($this,ptr,$ch)
70 set trie($this,to,$ch) $to
75 proc dump_trie {ofile} {
80 puts $f "/* TRIE: size $trie(size) */"
81 puts $f "\#include <string.h>"
83 struct yaz_iconv_trie_flat {
87 struct yaz_iconv_trie_dir {
88 struct yaz_iconv_trie *ptr;
92 struct yaz_iconv_trie {
93 struct yaz_iconv_trie_flat *flat;
94 struct yaz_iconv_trie_dir *dir;
99 while { [incr this -1] >= 0 } {
100 puts $f "/* PAGE $this */"
101 if {$trie($this,type) == "f"} {
102 puts $f "struct yaz_iconv_trie_flat $trie(prefix)page${this}_flat\[\] = \{"
103 foreach m $trie($this,content) {
104 puts -nonewline $f " \{\""
105 foreach d [lindex $m 0] {
106 puts -nonewline $f "\\x$d"
108 puts -nonewline $f "\", 0x[lindex $m 1]"
113 puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
114 puts $f " $trie(prefix)page${this}_flat, 0"
117 puts $f "struct yaz_iconv_trie_dir $trie(prefix)page${this}_dir\[256\] = \{"
118 for {set i 0} {$i < 256} {incr i} {
119 puts -nonewline $f " \{"
120 set ch [format %02X $i]
122 if {[info exist trie($this,ptr,$ch)]} {
123 puts -nonewline $f "&$trie(prefix)page$trie($this,ptr,$ch), "
126 puts -nonewline $f "0, "
128 if {[info exist trie($this,to,$ch)]} {
129 puts -nonewline $f "0x$trie($this,to,$ch)\}"
132 puts -nonewline $f "0\}"
135 puts -nonewline $f " /* $ch */"
144 puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
145 puts $f " 0, $trie(prefix)page${this}_dir"
150 static unsigned long lookup(struct yaz_iconv_trie *t, unsigned char *inp,
151 size_t inbytesleft, size_t *no_read)
153 if (!t || inbytesleft < 1)
157 size_t ch = inp[0] & 0xff;
159 lookup(t->dir[ch].ptr, inp+1, inbytesleft-1, no_read);
167 code = t->dir[ch].to;
174 struct yaz_iconv_trie_flat *flat = t->flat;
177 size_t len = strlen(flat->from);
178 if (len <= inbytesleft)
180 if (memcmp(flat->from, inp, len) == 0)
193 puts $f "unsigned long yaz_$trie(prefix)_conv
194 (unsigned char *inp, size_t inbytesleft, size_t *no_read)
198 code = lookup(&$trie(prefix)page0, inp, inbytesleft, no_read);
210 proc readfile {fname} {
212 set f [open $fname r]
215 set cnt [gets $f line]
221 regexp {<character hex="([^\"]*)".*<unientity>([0-9A-Z]*)</unientity>} $line s hex uni
222 # puts "$lineno hex=$hex uni=$uni $line"
223 if {[string length $uni]} {
236 set l [llength $argv]
239 set arg [lindex $argv $i]
240 switch -glob -- $arg {
245 if {[string length $arg]} {
246 set arg [lindex $argv [incr i]]
251 if {[string length $arg]} {
252 set arg [lindex $argv [incr i]]
254 set trie(prefix) $arg
257 if {[string length $arg]} {
258 set arg [lindex $argv [incr i]]
268 if {![info exists ifiles]} {
269 puts "charconv.tcl: missing input file(s)"
272 foreach ifile $ifiles {