X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=src%2Fcharconv.tcl;h=fcc83fd4097cd51595d14672a4cffb6f2bbec7df;hb=719e0dcf2d15c08086a06457701e21c6aff3d791;hp=44a8d85cb8a6c894402d68145afc643756dfe65a;hpb=47acd69a8a66bd220b56900cc2bc495aaa284ffa;p=yaz-moved-to-github.git diff --git a/src/charconv.tcl b/src/charconv.tcl index 44a8d85..fcc83fd 100755 --- a/src/charconv.tcl +++ b/src/charconv.tcl @@ -2,13 +2,94 @@ # the next line restats using tclsh \ exec tclsh "$0" "$@" # -# $Id: charconv.tcl,v 1.2 2004-03-15 23:14:40 adam Exp $ +# $Id: charconv.tcl,v 1.6 2004-03-20 07:16:25 adam Exp $ proc usage {} { puts {charconv.tcl: [-p prefix] [-s split] [-o ofile] file ... } exit 1 } +proc preamble_trie {ofilehandle} { + set f $ofilehandle + + set totype {unsigned short} + + puts $f "\#include " + puts $f " + struct yaz_iconv_trie_flat { + char from\[6\]; + $totype to; + }; + struct yaz_iconv_trie_dir { + short ptr; + $totype to; + }; + + struct yaz_iconv_trie { + struct yaz_iconv_trie_flat *flat; + struct yaz_iconv_trie_dir *dir; + }; + " + puts $f { + static unsigned long lookup(struct yaz_iconv_trie **ptrs, int ptr, unsigned char *inp, + size_t inbytesleft, size_t *no_read) + { + struct yaz_iconv_trie *t = (ptr >= 0) ? ptrs[ptr] : 0; + if (!t || inbytesleft < 1) + return 0; + if (t->dir) + { + size_t ch = inp[0] & 0xff; + unsigned long code = + lookup(ptrs, t->dir[ch].ptr, inp+1, inbytesleft-1, no_read); + if (code) + { + (*no_read)++; + return code; + } + if (t->dir[ch].to) + { + code = t->dir[ch].to; + *no_read = 1; + return code; + } + } + else + { + struct yaz_iconv_trie_flat *flat = t->flat; + while (flat->to) + { + size_t len = strlen(flat->from); + if (len <= inbytesleft) + { + if (memcmp(flat->from, inp, len) == 0) + { + *no_read = len; + return flat->to; + } + } + flat++; + } + } + return 0; + } + } +} + +proc reset_trie {} { + global trie + + foreach x [array names trie] { + unset trie($x) + } + + set trie(no) 1 + set trie(size) 0 + set trie(max) 0 + set trie(split) 50 + set trie(prefix) {} +} + proc ins_trie {from to} { global trie if {![info exists trie(no)]} { @@ -76,34 +157,12 @@ proc ins_trie_r {from to this} { } } -proc dump_trie {ofile} { +proc dump_trie {ofilehandle} { global trie - set f [open $ofile w] - - if {[string length $trie(max)] > 4} { - set totype int - } else { - set totype {unsigned short} - } + set f $ofilehandle puts $f "/* TRIE: size $trie(size) */" - puts $f "\#include " - puts $f " - struct yaz_iconv_trie_flat { - char *from; - $totype to; - }; - struct yaz_iconv_trie_dir { - struct yaz_iconv_trie *ptr; - $totype to; - }; - - struct yaz_iconv_trie { - struct yaz_iconv_trie_flat *flat; - struct yaz_iconv_trie_dir *dir; - }; - " set this $trie(no) while { [incr this -1] >= 0 } { @@ -118,7 +177,7 @@ proc dump_trie {ofile} { puts -nonewline $f "\", 0x[lindex $m 1]" puts $f "\}," } - puts $f " \{0, 0\}" + puts $f " \{\"\", 0\}" puts $f "\};" puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{" puts $f " $trie(prefix)page${this}_flat, 0" @@ -130,10 +189,10 @@ proc dump_trie {ofile} { set ch [format %02X $i] set null 1 if {[info exist trie($this,ptr,$ch)]} { - puts -nonewline $f "&$trie(prefix)page$trie($this,ptr,$ch), " + puts -nonewline $f "$trie($this,ptr,$ch), " set null 0 } else { - puts -nonewline $f "0, " + puts -nonewline $f "-1, " } if {[info exist trie($this,to,$ch)]} { puts -nonewline $f "0x$trie($this,to,$ch)\}" @@ -156,56 +215,20 @@ proc dump_trie {ofile} { puts $f "\};" } } - puts $f { - static unsigned long lookup(struct yaz_iconv_trie *t, unsigned char *inp, - size_t inbytesleft, size_t *no_read) - { - if (!t || inbytesleft < 1) - return 0; - if (t->dir) - { - size_t ch = inp[0] & 0xff; - unsigned long code = - lookup(t->dir[ch].ptr, inp+1, inbytesleft-1, no_read); - if (code) - { - (*no_read)++; - return code; - } - if (t->dir[ch].to) - { - code = t->dir[ch].to; - *no_read = 1; - return code; - } - } - else - { - struct yaz_iconv_trie_flat *flat = t->flat; - while (flat->from) - { - size_t len = strlen(flat->from); - if (len <= inbytesleft) - { - if (memcmp(flat->from, inp, len) == 0) - { - *no_read = len; - return flat->to; - } - } - flat++; - } - } - return 0; - } - + + puts $f "struct yaz_iconv_trie *$trie(prefix)ptrs \[\] = {" + for {set this 0} {$this < $trie(no)} {incr this} { + puts $f " &$trie(prefix)page$this," } + puts $f "0, };" + puts $f "" + puts $f "unsigned long yaz_$trie(prefix)_conv (unsigned char *inp, size_t inbytesleft, size_t *no_read) { unsigned long code; - code = lookup(&$trie(prefix)page0, inp, inbytesleft, no_read); + code = lookup($trie(prefix)ptrs, 0, inp, inbytesleft, no_read); if (!code) { *no_read = 1; @@ -214,25 +237,53 @@ proc dump_trie {ofile} { return code; } " - close $f } -proc readfile {fname} { +proc readfile {fname ofilehandle prefix omits} { + global trie + + set marc_lines 0 + set ucs_lines 0 set lineno 0 set f [open $fname r] + set tablenumber x while {1} { incr lineno set cnt [gets $f line] if {$cnt < 0} { break } - set hex {} - set uni {} - regexp {([0-9A-Z]*)} $line s hex uni - # puts "$lineno hex=$hex uni=$uni $line" - if {[string length $uni]} { - ins_trie $hex $uni - } + if {[regexp {} $line s]} { + reset_trie + set trie(prefix) "${prefix}" + } elseif {[regexp {} $line s]} { + dump_trie $ofilehandle + } elseif {[regexp {([0-9A-Fa-f]*)} $line s hex ucs]} { + ins_trie $hex $ucs + unset hex + } elseif {[regexp {} $line s]} { + if {[lsearch $omits $tablenumber] == -1} { + dump_trie $ofilehandle + } + } elseif {[regexp {} $line s]} { + if {[string length $ucs]} { + for {set i 0} {$i < [string length $marc]} {incr i 2} { + lappend hex [string range $marc $i [expr $i+1]] + } + # puts "ins_trie $hex $ucs" + ins_trie $hex $ucs + unset hex + } + set marc {} + set uni {} + } elseif {[regexp {([0-9A-Fa-f]*)} $line s marc]} { + incr marc_lines + } elseif {[regexp {([0-9A-Fa-f]*)} $line s ucs]} { + incr ucs_lines + } } close $f } @@ -240,11 +291,11 @@ proc readfile {fname} { set verbose 0 set ifile {} set ofile out.c -set trie(split) 40 -set trie(prefix) {} +set prefix {c} # Parse command line set l [llength $argv] set i 0 +set omits {} while {$i < $l} { set arg [lindex $argv $i] switch -glob -- $arg { @@ -261,14 +312,20 @@ while {$i < $l} { if {[string length $arg]} { set arg [lindex $argv [incr i]] } - set trie(prefix) $arg + set prefix $arg } -o { if {[string length $arg]} { set arg [lindex $argv [incr i]] } set ofile $arg - } + } + -O { + if {[string length $arg]} { + set arg [lindex $argv [incr i]] + } + lappend omits $arg + } default { lappend ifiles $arg } @@ -279,8 +336,13 @@ if {![info exists ifiles]} { puts "charconv.tcl: missing input file(s)" usage } + +set ofilehandle [open $ofile w] +preamble_trie $ofilehandle + foreach ifile $ifiles { - readfile $ifile + readfile $ifile $ofilehandle $prefix $omits } +close $ofilehandle + -dump_trie $ofile