critlib/0000755000076500001200000000000010573223524012401 5ustar jcwadmin00000000000000critlib/adjust0000755000076500001200000000341107645252356013633 0ustar jcwadmin00000000000000#!/usr/bin/env tclsh # Adjusts the index.html and pkgIndex.tcl files in this directory, # also creates a tar/gzip file of everything for easy downloading. set myname [file tail [pwd]] set tar $myname.tar.gz file delete $tar set size [exec tar cf - . | gzip | wc -c] ;# "tar cfz" gave wrong size set fd [open preamble.html] regexp "^(.*)\n%\n(.*)$" [read $fd] - prefix suffix close $fd #pkg_mkIndex . set ifd [open index.html w] puts $ifd $prefix puts $ifd "" set last 0 set pfd [open pkgIndex.tcl] while {[gets $pfd line] >= 0} { if {![regexp {package ifneeded (\w+) (\d+)\.(\S+) .* (\S+\.tcl)} $line - \ name major minor file]} continue if {![file exists $name.README]} continue set ver $major.$minor set secs [file mtime $file] set time [clock format $secs -format {%h %e, %Y}] set link $name if {[file exists $name.README]} { set link "$link" } set fd [open $file] set desc [gets $fd] close $fd regsub {\s*#\s+} $desc {} desc set cols [list "$link" $ver "  $desc  " "$time"] puts $ifd "" if {$last < $secs} { set last $secs } } close $pfd set updated [clock format $last -format {%Y/%m/%d}] puts $ifd "
Contents of $tar ([expr {($size+1023)>>10}] Kb):
[join $cols {}]
Last updated on $updated
" puts $ifd $suffix close $ifd # run the tests to check things are ok and save results #eval exec [info nameofexe] pkgtest >testout.txt #puts [exec tail -1 testout.txt] # create tar with dirname in it, then move the package inside it cd .. exec tar cfz $tar $myname exec mv $tar $myname critlib/ascenc.README0000644000076500001200000000143310573223116014512 0ustar jcwadmin00000000000000Basic ASCII encoding and decoding ================================= Rev 0.12: Changed bytelength to length (thx Steve R) Rev 0.11: Slightly simplified calling sequence, based on CriTcl 0.30 Rev 0.10: Initial release Implementation of base64 encoding and decoding. Low-level commands are: set text [ascenc::b2a_64 bytes] convert string to base64 (input size must be multiple of 3) set bytes [ascenc::a2b_64 text] convert base64 to string (input size must be multiple of 4) Built on top, the following commands deal with "full" base64 conversion: set text [ascenc::b64encode bytes] convert binary string to base64, in lines of 64 chars set bytes [ascenc::b64decode text] convert base64 to binary string, ignoring newlines and padding critlib/ascenc.tcl0000644000076500001200000000637710573223126014354 0ustar jcwadmin00000000000000# Simple ASCII <-> binary encodings (base64 for now) package provide ascenc 0.12 package require critcl 0.30 namespace eval ascenc { namespace export b64encode b64decode critcl::ccode { static char e64[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; static char d64[] = { -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 62, -1, -1, -1, 63, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, -1, 0, -1, -1, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, -1, -1, -1, -1, -1, -1, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, -1, -1, -1, -1, -1, }; } critcl::cproc b2a_64 {Tcl_Interp* ip Tcl_Obj* str} ok { int n; long v; unsigned char *s, *t; s = Tcl_GetByteArrayFromObj(str, &n); if (n % 3) { Tcl_SetResult(ip, "data size must be multiple of 3", TCL_STATIC); return TCL_ERROR; } t = Tcl_SetByteArrayLength(Tcl_GetObjResult(ip), (n/3)*4); while (n > 0) { v = (s[0] << 16) | (s[1] << 8) | s[2]; *t++ = e64[(v>>18)&0x3F]; *t++ = e64[(v>>12)&0x3F]; *t++ = e64[(v>>6)&0x3F]; *t++ = e64[v&0x3F]; s += 3; n -= 3; } return TCL_OK; } critcl::cproc a2b_64 {Tcl_Interp* ip Tcl_Obj* str} ok { int n; long v; unsigned char *s, *t; s = Tcl_GetByteArrayFromObj(str, &n); if (n % 4) { Tcl_SetResult(ip, "data size must be multiple of 4", TCL_STATIC); return TCL_ERROR; } t = Tcl_SetByteArrayLength(Tcl_GetObjResult(ip), (n/4)*3); while (n > 0) { v = d64[s[0]&0x7F] << 18; v |= d64[s[1]&0x7F] << 12; v |= d64[s[2]&0x7F] << 6; v |= d64[s[3]&0x7F]; *t++ = (unsigned char) (v >> 16); *t++ = (unsigned char) (v >> 8); *t++ = (unsigned char) v; s += 4; n -= 4; } return TCL_OK; } proc b64encode {bytes} { set r "" for {set off 0} {[binary scan $bytes @${off}a45 seg]} {incr off 45} { append r [b2a_64 $seg] \n } set n [expr {[string length $bytes] - $off}] if {$n > 0} { binary scan $bytes @${off}a$n seg append seg [binary format a[expr {2-($n+2)%3}] {}] set tail [string range [b2a_64 $seg] 0 [expr {($n*4)/3}]] # is padding with one or two equal signs optional? while {[string length $tail] % 4} { append tail = } append r $tail \n } return $r } proc b64decode {text} { regsub -all {[^A-Za-z0-9+/]} $text {} text set n [string length $text] append text [string repeat = [expr {3-($n+3)%4}]] binary scan [a2b_64 $text] a[expr {($n*3)/4}] text return $text } if {[info exists pkgtest] && $pkgtest} { puts "123456789 = [b2a_64 123456789] = [a2b_64 [b2a_64 123456789]]" foreach x {"" 1 12 123 1234 12345 0 00 000 0000 00000 "this is a test!"} { puts "$x -> [string trim [b64encode $x]] -> [b64decode [b64encode $x]]" } set x 012345678901234567890123456789012345678901234567890123456789 puts -nonewline [b64encode $x] puts [b64decode [b64encode $x]] } } critlib/blowfish.README0000644000076500001200000000121307627170537015105 0ustar jcwadmin00000000000000Wrapper for the Blowfish encryption algorithm ============================================= Rev 0.11: Fixes Feb 2003, by Uwe Koloska Rev 0.10: Initial release This package defines a "blowfish" command which can be called in 2 ways: set coded [blowfish encode plain key] # encrypt data with key set plain [blowfish decode coded key] # decrypt data with key Data is treated as binary, meaning that all input and output is going to be converted and treated as byte arrays in Tcl. An idea: if you need solid encryption in your own application, store the key in C, and have CriTcl compile it - this makes it harder to extract. critlib/blowfish.tcl0000644000076500001200000000263007627170502014726 0ustar jcwadmin00000000000000# Wrapper for Eric Young's implementation of Blowfish encryption package provide blowfish 0.11 package require critcl critcl::cheaders blowfish_c/*.h critcl::csources blowfish_c/*.c critcl::ccode { #include "blowfish.h" } critcl::ccommand blowfish {dummy ip objc objv} { int index, dlen, klen, count = 0; unsigned char *data, *key; Tcl_Obj *obj; BF_KEY kbuf; unsigned char ivec[] = {0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10}; static char* cmds[] = { "encode", "decode", NULL }; if (objc != 4) { Tcl_WrongNumArgs(ip, 1, objv, "mode data key"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(ip, objv[1], cmds, "option", 0, &index) != TCL_OK) return TCL_ERROR; obj = objv[2]; if (Tcl_IsShared(obj)) obj = Tcl_DuplicateObj(obj); data = Tcl_GetByteArrayFromObj(obj, &dlen); key = Tcl_GetByteArrayFromObj(objv[3], &klen); BF_set_key(&kbuf, klen, key); BF_cfb64_encrypt(data, data, dlen, &kbuf, ivec, &count, index == 0 ? BF_ENCRYPT : BF_DECRYPT); Tcl_InvalidateStringRep(obj); Tcl_SetObjResult(ip, obj); return TCL_OK; } if {[info exists pkgtest] && $pkgtest} { proc blowfish_try {} { set plain "Hello world!" puts "plain = $plain" set key "this is a secret" set coded [blowfish::blowfish encode $plain $key] binary scan $coded H* secret puts "coded = $secret" puts "clear = [blowfish::blowfish decode $coded $key]" } blowfish_try } critlib/blowfish_c/0000755000076500001200000000000007215174267014530 5ustar jcwadmin00000000000000critlib/blowfish_c/bf_cfb64.c0000644000076500001200000001063407215174250016243 0ustar jcwadmin00000000000000/* crypto/bf/bf_cfb64.c */ /* Copyright (C) 1995-1997 Eric Young (eay@mincom.oz.au) * All rights reserved. * * This package is an SSL implementation written * by Eric Young (eay@mincom.oz.au). * The implementation was written so as to conform with Netscapes SSL. * * This library is free for commercial and non-commercial use as long as * the following conditions are aheared to. The following conditions * apply to all code found in this distribution, be it the RC4, RSA, * lhash, DES, etc., code; not just the SSL code. The SSL documentation * included with this distribution is covered by the same copyright terms * except that the holder is Tim Hudson (tjh@mincom.oz.au). * * Copyright remains Eric Young's, and as such any Copyright notices in * the code are not to be removed. * If this package is used in a product, Eric Young should be given attribution * as the author of the parts of the library used. * This can be in the form of a textual message at program startup or * in documentation (online or textual) provided with the package. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * "This product includes cryptographic software written by * Eric Young (eay@mincom.oz.au)" * The word 'cryptographic' can be left out if the rouines from the library * being used are not cryptographic related :-). * 4. If you include any Windows specific code (or a derivative thereof) from * the apps directory (application code) you must include an acknowledgement: * "This product includes software written by Tim Hudson (tjh@mincom.oz.au)" * * THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * The licence and distribution terms for any publically available version or * derivative of this code cannot be changed. i.e. this code cannot simply be * copied and put under another distribution licence * [including the GNU Public Licence.] */ #include "blowfish.h" #include "bf_locl.h" /* The input and output encrypted as though 64bit cfb mode is being * used. The extra state information to record how much of the * 64bit block we have used is contained in *num; */ void BF_cfb64_encrypt(in, out, length, schedule, ivec, num, encrypt) unsigned char *in; unsigned char *out; long length; BF_KEY *schedule; unsigned char *ivec; int *num; int encrypt; { register BF_LONG v0,v1,t; register int n= *num; register long l=length; BF_LONG ti[2]; unsigned char *iv,c,cc; iv=(unsigned char *)ivec; if (encrypt) { while (l--) { if (n == 0) { n2l(iv,v0); ti[0]=v0; n2l(iv,v1); ti[1]=v1; BF_encrypt((unsigned long *)ti,schedule,BF_ENCRYPT); iv=(unsigned char *)ivec; t=ti[0]; l2n(t,iv); t=ti[1]; l2n(t,iv); iv=(unsigned char *)ivec; } c= *(in++)^iv[n]; *(out++)=c; iv[n]=c; n=(n+1)&0x07; } } else { while (l--) { if (n == 0) { n2l(iv,v0); ti[0]=v0; n2l(iv,v1); ti[1]=v1; BF_encrypt((unsigned long *)ti,schedule,BF_ENCRYPT); iv=(unsigned char *)ivec; t=ti[0]; l2n(t,iv); t=ti[1]; l2n(t,iv); iv=(unsigned char *)ivec; } cc= *(in++); c=iv[n]; iv[n]=cc; *(out++)=c^cc; n=(n+1)&0x07; } } v0=v1=ti[0]=ti[1]=t=c=cc=0; *num=n; } critlib/blowfish_c/bf_enc.c0000644000076500001200000001141407215174217016104 0ustar jcwadmin00000000000000/* crypto/bf/bf_enc.c */ /* Copyright (C) 1995-1997 Eric Young (eay@mincom.oz.au) * All rights reserved. * * This package is an SSL implementation written * by Eric Young (eay@mincom.oz.au). * The implementation was written so as to conform with Netscapes SSL. * * This library is free for commercial and non-commercial use as long as * the following conditions are aheared to. The following conditions * apply to all code found in this distribution, be it the RC4, RSA, * lhash, DES, etc., code; not just the SSL code. The SSL documentation * included with this distribution is covered by the same copyright terms * except that the holder is Tim Hudson (tjh@mincom.oz.au). * * Copyright remains Eric Young's, and as such any Copyright notices in * the code are not to be removed. * If this package is used in a product, Eric Young should be given attribution * as the author of the parts of the library used. * This can be in the form of a textual message at program startup or * in documentation (online or textual) provided with the package. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * "This product includes cryptographic software written by * Eric Young (eay@mincom.oz.au)" * The word 'cryptographic' can be left out if the rouines from the library * being used are not cryptographic related :-). * 4. If you include any Windows specific code (or a derivative thereof) from * the apps directory (application code) you must include an acknowledgement: * "This product includes software written by Tim Hudson (tjh@mincom.oz.au)" * * THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * The licence and distribution terms for any publically available version or * derivative of this code cannot be changed. i.e. this code cannot simply be * copied and put under another distribution licence * [including the GNU Public Licence.] */ #include "blowfish.h" #include "bf_locl.h" /* Blowfish as implemented from 'Blowfish: Springer-Verlag paper' * (From LECTURE NOTES IN COIMPUTER SCIENCE 809, FAST SOFTWARE ENCRYPTION, * CAMBRIDGE SECURITY WORKSHOP, CAMBRIDGE, U.K., DECEMBER 9-11, 1993) */ #if (BF_ROUNDS != 16) && (BF_ROUNDS != 20) If you set BF_ROUNDS to some value other than 16 or 20, you will have to modify the code. #endif void BF_encrypt(data,key,encrypt) BF_LONG *data; BF_KEY *key; int encrypt; { register BF_LONG l,r,*p,*s; p=key->P; s= &(key->S[0]); l=data[0]; r=data[1]; if (encrypt) { l^=p[0]; BF_ENC(r,l,s,p[ 1]); BF_ENC(l,r,s,p[ 2]); BF_ENC(r,l,s,p[ 3]); BF_ENC(l,r,s,p[ 4]); BF_ENC(r,l,s,p[ 5]); BF_ENC(l,r,s,p[ 6]); BF_ENC(r,l,s,p[ 7]); BF_ENC(l,r,s,p[ 8]); BF_ENC(r,l,s,p[ 9]); BF_ENC(l,r,s,p[10]); BF_ENC(r,l,s,p[11]); BF_ENC(l,r,s,p[12]); BF_ENC(r,l,s,p[13]); BF_ENC(l,r,s,p[14]); BF_ENC(r,l,s,p[15]); BF_ENC(l,r,s,p[16]); #if BF_ROUNDS == 20 BF_ENC(r,l,s,p[17]); BF_ENC(l,r,s,p[18]); BF_ENC(r,l,s,p[19]); BF_ENC(l,r,s,p[20]); #endif r^=p[BF_ROUNDS+1]; } else { l^=p[BF_ROUNDS+1]; #if BF_ROUNDS == 20 BF_ENC(r,l,s,p[20]); BF_ENC(l,r,s,p[19]); BF_ENC(r,l,s,p[18]); BF_ENC(l,r,s,p[17]); #endif BF_ENC(r,l,s,p[16]); BF_ENC(l,r,s,p[15]); BF_ENC(r,l,s,p[14]); BF_ENC(l,r,s,p[13]); BF_ENC(r,l,s,p[12]); BF_ENC(l,r,s,p[11]); BF_ENC(r,l,s,p[10]); BF_ENC(l,r,s,p[ 9]); BF_ENC(r,l,s,p[ 8]); BF_ENC(l,r,s,p[ 7]); BF_ENC(r,l,s,p[ 6]); BF_ENC(l,r,s,p[ 5]); BF_ENC(r,l,s,p[ 4]); BF_ENC(l,r,s,p[ 3]); BF_ENC(r,l,s,p[ 2]); BF_ENC(l,r,s,p[ 1]); r^=p[0]; } data[1]=l&0xffffffff; data[0]=r&0xffffffff; } critlib/blowfish_c/bf_locl.h0000644000076500001200000002001207215174267016274 0ustar jcwadmin00000000000000/* crypto/bf/bf_local.h */ /* Copyright (C) 1995-1997 Eric Young (eay@mincom.oz.au) * All rights reserved. * * This package is an SSL implementation written * by Eric Young (eay@mincom.oz.au). * The implementation was written so as to conform with Netscapes SSL. * * This library is free for commercial and non-commercial use as long as * the following conditions are aheared to. The following conditions * apply to all code found in this distribution, be it the RC4, RSA, * lhash, DES, etc., code; not just the SSL code. The SSL documentation * included with this distribution is covered by the same copyright terms * except that the holder is Tim Hudson (tjh@mincom.oz.au). * * Copyright remains Eric Young's, and as such any Copyright notices in * the code are not to be removed. * If this package is used in a product, Eric Young should be given attribution * as the author of the parts of the library used. * This can be in the form of a textual message at program startup or * in documentation (online or textual) provided with the package. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * "This product includes cryptographic software written by * Eric Young (eay@mincom.oz.au)" * The word 'cryptographic' can be left out if the rouines from the library * being used are not cryptographic related :-). * 4. If you include any Windows specific code (or a derivative thereof) from * the apps directory (application code) you must include an acknowledgement: * "This product includes software written by Tim Hudson (tjh@mincom.oz.au)" * * THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * The licence and distribution terms for any publically available version or * derivative of this code cannot be changed. i.e. this code cannot simply be * copied and put under another distribution licence * [including the GNU Public Licence.] */ /* WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING * * Always modify bf_locl.org since bf_locl.h is automatically generated from * it during SSLeay configuration. * * WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING */ #undef c2l #define c2l(c,l) (l =((unsigned long)(*((c)++))) , \ l|=((unsigned long)(*((c)++)))<< 8L, \ l|=((unsigned long)(*((c)++)))<<16L, \ l|=((unsigned long)(*((c)++)))<<24L) /* NOTE - c is not incremented as per c2l */ #undef c2ln #define c2ln(c,l1,l2,n) { \ c+=n; \ l1=l2=0; \ switch (n) { \ case 8: l2 =((unsigned long)(*(--(c))))<<24L; \ case 7: l2|=((unsigned long)(*(--(c))))<<16L; \ case 6: l2|=((unsigned long)(*(--(c))))<< 8L; \ case 5: l2|=((unsigned long)(*(--(c)))); \ case 4: l1 =((unsigned long)(*(--(c))))<<24L; \ case 3: l1|=((unsigned long)(*(--(c))))<<16L; \ case 2: l1|=((unsigned long)(*(--(c))))<< 8L; \ case 1: l1|=((unsigned long)(*(--(c)))); \ } \ } #undef l2c #define l2c(l,c) (*((c)++)=(unsigned char)(((l) )&0xff), \ *((c)++)=(unsigned char)(((l)>> 8L)&0xff), \ *((c)++)=(unsigned char)(((l)>>16L)&0xff), \ *((c)++)=(unsigned char)(((l)>>24L)&0xff)) /* NOTE - c is not incremented as per l2c */ #undef l2cn #define l2cn(l1,l2,c,n) { \ c+=n; \ switch (n) { \ case 8: *(--(c))=(unsigned char)(((l2)>>24L)&0xff); \ case 7: *(--(c))=(unsigned char)(((l2)>>16L)&0xff); \ case 6: *(--(c))=(unsigned char)(((l2)>> 8L)&0xff); \ case 5: *(--(c))=(unsigned char)(((l2) )&0xff); \ case 4: *(--(c))=(unsigned char)(((l1)>>24L)&0xff); \ case 3: *(--(c))=(unsigned char)(((l1)>>16L)&0xff); \ case 2: *(--(c))=(unsigned char)(((l1)>> 8L)&0xff); \ case 1: *(--(c))=(unsigned char)(((l1) )&0xff); \ } \ } /* NOTE - c is not incremented as per n2l */ #define n2ln(c,l1,l2,n) { \ c+=n; \ l1=l2=0; \ switch (n) { \ case 8: l2 =((unsigned long)(*(--(c)))) ; \ case 7: l2|=((unsigned long)(*(--(c))))<< 8; \ case 6: l2|=((unsigned long)(*(--(c))))<<16; \ case 5: l2|=((unsigned long)(*(--(c))))<<24; \ case 4: l1 =((unsigned long)(*(--(c)))) ; \ case 3: l1|=((unsigned long)(*(--(c))))<< 8; \ case 2: l1|=((unsigned long)(*(--(c))))<<16; \ case 1: l1|=((unsigned long)(*(--(c))))<<24; \ } \ } /* NOTE - c is not incremented as per l2n */ #define l2nn(l1,l2,c,n) { \ c+=n; \ switch (n) { \ case 8: *(--(c))=(unsigned char)(((l2) )&0xff); \ case 7: *(--(c))=(unsigned char)(((l2)>> 8)&0xff); \ case 6: *(--(c))=(unsigned char)(((l2)>>16)&0xff); \ case 5: *(--(c))=(unsigned char)(((l2)>>24)&0xff); \ case 4: *(--(c))=(unsigned char)(((l1) )&0xff); \ case 3: *(--(c))=(unsigned char)(((l1)>> 8)&0xff); \ case 2: *(--(c))=(unsigned char)(((l1)>>16)&0xff); \ case 1: *(--(c))=(unsigned char)(((l1)>>24)&0xff); \ } \ } #undef n2l #define n2l(c,l) (l =((unsigned long)(*((c)++)))<<24L, \ l|=((unsigned long)(*((c)++)))<<16L, \ l|=((unsigned long)(*((c)++)))<< 8L, \ l|=((unsigned long)(*((c)++)))) #undef l2n #define l2n(l,c) (*((c)++)=(unsigned char)(((l)>>24L)&0xff), \ *((c)++)=(unsigned char)(((l)>>16L)&0xff), \ *((c)++)=(unsigned char)(((l)>> 8L)&0xff), \ *((c)++)=(unsigned char)(((l) )&0xff)) /* This is actually a big endian algorithm, the most significate byte * is used to lookup array 0 */ /* use BF_PTR2 for intel boxes, * BF_PTR for sparc and MIPS/SGI * use nothing for Alpha and HP. */ #if !defined(BF_PTR) && !defined(BF_PTR2) #undef BF_PTR #endif #define BF_M 0x3fc #define BF_0 22L #define BF_1 14L #define BF_2 6L #define BF_3 2L /* left shift */ #if defined(BF_PTR2) /* This is basically a special pentium verson */ #define BF_ENC(LL,R,S,P) \ { \ BF_LONG t,u,v; \ u=R>>BF_0; \ v=R>>BF_1; \ u&=BF_M; \ v&=BF_M; \ t= *(BF_LONG *)((unsigned char *)&(S[ 0])+u); \ u=R>>BF_2; \ t+= *(BF_LONG *)((unsigned char *)&(S[256])+v); \ v=R<>BF_0)&BF_M))+ \ *(BF_LONG *)((unsigned char *)&(S[256])+((R>>BF_1)&BF_M)))^ \ *(BF_LONG *)((unsigned char *)&(S[512])+((R>>BF_2)&BF_M)))+ \ *(BF_LONG *)((unsigned char *)&(S[768])+((R<>24L) ] + \ S[0x0100+((R>>16L)&0xff)])^ \ S[0x0200+((R>> 8L)&0xff)])+ \ S[0x0300+((R )&0xff)])&0xffffffff; #endif critlib/blowfish_c/bf_pi.h0000644000076500001200000004161307215174267015765 0ustar jcwadmin00000000000000/* crypto/bf/bf_pi.h */ /* Copyright (C) 1995-1997 Eric Young (eay@mincom.oz.au) * All rights reserved. * * This package is an SSL implementation written * by Eric Young (eay@mincom.oz.au). * The implementation was written so as to conform with Netscapes SSL. * * This library is free for commercial and non-commercial use as long as * the following conditions are aheared to. The following conditions * apply to all code found in this distribution, be it the RC4, RSA, * lhash, DES, etc., code; not just the SSL code. The SSL documentation * included with this distribution is covered by the same copyright terms * except that the holder is Tim Hudson (tjh@mincom.oz.au). * * Copyright remains Eric Young's, and as such any Copyright notices in * the code are not to be removed. * If this package is used in a product, Eric Young should be given attribution * as the author of the parts of the library used. * This can be in the form of a textual message at program startup or * in documentation (online or textual) provided with the package. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * "This product includes cryptographic software written by * Eric Young (eay@mincom.oz.au)" * The word 'cryptographic' can be left out if the rouines from the library * being used are not cryptographic related :-). * 4. If you include any Windows specific code (or a derivative thereof) from * the apps directory (application code) you must include an acknowledgement: * "This product includes software written by Tim Hudson (tjh@mincom.oz.au)" * * THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * The licence and distribution terms for any publically available version or * derivative of this code cannot be changed. i.e. this code cannot simply be * copied and put under another distribution licence * [including the GNU Public Licence.] */ static BF_KEY bf_init= { { 0x243f6a88L, 0x85a308d3L, 0x13198a2eL, 0x03707344L, 0xa4093822L, 0x299f31d0L, 0x082efa98L, 0xec4e6c89L, 0x452821e6L, 0x38d01377L, 0xbe5466cfL, 0x34e90c6cL, 0xc0ac29b7L, 0xc97c50ddL, 0x3f84d5b5L, 0xb5470917L, 0x9216d5d9L, 0x8979fb1b },{ 0xd1310ba6L, 0x98dfb5acL, 0x2ffd72dbL, 0xd01adfb7L, 0xb8e1afedL, 0x6a267e96L, 0xba7c9045L, 0xf12c7f99L, 0x24a19947L, 0xb3916cf7L, 0x0801f2e2L, 0x858efc16L, 0x636920d8L, 0x71574e69L, 0xa458fea3L, 0xf4933d7eL, 0x0d95748fL, 0x728eb658L, 0x718bcd58L, 0x82154aeeL, 0x7b54a41dL, 0xc25a59b5L, 0x9c30d539L, 0x2af26013L, 0xc5d1b023L, 0x286085f0L, 0xca417918L, 0xb8db38efL, 0x8e79dcb0L, 0x603a180eL, 0x6c9e0e8bL, 0xb01e8a3eL, 0xd71577c1L, 0xbd314b27L, 0x78af2fdaL, 0x55605c60L, 0xe65525f3L, 0xaa55ab94L, 0x57489862L, 0x63e81440L, 0x55ca396aL, 0x2aab10b6L, 0xb4cc5c34L, 0x1141e8ceL, 0xa15486afL, 0x7c72e993L, 0xb3ee1411L, 0x636fbc2aL, 0x2ba9c55dL, 0x741831f6L, 0xce5c3e16L, 0x9b87931eL, 0xafd6ba33L, 0x6c24cf5cL, 0x7a325381L, 0x28958677L, 0x3b8f4898L, 0x6b4bb9afL, 0xc4bfe81bL, 0x66282193L, 0x61d809ccL, 0xfb21a991L, 0x487cac60L, 0x5dec8032L, 0xef845d5dL, 0xe98575b1L, 0xdc262302L, 0xeb651b88L, 0x23893e81L, 0xd396acc5L, 0x0f6d6ff3L, 0x83f44239L, 0x2e0b4482L, 0xa4842004L, 0x69c8f04aL, 0x9e1f9b5eL, 0x21c66842L, 0xf6e96c9aL, 0x670c9c61L, 0xabd388f0L, 0x6a51a0d2L, 0xd8542f68L, 0x960fa728L, 0xab5133a3L, 0x6eef0b6cL, 0x137a3be4L, 0xba3bf050L, 0x7efb2a98L, 0xa1f1651dL, 0x39af0176L, 0x66ca593eL, 0x82430e88L, 0x8cee8619L, 0x456f9fb4L, 0x7d84a5c3L, 0x3b8b5ebeL, 0xe06f75d8L, 0x85c12073L, 0x401a449fL, 0x56c16aa6L, 0x4ed3aa62L, 0x363f7706L, 0x1bfedf72L, 0x429b023dL, 0x37d0d724L, 0xd00a1248L, 0xdb0fead3L, 0x49f1c09bL, 0x075372c9L, 0x80991b7bL, 0x25d479d8L, 0xf6e8def7L, 0xe3fe501aL, 0xb6794c3bL, 0x976ce0bdL, 0x04c006baL, 0xc1a94fb6L, 0x409f60c4L, 0x5e5c9ec2L, 0x196a2463L, 0x68fb6fafL, 0x3e6c53b5L, 0x1339b2ebL, 0x3b52ec6fL, 0x6dfc511fL, 0x9b30952cL, 0xcc814544L, 0xaf5ebd09L, 0xbee3d004L, 0xde334afdL, 0x660f2807L, 0x192e4bb3L, 0xc0cba857L, 0x45c8740fL, 0xd20b5f39L, 0xb9d3fbdbL, 0x5579c0bdL, 0x1a60320aL, 0xd6a100c6L, 0x402c7279L, 0x679f25feL, 0xfb1fa3ccL, 0x8ea5e9f8L, 0xdb3222f8L, 0x3c7516dfL, 0xfd616b15L, 0x2f501ec8L, 0xad0552abL, 0x323db5faL, 0xfd238760L, 0x53317b48L, 0x3e00df82L, 0x9e5c57bbL, 0xca6f8ca0L, 0x1a87562eL, 0xdf1769dbL, 0xd542a8f6L, 0x287effc3L, 0xac6732c6L, 0x8c4f5573L, 0x695b27b0L, 0xbbca58c8L, 0xe1ffa35dL, 0xb8f011a0L, 0x10fa3d98L, 0xfd2183b8L, 0x4afcb56cL, 0x2dd1d35bL, 0x9a53e479L, 0xb6f84565L, 0xd28e49bcL, 0x4bfb9790L, 0xe1ddf2daL, 0xa4cb7e33L, 0x62fb1341L, 0xcee4c6e8L, 0xef20cadaL, 0x36774c01L, 0xd07e9efeL, 0x2bf11fb4L, 0x95dbda4dL, 0xae909198L, 0xeaad8e71L, 0x6b93d5a0L, 0xd08ed1d0L, 0xafc725e0L, 0x8e3c5b2fL, 0x8e7594b7L, 0x8ff6e2fbL, 0xf2122b64L, 0x8888b812L, 0x900df01cL, 0x4fad5ea0L, 0x688fc31cL, 0xd1cff191L, 0xb3a8c1adL, 0x2f2f2218L, 0xbe0e1777L, 0xea752dfeL, 0x8b021fa1L, 0xe5a0cc0fL, 0xb56f74e8L, 0x18acf3d6L, 0xce89e299L, 0xb4a84fe0L, 0xfd13e0b7L, 0x7cc43b81L, 0xd2ada8d9L, 0x165fa266L, 0x80957705L, 0x93cc7314L, 0x211a1477L, 0xe6ad2065L, 0x77b5fa86L, 0xc75442f5L, 0xfb9d35cfL, 0xebcdaf0cL, 0x7b3e89a0L, 0xd6411bd3L, 0xae1e7e49L, 0x00250e2dL, 0x2071b35eL, 0x226800bbL, 0x57b8e0afL, 0x2464369bL, 0xf009b91eL, 0x5563911dL, 0x59dfa6aaL, 0x78c14389L, 0xd95a537fL, 0x207d5ba2L, 0x02e5b9c5L, 0x83260376L, 0x6295cfa9L, 0x11c81968L, 0x4e734a41L, 0xb3472dcaL, 0x7b14a94aL, 0x1b510052L, 0x9a532915L, 0xd60f573fL, 0xbc9bc6e4L, 0x2b60a476L, 0x81e67400L, 0x08ba6fb5L, 0x571be91fL, 0xf296ec6bL, 0x2a0dd915L, 0xb6636521L, 0xe7b9f9b6L, 0xff34052eL, 0xc5855664L, 0x53b02d5dL, 0xa99f8fa1L, 0x08ba4799L, 0x6e85076aL, 0x4b7a70e9L, 0xb5b32944L, 0xdb75092eL, 0xc4192623L, 0xad6ea6b0L, 0x49a7df7dL, 0x9cee60b8L, 0x8fedb266L, 0xecaa8c71L, 0x699a17ffL, 0x5664526cL, 0xc2b19ee1L, 0x193602a5L, 0x75094c29L, 0xa0591340L, 0xe4183a3eL, 0x3f54989aL, 0x5b429d65L, 0x6b8fe4d6L, 0x99f73fd6L, 0xa1d29c07L, 0xefe830f5L, 0x4d2d38e6L, 0xf0255dc1L, 0x4cdd2086L, 0x8470eb26L, 0x6382e9c6L, 0x021ecc5eL, 0x09686b3fL, 0x3ebaefc9L, 0x3c971814L, 0x6b6a70a1L, 0x687f3584L, 0x52a0e286L, 0xb79c5305L, 0xaa500737L, 0x3e07841cL, 0x7fdeae5cL, 0x8e7d44ecL, 0x5716f2b8L, 0xb03ada37L, 0xf0500c0dL, 0xf01c1f04L, 0x0200b3ffL, 0xae0cf51aL, 0x3cb574b2L, 0x25837a58L, 0xdc0921bdL, 0xd19113f9L, 0x7ca92ff6L, 0x94324773L, 0x22f54701L, 0x3ae5e581L, 0x37c2dadcL, 0xc8b57634L, 0x9af3dda7L, 0xa9446146L, 0x0fd0030eL, 0xecc8c73eL, 0xa4751e41L, 0xe238cd99L, 0x3bea0e2fL, 0x3280bba1L, 0x183eb331L, 0x4e548b38L, 0x4f6db908L, 0x6f420d03L, 0xf60a04bfL, 0x2cb81290L, 0x24977c79L, 0x5679b072L, 0xbcaf89afL, 0xde9a771fL, 0xd9930810L, 0xb38bae12L, 0xdccf3f2eL, 0x5512721fL, 0x2e6b7124L, 0x501adde6L, 0x9f84cd87L, 0x7a584718L, 0x7408da17L, 0xbc9f9abcL, 0xe94b7d8cL, 0xec7aec3aL, 0xdb851dfaL, 0x63094366L, 0xc464c3d2L, 0xef1c1847L, 0x3215d908L, 0xdd433b37L, 0x24c2ba16L, 0x12a14d43L, 0x2a65c451L, 0x50940002L, 0x133ae4ddL, 0x71dff89eL, 0x10314e55L, 0x81ac77d6L, 0x5f11199bL, 0x043556f1L, 0xd7a3c76bL, 0x3c11183bL, 0x5924a509L, 0xf28fe6edL, 0x97f1fbfaL, 0x9ebabf2cL, 0x1e153c6eL, 0x86e34570L, 0xeae96fb1L, 0x860e5e0aL, 0x5a3e2ab3L, 0x771fe71cL, 0x4e3d06faL, 0x2965dcb9L, 0x99e71d0fL, 0x803e89d6L, 0x5266c825L, 0x2e4cc978L, 0x9c10b36aL, 0xc6150ebaL, 0x94e2ea78L, 0xa5fc3c53L, 0x1e0a2df4L, 0xf2f74ea7L, 0x361d2b3dL, 0x1939260fL, 0x19c27960L, 0x5223a708L, 0xf71312b6L, 0xebadfe6eL, 0xeac31f66L, 0xe3bc4595L, 0xa67bc883L, 0xb17f37d1L, 0x018cff28L, 0xc332ddefL, 0xbe6c5aa5L, 0x65582185L, 0x68ab9802L, 0xeecea50fL, 0xdb2f953bL, 0x2aef7dadL, 0x5b6e2f84L, 0x1521b628L, 0x29076170L, 0xecdd4775L, 0x619f1510L, 0x13cca830L, 0xeb61bd96L, 0x0334fe1eL, 0xaa0363cfL, 0xb5735c90L, 0x4c70a239L, 0xd59e9e0bL, 0xcbaade14L, 0xeecc86bcL, 0x60622ca7L, 0x9cab5cabL, 0xb2f3846eL, 0x648b1eafL, 0x19bdf0caL, 0xa02369b9L, 0x655abb50L, 0x40685a32L, 0x3c2ab4b3L, 0x319ee9d5L, 0xc021b8f7L, 0x9b540b19L, 0x875fa099L, 0x95f7997eL, 0x623d7da8L, 0xf837889aL, 0x97e32d77L, 0x11ed935fL, 0x16681281L, 0x0e358829L, 0xc7e61fd6L, 0x96dedfa1L, 0x7858ba99L, 0x57f584a5L, 0x1b227263L, 0x9b83c3ffL, 0x1ac24696L, 0xcdb30aebL, 0x532e3054L, 0x8fd948e4L, 0x6dbc3128L, 0x58ebf2efL, 0x34c6ffeaL, 0xfe28ed61L, 0xee7c3c73L, 0x5d4a14d9L, 0xe864b7e3L, 0x42105d14L, 0x203e13e0L, 0x45eee2b6L, 0xa3aaabeaL, 0xdb6c4f15L, 0xfacb4fd0L, 0xc742f442L, 0xef6abbb5L, 0x654f3b1dL, 0x41cd2105L, 0xd81e799eL, 0x86854dc7L, 0xe44b476aL, 0x3d816250L, 0xcf62a1f2L, 0x5b8d2646L, 0xfc8883a0L, 0xc1c7b6a3L, 0x7f1524c3L, 0x69cb7492L, 0x47848a0bL, 0x5692b285L, 0x095bbf00L, 0xad19489dL, 0x1462b174L, 0x23820e00L, 0x58428d2aL, 0x0c55f5eaL, 0x1dadf43eL, 0x233f7061L, 0x3372f092L, 0x8d937e41L, 0xd65fecf1L, 0x6c223bdbL, 0x7cde3759L, 0xcbee7460L, 0x4085f2a7L, 0xce77326eL, 0xa6078084L, 0x19f8509eL, 0xe8efd855L, 0x61d99735L, 0xa969a7aaL, 0xc50c06c2L, 0x5a04abfcL, 0x800bcadcL, 0x9e447a2eL, 0xc3453484L, 0xfdd56705L, 0x0e1e9ec9L, 0xdb73dbd3L, 0x105588cdL, 0x675fda79L, 0xe3674340L, 0xc5c43465L, 0x713e38d8L, 0x3d28f89eL, 0xf16dff20L, 0x153e21e7L, 0x8fb03d4aL, 0xe6e39f2bL, 0xdb83adf7L, 0xe93d5a68L, 0x948140f7L, 0xf64c261cL, 0x94692934L, 0x411520f7L, 0x7602d4f7L, 0xbcf46b2eL, 0xd4a20068L, 0xd4082471L, 0x3320f46aL, 0x43b7d4b7L, 0x500061afL, 0x1e39f62eL, 0x97244546L, 0x14214f74L, 0xbf8b8840L, 0x4d95fc1dL, 0x96b591afL, 0x70f4ddd3L, 0x66a02f45L, 0xbfbc09ecL, 0x03bd9785L, 0x7fac6dd0L, 0x31cb8504L, 0x96eb27b3L, 0x55fd3941L, 0xda2547e6L, 0xabca0a9aL, 0x28507825L, 0x530429f4L, 0x0a2c86daL, 0xe9b66dfbL, 0x68dc1462L, 0xd7486900L, 0x680ec0a4L, 0x27a18deeL, 0x4f3ffea2L, 0xe887ad8cL, 0xb58ce006L, 0x7af4d6b6L, 0xaace1e7cL, 0xd3375fecL, 0xce78a399L, 0x406b2a42L, 0x20fe9e35L, 0xd9f385b9L, 0xee39d7abL, 0x3b124e8bL, 0x1dc9faf7L, 0x4b6d1856L, 0x26a36631L, 0xeae397b2L, 0x3a6efa74L, 0xdd5b4332L, 0x6841e7f7L, 0xca7820fbL, 0xfb0af54eL, 0xd8feb397L, 0x454056acL, 0xba489527L, 0x55533a3aL, 0x20838d87L, 0xfe6ba9b7L, 0xd096954bL, 0x55a867bcL, 0xa1159a58L, 0xcca92963L, 0x99e1db33L, 0xa62a4a56L, 0x3f3125f9L, 0x5ef47e1cL, 0x9029317cL, 0xfdf8e802L, 0x04272f70L, 0x80bb155cL, 0x05282ce3L, 0x95c11548L, 0xe4c66d22L, 0x48c1133fL, 0xc70f86dcL, 0x07f9c9eeL, 0x41041f0fL, 0x404779a4L, 0x5d886e17L, 0x325f51ebL, 0xd59bc0d1L, 0xf2bcc18fL, 0x41113564L, 0x257b7834L, 0x602a9c60L, 0xdff8e8a3L, 0x1f636c1bL, 0x0e12b4c2L, 0x02e1329eL, 0xaf664fd1L, 0xcad18115L, 0x6b2395e0L, 0x333e92e1L, 0x3b240b62L, 0xeebeb922L, 0x85b2a20eL, 0xe6ba0d99L, 0xde720c8cL, 0x2da2f728L, 0xd0127845L, 0x95b794fdL, 0x647d0862L, 0xe7ccf5f0L, 0x5449a36fL, 0x877d48faL, 0xc39dfd27L, 0xf33e8d1eL, 0x0a476341L, 0x992eff74L, 0x3a6f6eabL, 0xf4f8fd37L, 0xa812dc60L, 0xa1ebddf8L, 0x991be14cL, 0xdb6e6b0dL, 0xc67b5510L, 0x6d672c37L, 0x2765d43bL, 0xdcd0e804L, 0xf1290dc7L, 0xcc00ffa3L, 0xb5390f92L, 0x690fed0bL, 0x667b9ffbL, 0xcedb7d9cL, 0xa091cf0bL, 0xd9155ea3L, 0xbb132f88L, 0x515bad24L, 0x7b9479bfL, 0x763bd6ebL, 0x37392eb3L, 0xcc115979L, 0x8026e297L, 0xf42e312dL, 0x6842ada7L, 0xc66a2b3bL, 0x12754cccL, 0x782ef11cL, 0x6a124237L, 0xb79251e7L, 0x06a1bbe6L, 0x4bfb6350L, 0x1a6b1018L, 0x11caedfaL, 0x3d25bdd8L, 0xe2e1c3c9L, 0x44421659L, 0x0a121386L, 0xd90cec6eL, 0xd5abea2aL, 0x64af674eL, 0xda86a85fL, 0xbebfe988L, 0x64e4c3feL, 0x9dbc8057L, 0xf0f7c086L, 0x60787bf8L, 0x6003604dL, 0xd1fd8346L, 0xf6381fb0L, 0x7745ae04L, 0xd736fcccL, 0x83426b33L, 0xf01eab71L, 0xb0804187L, 0x3c005e5fL, 0x77a057beL, 0xbde8ae24L, 0x55464299L, 0xbf582e61L, 0x4e58f48fL, 0xf2ddfda2L, 0xf474ef38L, 0x8789bdc2L, 0x5366f9c3L, 0xc8b38e74L, 0xb475f255L, 0x46fcd9b9L, 0x7aeb2661L, 0x8b1ddf84L, 0x846a0e79L, 0x915f95e2L, 0x466e598eL, 0x20b45770L, 0x8cd55591L, 0xc902de4cL, 0xb90bace1L, 0xbb8205d0L, 0x11a86248L, 0x7574a99eL, 0xb77f19b6L, 0xe0a9dc09L, 0x662d09a1L, 0xc4324633L, 0xe85a1f02L, 0x09f0be8cL, 0x4a99a025L, 0x1d6efe10L, 0x1ab93d1dL, 0x0ba5a4dfL, 0xa186f20fL, 0x2868f169L, 0xdcb7da83L, 0x573906feL, 0xa1e2ce9bL, 0x4fcd7f52L, 0x50115e01L, 0xa70683faL, 0xa002b5c4L, 0x0de6d027L, 0x9af88c27L, 0x773f8641L, 0xc3604c06L, 0x61a806b5L, 0xf0177a28L, 0xc0f586e0L, 0x006058aaL, 0x30dc7d62L, 0x11e69ed7L, 0x2338ea63L, 0x53c2dd94L, 0xc2c21634L, 0xbbcbee56L, 0x90bcb6deL, 0xebfc7da1L, 0xce591d76L, 0x6f05e409L, 0x4b7c0188L, 0x39720a3dL, 0x7c927c24L, 0x86e3725fL, 0x724d9db9L, 0x1ac15bb4L, 0xd39eb8fcL, 0xed545578L, 0x08fca5b5L, 0xd83d7cd3L, 0x4dad0fc4L, 0x1e50ef5eL, 0xb161e6f8L, 0xa28514d9L, 0x6c51133cL, 0x6fd5c7e7L, 0x56e14ec4L, 0x362abfceL, 0xddc6c837L, 0xd79a3234L, 0x92638212L, 0x670efa8eL, 0x406000e0L, 0x3a39ce37L, 0xd3faf5cfL, 0xabc27737L, 0x5ac52d1bL, 0x5cb0679eL, 0x4fa33742L, 0xd3822740L, 0x99bc9bbeL, 0xd5118e9dL, 0xbf0f7315L, 0xd62d1c7eL, 0xc700c47bL, 0xb78c1b6bL, 0x21a19045L, 0xb26eb1beL, 0x6a366eb4L, 0x5748ab2fL, 0xbc946e79L, 0xc6a376d2L, 0x6549c2c8L, 0x530ff8eeL, 0x468dde7dL, 0xd5730a1dL, 0x4cd04dc6L, 0x2939bbdbL, 0xa9ba4650L, 0xac9526e8L, 0xbe5ee304L, 0xa1fad5f0L, 0x6a2d519aL, 0x63ef8ce2L, 0x9a86ee22L, 0xc089c2b8L, 0x43242ef6L, 0xa51e03aaL, 0x9cf2d0a4L, 0x83c061baL, 0x9be96a4dL, 0x8fe51550L, 0xba645bd6L, 0x2826a2f9L, 0xa73a3ae1L, 0x4ba99586L, 0xef5562e9L, 0xc72fefd3L, 0xf752f7daL, 0x3f046f69L, 0x77fa0a59L, 0x80e4a915L, 0x87b08601L, 0x9b09e6adL, 0x3b3ee593L, 0xe990fd5aL, 0x9e34d797L, 0x2cf0b7d9L, 0x022b8b51L, 0x96d5ac3aL, 0x017da67dL, 0xd1cf3ed6L, 0x7c7d2d28L, 0x1f9f25cfL, 0xadf2b89bL, 0x5ad6b472L, 0x5a88f54cL, 0xe029ac71L, 0xe019a5e6L, 0x47b0acfdL, 0xed93fa9bL, 0xe8d3c48dL, 0x283b57ccL, 0xf8d56629L, 0x79132e28L, 0x785f0191L, 0xed756055L, 0xf7960e44L, 0xe3d35e8cL, 0x15056dd4L, 0x88f46dbaL, 0x03a16125L, 0x0564f0bdL, 0xc3eb9e15L, 0x3c9057a2L, 0x97271aecL, 0xa93a072aL, 0x1b3f6d9bL, 0x1e6321f5L, 0xf59c66fbL, 0x26dcf319L, 0x7533d928L, 0xb155fdf5L, 0x03563482L, 0x8aba3cbbL, 0x28517711L, 0xc20ad9f8L, 0xabcc5167L, 0xccad925fL, 0x4de81751L, 0x3830dc8eL, 0x379d5862L, 0x9320f991L, 0xea7a90c2L, 0xfb3e7bceL, 0x5121ce64L, 0x774fbe32L, 0xa8b6e37eL, 0xc3293d46L, 0x48de5369L, 0x6413e680L, 0xa2ae0810L, 0xdd6db224L, 0x69852dfdL, 0x09072166L, 0xb39a460aL, 0x6445c0ddL, 0x586cdecfL, 0x1c20c8aeL, 0x5bbef7ddL, 0x1b588d40L, 0xccd2017fL, 0x6bb4e3bbL, 0xdda26a7eL, 0x3a59ff45L, 0x3e350a44L, 0xbcb4cdd5L, 0x72eacea8L, 0xfa6484bbL, 0x8d6612aeL, 0xbf3c6f47L, 0xd29be463L, 0x542f5d9eL, 0xaec2771bL, 0xf64e6370L, 0x740e0d8dL, 0xe75b1357L, 0xf8721671L, 0xaf537d5dL, 0x4040cb08L, 0x4eb4e2ccL, 0x34d2466aL, 0x0115af84L, 0xe1b00428L, 0x95983a1dL, 0x06b89fb4L, 0xce6ea048L, 0x6f3f3b82L, 0x3520ab82L, 0x011a1d4bL, 0x277227f8L, 0x611560b1L, 0xe7933fdcL, 0xbb3a792bL, 0x344525bdL, 0xa08839e1L, 0x51ce794bL, 0x2f32c9b7L, 0xa01fbac9L, 0xe01cc87eL, 0xbcc7d1f6L, 0xcf0111c3L, 0xa1e8aac7L, 0x1a908749L, 0xd44fbd9aL, 0xd0dadecbL, 0xd50ada38L, 0x0339c32aL, 0xc6913667L, 0x8df9317cL, 0xe0b12b4fL, 0xf79e59b7L, 0x43f5bb3aL, 0xf2d519ffL, 0x27d9459cL, 0xbf97222cL, 0x15e6fc2aL, 0x0f91fc71L, 0x9b941525L, 0xfae59361L, 0xceb69cebL, 0xc2a86459L, 0x12baa8d1L, 0xb6c1075eL, 0xe3056a0cL, 0x10d25065L, 0xcb03a442L, 0xe0ec6e0eL, 0x1698db3bL, 0x4c98a0beL, 0x3278e964L, 0x9f1f9532L, 0xe0d392dfL, 0xd3a0342bL, 0x8971f21eL, 0x1b0a7441L, 0x4ba3348cL, 0xc5be7120L, 0xc37632d8L, 0xdf359f8dL, 0x9b992f2eL, 0xe60b6f47L, 0x0fe3f11dL, 0xe54cda54L, 0x1edad891L, 0xce6279cfL, 0xcd3e7e6fL, 0x1618b166L, 0xfd2c1d05L, 0x848fd2c5L, 0xf6fb2299L, 0xf523f357L, 0xa6327623L, 0x93a83531L, 0x56cccd02L, 0xacf08162L, 0x5a75ebb5L, 0x6e163697L, 0x88d273ccL, 0xde966292L, 0x81b949d0L, 0x4c50901bL, 0x71c65614L, 0xe6c6c7bdL, 0x327a140aL, 0x45e1d006L, 0xc3f27b9aL, 0xc9aa53fdL, 0x62a80f00L, 0xbb25bfe2L, 0x35bdd2f6L, 0x71126905L, 0xb2040222L, 0xb6cbcf7cL, 0xcd769c2bL, 0x53113ec0L, 0x1640e3d3L, 0x38abbd60L, 0x2547adf0L, 0xba38209cL, 0xf746ce76L, 0x77afa1c5L, 0x20756060L, 0x85cbfe4eL, 0x8ae88dd8L, 0x7aaaf9b0L, 0x4cf9aa7eL, 0x1948c25cL, 0x02fb8a8cL, 0x01c36ae4L, 0xd6ebe1f9L, 0x90d4f869L, 0xa65cdea0L, 0x3f09252dL, 0xc208e69fL, 0xb74e6132L, 0xce77e25bL, 0x578fdfe3L, 0x3ac372e6L, } }; critlib/blowfish_c/bf_skey.c0000644000076500001200000000773307215174232016320 0ustar jcwadmin00000000000000/* crypto/bf/bf_skey.c */ /* Copyright (C) 1995-1997 Eric Young (eay@mincom.oz.au) * All rights reserved. * * This package is an SSL implementation written * by Eric Young (eay@mincom.oz.au). * The implementation was written so as to conform with Netscapes SSL. * * This library is free for commercial and non-commercial use as long as * the following conditions are aheared to. The following conditions * apply to all code found in this distribution, be it the RC4, RSA, * lhash, DES, etc., code; not just the SSL code. The SSL documentation * included with this distribution is covered by the same copyright terms * except that the holder is Tim Hudson (tjh@mincom.oz.au). * * Copyright remains Eric Young's, and as such any Copyright notices in * the code are not to be removed. * If this package is used in a product, Eric Young should be given attribution * as the author of the parts of the library used. * This can be in the form of a textual message at program startup or * in documentation (online or textual) provided with the package. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * "This product includes cryptographic software written by * Eric Young (eay@mincom.oz.au)" * The word 'cryptographic' can be left out if the rouines from the library * being used are not cryptographic related :-). * 4. If you include any Windows specific code (or a derivative thereof) from * the apps directory (application code) you must include an acknowledgement: * "This product includes software written by Tim Hudson (tjh@mincom.oz.au)" * * THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * The licence and distribution terms for any publically available version or * derivative of this code cannot be changed. i.e. this code cannot simply be * copied and put under another distribution licence * [including the GNU Public Licence.] */ #include #include #include "blowfish.h" #include "bf_locl.h" #include "bf_pi.h" void BF_set_key(key,len,data) BF_KEY *key; int len; unsigned char *data; { int i; BF_LONG *p,ri,in[2]; unsigned char *d,*end; memcpy((char *)key,(char *)&bf_init,sizeof(BF_KEY)); p=key->P; if (len > ((BF_ROUNDS+2)*4)) len=(BF_ROUNDS+2)*4; d=data; end= &(data[len]); for (i=0; i<(BF_ROUNDS+2); i++) { ri= *(d++); if (d >= end) d=data; ri<<=8; ri|= *(d++); if (d >= end) d=data; ri<<=8; ri|= *(d++); if (d >= end) d=data; ri<<=8; ri|= *(d++); if (d >= end) d=data; p[i]^=ri; } in[0]=0L; in[1]=0L; for (i=0; i<(BF_ROUNDS+2); i+=2) { BF_encrypt(in,key,BF_ENCRYPT); p[i ]=in[0]; p[i+1]=in[1]; } p=key->S; for (i=0; i<4*256; i+=2) { BF_encrypt(in,key,BF_ENCRYPT); p[i ]=in[0]; p[i+1]=in[1]; } } critlib/blowfish_c/blowfish.h0000644000076500001200000001071007215174267016515 0ustar jcwadmin00000000000000/* crypto/bf/blowfish.h */ /* Copyright (C) 1995-1997 Eric Young (eay@mincom.oz.au) * All rights reserved. * * This package is an SSL implementation written * by Eric Young (eay@mincom.oz.au). * The implementation was written so as to conform with Netscapes SSL. * * This library is free for commercial and non-commercial use as long as * the following conditions are aheared to. The following conditions * apply to all code found in this distribution, be it the RC4, RSA, * lhash, DES, etc., code; not just the SSL code. The SSL documentation * included with this distribution is covered by the same copyright terms * except that the holder is Tim Hudson (tjh@mincom.oz.au). * * Copyright remains Eric Young's, and as such any Copyright notices in * the code are not to be removed. * If this package is used in a product, Eric Young should be given attribution * as the author of the parts of the library used. * This can be in the form of a textual message at program startup or * in documentation (online or textual) provided with the package. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * "This product includes cryptographic software written by * Eric Young (eay@mincom.oz.au)" * The word 'cryptographic' can be left out if the rouines from the library * being used are not cryptographic related :-). * 4. If you include any Windows specific code (or a derivative thereof) from * the apps directory (application code) you must include an acknowledgement: * "This product includes software written by Tim Hudson (tjh@mincom.oz.au)" * * THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * The licence and distribution terms for any publically available version or * derivative of this code cannot be changed. i.e. this code cannot simply be * copied and put under another distribution licence * [including the GNU Public Licence.] */ #ifndef HEADER_BLOWFISH_H #define HEADER_BLOWFISH_H #ifdef __cplusplus extern "C" { #endif #define BF_ENCRYPT 1 #define BF_DECRYPT 0 /* If you make this 'unsigned int' the pointer variants will work on * the Alpha, otherwise they will not. Strangly using the '8 byte' * BF_LONG and the default 'non-pointer' inner loop is the best configuration * for the Alpha */ #define BF_LONG unsigned long #define BF_ROUNDS 16 #define BF_BLOCK 8 typedef struct bf_key_st { BF_LONG P[BF_ROUNDS+2]; BF_LONG S[4*256]; } BF_KEY; #ifndef NOPROTO void BF_set_key(BF_KEY *key, int len, unsigned char *data); void BF_ecb_encrypt(unsigned char *in,unsigned char *out,BF_KEY *key, int encrypt); void BF_encrypt(BF_LONG *data,BF_KEY *key,int encrypt); void BF_cbc_encrypt(unsigned char *in, unsigned char *out, long length, BF_KEY *ks, unsigned char *iv, int encrypt); void BF_cfb64_encrypt(unsigned char *in, unsigned char *out, long length, BF_KEY *schedule, unsigned char *ivec, int *num, int encrypt); void BF_ofb64_encrypt(unsigned char *in, unsigned char *out, long length, BF_KEY *schedule, unsigned char *ivec, int *num); char *BF_options(void); #else void BF_set_key(); void BF_ecb_encrypt(); void BF_encrypt(); void BF_cbc_encrypt(); void BF_cfb64_encrypt(); void BF_ofb64_encrypt(); char *BF_options(); #endif #ifdef __cplusplus } #endif #endif critlib/cblas/0000755000076500001200000000000007377223650013475 5ustar jcwadmin00000000000000critlib/cblas/cblas.h0000755000076500001200000000000010573223446022317 2/home/builds/cblas/src/cblas.hustar jcwadmin00000000000000critlib/cblas/cblasdefs.tcl0000644000076500001200000003174107377223650016135 0ustar jcwadmin00000000000000cblasdef caxpy {MVV CIV CVP CVP CIV MVP CIV} \ N alpha X incX Y incY cblasdef ccopy {MVV CIV CVP CIV MVP CIV} \ N X incX Y incY cblasdef cdotc_sub {MVV CIV CVP CIV CVP CIV MVP} \ N X incX Y incY dotc cblasdef cdotu_sub {MVV CIV CVP CIV CVP CIV MVP} \ N X incX Y incY dotu cblasdef cgbmv {MVV CEO CET CIV CIV CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ order TransA M N KL KU alpha A lda X incX beta Y incY cblasdef cgemm {MVV CEO CET CET CIV CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ Order TransA TransB M N K alpha A lda B ldb beta C ldc cblasdef cgemv {MVV CEO CET CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ order TransA M N alpha A lda X incX beta Y incY cblasdef cgerc {MVV CEO CIV CIV CVP CVP CIV CVP CIV MVP CIV} \ order M N alpha X incX Y incY A lda cblasdef cgeru {MVV CEO CIV CIV CVP CVP CIV CVP CIV MVP CIV} \ order M N alpha X incX Y incY A lda cblasdef chbmv {MVV CEO CEU CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ order Uplo N K alpha A lda X incX beta Y incY cblasdef chemm {MVV CEO CES CEU CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ Order Side Uplo M N alpha A lda B ldb beta C ldc cblasdef chemv {MVV CEO CEU CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ order Uplo N alpha A lda X incX beta Y incY cblasdef cher {MVV CEO CEU CIV CFV CVP CIV MVP CIV} \ order Uplo N alpha X incX A lda cblasdef cher2 {MVV CEO CEU CIV CVP CVP CIV CVP CIV MVP CIV} \ order Uplo N alpha X incX Y incY A lda cblasdef cher2k {MVV CEO CEU CET CIV CIV CVP CVP CIV CVP CIV CFV MVP CIV} \ Order Uplo Trans N K alpha A lda B ldb beta C ldc cblasdef cherk {MVV CEO CEU CET CIV CIV CFV CVP CIV CFV MVP CIV} \ Order Uplo Trans N K alpha A lda beta C ldc cblasdef chpmv {MVV CEO CEU CIV CVP CVP CVP CIV CVP MVP CIV} \ order Uplo N alpha Ap X incX beta Y incY cblasdef chpr {MVV CEO CEU CIV CFV CVP CIV MVP} \ order Uplo N alpha X incX A cblasdef chpr2 {MVV CEO CEU CIV CVP CVP CIV CVP CIV MVP} \ order Uplo N alpha X incX Y incY Ap cblasdef cscal {MVV CIV CVP MVP CIV} \ N alpha X incX cblasdef csscal {MVV CIV CFV MVP CIV} \ N alpha X incX cblasdef cswap {MVV CIV MVP CIV MVP CIV} \ N X incX Y incY cblasdef csymm {MVV CEO CES CEU CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ Order Side Uplo M N alpha A lda B ldb beta C ldc cblasdef csyr2k {MVV CEO CEU CET CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ Order Uplo Trans N K alpha A lda B ldb beta C ldc cblasdef csyrk {MVV CEO CEU CET CIV CIV CVP CVP CIV CVP MVP CIV} \ Order Uplo Trans N K alpha A lda beta C ldc cblasdef ctbmv {MVV CEO CEU CET CED CIV CIV CVP CIV MVP CIV} \ order Uplo TransA Diag N K A lda X incX cblasdef ctbsv {MVV CEO CEU CET CED CIV CIV CVP CIV MVP CIV} \ order Uplo TransA Diag N K A lda X incX cblasdef ctpmv {MVV CEO CEU CET CED CIV CVP MVP CIV} \ order Uplo TransA Diag N Ap X incX cblasdef ctpsv {MVV CEO CEU CET CED CIV CVP MVP CIV} \ order Uplo TransA Diag N Ap X incX cblasdef ctrmm {MVV CEO CES CEU CET CED CIV CIV CVP CVP CIV MVP CIV} \ Order Side Uplo TransA Diag M N alpha A lda B ldb cblasdef ctrmv {MVV CEO CEU CET CED CIV CVP CIV MVP CIV} \ order Uplo TransA Diag N A lda X incX cblasdef ctrsm {MVV CEO CES CEU CET CED CIV CIV CVP CVP CIV MVP CIV} \ Order Side Uplo TransA Diag M N alpha A lda B ldb cblasdef ctrsv {MVV CEO CEU CET CED CIV CVP CIV MVP CIV} \ order Uplo TransA Diag N A lda X incX cblasdef dasum {MDV CIV CDP CIV} \ N X incX cblasdef daxpy {MVV CIV CDV CDP CIV MDP CIV} \ N alpha X incX Y incY cblasdef dcopy {MVV CIV CDP CIV MDP CIV} \ N X incX Y incY cblasdef ddot {MDV CIV CDP CIV CDP CIV} \ N X incX Y incY cblasdef dgbmv {MVV CEO CET CIV CIV CIV CIV CDV CDP CIV CDP CIV CDV MDP CIV} \ order TransA M N KL KU alpha A lda X incX beta Y incY cblasdef dgemm {MVV CEO CET CET CIV CIV CIV CDV CDP CIV CDP CIV CDV MDP CIV} \ Order TransA TransB M N K alpha A lda B ldb beta C ldc cblasdef dgemv {MVV CEO CET CIV CIV CDV CDP CIV CDP CIV CDV MDP CIV} \ order TransA M N alpha A lda X incX beta Y incY cblasdef dger {MVV CEO CIV CIV CDV CDP CIV CDP CIV MDP CIV} \ order M N alpha X incX Y incY A lda cblasdef dnrm2 {MDV CIV CDP CIV} \ N X incX cblasdef drot {MVV CIV MDP CIV MDP CIV CDV CDV} \ N X incX Y incY c s cblasdef drotg {MVV MDP MDP MDP MDP} \ a b c s #cblasdef drotm {MVV CIV MDP CIV MDP CIV CDP} \ # N X incX Y incY P #cblasdef drotmg {MVV MDP MDP MDP CDV MDP} \ # d1 d2 b1 b2 P cblasdef dsbmv {MVV CEO CEU CIV CIV CDV CDP CIV CDP CIV CDV MDP CIV} \ order Uplo N K alpha A lda X incX beta Y incY cblasdef dscal {MVV CIV CDV MDP CIV} \ N alpha X incX #cblasdef dsdot {MDV CIV CFP CIV CFP CIV} \ # N X incX Y incY cblasdef dspmv {MVV CEO CEU CIV CDV CDP CDP CIV CDV MDP CIV} \ order Uplo N alpha Ap X incX beta Y incY cblasdef dspr {MVV CEO CEU CIV CDV CDP CIV MDP} \ order Uplo N alpha X incX Ap cblasdef dspr2 {MVV CEO CEU CIV CDV CDP CIV CDP CIV MDP} \ order Uplo N alpha X incX Y incY A cblasdef dswap {MVV CIV MDP CIV MDP CIV} \ N X incX Y incY cblasdef dsymm {MVV CEO CES CEU CIV CIV CDV CDP CIV CDP CIV CDV MDP CIV} \ Order Side Uplo M N alpha A lda B ldb beta C ldc cblasdef dsymv {MVV CEO CEU CIV CDV CDP CIV CDP CIV CDV MDP CIV} \ order Uplo N alpha A lda X incX beta Y incY cblasdef dsyr {MVV CEO CEU CIV CDV CDP CIV MDP CIV} \ order Uplo N alpha X incX A lda cblasdef dsyr2 {MVV CEO CEU CIV CDV CDP CIV CDP CIV MDP CIV} \ order Uplo N alpha X incX Y incY A lda cblasdef dsyr2k {MVV CEO CEU CET CIV CIV CDV CDP CIV CDP CIV CDV MDP CIV} \ Order Uplo Trans N K alpha A lda B ldb beta C ldc cblasdef dsyrk {MVV CEO CEU CET CIV CIV CDV CDP CIV CDV MDP CIV} \ Order Uplo Trans N K alpha A lda beta C ldc cblasdef dtbmv {MVV CEO CEU CET CED CIV CIV CDP CIV MDP CIV} \ order Uplo TransA Diag N K A lda X incX cblasdef dtbsv {MVV CEO CEU CET CED CIV CIV CDP CIV MDP CIV} \ order Uplo TransA Diag N K A lda X incX cblasdef dtpmv {MVV CEO CEU CET CED CIV CDP MDP CIV} \ order Uplo TransA Diag N Ap X incX cblasdef dtpsv {MVV CEO CEU CET CED CIV CDP MDP CIV} \ order Uplo TransA Diag N Ap X incX cblasdef dtrmm {MVV CEO CES CEU CET CED CIV CIV CDV CDP CIV MDP CIV} \ Order Side Uplo TransA Diag M N alpha A lda B ldb cblasdef dtrmv {MVV CEO CEU CET CED CIV CDP CIV MDP CIV} \ order Uplo TransA Diag N A lda X incX cblasdef dtrsm {MVV CEO CES CEU CET CED CIV CIV CDV CDP CIV MDP CIV} \ Order Side Uplo TransA Diag M N alpha A lda B ldb cblasdef dtrsv {MVV CEO CEU CET CED CIV CDP CIV MDP CIV} \ order Uplo TransA Diag N A lda X incX cblasdef dzasum {MDV CIV CVP CIV} \ N X incX cblasdef dznrm2 {MDV CIV CVP CIV} \ N X incX cblasdef icamax {MIV CIV CVP CIV} \ N X incX cblasdef idamax {MIV CIV CDP CIV} \ N X incX cblasdef isamax {MIV CIV CFP CIV} \ N X incX cblasdef izamax {MIV CIV CVP CIV} \ N X incX cblasdef sasum {MFV CIV CFP CIV} \ N X incX cblasdef saxpy {MVV CIV CFV CFP CIV MFP CIV} \ N alpha X incX Y incY cblasdef scasum {MFV CIV CVP CIV} \ N X incX cblasdef scnrm2 {MFV CIV CVP CIV} \ N X incX cblasdef scopy {MVV CIV CFP CIV MFP CIV} \ N X incX Y incY cblasdef sdot {MFV CIV CFP CIV CFP CIV} \ N X incX Y incY #cblasdef sdsdot {MFV CIV CFV CFP CIV CFP CIV} \ # N alpha X incX Y incY cblasdef sgbmv {MVV CEO CET CIV CIV CIV CIV CFV CFP CIV CFP CIV CFV MFP CIV} \ order TransA M N KL KU alpha A lda X incX beta Y incY cblasdef sgemm {MVV CEO CET CET CIV CIV CIV CFV CFP CIV CFP CIV CFV MFP CIV} \ Order TransA TransB M N K alpha A lda B ldb beta C ldc cblasdef sgemv {MVV CEO CET CIV CIV CFV CFP CIV CFP CIV CFV MFP CIV} \ order TransA M N alpha A lda X incX beta Y incY cblasdef sger {MVV CEO CIV CIV CFV CFP CIV CFP CIV MFP CIV} \ order M N alpha X incX Y incY A lda cblasdef snrm2 {MFV CIV CFP CIV} \ N X incX cblasdef srot {MVV CIV MFP CIV MFP CIV CFV CFV} \ N X incX Y incY c s cblasdef srotg {MVV MFP MFP MFP MFP} \ a b c s #cblasdef srotm {MVV CIV MFP CIV MFP CIV CFP} \ # N X incX Y incY P #cblasdef srotmg {MVV MFP MFP MFP CFV MFP} \ # d1 d2 b1 b2 P cblasdef ssbmv {MVV CEO CEU CIV CIV CFV CFP CIV CFP CIV CFV MFP CIV} \ order Uplo N K alpha A lda X incX beta Y incY cblasdef sscal {MVV CIV CFV MFP CIV} \ N alpha X incX cblasdef sspmv {MVV CEO CEU CIV CFV CFP CFP CIV CFV MFP CIV} \ order Uplo N alpha Ap X incX beta Y incY cblasdef sspr {MVV CEO CEU CIV CFV CFP CIV MFP} \ order Uplo N alpha X incX Ap cblasdef sspr2 {MVV CEO CEU CIV CFV CFP CIV CFP CIV MFP} \ order Uplo N alpha X incX Y incY A cblasdef sswap {MVV CIV MFP CIV MFP CIV} \ N X incX Y incY cblasdef ssymm {MVV CEO CES CEU CIV CIV CFV CFP CIV CFP CIV CFV MFP CIV} \ Order Side Uplo M N alpha A lda B ldb beta C ldc cblasdef ssymv {MVV CEO CEU CIV CFV CFP CIV CFP CIV CFV MFP CIV} \ order Uplo N alpha A lda X incX beta Y incY cblasdef ssyr {MVV CEO CEU CIV CFV CFP CIV MFP CIV} \ order Uplo N alpha X incX A lda cblasdef ssyr2 {MVV CEO CEU CIV CFV CFP CIV CFP CIV MFP CIV} \ order Uplo N alpha X incX Y incY A lda cblasdef ssyr2k {MVV CEO CEU CET CIV CIV CFV CFP CIV CFP CIV CFV MFP CIV} \ Order Uplo Trans N K alpha A lda B ldb beta C ldc cblasdef ssyrk {MVV CEO CEU CET CIV CIV CFV CFP CIV CFV MFP CIV} \ Order Uplo Trans N K alpha A lda beta C ldc cblasdef stbmv {MVV CEO CEU CET CED CIV CIV CFP CIV MFP CIV} \ order Uplo TransA Diag N K A lda X incX cblasdef stbsv {MVV CEO CEU CET CED CIV CIV CFP CIV MFP CIV} \ order Uplo TransA Diag N K A lda X incX cblasdef stpmv {MVV CEO CEU CET CED CIV CFP MFP CIV} \ order Uplo TransA Diag N Ap X incX cblasdef stpsv {MVV CEO CEU CET CED CIV CFP MFP CIV} \ order Uplo TransA Diag N Ap X incX cblasdef strmm {MVV CEO CES CEU CET CED CIV CIV CFV CFP CIV MFP CIV} \ Order Side Uplo TransA Diag M N alpha A lda B ldb cblasdef strmv {MVV CEO CEU CET CED CIV CFP CIV MFP CIV} \ order Uplo TransA Diag N A lda X incX cblasdef strsm {MVV CEO CES CEU CET CED CIV CIV CFV CFP CIV MFP CIV} \ Order Side Uplo TransA Diag M N alpha A lda B ldb cblasdef strsv {MVV CEO CEU CET CED CIV CFP CIV MFP CIV} \ order Uplo TransA Diag N A lda X incX cblasdef zaxpy {MVV CIV CVP CVP CIV MVP CIV} \ N alpha X incX Y incY cblasdef zcopy {MVV CIV CVP CIV MVP CIV} \ N X incX Y incY cblasdef zdotc_sub {MVV CIV CVP CIV CVP CIV MVP} \ N X incX Y incY dotc cblasdef zdotu_sub {MVV CIV CVP CIV CVP CIV MVP} \ N X incX Y incY dotu cblasdef zdscal {MVV CIV CDV MVP CIV} \ N alpha X incX cblasdef zgbmv {MVV CEO CET CIV CIV CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ order TransA M N KL KU alpha A lda X incX beta Y incY cblasdef zgemm {MVV CEO CET CET CIV CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ Order TransA TransB M N K alpha A lda B ldb beta C ldc cblasdef zgemv {MVV CEO CET CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ order TransA M N alpha A lda X incX beta Y incY cblasdef zgerc {MVV CEO CIV CIV CVP CVP CIV CVP CIV MVP CIV} \ order M N alpha X incX Y incY A lda cblasdef zgeru {MVV CEO CIV CIV CVP CVP CIV CVP CIV MVP CIV} \ order M N alpha X incX Y incY A lda cblasdef zhbmv {MVV CEO CEU CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ order Uplo N K alpha A lda X incX beta Y incY cblasdef zhemm {MVV CEO CES CEU CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ Order Side Uplo M N alpha A lda B ldb beta C ldc cblasdef zhemv {MVV CEO CEU CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ order Uplo N alpha A lda X incX beta Y incY cblasdef zher {MVV CEO CEU CIV CDV CVP CIV MVP CIV} \ order Uplo N alpha X incX A lda cblasdef zher2 {MVV CEO CEU CIV CVP CVP CIV CVP CIV MVP CIV} \ order Uplo N alpha X incX Y incY A lda cblasdef zher2k {MVV CEO CEU CET CIV CIV CVP CVP CIV CVP CIV CDV MVP CIV} \ Order Uplo Trans N K alpha A lda B ldb beta C ldc cblasdef zherk {MVV CEO CEU CET CIV CIV CDV CVP CIV CDV MVP CIV} \ Order Uplo Trans N K alpha A lda beta C ldc cblasdef zhpmv {MVV CEO CEU CIV CVP CVP CVP CIV CVP MVP CIV} \ order Uplo N alpha Ap X incX beta Y incY cblasdef zhpr {MVV CEO CEU CIV CDV CVP CIV MVP} \ order Uplo N alpha X incX A cblasdef zhpr2 {MVV CEO CEU CIV CVP CVP CIV CVP CIV MVP} \ order Uplo N alpha X incX Y incY Ap cblasdef zscal {MVV CIV CVP MVP CIV} \ N alpha X incX cblasdef zswap {MVV CIV MVP CIV MVP CIV} \ N X incX Y incY cblasdef zsymm {MVV CEO CES CEU CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ Order Side Uplo M N alpha A lda B ldb beta C ldc cblasdef zsyr2k {MVV CEO CEU CET CIV CIV CVP CVP CIV CVP CIV CVP MVP CIV} \ Order Uplo Trans N K alpha A lda B ldb beta C ldc cblasdef zsyrk {MVV CEO CEU CET CIV CIV CVP CVP CIV CVP MVP CIV} \ Order Uplo Trans N K alpha A lda beta C ldc cblasdef ztbmv {MVV CEO CEU CET CED CIV CIV CVP CIV MVP CIV} \ order Uplo TransA Diag N K A lda X incX cblasdef ztbsv {MVV CEO CEU CET CED CIV CIV CVP CIV MVP CIV} \ order Uplo TransA Diag N K A lda X incX cblasdef ztpmv {MVV CEO CEU CET CED CIV CVP MVP CIV} \ order Uplo TransA Diag N Ap X incX cblasdef ztpsv {MVV CEO CEU CET CED CIV CVP MVP CIV} \ order Uplo TransA Diag N Ap X incX cblasdef ztrmm {MVV CEO CES CEU CET CED CIV CIV CVP CVP CIV MVP CIV} \ Order Side Uplo TransA Diag M N alpha A lda B ldb cblasdef ztrmv {MVV CEO CEU CET CED CIV CVP CIV MVP CIV} \ order Uplo TransA Diag N A lda X incX cblasdef ztrsm {MVV CEO CES CEU CET CED CIV CIV CVP CVP CIV MVP CIV} \ Order Side Uplo TransA Diag M N alpha A lda B ldb cblasdef ztrsv {MVV CEO CEU CET CED CIV CVP CIV MVP CIV} \ order Uplo TransA Diag N A lda X incX critlib/cblas/libcblas.a0000755000076500001200000000000010573223446024625 2/home/builds/cblas/lib/LINUX/cblas_LINUX.austar jcwadmin00000000000000critlib/cblas/massage.tcl0000755000076500001200000000432607377221273015630 0ustar jcwadmin00000000000000#!/usr/bin/tclsh # Take the "cblas.h" header and turn it into a Tcl definition script. # Nov 2001, jcw@equi4.com # The output consists of calls "cblasdef blasname {types} argnames...". # The types are three-letter encodings of the C type: # char 1: C=constant M=mutable # char 2: I=int F=float D=double V=void, or E=enum # char 3: P=pointer V=value # Or, in the case of enums: # char 3: O=order T=transpose U=uplo D=diag S=side set fd [open cblas.h] set horig [read $fd] close $fd set t $horig regsub -all "#.*?\n" $t { } t regsub -all {/\*.*?\*/} $t { } t regsub -all {CBLAS_INDEX} $t {int} t regsub -all {\mcblas_} $t {} t #regsub -all {_sub\M} $t {} t regsub -all {\mconst\s+enum\s+CBLAS_(.)\w+} $t {#CE\1} t regsub -all {\mconst\s+int\s+\*} $t {#CIP } t regsub -all {\mconst\s+int\M} $t {#CIV} t regsub -all {\mint\s+\*} $t {#MIP } t regsub -all {\mint\M} $t {#MIV} t regsub -all {\mconst\s+float\s+\*} $t {#CFP } t regsub -all {\mconst\s+float\M} $t {#CFV} t regsub -all {\mfloat\s+\*} $t {#MFP } t regsub -all {\mfloat\M} $t {#MFV} t regsub -all {\mconst\s+double\s+\*} $t {#CDP } t regsub -all {\mconst\s+double\M} $t {#CDV} t regsub -all {\mdouble\s+\*} $t {#MDP } t regsub -all {\mdouble\M} $t {#MDV} t regsub -all {\mconst\s+void\s+\*} $t {#CVP } t #regsub -all {\mconst\s+void\M} $t {#CVV} t regsub -all {\mvoid\s+\*} $t {#MVP } t regsub -all {\mvoid\M} $t {#MVV} t #regsub -all {\mconst\s+char\s+\*} $t {#CCP } t regsub -all {\menum\M.*?;} $t { } t regsub -all {,} $t { } t regsub -all {\(} $t " \{ " t regsub -all {\)} $t " \} " t regsub -all {\s\s+} $t { } t regsub -all {\s+;} $t {;} t regsub -all {;\s+} $t {;} t regsub -all {^\s+} $t {} t regsub -all {;$} $t {} t foreach x [split [string trim $t] {;}] { if {[llength $x] != 3} { puts $x } foreach {a b c} $x break if {$b == "xerbla"} continue if {[llength $c] % 2} { puts $x } set t [list $a] set n {} foreach {y z} $c { lappend t $y lappend n $z } regsub -all {#} $t {} t set defs($b) [list $t $n] } puts "cblas.h: [array size defs] definitions" set fd [open cblasdefs.tcl w] foreach x [lsort [array names defs]] { set y $defs($x) puts $fd "cblasdef $x\t[list [lindex $y 0]] \\" puts $fd "\t\t[lindex $y 1]" } close $fd critlib/cblas.README0000644000076500001200000000433607377265226014367 0ustar jcwadmin00000000000000Interfacing to the (C)BLAS math library ======================================= Rev 0.11: Now works, added example1 from CBLAS distribution Rev 0.10: Initial release This is an extension which uses Tcl to generate its own CriTcl binding. There's a script ("cblas/massage.tcl") which reads the "cblas.h" header and generates a Tcl script representing all CBLAS routine definitions. After that, things are relatively straightforward: cblas.tcl is a Tcl package, which uses the generated Tcl script to produce tons of calls to critcl::ccommand. Each defines one Tcl command, named "cblas::...". The mechanism for dealing with data is tricky (but efficient). Where an input array is needed, you should give the name of a variable which contains a bytearray with the proper data. Where an output array is needed, you need to supply a variable which has been preset to a byte array of the proper size. That can be a "binary format d* {...}" to provide data, or by creating a blank buffer ("binary format x32" sets up a 32-byte buffer). Tcl does offer a nice convenience: where an enum is expected (of type Order, Transpose, Uplo, Diag, or Side), you supply the setting as a string (i.e. specify row order as "R", "Row", or "RowMajor"). This is efficient (as are scalar numeric arguments) due to Tcl's dual objects. Here's CBLAS example 1, in Tcl: package require cblas set m 4 set n 4 set lda 4 set incx 1 set incy 1 set alpha 1 set beta 0 set a [binary format d*d*d*d* {1 2 3 4} \ {1 1 1 1} \ {3 4 5 6} \ {5 6 7 8}] set x [binary format d* {1 2 1 1}] set y [binary format d* {0 0 0 0}] cblas::dgemv C N $m $n $alpha a $lda x $incx $beta y $incy binary scan $y d* out puts $out The following routines were disabled during my trial, because I do not seem to have all the required BLAS routines and got linker errors: drotm drotmg dsdot sdsdot srotm srotmg The CBLAS code has not been modified, but a "-fPIC" option was added to the makefile, so CriTcl can link this package as shared library. This package is still experimental. As some other packages in CritLib, it is working code but also an example of what "CriTcl-coding" can do. critlib/cblas.tcl0000644000076500001200000001177707377254004014213 0ustar jcwadmin00000000000000# Interface to the 140+ CBLAS standard math routines package provide cblas 0.11 package require critcl namespace eval cblas { namespace export * namespace eval v { array set ctype { CEO int CET int CEU int CED int CES int CIP {const int *} CIV int MIP {int *} MIV int CFP {const float *} CFV float MFP {float *} MFV float CDP {const double *} CDV double MDP {double *} MDV double CVP {const void *} MVP {void *} MVV void } array set cdesc { CEO O CET T CEU U CED D CES S CIP i CFP f CDP d CVP v } } critcl::cheaders cblas/cblas.h critcl::clibraries -Lcblas -lcblas -lblas -lg2c critcl::ccode { #include #include #include /* static int SetupArgs(Tcl_Interp* ip, int nargs, char* desc, int objc, Tcl_Obj *CONST objv[], ...) */ static int SetupArgs TCL_VARARGS_DEF(Tcl_Interp*, arg1) { int nargs, objc, i; double d; char *desc; Tcl_Obj *o, ** objv; Tcl_Interp *ip; va_list argList; ip = TCL_VARARGS_START(Tcl_Interp*, arg1, argList); nargs = va_arg(argList, int); desc = va_arg(argList, char*); objc = va_arg(argList, int); objv = va_arg(argList, Tcl_Obj**); if (nargs != objc - 1) { char *args = strchr(desc, ' '); Tcl_WrongNumArgs(ip, 1, objv, args != NULL ? args + 1 : "?"); return TCL_ERROR; } while (*desc != ':') { void *p = va_arg(argList, void*); ++objv; switch (*desc++) { case 'O': { static char* codes[] = { "RowMajor", "ColMajor", 0 }; if (Tcl_GetIndexFromObj(ip, *objv, codes, "order", 0, &i) != TCL_OK) return TCL_ERROR; *(int*) p = i + 101; break; } case 'T': { static char* codes[] = { "NoTrans", "Trans", "ConjTrans", 0 }; if (Tcl_GetIndexFromObj(ip, *objv, codes, "trans", 0, &i) != TCL_OK) return TCL_ERROR; *(int*) p = i + 111; break; } case 'U': { static char* codes[] = { "Upper", "Lower", 0 }; if (Tcl_GetIndexFromObj(ip, *objv, codes, "uplo", 0, &i) != TCL_OK) return TCL_ERROR; *(int*) p = i + 121; break; } case 'D': { static char* codes[] = { "NonUnit", "Unit", 0 }; if (Tcl_GetIndexFromObj(ip, *objv, codes, "diag", 0, &i) != TCL_OK) return TCL_ERROR; *(int*) p = i + 131; break; } case 'S': { static char* codes[] = { "Left", "Right", 0 }; if (Tcl_GetIndexFromObj(ip, *objv, codes, "side", 0, &i) != TCL_OK) return TCL_ERROR; *(int*) p = i + 141; break; } case 'i': if (Tcl_GetIntFromObj(ip, *objv, &i) != TCL_OK) return TCL_ERROR; *(int*) p = i; break; case 'f': if (Tcl_GetDoubleFromObj(ip, *objv, &d) != TCL_OK) return TCL_ERROR; *(float*) p = d; break; case 'd': if (Tcl_GetDoubleFromObj(ip, *objv, &d) != TCL_OK) return TCL_ERROR; *(double*) p = d; break; case '<': case '>': o = Tcl_ObjGetVar2(ip, *objv, NULL, TCL_LEAVE_ERR_MSG); /* output variables must not be shared, copy if they are */ if (o != NULL && desc[-1] == '>' && Tcl_IsShared(o)) o = Tcl_ObjSetVar2(ip, *objv, NULL, Tcl_DuplicateObj(o), TCL_LEAVE_ERR_MSG); if (o == NULL) return TCL_ERROR; *(char**) p = Tcl_GetByteArrayFromObj(o, NULL); ++desc; break; default: Tcl_SetResult(ip, "bad option in SetupArgs", TCL_STATIC); return TCL_ERROR; } } return TCL_OK; } } proc cblasdef {name types args} { set rtype [lindex $types 0] set types [lrange $types 1 end] set body "" if {$rtype != "MVV"} { append body " $v::ctype($rtype) _$name;\n" } set desc "" set vars "" foreach x $types y $args { append body " $v::ctype($x) _$y;\n" append desc $v::cdesc($x) append vars ",&_$y" } append body " if (SetupArgs(ip,[llength $types],\"$desc:$name $args\"," append body "objc,objv$vars) != TCL_OK)\n" append body " return TCL_ERROR;\n" regsub -all {&} $vars {} vars append body " " if {$rtype != "MVV"} { append body "_$name = " } append body "cblas_${name}([string range $vars 1 end]);\n" append body " return TCL_OK;\n" critcl::ccommand $name {dummy ip objc objv} $body } # cannot use "source", because that messes up "info source" for CriTcl set fd [open cblas/cblasdefs.tcl]; set script [read $fd]; close $fd eval $script rename cblasdef "" if {[info exists pkgtest] && $pkgtest} { set m 4 set n 4 set lda 4 set incx 1 set incy 1 set alpha 1 set beta 0 set a [binary format d*d*d*d* {1 2 3 4} {1 1 1 1} {3 4 5 6} {5 6 7 8}] set x [binary format d* {1 2 1 1}] set y [binary format d* {0 0 0 0}] dgemv C N $m $n $alpha a $lda x $incx $beta y $incy binary scan $y d* out puts $out } } critlib/critbind0000755000076500001200000000760607376053420014141 0ustar jcwadmin00000000000000#!/usr/bin/env tclsh # Build a custom lib or app, with all extensions linked in package require critcl set mode dynamic set linklib "" if {[lindex $argv 0] == "-link"} { set linklib [lindex $argv 1] if {[file extension $linklib] == ".a"} { set mode standalone } else { set mode static } set argv [lrange $argv 2 end] } if {[llength $argv] < 2} { puts { Usage: critbind ?-link lib? outfile infiles... The input files must all be Tcl scripts with calls to CriTcl in them. These are source'd and compilation is forced, producing object code which is then combined into a single file. The default is to create a "merged shared extension library", but if "-link" is specified, an executable will be built instead. The "lib" argument specifies the Tcl library to link to. If a static (.a) lib is given, the executable will be fully self-contained, otherwise it will use shared libraries (and be considerably smaller). Note that as library all extensions are inited by the load command, whereas with executables you'll need to do "load {} blah" to enable package "blah". This may change in the future. } exit } critcl::config combine $mode set outname [lindex $argv 0] puts "Processing:" set libs {} set objs {} set exts {} set inis {} set defs {} foreach f [lrange $argv 1 end] { set name [file root [file tail $f]] if {$name == "critcl"} continue ;# avoid reloading puts " $name" set f [critcl::file_normalize $f] set dir [file dirname $f] source $f # collect the names of all libraries (these have not yet been linked in) if {[info exists critcl::v::code($f,libs)]} { foreach x $critcl::v::code($f,libs) { if {[lsearch -exact $libs $x] < 0} { lappend libs $x } } } if {![info exists critcl::v::code($f,list)]} { puts "$f: ignored" continue } foreach {libfile ininame} [critcl::cbuild $f 0] break lappend objs $libfile append exts "extern Tcl_AppInitProc ${ininame}_Init;\n" append inis "if (${ininame}_Init(ip) != TCL_OK) return TCL_ERROR;\n" append defs "Tcl_StaticPackage(NULL, \"$name\", ${ininame}_Init, NULL);\n" } puts "Libraries: $libs" if {$linklib == ""} { if {[file extension $outname] == ".a"} { # create a static library, i.e. just collect all object code # info about which other libs which need to be linked in will be lost eval [list exec ar crs $outname] $objs } else { # create a single merged shared library critcl::config combine "" eval critcl::clibraries $objs $libs # make sure the init routine ends up with the right name regexp {^\w+} [file tail [info script]] origname set origname [string totitle $origname]_Init regexp {^\w+} [file tail $outname] targetname set targetname [string totitle $targetname]_Init critcl::ccode "#define $origname $targetname" critcl::cinit $inis set maininfo [critcl::cbuild "" 0] if {[file extension $outname] == ""} { append outname [info sharedlibext] } file delete $outname file copy [lindex $maininfo 0] $outname } } else { # create an application, either standalone or linked dynamically to Tcl set init [critcl::config appinit] if {$init == ""} { set init "return Tcl_Init(ip);" } # make sure the tclAppInit.c file is found set dir [file join [file dirname [info script]] critcl_c] critcl::cheaders -I$dir critcl::ccode " #define TCL_LOCAL_APPINIT LocalAppInit #include int LocalAppInit(Tcl_Interp *ip) { $exts $defs { $init } } " set maininfo [critcl::cbuild "" 0] set mainobj [lindex $maininfo 0] set cmdline "gcc -static -o $outname $mainobj $objs $libs $linklib -ldl -lm" if {$mode == "static"} { regsub { -static } $cmdline { -rdynamic } cmdline append cmdline " -Wl,-rpath,[file dirname $linklib]" } puts $cmdline eval exec $cmdline catch { exec strip $outname } } critlib/critbind.README0000644000076500001200000000431307376052304015062 0ustar jcwadmin00000000000000Using C code in Tcl has never been easier ========================================= 2001/11/19: Support app-specific initialization 2001/11/18: Added static lib output 2001/11/15: Initial release CritBind is a utility script which works in combination with "CriTcl" to automatically generate object code from C, nicely wrapped for use in Tcl. Usage: critbind ?-link lib? outfile infiles... The input files must all be Tcl scripts with calls to CriTcl in them. These are source'd and compilation is forced, producing object code which is then combined into a single file. The default is to create a "merged extension library", but if "-link" is specified, an executable will be built instead. The "lib" arg specifies the Tcl library to link to. If a static (.a) lib is given, the executable will be fully self-contained, otherwise it will use shared libraries (and be much smaller). Note that as library all extensions are inited by the load command, whereas with executables you'll need to do "load {} blah" to enable package "blah". This may change in the future. Examples: Combine all of critlib's packages into a single "critlib.so": critbind critlib.so $path/critlib/*.tcl Combine all of critlib's packages into a "critlib.a" to link later: critbind critlib.a $path/critlib/*.tcl Build a tiny "critclsh" app with all compiled CritLib code in it: critbind -link $path/libtcl8.4.so critclsh $path/critlib/*.tcl Build a big statically-linked app, which also includes Tcl itself: critbind -link $path/libtcl8.4.a critclsh $path/critlib/*.tcl Note that this binding deals only with the (compiled) C side of things. The package scripts / supporting Tcl code are not in the file generated by critbind. That, dear reader, will happen later... For now, you can simply "load" the code, and then use the packages as before - CriTcl compilation does not happen if commands exist, i.e. this binding mechanism is good enough to *not* require a compiler everywhere. This initial release does not know about Tk (or wish). Nevertheless, it should be possible to load and use Tk: the latest versions of Tcl support loading Tk dynamically, i.e. as a normal extension. critlib/critcl.README0000644000076500001200000001356607645251255014563 0ustar jcwadmin00000000000000A C Runtime In Tcl for on-the-fly compilation ============================================= Rev 0.33: Bumped version to brin in line with critcl.kit Rev 0.32: Improvements by Steve Landers for standalone use Rev 0.31: Fixed so critcl can be used from the interactive prompt Rev 0.30: Allow passing Tcl_Interp*, Tcl_Obj*'s, or return a status Rev 0.29: Redirect gcc stderr to logfile, add some support for "-g" Rev 0.28: Support for app-specific initialization (used in TclKit) Rev 0.27: Commands are now defined in currently active namespace The http://mini.net/tcl/2516.html page is a good spot to comment on this. The C Runtime In Tcl is a self-contained package to build C code into an extension on the fly. It is somewhat inspired by Brian Ingerson's Inline for Perl, but CriTcl is considerably more lightweight. The idea is to wrap C code into something that will compile into a Tcl extension, and then also fire up the compiler. Compiled chunks will be cached in your ~/.critcl/ directory, so subsequent use will be instant. The main definition is "critcl::cproc", it lets you define a (surprise!) C proc, with C code as body. Args and return values must be typed. There are no default args or ways to pass more sophisticated data items than int/long/float/double/char* for now. The return type can be "string", meaning it's a Tcl_Alloc'ed char* which will at some point be Tcl_Free'd. As of rev 0.30, you can also use Tcl_Obj* args (no refcount change), or return it (in which case it will be decref'ed). If the first parameter to a cproc has type "Tcl_Interp*", that'll be passed in. Lastly, if the return type is "ok", then an int return code of type TCL_OK/TCL_ERROR is expected and will be processed as usual (errors must set the result, so it is most likely that you'll also want to specify the Tcl_Interp* arg). Some more commands defined in CriTcl are: critcl::ccode { ... C code ... } inject C code as is (#includes, #defines, common defs, etc) critcl::cinit { ... C code ... } inject C code as is, to be executed at extension-init time critcl::ccommand name {cd ip objc objv} { ... C code ... } ties code to the Tcl_CreateObjCommand without further wrapping critcl::cdata name anydata when called, [name] will return anydata (as byte array) To compile additional source files, you can use the following: critcl::cheaders file ... set up file(s) to be available in compiles (also: "dir/*.h") critcl::csources file ... additional source files passed to the compiler on the cmd line critcl::clibraries file ... additional libraries (args such as "-l..." are passed on as is) GENERATING SHARED LIBS FOR FURTHER USE As of revision 0.22, you can now choose to store compiled binaries in a specific directory and give them a more meaningful name. If file "foo.tcl" uses critcl, then the following sequence can be used: package require critcl critcl::config outdir . source blah/foo.tcl ;# creates & uses "blah/foo.so" Or, use an absolute path to store all compiled libs in a single area: package require critcl critcl::config outdir ~/critcl-linux/ source blah/foo.tcl ;# creates & uses "~/critcl-linux/foo.so" If the libs exist, no re-compilations will be started. Note: there is a key difference with the default case (which creates libs with funny names in the ~/.critcl/ area): SETTING "OUTDIR" DISABLES AUTOMATIC RECOMPILES! If you set outdir, then you must delete shared libs to get them re-built. The CritLib distribution comes with a simple "pkgtest.tcl" script, which can be used to (re-) generate shared libs for all CritLib packages: rm -f ~/mylibs/* pkgtest ~/mylibs Without command-line argument, pkgtest does a normal test run as before. If all libraries are found, then CriTcl will never launch the compiler. This makes it possible to deploy to systems which do not need/have gcc. See also the "critbind" utility, which can generate a single file for easy deployment (as shared lib, static lib, or as complete app). SOLVING COMPILE PROBLEMS The intermediate C code generated by CriTcl can be kept around by doing: critcl::config keepsrc 1 In case of compile errors the source always remains in the ~/.critcl/ directory, but either way it won't be obvious because of the weird file names. To find out what the last compile was doing, look at the end of the log file, which for 0.22 is called "~/.critcl/v022.log". CriTcl inserts a "#line" directive in the generated C source, so that an error on line three of cproc "foo" in script "bar.tcl" will be reported by gcc as occurring on "bar.tcl/foo", line 3. No name is added to ccode sections, so with multiple sections, identifying the line is harder. If "critcl::cheaders -g" is given, then the output file is not stripped and the "-DNDEBUG" flag is not added to the gcc command line. CLEANING UP Over time, the ~/.critcl/ directory could fill up with debris: obsolete builds of your compiled code and builds from previous CriTcl revisions. You can always delete the ~/.critcl/ area - it has no further impact than causing a few re-compiles on next use. The use of Tcl stubs, and the fact that this extension has all include files it needs to make compilation self-contained, means that this is a pure Tcl package, which should work with any (8.1 and up) installation of Tcl. Most importantly, CriTcl does not care a bit where Tcl was installed, nor even whether it was built as a static or as a dynamic executable. This is a working demo, but it is still young. It will for now blindly use "gcc" to do the compile and has somewhat rudimentary error handling. CriTcl has been verified to work on Linux and Win NT4 (MinGW) so far. One more thing: this code assumes the "md5" command is available, either as command or as package. A number of heuristics are used to locate an appropriate implementation, as last resort CriTcl will use "md5pure.tcl" which is now included in CritLib. critlib/critcl.tcl0000644000076500001200000005162207645252340014377 0ustar jcwadmin00000000000000# C Runtime In Tcl - compile C code on the fly package provide critcl 0.33 # md5 could be a cmd or a pkg, or be in a separate namespace if {[catch { md5 "" }]} { # do *not* use "package require md5c" since crtcl is not loaded yet, # but do look for a compiled one, in case object code already exists if {![catch { md5c "" }]} { interp alias {} md5 {} md5c } else { # else try to load the Tcl version in tcllib catch { package require md5 } if {![catch { md5::md5 "" }]} { interp alias {} md5 {} md5::md5 } else { # last resort: package require or source Don Libes' md5pure script if {[catch { package require md5pure }]} { if {[file exists md5pure.tcl]} { source md5pure.tcl interp alias {} md5 {} md5pure::md5 } else { source [file join [file dirname [info script]] ../md5/md5.tcl] interp alias {} md5 {} md5::md5 } } else { interp alias {} md5 {} md5pure::md5 } } } } namespace eval ::critcl { namespace export config csources clibraries cinit ccode ccommand cproc \ cdata compiling scripting failed done tk cache tsources \ platform # ouch, some md5 implementations return hex, others binary if {[string length [md5 ""]] == 32} { proc md5_hex {s} { return [md5 $s] } } else { proc md5_hex {s} { binary scan [md5 $s] H* md; return $md } } # file normalize is a Tcl 8.4 extension, emulate it if not available if {[catch { file normalize . }]} { proc file_normalize {file} { set sp [file split $file] if {[file pathtype [lindex $sp 0]] == "relative"} { set sp [file split [eval [list file join [pwd]] $sp]] } set np {} foreach ele $sp { if {$ele != ".."} { if {$ele != "."} { lappend np $ele } } elseif {[llength $np]> 1} { set np [lrange $np 0 [expr {[llength $np] - 2}]] } } if {[llength $np] > 0} { return [eval file join $np] } } } else { proc file_normalize {file} { return [file normalize $file] } } # return a platform designator, including both OS and machine # # only use first element of $tcl_platform(os) - we don't care # whether we are on "Windows NT" or "Windows XP" or whatever # # transforms $tcl_platform(machine) for some special cases # - on SunOS, matches for sun4* are transformed to sparc # - on all OS's matches for intel and i*86* are transformed to x86 # - on MacOS X "Power Macintosh" is transformed to ppc # proc platform {} { global tcl_platform set plat [lindex $tcl_platform(os) 0] set mach $tcl_platform(machine) switch -glob -- $mach { sun4* { set mach sparc } intel - i*86* { set mach x86 } "Power Macintosh" { set mach ppc } } if {$plat eq "AIX"} { set mach ppc } if {$plat eq "HP-UX"} { set mach hppa } return "$plat-$mach" } proc cache {} { return [file join ~ .critcl [::critcl::platform]] } # keep all variables in a sub-namespace for easy access namespace eval v { variable cache [::critcl::cache] variable hdrdir [file join [file dirname [info script]] critcl_c] variable prefix "v[package require critcl]" regsub {\.} $prefix {} prefix variable compile {gcc -shared -DUSE_TCL_STUBS} # this should be deferred until after we know if we are cross compiling if {$::tcl_platform(platform) != "windows"} { lappend compile "-fPIC" } variable options array set options {outdir "" keepsrc 0 combine "" appinit "" force 0} array set options {I "" L "" tk 0 language ""} variable code ;# this array collects all code snippets variable curr ;# current digest variable compiling 0 ;# indicates that the gcc/cc is available variable failed 0 ;# set if compile fails variable ininame "" variable libfile "" variable sharedlibext [info sharedlibextension] } proc emit {s} { append v::code($v::curr) $s } proc emitln {{s ""}} { emit "$s\n" } proc config {option args} { if {![info exists v::options($option)] || [llength $args] > 1} { error "option must be one of: [lsort [array names v::options]]" } if {[llength $args] == 0} { return $v::options($option) } set v::options($option) [lindex $args 0] } proc setparam {type list} { set digest [md5_hex "$type $list"] set file [file_normalize [info script]] lappend v::code($file,list) "" $digest ;# add so we can detect changes upvar v::code($file,$type) param if {[llength $list] > 0} { set base [file dirname $file] foreach x $list { if {[string index $x 0] == "-"} { lappend param $x } else { foreach y [glob [file join $base $x]] { set z [file_normalize $y] if {![file exists $z]} { error "$z: not found" } lappend param $z } } } } elseif {[info exists param]} { return $param } } proc cheaders {args} { return [setparam hdrs $args] } proc csources {args} { return [setparam srcs $args] } proc clibraries {args} { return [setparam libs $args] } proc cinit {text} { set digest [md5_hex $text] set file [file_normalize [info script]] lappend v::code($file,list) "" $digest ;# add so we can detect changes append v::code($file,init) $text \n } proc ccode {text} { set digest [md5_hex $text] set file [file_normalize [info script]] lappend v::code($file,list) "" $digest ;# add so we can detect changes set v::code($digest) "#line 1 \"[file tail $file]\"\n" append v::code($digest) $text \n } proc define {name args} { set v::curr [md5_hex "$name $args"] set file [file_normalize [info script]] set ns [uplevel 2 namespace current] if {$ns == "::"} { set ns "" } else { append ns :: } set ::auto_index($ns$name) [list [namespace current]::cbuild $file] #if {[info commands $name] != ""} { rename $name "" } lappend v::code($file,list) $name $v::curr set v::code($v::curr) "#define ns_$name \"$ns$name\" #line 1 \"[file tail $file]/$name\" " } proc ccommand {name anames args} { define $name $anames $args set clientdata NULL set delproc 0 while {[string match "-*" $args]} { switch -- [lindex $args 0] { -clientdata { set clientdata [lindex $args 1] } -delproc { set delproc [lindex $args 1] } } set args [lrange $args 2 end] } set v::clientdata($name) $clientdata set v::delproc($name) $delproc set body $args if {$body != ""} { lappend anames "" foreach {cd ip oc ov} $anames break if {$cd == ""} { set cd clientdata } if {$ip == ""} { set ip interp } if {$oc == ""} { set oc objc } if {$ov == ""} { set ov objv } set ca "(ClientData $cd, Tcl_Interp *$ip, int $oc, Tcl_Obj *CONST $ov\[])" emitln "static int" emitln "tcl_$name$ca" emitln \{ emit $body emitln \} } else { # if no body is specified, then $anames is alias for the real cmd proc emitln "#define tcl_$name $anames" emitln "int $anames\(\);" } unset v::curr } proc cproc {name adefs rtype {body "#"}} { define $name $adefs $rtype $body set cname c_$name set wname tcl_$name array set types {} set names {} set cargs {} set cnames {} # is first arg is "Tcl_Interp*", pass it without counting it as a cmd arg if {[lindex $adefs 0] == "Tcl_Interp*"} { lappend cnames ip lappend cargs [lrange $adefs 0 1] set adefs [lrange $adefs 2 end] } foreach {t n} $adefs { set types($n) $t lappend names $n lappend cnames _$n lappend cargs "$t $n" } switch -- $rtype { ok { set rtype2 "int" } string - dstring - vstring { set rtype2 "char*" } default { set rtype2 $rtype } } if {$body != "#"} { emitln "static $rtype2" emitln "${cname}([join $cargs {, }])" emit \{ emit $body emitln \} } else { emitln "#define $cname $name" } set ca "(ClientData cd, Tcl_Interp *ip, int oc, Tcl_Obj *CONST ov\[])" emitln emitln "static int" emitln "$wname$ca" emitln \{ foreach x $names { set t $types($x) switch -- $t { int - long - float - double - char* - Tcl_Obj* { emitln " $types($x) _$x;" } default { emitln " void *_$x;" } } } if {$rtype != "void"} { emit " $rtype2 rv;" } emitln " if (oc != [expr {[llength $names] + 1}]) { Tcl_WrongNumArgs(ip, 1, ov, \"[join $names { }]\"); return TCL_ERROR; } " set n 0 foreach x $names { incr n switch -- $types($x) { int { emitln " if (Tcl_GetIntFromObj(ip, ov\[$n], &_$x) != TCL_OK)" emitln " return TCL_ERROR;" } long { emitln " if (Tcl_GetLongFromObj(ip, ov\[$n], &_$x) != TCL_OK)" emitln " return TCL_ERROR;" } float { emitln " { double t;" emitln " if (Tcl_GetDoubleFromObj(ip, ov\[$n], &t) != TCL_OK)" emitln " return TCL_ERROR;" emitln " _$x = (float) t;" emitln " }" } double { emitln " if (Tcl_GetDoubleFromObj(ip, ov\[$n], &_$x) != TCL_OK)" emitln " return TCL_ERROR;" } char* { emitln " _$x = Tcl_GetString(ov\[$n]);" } default { emitln " _$x = ov\[$n];" } } } emitln emit " "; if {$rtype != "void"} { emit "rv = " } emitln "${cname}([join $cnames {, }]);" emitln switch -- $rtype { void { } ok { emitln " return rv;" } int { emitln " Tcl_SetIntObj(Tcl_GetObjResult(ip), rv);" } long { emitln " Tcl_SetLongObj(Tcl_GetObjResult(ip), rv);" } float - double { emitln " Tcl_SetDoubleObj(Tcl_GetObjResult(ip), rv);" } char* { emitln " Tcl_SetResult(ip, rv, TCL_STATIC);" } string - dstring { emitln " Tcl_SetResult(ip, rv, TCL_DYNAMIC);" } vstring { emitln " Tcl_SetResult(ip, rv, TCL_VOLATILE);" } default { emitln " Tcl_SetObjResult(ip, rv); Tcl_DecrRefCount(rv);" } } if {$rtype != "ok"} { emitln " return TCL_OK;" } emitln \} unset v::curr } proc cdata {name data} { binary scan $data c* bytes ;# split as bytes, not (unicode) chars set inittext "" set line "" foreach x $bytes { if {[string length $line] > 70} { append inittext " " $line \n set line "" } append line $x , } append inittext " " $line set count [llength $bytes] uplevel [list critcl::ccommand $name {dummy ip objc objv} " static char script\[$count] = { $inittext }; Tcl_SetByteArrayObj(Tcl_GetObjResult(ip), (unsigned char*) script, $count); return TCL_OK; "] return $name } proc cbuild {{file ""} {load 1} {prefix {}} {silent ""}} { if {$file == ""} { set file [file_normalize [info script]] } # each unique set of cmds is compiled into a separate extension set digest [md5_hex "$file $v::code($file,list)"] set cache $v::cache regsub {^~} $cache "$::env(HOME)/" cache set cache [file_normalize $cache] set base [file join $cache ${v::prefix}_$digest] set libfile $base # the compiled library will be saved for permanent use if the outdir # option is set (in which case rebuilds will no longer be automatic) if {$v::options(outdir) != ""} { set odir [file join [file dirname $file] $v::options(outdir)] set oroot [file root [file tail $file]] set libfile [file_normalize [file join $odir $oroot]] file mkdir $odir } # get the settings for this file into local variables foreach x {hdrs srcs libs init} { set $x [append v::code($file,$x) ""] ;# make sure it exists } # modify the output file name if debugging symbols are requested if {[lsearch -exact $hdrs "-g"] >= 0} { append libfile _g } # choose distinct suffix so switching between them causes a rebuild switch -- $v::options(combine) { "" { append libfile $v::sharedlibext } dynamic { append libfile _pic.o } static { append libfile _stub.o } standalone { append libfile .o } } # the init proc name takes a capitalized prefix from the package name set ininame stdin ;# in case it's called interactively regexp {^\w+} [file tail $file] ininame set ininame [string totitle $ininame] if {$prefix != {}} { set ininame "${prefix}_$ininame" } if {$v::options(force) || ![file exists $libfile]} { file mkdir $cache set log [file join $cache [pid].log] set lfd [open $log w] puts $lfd "\n[clock format [clock seconds]] - $file" set fd [open $base.c w] set names {} puts $fd "/* Generated by critcl on [clock format [clock seconds]] * source: $file * binary: $libfile */ #include \"tcl.h\"\n" if {$v::options(tk)} { puts $fd "\n#include \"tk.h\"" } foreach {name digest} $v::code($file,list) { if {[info exists v::code($digest)]} { puts $fd "/* [string repeat - 70] */\n" puts $fd $v::code($digest) if {$name != ""} { lappend names $name } } } puts $fd "/* [string repeat - 70] */" puts -nonewline $fd { #if USE_TCL_STUBS TclStubs *tclStubsPtr; TclPlatStubs *tclPlatStubsPtr; struct TclIntStubs *tclIntStubsPtr; struct TclIntPlatStubs *tclIntPlatStubsPtr; static int MyInitTclStubs (Tcl_Interp *ip) { typedef struct { char *result; Tcl_FreeProc *freeProc; int errorLine; TclStubs *stubTable; } HeadOfInterp; HeadOfInterp *hoi = (HeadOfInterp*) ip; if (hoi->stubTable == NULL || hoi->stubTable->magic != TCL_STUB_MAGIC) { ip->result = "This extension requires stubs-support."; ip->freeProc = TCL_STATIC; return 0; } tclStubsPtr = hoi->stubTable; if (Tcl_PkgRequire(ip, "Tcl", "8.1", 0) == NULL) { tclStubsPtr = NULL; return 0; } if (tclStubsPtr->hooks != NULL) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; } return 1; } #endif } # now do the Tk stuff if {$v::options(tk)} { setup_tk_stubs $fd append v::compile " -DUSE_TK_STUBS" } puts $fd " #ifdef __cplusplus extern \"C\" { #endif DLLEXPORT int ${ininame}_Init(Tcl_Interp *ip) { #if USE_TCL_STUBS if (!MyInitTclStubs(ip)) return TCL_ERROR; #endif" if {$v::options(tk)} { puts $fd " #if USE_TK_STUBS if (!MyInitTkStubs(ip)) return TCL_ERROR; #endif" } puts $fd "$init " foreach x [lsort $names] { if {[info exists v::clientdata($name)]} { set cd $v::clientdata($name) } else { set cd NULL } if {[info exists v::delproc($name)]} { set dp $v::delproc($name) } else { set dp 0 } puts $fd " Tcl_CreateObjCommand(ip, ns_$x, tcl_$x, $cd, $dp);" } puts $fd " return TCL_OK; } #ifdef __cplusplus } #endif" close $fd foreach x [glob -directory $v::hdrdir *.h] { set fn [file join $cache [file tail $x]] if {![file exists $fn]} { file copy $x $fn } } set copts [list] if {$v::options(language) != ""} { lappend copts -x $v::options(language) } if {$v::options(I) != ""} { lappend copts -I$v:::options(I) } lappend copts -I$cache set copies {} foreach x $hdrs { if {[string index $x 0] == "-"} { lappend copts $x } else { set copy [file join $cache [file tail $x]] file delete $copy file copy $x $copy lappend copies $copy } } set cmdline "$v::compile $copts -o $libfile $base.c $srcs" append cmdline " " $libs if {$v::options(combine) == ""} { if {![regexp { -g } $cmdline]} { append cmdline " -O2 -DNDEBUG -Wl,-s" } } else { regsub { -shared } $cmdline { -r -nostdlib } cmdline if {$v::options(combine) != "dynamic"} { regsub { -fPIC } $cmdline { } cmdline if {$v::options(combine) == "standalone"} { regsub { -DUSE_TCL_STUBS } $cmdline { } cmdline } } } if {$::tcl_platform(os) == "Darwin"} { regsub { -shared } $cmdline { -dynamiclib -fno-common } cmdline regsub { -Wl,-s} $cmdline {} cmdline } puts $lfd $cmdline if {[catch { eval exec $cmdline 2>@ $lfd if {!$v::options(keepsrc)} { file delete $base.c } puts $lfd "$libfile: [file size $libfile] bytes" } err]} { puts $lfd "ERROR while compiling code in $file:" incr v::failed } # read build log close $lfd set lfd [open $log] set msgs [read $lfd] close $lfd file delete -force $log # append to critcl log set log [file join $cache $v::prefix.log] set lfd [open $log a] puts $lfd $msgs close $lfd foreach x $copies { file delete $x } } if {$v::failed} { if {$silent == ""} { puts stderr $msgs puts stderr "critcl build failed ($file)" } } elseif {$load} { load $libfile $ininame } foreach {name digest} $v::code($file,list) { if {$name != "" && [info exists v::code($digest)]} { unset v::code($digest) } } foreach x {hdrs srcs init} { array unset v::code $file,$x } return [list $libfile $ininame] } proc setup_tk_stubs fd { puts -nonewline $fd { #if USE_TK_STUBS TkStubs *tkStubsPtr; struct TkPlatStubs *tkPlatStubsPtr; struct TkIntStubs *tkIntStubsPtr; struct TkIntPlatStubs *tkIntPlatStubsPtr; struct TkIntXlibStubs *tkIntXlibStubsPtr; static int MyInitTkStubs (Tcl_Interp *ip) { if (Tcl_PkgRequireEx(ip, "Tk", "8.1", 0, (ClientData*) &tkStubsPtr) == NULL) return 0; if (tkStubsPtr == NULL || tkStubsPtr->hooks == NULL) { Tcl_SetResult(ip, "This extension requires Tk stubs-support.", TCL_STATIC); return 0; } tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs; tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs; tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs; tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs; return 1; } #endif } } proc compiling {} { # check that we can indeed run a compiler # should only need to do this if we have to compile the code? set nul /dev/null if {$::tcl_platform(platform) == "windows"} { set nul NUL } if {[catch {exec gcc -v 2> $nul}] && [catch {exec cc -v 2> $nul}]} { set v::compiling 0 } else { set v::compiling 1 } return $v::compiling } proc scripting {} { return [expr {$v::compiling == 0}] } proc done {} { return 0 } proc failed {{silent ""}} { if {$v::libsrc == ""} { cbuild "" 0 "" $silent } else { lassign [cbuild $v::libsrc 0 ns silent] v::libfile v::ininame } proc failed {args} { puts stderr "error: critcl::failed can only be called once" exit 1 } return $v::failed } proc tk {} { critcl::config tk 1 } proc check {code} { file mkdir $v::cache ;# just in case set pref [file normalize [file join $v::cache check_[pid]]] set src $pref.c set fd [open $src w] puts $fd $code close $fd set copts [list] if {$v::options(I) != ""} { lappend copts -I$v:::options(I) } lappend copts -I$v::cache set cmdline "$v::compile $copts [file normalize $src] -o $pref.o" if {[catch {eval exec $cmdline} err]} { set result 0 } else { set result 1 } foreach tmp [glob -directory $v::cache check_[pid].*] { file delete -force $tmp } return $result } proc crosscheck {} { global tcl_platform if {![catch {set machine [eval exec "$v::compile -dumpmachine"]}]} { set platform "" switch -glob -- $machine { *mingw* { if {![string equal $tcl_platform(platform) windows]} { set tcl_platform(byteOrder) littleEndian set tcl_platform(machine) intel set tcl_platform(os) "Windows NT" set tcl_platform(osVersion) 5.0 set tcl_platform(platform) windows set tcl_platform(wordSize) 4 set result 1 set v::sharedlibext .dll set v::cache [::critcl::cache] regsub { -fPIC} $v::compile {} v::compile set platform Windows set desc Xmingwin } } } } if {$platform != ""} { puts stderr "Cross compiling for $platform using $desc" } } proc sharedlibext {} { return $v::sharedlibext } proc tsources {args} { lappend v::tsources $args } } critlib/critcl_c/0000755000076500001200000000000007363030171014160 5ustar jcwadmin00000000000000critlib/critcl_c/tcl.h0000644000076500001200000022510307363030171015116 0ustar jcwadmin00000000000000/* * tcl.h -- * * This header file describes the externally-visible facilities * of the Tcl interpreter. * * Copyright (c) 1987-1994 The Regents of the University of California. * Copyright (c) 1993-1996 Lucent Technologies. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tcl.h,v 1.104 2001/10/15 17:34:35 hobbs Exp $ */ #ifndef _TCL #define _TCL /* * For C++ compilers, use extern "C" */ #ifdef __cplusplus extern "C" { #endif /* * The following defines are used to indicate the various release levels. */ #define TCL_ALPHA_RELEASE 0 #define TCL_BETA_RELEASE 1 #define TCL_FINAL_RELEASE 2 /* * When version numbers change here, must also go into the following files * and update the version numbers: * * library/init.tcl (only if Major.minor changes, not patchlevel) 1 LOC * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.in (as above) * win/tcl.m4 (not patchlevel) * win/makefile.vc (not patchlevel) 2 LOC * library/reg/pkgIndex.tcl (not patchlevel, for tclregNN.dll) * library/dde/pkgIndex.tcl (not patchlevel, for tclddeNN.dll) * README (sections 0 and 2) * mac/README (2 LOC, not patchlevel) * win/README.binary (sections 0-4) * win/README (not patchlevel) (sections 0 and 2) * unix/README (not patchlevel) (part (h)) * unix/tcl.spec (2 LOC Major/Minor, 1 LOC patch) * tests/basic.test (1 LOC M/M) * tools/tcl.hpj.in (not patchlevel, for windows installer) * tools/tcl.wse.in (for windows installer) * tools/tclSplash.bmp (not patchlevel) */ #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 4 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE #define TCL_RELEASE_SERIAL 4 #define TCL_VERSION "8.4" #define TCL_PATCH_LEVEL "8.4a4" /* * The following definitions set up the proper options for Windows * compilers. We use this method because there is no autoconf equivalent. */ #ifndef __WIN32__ # if defined(_WIN32) || defined(WIN32) || \ defined(__CYGWIN__) || defined(__MINGW32__) || defined(__BORLANDC__) # define __WIN32__ # ifndef WIN32 # define WIN32 # endif # endif #endif #ifdef __WIN32__ # ifndef STRICT # define STRICT # endif # ifndef USE_PROTOTYPE # define USE_PROTOTYPE 1 # endif # ifndef HAS_STDARG # define HAS_STDARG 1 # endif # ifndef USE_PROTOTYPE # define USE_PROTOTYPE 1 # endif #endif /* __WIN32__ */ /* * The following definitions set up the proper options for Macintosh * compilers. We use this method because there is no autoconf equivalent. */ #ifdef MAC_TCL # ifndef HAS_STDARG # define HAS_STDARG 1 # endif # ifndef USE_TCLALLOC # define USE_TCLALLOC 1 # endif # ifndef NO_STRERROR # define NO_STRERROR 1 # endif # define INLINE #endif /* * Utility macros: STRINGIFY takes an argument and wraps it in "" (double * quotation marks), JOIN joins two arguments. */ #define VERBATIM(x) x #ifdef _MSC_VER # define STRINGIFY(x) STRINGIFY1(x) # define STRINGIFY1(x) #x # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b #else # ifdef RESOURCE_INCLUDED # define STRINGIFY(x) STRINGIFY1(x) # define STRINGIFY1(x) #x # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b # else # ifdef __STDC__ # define STRINGIFY(x) #x # define JOIN(a,b) a##b # else # define STRINGIFY(x) "x" # define JOIN(a,b) VERBATIM(a)VERBATIM(b) # endif # endif #endif /* * Special macro to define mutexes, that doesn't do anything * if we are not using threads. */ #ifdef TCL_THREADS #define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name; #else #define TCL_DECLARE_MUTEX(name) #endif /* * Macros that eliminate the overhead of the thread synchronization * functions when compiling without thread support. */ #ifndef TCL_THREADS #define Tcl_MutexLock(mutexPtr) #define Tcl_MutexUnlock(mutexPtr) #define Tcl_MutexFinalize(mutexPtr) #define Tcl_ConditionNotify(condPtr) #define Tcl_ConditionWait(condPtr, mutexPtr, timePtr) #define Tcl_ConditionFinalize(condPtr) #endif /* TCL_THREADS */ /* * A special definition used to allow this header file to be included * in resource files so that they can get obtain version information from * this file. Resource compilers don't like all the C stuff, like typedefs * and procedure declarations, that occur below. */ #ifndef RESOURCE_INCLUDED #ifndef BUFSIZ #include #endif /* * Definitions that allow Tcl functions with variable numbers of * arguments to be used with either varargs.h or stdarg.h. TCL_VARARGS * is used in procedure prototypes. TCL_VARARGS_DEF is used to declare * the arguments in a function definiton: it takes the type and name of * the first argument and supplies the appropriate argument declaration * string for use in the function definition. TCL_VARARGS_START * initializes the va_list data structure and returns the first argument. */ #if defined(__STDC__) || defined(HAS_STDARG) # include # define TCL_VARARGS(type, name) (type name, ...) # define TCL_VARARGS_DEF(type, name) (type name, ...) # define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) #else # include # ifdef __cplusplus # define TCL_VARARGS(type, name) (type name, ...) # define TCL_VARARGS_DEF(type, name) (type va_alist, ...) # else # define TCL_VARARGS(type, name) () # define TCL_VARARGS_DEF(type, name) (va_alist) # endif # define TCL_VARARGS_START(type, name, list) \ (va_start(list), va_arg(list, type)) #endif /* * Macros used to declare a function to be exported by a DLL. * Used by Windows, maps to no-op declarations on non-Windows systems. * The default build on windows is for a DLL, which causes the DLLIMPORT * and DLLEXPORT macros to be nonempty. To build a static library, the * macro STATIC_BUILD should be defined. */ #ifdef STATIC_BUILD # define DLLIMPORT # define DLLEXPORT #else # if defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || (defined(__GNUC__) && defined(__declspec))) # define DLLIMPORT __declspec(dllimport) # define DLLEXPORT __declspec(dllexport) # else # define DLLIMPORT # define DLLEXPORT # endif #endif /* * These macros are used to control whether functions are being declared for * import or export. If a function is being declared while it is being built * to be included in a shared library, then it should have the DLLEXPORT * storage class. If is being declared for use by a module that is going to * link against the shared library, then it should have the DLLIMPORT storage * class. If the symbol is beind declared for a static build or for use from a * stub library, then the storage class should be empty. * * The convention is that a macro called BUILD_xxxx, where xxxx is the * name of a library we are building, is set on the compile line for sources * that are to be placed in the library. When this macro is set, the * storage class will be set to DLLEXPORT. At the end of the header file, the * storage class will be reset to DLLIMPORt. */ #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT #else # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif /* * Definitions that allow this header file to be used either with or * without ANSI C features like function prototypes. */ #undef _ANSI_ARGS_ #undef CONST #ifndef INLINE # define INLINE #endif #if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE) # define _USING_PROTOTYPES_ 1 # define _ANSI_ARGS_(x) x # define CONST const #else # define _ANSI_ARGS_(x) () # define CONST #endif /* * Make sure EXTERN isn't defined elsewhere */ #ifdef EXTERN #undef EXTERN #endif /* EXTERN */ #ifdef __cplusplus # define EXTERN extern "C" TCL_STORAGE_CLASS #else # define EXTERN extern TCL_STORAGE_CLASS #endif /* * Macro to use instead of "void" for arguments that must have * type "void *" in ANSI C; maps them to type "char *" in * non-ANSI systems. */ #ifndef __WIN32__ #ifndef VOID # ifdef __STDC__ # define VOID void # else # define VOID char # endif #endif #else /* __WIN32__ */ /* * The following code is copied from winnt.h */ #ifndef VOID #define VOID void typedef char CHAR; typedef short SHORT; typedef long LONG; #endif #endif /* __WIN32__ */ /* * Miscellaneous declarations. */ #ifndef NULL #define NULL 0 #endif #ifndef _CLIENTDATA # if defined(__STDC__) || defined(__cplusplus) || defined(__BORLANDC__) typedef void *ClientData; # else typedef int *ClientData; # endif /* __STDC__ */ #define _CLIENTDATA #endif /* * This flag controls whether binary compatability is maintained with * extensions built against a previous version of Tcl. This is true * by default. */ #ifndef TCL_PRESERVE_BINARY_COMPATABILITY #define TCL_PRESERVE_BINARY_COMPATABILITY 1 #endif /* * Data structures defined opaquely in this module. The definitions below * just provide dummy types. A few fields are made visible in Tcl_Interp * structures, namely those used for returning a string result from * commands. Direct access to the result field is discouraged in Tcl 8.0. * The interpreter result is either an object or a string, and the two * values are kept consistent unless some C code sets interp->result * directly. Programmers should use either the procedure Tcl_GetObjResult() * or Tcl_GetStringResult() to read the interpreter's result. See the * SetResult man page for details. * * Note: any change to the Tcl_Interp definition below must be mirrored * in the "real" definition in tclInt.h. * * Note: Tcl_ObjCmdProc procedures do not directly set result and freeProc. * Instead, they set a Tcl_Obj member in the "real" structure that can be * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ typedef struct Tcl_Interp { char *result; /* If the last command returned a string * result, this points to it. */ void (*freeProc) _ANSI_ARGS_((char *blockPtr)); /* Zero means the string result is * statically allocated. TCL_DYNAMIC means * it was allocated with ckalloc and should * be freed with ckfree. Other values give * the address of procedure to invoke to * free the result. Tcl_Eval must free it * before executing next command. */ int errorLine; /* When TCL_ERROR is returned, this gives * the line number within the command where * the error occurred (1 if first line). */ } Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; typedef struct Tcl_Command_ *Tcl_Command; typedef struct Tcl_Condition_ *Tcl_Condition; typedef struct Tcl_EncodingState_ *Tcl_EncodingState; typedef struct Tcl_Encoding_ *Tcl_Encoding; typedef struct Tcl_Event Tcl_Event; typedef struct Tcl_Mutex_ *Tcl_Mutex; typedef struct Tcl_Pid_ *Tcl_Pid; typedef struct Tcl_RegExp_ *Tcl_RegExp; typedef struct Tcl_ThreadDataKey_ *Tcl_ThreadDataKey; typedef struct Tcl_ThreadId_ *Tcl_ThreadId; typedef struct Tcl_TimerToken_ *Tcl_TimerToken; typedef struct Tcl_Trace_ *Tcl_Trace; typedef struct Tcl_Var_ *Tcl_Var; typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion; /* * Definition of the interface to procedures implementing threads. * A procedure following this definition is given to each call of * 'Tcl_CreateThread' and will be called as the main fuction of * the new thread created by that call. */ #ifdef MAC_TCL typedef pascal void *(Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); #elif defined __WIN32__ typedef unsigned (__stdcall Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); #else typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); #endif /* * Threading function return types used for abstracting away platform * differences when writing a Tcl_ThreadCreateProc. See the NewThread * function in generic/tclThreadTest.c for it's usage. */ #ifdef MAC_TCL # define Tcl_ThreadCreateType pascal void * # define TCL_THREAD_CREATE_RETURN return NULL #elif defined __WIN32__ # define Tcl_ThreadCreateType unsigned __stdcall # define TCL_THREAD_CREATE_RETURN return 0 #else # define Tcl_ThreadCreateType void # define TCL_THREAD_CREATE_RETURN #endif /* * Definition of values for default stacksize and the possible flags to be * given to Tcl_CreateThread. */ #define TCL_THREAD_STACK_DEFAULT (0) /* Use default size for stack */ #define TCL_THREAD_NOFLAGS (0000) /* Standard flags, default behaviour */ #define TCL_THREAD_JOINABLE (0001) /* Mark the thread as joinable */ /* * Flag values passed to Tcl_GetRegExpFromObj. */ #define TCL_REG_BASIC 000000 /* BREs (convenience) */ #define TCL_REG_EXTENDED 000001 /* EREs */ #define TCL_REG_ADVF 000002 /* advanced features in EREs */ #define TCL_REG_ADVANCED 000003 /* AREs (which are also EREs) */ #define TCL_REG_QUOTE 000004 /* no special characters, none */ #define TCL_REG_NOCASE 000010 /* ignore case */ #define TCL_REG_NOSUB 000020 /* don't care about subexpressions */ #define TCL_REG_EXPANDED 000040 /* expanded format, white space & * comments */ #define TCL_REG_NLSTOP 000100 /* \n doesn't match . or [^ ] */ #define TCL_REG_NLANCH 000200 /* ^ matches after \n, $ before */ #define TCL_REG_NEWLINE 000300 /* newlines are line terminators */ #define TCL_REG_CANMATCH 001000 /* report details on partial/limited * matches */ /* * The following flag is experimental and only intended for use by Expect. It * will probably go away in a later release. */ #define TCL_REG_BOSONLY 002000 /* prepend \A to pattern so it only * matches at the beginning of the * string. */ /* * Flags values passed to Tcl_RegExpExecObj. */ #define TCL_REG_NOTBOL 0001 /* Beginning of string does not match ^. */ #define TCL_REG_NOTEOL 0002 /* End of string does not match $. */ /* * Structures filled in by Tcl_RegExpInfo. Note that all offset values are * relative to the start of the match string, not the beginning of the * entire string. */ typedef struct Tcl_RegExpIndices { long start; /* character offset of first character in match */ long end; /* character offset of first character after the * match. */ } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { int nsubs; /* number of subexpressions in the * compiled expression */ Tcl_RegExpIndices *matches; /* array of nsubs match offset * pairs */ long extendStart; /* The offset at which a subsequent * match might begin. */ long reserved; /* Reserved for later use. */ } Tcl_RegExpInfo; /* * Picky compilers complain if this typdef doesn't appear before the * struct's reference in tclDecls.h. */ typedef struct stat *Tcl_Stat_; /* * When a TCL command returns, the interpreter contains a result from the * command. Programmers are strongly encouraged to use one of the * procedures Tcl_GetObjResult() or Tcl_GetStringResult() to read the * interpreter's result. See the SetResult man page for details. Besides * this result, the command procedure returns an integer code, which is * one of the following: * * TCL_OK Command completed normally; the interpreter's * result contains the command's result. * TCL_ERROR The command couldn't be completed successfully; * the interpreter's result describes what went wrong. * TCL_RETURN The command requests that the current procedure * return; the interpreter's result contains the * procedure's return value. * TCL_BREAK The command requests that the innermost loop * be exited; the interpreter's result is meaningless. * TCL_CONTINUE Go on to the next iteration of the current loop; * the interpreter's result is meaningless. */ #define TCL_OK 0 #define TCL_ERROR 1 #define TCL_RETURN 2 #define TCL_BREAK 3 #define TCL_CONTINUE 4 #define TCL_RESULT_SIZE 200 /* * Flags to control what substitutions are performed by Tcl_SubstObj(): */ #define TCL_SUBST_COMMANDS 001 #define TCL_SUBST_VARIABLES 002 #define TCL_SUBST_BACKSLASHES 004 #define TCL_SUBST_ALL 007 /* * Argument descriptors for math function callbacks in expressions: */ typedef enum {TCL_INT, TCL_DOUBLE, TCL_EITHER} Tcl_ValueType; typedef struct Tcl_Value { Tcl_ValueType type; /* Indicates intValue or doubleValue is * valid, or both. */ long intValue; /* Integer value. */ double doubleValue; /* Double-precision floating value. */ } Tcl_Value; /* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the procedure types declared * below. */ struct Tcl_Obj; /* * Procedure types defined by Tcl: */ typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp *interp)); typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int code)); typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData, int mask)); typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data)); typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])); typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, ClientData cmdClientData, int argc, char *argv[])); typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr)); typedef int (Tcl_EncodingConvertProc)_ANSI_ARGS_((ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); typedef void (Tcl_EncodingFreeProc)_ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_EventProc) _ANSI_ARGS_((Tcl_Event *evPtr, int flags)); typedef void (Tcl_EventCheckProc) _ANSI_ARGS_((ClientData clientData, int flags)); typedef int (Tcl_EventDeleteProc) _ANSI_ARGS_((Tcl_Event *evPtr, ClientData clientData)); typedef void (Tcl_EventSetupProc) _ANSI_ARGS_((ClientData clientData, int flags)); typedef void (Tcl_ExitProc) _ANSI_ARGS_((ClientData clientData)); typedef void (Tcl_FileProc) _ANSI_ARGS_((ClientData clientData, int mask)); typedef void (Tcl_FileFreeProc) _ANSI_ARGS_((ClientData clientData)); typedef void (Tcl_FreeInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr)); typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr)); typedef void (Tcl_IdleProc) _ANSI_ARGS_((ClientData clientData)); typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp)); typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)); typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv)); typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp)); typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(CONST char *, format)); typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData, Tcl_Channel chan, char *address, int port)); typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp, struct Tcl_Obj *objPtr)); typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr)); typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, char *part1, char *part2, int flags)); typedef void (Tcl_CommandTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, CONST char *oldName, CONST char *newName, int flags)); typedef void (Tcl_CreateFileHandlerProc) _ANSI_ARGS_((int fd, int mask, Tcl_FileProc *proc, ClientData clientData)); typedef void (Tcl_DeleteFileHandlerProc) _ANSI_ARGS_((int fd)); typedef void (Tcl_MainLoopProc) _ANSI_ARGS_((void)); /* * The following structure represents a type of object, which is a * particular internal representation for an object plus a set of * procedures that provide standard operations on objects of that type. */ typedef struct Tcl_ObjType { char *name; /* Name of the type, e.g. "int". */ Tcl_FreeInternalRepProc *freeIntRepProc; /* Called to free any storage for the type's * internal rep. NULL if the internal rep * does not need freeing. */ Tcl_DupInternalRepProc *dupIntRepProc; /* Called to create a new object as a copy * of an existing object. */ Tcl_UpdateStringProc *updateStringProc; /* Called to update the string rep from the * type's internal representation. */ Tcl_SetFromAnyProc *setFromAnyProc; /* Called to convert the object's internal * rep to this type. Frees the internal rep * of the old type. Returns TCL_ERROR on * failure. */ } Tcl_ObjType; /* * One of the following structures exists for each object in the Tcl * system. An object stores a value as either a string, some internal * representation, or both. */ typedef struct Tcl_Obj { int refCount; /* When 0 the object will be freed. */ char *bytes; /* This points to the first byte of the * object's string representation. The array * must be followed by a null byte (i.e., at * offset length) but may also contain * embedded null characters. The array's * storage is allocated by ckalloc. NULL * means the string rep is invalid and must * be regenerated from the internal rep. * Clients should use Tcl_GetStringFromObj * or Tcl_GetString to get a pointer to the * byte array as a readonly value. */ int length; /* The number of bytes at *bytes, not * including the terminating null. */ Tcl_ObjType *typePtr; /* Denotes the object's type. Always * corresponds to the type of the object's * internal rep. NULL indicates the object * has no internal rep (has no type). */ union { /* The internal representation: */ long longValue; /* - an long integer value */ double doubleValue; /* - a double-precision floating value */ VOID *otherValuePtr; /* - another, type-specific value */ struct { /* - internal rep as two pointers */ VOID *ptr1; VOID *ptr2; } twoPtrValue; } internalRep; } Tcl_Obj; /* * Macros to increment and decrement a Tcl_Obj's reference count, and to * test whether an object is shared (i.e. has reference count > 1). * Note: clients should use Tcl_DecrRefCount() when they are finished using * an object, and should never call TclFreeObj() directly. TclFreeObj() is * only defined and made public in tcl.h to support Tcl_DecrRefCount's macro * definition. Note also that Tcl_DecrRefCount() refers to the parameter * "obj" twice. This means that you should avoid calling it with an * expression that is expensive to compute or has side effects. */ void Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr)); void Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr)); int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr)); #ifdef TCL_MEM_DEBUG # define Tcl_IncrRefCount(objPtr) \ Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__) # define Tcl_DecrRefCount(objPtr) \ Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__) # define Tcl_IsShared(objPtr) \ Tcl_DbIsShared(objPtr, __FILE__, __LINE__) #else # define Tcl_IncrRefCount(objPtr) \ ++(objPtr)->refCount # define Tcl_DecrRefCount(objPtr) \ if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr) # define Tcl_IsShared(objPtr) \ ((objPtr)->refCount > 1) #endif /* * Macros and definitions that help to debug the use of Tcl objects. * When TCL_MEM_DEBUG is defined, the Tcl_New declarations are * overridden to call debugging versions of the object creation procedures. */ #ifdef TCL_MEM_DEBUG # define Tcl_NewBooleanObj(val) \ Tcl_DbNewBooleanObj(val, __FILE__, __LINE__) # define Tcl_NewByteArrayObj(bytes, len) \ Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__) # define Tcl_NewDoubleObj(val) \ Tcl_DbNewDoubleObj(val, __FILE__, __LINE__) # define Tcl_NewIntObj(val) \ Tcl_DbNewLongObj(val, __FILE__, __LINE__) # define Tcl_NewListObj(objc, objv) \ Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__) # define Tcl_NewLongObj(val) \ Tcl_DbNewLongObj(val, __FILE__, __LINE__) # define Tcl_NewObj() \ Tcl_DbNewObj(__FILE__, __LINE__) # define Tcl_NewStringObj(bytes, len) \ Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__) #endif /* TCL_MEM_DEBUG */ /* * The following structure contains the state needed by * Tcl_SaveResult. No-one outside of Tcl should access any of these * fields. This structure is typically allocated on the stack. */ typedef struct Tcl_SavedResult { char *result; Tcl_FreeProc *freeProc; Tcl_Obj *objResultPtr; char *appendResult; int appendAvl; int appendUsed; char resultSpace[TCL_RESULT_SIZE+1]; } Tcl_SavedResult; /* * The following definitions support Tcl's namespace facility. * Note: the first five fields must match exactly the fields in a * Namespace structure (see tclInt.h). */ typedef struct Tcl_Namespace { char *name; /* The namespace's name within its parent * namespace. This contains no ::'s. The * name of the global namespace is "" * although "::" is an synonym. */ char *fullName; /* The namespace's fully qualified name. * This starts with ::. */ ClientData clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc* deleteProc; /* Procedure invoked when deleting the * namespace to, e.g., free clientData. */ struct Tcl_Namespace* parentPtr; /* Points to the namespace that contains * this one. NULL if this is the global * namespace. */ } Tcl_Namespace; /* * The following structure represents a call frame, or activation record. * A call frame defines a naming context for a procedure call: its local * scope (for local variables) and its namespace scope (used for non-local * variables; often the global :: namespace). A call frame can also define * the naming context for a namespace eval or namespace inscope command: * the namespace in which the command's code should execute. The * Tcl_CallFrame structures exist only while procedures or namespace * eval/inscope's are being executed, and provide a Tcl call stack. * * A call frame is initialized and pushed using Tcl_PushCallFrame and * popped using Tcl_PopCallFrame. Storage for a Tcl_CallFrame must be * provided by the Tcl_PushCallFrame caller, and callers typically allocate * them on the C call stack for efficiency. For this reason, Tcl_CallFrame * is defined as a structure and not as an opaque token. However, most * Tcl_CallFrame fields are hidden since applications should not access * them directly; others are declared as "dummyX". * * WARNING!! The structure definition must be kept consistent with the * CallFrame structure in tclInt.h. If you change one, change the other. */ typedef struct Tcl_CallFrame { Tcl_Namespace *nsPtr; int dummy1; int dummy2; char *dummy3; char *dummy4; char *dummy5; int dummy6; char *dummy7; char *dummy8; int dummy9; char* dummy10; } Tcl_CallFrame; /* * Information about commands that is returned by Tcl_GetCommandInfo and * passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based * command procedure while proc is a traditional Tcl argc/argv * string-based procedure. Tcl_CreateObjCommand and Tcl_CreateCommand * ensure that both objProc and proc are non-NULL and can be called to * execute the command. However, it may be faster to call one instead of * the other. The member isNativeObjectProc is set to 1 if an * object-based procedure was registered by Tcl_CreateObjCommand, and to * 0 if a string-based procedure was registered by Tcl_CreateCommand. * The other procedure is typically set to a compatibility wrapper that * does string-to-object or object-to-string argument conversions then * calls the other procedure. */ typedef struct Tcl_CmdInfo { int isNativeObjectProc; /* 1 if objProc was registered by a call to * Tcl_CreateObjCommand; 0 otherwise. * Tcl_SetCmdInfo does not modify this * field. */ Tcl_ObjCmdProc *objProc; /* Command's object-based procedure. */ ClientData objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based procedure. */ ClientData clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Procedure to call when command is * deleted. */ ClientData deleteData; /* Value to pass to deleteProc (usually * the same as clientData). */ Tcl_Namespace *namespacePtr; /* Points to the namespace that contains * this command. Note that Tcl_SetCmdInfo * will not change a command's namespace; * use Tcl_RenameCommand to do that. */ } Tcl_CmdInfo; /* * The structure defined below is used to hold dynamic strings. The only * field that clients should use is the string field, and they should * never modify it. */ #define TCL_DSTRING_STATIC_SIZE 200 typedef struct Tcl_DString { char *string; /* Points to beginning of string: either * staticSpace below or a malloced array. */ int length; /* Number of non-NULL characters in the * string. */ int spaceAvl; /* Total number of bytes available for the * string and its terminating NULL char. */ char staticSpace[TCL_DSTRING_STATIC_SIZE]; /* Space to use in common case where string * is small. */ } Tcl_DString; #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) #define Tcl_DStringTrunc Tcl_DStringSetLength /* * Definitions for the maximum number of digits of precision that may * be specified in the "tcl_precision" variable, and the number of * bytes of buffer space required by Tcl_PrintDouble. */ #define TCL_MAX_PREC 17 #define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10) /* * Definition for a number of bytes of buffer space sufficient to hold the * string representation of an integer in base 10 (assuming the existence * of 64-bit integers). */ #define TCL_INTEGER_SPACE 24 /* * Flag that may be passed to Tcl_ConvertElement to force it not to * output braces (careful! if you change this flag be sure to change * the definitions at the front of tclUtil.c). */ #define TCL_DONT_USE_BRACES 1 /* * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow * abbreviated strings. */ #define TCL_EXACT 1 /* * Flag values passed to Tcl_RecordAndEval and/or Tcl_EvalObj. * WARNING: these bit choices must not conflict with the bit choices * for evalFlag bits in tclInt.h!! */ #define TCL_NO_EVAL 0x10000 #define TCL_EVAL_GLOBAL 0x20000 #define TCL_EVAL_DIRECT 0x40000 /* * Special freeProc values that may be passed to Tcl_SetResult (see * the man page for details): */ #define TCL_VOLATILE ((Tcl_FreeProc *) 1) #define TCL_STATIC ((Tcl_FreeProc *) 0) #define TCL_DYNAMIC ((Tcl_FreeProc *) 3) /* * Flag values passed to variable-related procedures. */ #define TCL_GLOBAL_ONLY 1 #define TCL_NAMESPACE_ONLY 2 #define TCL_APPEND_VALUE 4 #define TCL_LIST_ELEMENT 8 #define TCL_TRACE_READS 0x10 #define TCL_TRACE_WRITES 0x20 #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 #define TCL_INTERP_DESTROYED 0x100 #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 #ifndef TCL_REMOVE_OBSOLETE_TRACES /* Required to support old variable/vdelete/vinfo traces */ #define TCL_TRACE_OLD_STYLE 0x1000 #endif /* * Flag values passed to command-related procedures. */ #define TCL_TRACE_RENAME 0x2000 #define TCL_TRACE_DELETE 0x4000 /* * The TCL_PARSE_PART1 flag is deprecated and has no effect. * The part1 is now always parsed whenever the part2 is NULL. * (This is to avoid a common error when converting code to * use the new object based APIs and forgetting to give the * flag) */ #ifndef TCL_NO_DEPRECATED #define TCL_PARSE_PART1 0x400 #endif /* * Types for linked variables: */ #define TCL_LINK_INT 1 #define TCL_LINK_DOUBLE 2 #define TCL_LINK_BOOLEAN 3 #define TCL_LINK_STRING 4 #define TCL_LINK_READ_ONLY 0x80 /* * Forward declarations of Tcl_HashTable and related types. */ typedef struct Tcl_HashKeyType Tcl_HashKeyType; typedef struct Tcl_HashTable Tcl_HashTable; typedef struct Tcl_HashEntry Tcl_HashEntry; typedef unsigned int (Tcl_HashKeyProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr, VOID *keyPtr)); typedef int (Tcl_CompareHashKeysProc) _ANSI_ARGS_((VOID *keyPtr, Tcl_HashEntry *hPtr)); typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) _ANSI_ARGS_(( Tcl_HashTable *tablePtr, VOID *keyPtr)); typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr)); /* * This flag controls whether the hash table stores the hash of a key, or * recalculates it. There should be no reason for turning this flag off * as it is completely binary and source compatible unless you directly * access the bucketPtr member of the Tcl_HashTableEntry structure. This * member has been removed and the space used to store the hash value. */ #ifndef TCL_HASH_KEY_STORE_HASH #define TCL_HASH_KEY_STORE_HASH 1 #endif /* * Structure definition for an entry in a hash table. No-one outside * Tcl should access any of these fields directly; use the macros * defined below. */ struct Tcl_HashEntry { Tcl_HashEntry *nextPtr; /* Pointer to next entry in this * hash bucket, or NULL for end of * chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ #if TCL_HASH_KEY_STORE_HASH # if TCL_PRESERVE_BINARY_COMPATABILITY VOID *hash; /* Hash value, stored as pointer to * ensure that the offsets of the * fields in this structure are not * changed. */ # else unsigned int hash; /* Hash value. */ # endif #else Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to * first entry in this entry's chain: * used for deleting the entry. */ #endif ClientData clientData; /* Application stores something here * with Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ Tcl_Obj *objPtr; /* Tcl_Obj * key value. */ int words[1]; /* Multiple integer words for key. * The actual size will be as large * as necessary for this table's * keys. */ char string[4]; /* String for key. The actual size * will be as large as needed to hold * the key. */ } key; /* MUST BE LAST FIELD IN RECORD!! */ }; /* * Flags used in Tcl_HashKeyType. * * TCL_HASH_KEY_RANDOMIZE_HASH: * There are some things, pointers for example * which don't hash well because they do not use * the lower bits. If this flag is set then the * hash table will attempt to rectify this by * randomising the bits and then using the upper * N bits as the index into the table. */ #define TCL_HASH_KEY_RANDOMIZE_HASH 0x1 /* * Structure definition for the methods associated with a hash table * key type. */ #define TCL_HASH_KEY_TYPE_VERSION 1 struct Tcl_HashKeyType { int version; /* Version of the table. If this structure is * extended in future then the version can be * used to distinguish between different * structures. */ int flags; /* Flags, see above for details. */ /* Calculates a hash value for the key. If this is NULL then the pointer * itself is used as a hash value. */ Tcl_HashKeyProc *hashKeyProc; /* Compares two keys and returns zero if they do not match, and non-zero * if they do. If this is NULL then the pointers are compared. */ Tcl_CompareHashKeysProc *compareKeysProc; /* Called to allocate memory for a new entry, i.e. if the key is a * string then this could allocate a single block which contains enough * space for both the entry and the string. Only the key field of the * allocated Tcl_HashEntry structure needs to be filled in. If something * else needs to be done to the key, i.e. incrementing a reference count * then that should be done by this function. If this is NULL then Tcl_Alloc * is used to allocate enough space for a Tcl_HashEntry and the key pointer * is assigned to key.oneWordValue. */ Tcl_AllocHashEntryProc *allocEntryProc; /* Called to free memory associated with an entry. If something else needs * to be done to the key, i.e. decrementing a reference count then that * should be done by this function. If this is NULL then Tcl_Free is used * to free the Tcl_HashEntry. */ Tcl_FreeHashEntryProc *freeEntryProc; }; /* * Structure definition for a hash table. Must be in tcl.h so clients * can allocate space for these structures, but clients should never * access any fields in this structure. */ #define TCL_SMALL_HASH_TABLE 4 struct Tcl_HashTable { Tcl_HashEntry **buckets; /* Pointer to bucket array. Each * element points to first entry in * bucket's hash chain, or NULL. */ Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables * (to avoid mallocs and frees). */ int numBuckets; /* Total number of buckets allocated * at **bucketPtr. */ int numEntries; /* Total number of entries present * in table. */ int rebuildSize; /* Enlarge table when numEntries gets * to be this large. */ int downShift; /* Shift count used in hashing * function. Designed to use high- * order bits of randomized keys. */ int mask; /* Mask value used in hashing * function. */ int keyType; /* Type of keys used in this table. * It's either TCL_CUSTOM_KEYS, * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, * or an integer giving the number of * ints that is the size of the key. */ #if TCL_PRESERVE_BINARY_COMPATABILITY Tcl_HashEntry *(*findProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr, CONST char *key)); Tcl_HashEntry *(*createProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr)); #endif Tcl_HashKeyType *typePtr; /* Type of the keys used in the * Tcl_HashTable. */ }; /* * Structure definition for information used to keep track of searches * through hash tables: */ typedef struct Tcl_HashSearch { Tcl_HashTable *tablePtr; /* Table being searched. */ int nextIndex; /* Index of next bucket to be * enumerated after present one. */ Tcl_HashEntry *nextEntryPtr; /* Next entry to be enumerated in the * the current bucket. */ } Tcl_HashSearch; /* * Acceptable key types for hash tables: * * TCL_STRING_KEYS: The keys are strings, they are copied into * the entry. * TCL_ONE_WORD_KEYS: The keys are pointers, the pointer is stored * in the entry. * TCL_CUSTOM_TYPE_KEYS: The keys are arbitrary types which are copied * into the entry. * TCL_CUSTOM_PTR_KEYS: The keys are pointers to arbitrary types, the * pointer is stored in the entry. * * While maintaining binary compatability the above have to be distinct * values as they are used to differentiate between old versions of the * hash table which don't have a typePtr and new ones which do. Once binary * compatability is discarded in favour of making more wide spread changes * TCL_STRING_KEYS can be the same as TCL_CUSTOM_TYPE_KEYS, and * TCL_ONE_WORD_KEYS can be the same as TCL_CUSTOM_PTR_KEYS because they * simply determine how the key is accessed from the entry and not the * behaviour. */ #define TCL_STRING_KEYS 0 #define TCL_ONE_WORD_KEYS 1 #if TCL_PRESERVE_BINARY_COMPATABILITY # define TCL_CUSTOM_TYPE_KEYS -2 # define TCL_CUSTOM_PTR_KEYS -1 #else # define TCL_CUSTOM_TYPE_KEYS TCL_STRING_KEYS # define TCL_CUSTOM_PTR_KEYS TCL_ONE_WORD_KEYS #endif /* * Macros for clients to use to access fields of hash entries: */ #define Tcl_GetHashValue(h) ((h)->clientData) #define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value)) #if TCL_PRESERVE_BINARY_COMPATABILITY # define Tcl_GetHashKey(tablePtr, h) \ ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ ? (h)->key.oneWordValue \ : (h)->key.string)) #else # define Tcl_GetHashKey(tablePtr, h) \ ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) \ ? (h)->key.oneWordValue \ : (h)->key.string)) #endif /* * Macros to use for clients to use to invoke find and create procedures * for hash tables: */ #if TCL_PRESERVE_BINARY_COMPATABILITY # define Tcl_FindHashEntry(tablePtr, key) \ (*((tablePtr)->findProc))(tablePtr, key) # define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, key, newPtr) #endif #if !TCL_PRESERVE_BINARY_COMPATABILITY /* * Macro to use new extended version of Tcl_InitHashTable. */ #define Tcl_InitHashTable(tablePtr, keyType) \ Tcl_InitHashTableEx(tablePtr, keyType, NULL) #endif /* * Flag values to pass to Tcl_DoOneEvent to disable searches * for some kinds of events: */ #define TCL_DONT_WAIT (1<<1) #define TCL_WINDOW_EVENTS (1<<2) #define TCL_FILE_EVENTS (1<<3) #define TCL_TIMER_EVENTS (1<<4) #define TCL_IDLE_EVENTS (1<<5) /* WAS 0x10 ???? */ #define TCL_ALL_EVENTS (~TCL_DONT_WAIT) /* * The following structure defines a generic event for the Tcl event * system. These are the things that are queued in calls to Tcl_QueueEvent * and serviced later by Tcl_DoOneEvent. There can be many different * kinds of events with different fields, corresponding to window events, * timer events, etc. The structure for a particular event consists of * a Tcl_Event header followed by additional information specific to that * event. */ struct Tcl_Event { Tcl_EventProc *proc; /* Procedure to call to service this event. */ struct Tcl_Event *nextPtr; /* Next in list of pending events, or NULL. */ }; /* * Positions to pass to Tcl_QueueEvent: */ typedef enum { TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK } Tcl_QueuePosition; /* * Values to pass to Tcl_SetServiceMode to specify the behavior of notifier * event routines. */ #define TCL_SERVICE_NONE 0 #define TCL_SERVICE_ALL 1 /* * The following structure keeps is used to hold a time value, either as * an absolute time (the number of seconds from the epoch) or as an * elapsed time. On Unix systems the epoch is Midnight Jan 1, 1970 GMT. * On Macintosh systems the epoch is Midnight Jan 1, 1904 GMT. */ typedef struct Tcl_Time { long sec; /* Seconds. */ long usec; /* Microseconds. */ } Tcl_Time; typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr)); typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr)); /* * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler * to indicate what sorts of events are of interest: */ #define TCL_READABLE (1<<1) #define TCL_WRITABLE (1<<2) #define TCL_EXCEPTION (1<<3) /* * Flag values to pass to Tcl_OpenCommandChannel to indicate the * disposition of the stdio handles. TCL_STDIN, TCL_STDOUT, TCL_STDERR, * are also used in Tcl_GetStdChannel. */ #define TCL_STDIN (1<<1) #define TCL_STDOUT (1<<2) #define TCL_STDERR (1<<3) #define TCL_ENFORCE_MODE (1<<4) /* * Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel * should be closed. */ #define TCL_CLOSE_READ (1<<1) #define TCL_CLOSE_WRITE (1<<2) /* * Value to use as the closeProc for a channel that supports the * close2Proc interface. */ #define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *)1) /* * Channel version tag. This was introduced in 8.3.2/8.4. */ #define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1) #define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2) /* * Typedefs for the various operations in a channel type: */ typedef int (Tcl_DriverBlockModeProc) _ANSI_ARGS_(( ClientData instanceData, int mode)); typedef int (Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp)); typedef int (Tcl_DriverClose2Proc) _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp, int flags)); typedef int (Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData, char *buf, int toRead, int *errorCodePtr)); typedef int (Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData, char *buf, int toWrite, int *errorCodePtr)); typedef int (Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData, long offset, int mode, int *errorCodePtr)); typedef int (Tcl_DriverSetOptionProc) _ANSI_ARGS_(( ClientData instanceData, Tcl_Interp *interp, char *optionName, char *value)); typedef int (Tcl_DriverGetOptionProc) _ANSI_ARGS_(( ClientData instanceData, Tcl_Interp *interp, char *optionName, Tcl_DString *dsPtr)); typedef void (Tcl_DriverWatchProc) _ANSI_ARGS_(( ClientData instanceData, int mask)); typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_(( ClientData instanceData, int direction, ClientData *handlePtr)); typedef int (Tcl_DriverFlushProc) _ANSI_ARGS_(( ClientData instanceData)); typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_(( ClientData instanceData, int interestMask)); /* * The following declarations either map ckalloc and ckfree to * malloc and free, or they map them to procedures with all sorts * of debugging hooks defined in tclCkalloc.c. */ #ifdef TCL_MEM_DEBUG # define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__) # define ckfree(x) Tcl_DbCkfree(x, __FILE__, __LINE__) # define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__) # define attemptckalloc(x) Tcl_AttemptDbCkalloc(x, __FILE__, __LINE__) # define attemptckrealloc(x,y) Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__) #else /* !TCL_MEM_DEBUG */ /* * If we are not using the debugging allocator, we should call the * Tcl_Alloc, et al. routines in order to guarantee that every module * is using the same memory allocator both inside and outside of the * Tcl library. */ # define ckalloc(x) Tcl_Alloc(x) # define ckfree(x) Tcl_Free(x) # define ckrealloc(x,y) Tcl_Realloc(x,y) # define attemptckalloc(x) Tcl_AttemptAlloc(x) # define attemptckrealloc(x,y) Tcl_AttemptRealloc(x,y) # define Tcl_InitMemory(x) # define Tcl_DumpActiveMemory(x) # define Tcl_ValidateAllMemory(x,y) #endif /* !TCL_MEM_DEBUG */ /* * Enum for different end of line translation and recognition modes. */ typedef enum Tcl_EolTranslation { TCL_TRANSLATE_AUTO, /* Eol == \r, \n and \r\n. */ TCL_TRANSLATE_CR, /* Eol == \r. */ TCL_TRANSLATE_LF, /* Eol == \n. */ TCL_TRANSLATE_CRLF /* Eol == \r\n. */ } Tcl_EolTranslation; /* * struct Tcl_ChannelType: * * One such structure exists for each type (kind) of channel. * It collects together in one place all the functions that are * part of the specific channel type. * * It is recommend that the Tcl_Channel* functions are used to access * elements of this structure, instead of direct accessing. */ typedef struct Tcl_ChannelType { char *typeName; /* The name of the channel type in Tcl * commands. This storage is owned by * channel type. */ Tcl_ChannelTypeVersion version; /* Version of the channel type. */ Tcl_DriverCloseProc *closeProc; /* Procedure to call to close the * channel, or TCL_CLOSE2PROC if the * close2Proc should be used * instead. */ Tcl_DriverInputProc *inputProc; /* Procedure to call for input * on channel. */ Tcl_DriverOutputProc *outputProc; /* Procedure to call for output * on channel. */ Tcl_DriverSeekProc *seekProc; /* Procedure to call to seek * on the channel. May be NULL. */ Tcl_DriverSetOptionProc *setOptionProc; /* Set an option on a channel. */ Tcl_DriverGetOptionProc *getOptionProc; /* Get an option from a channel. */ Tcl_DriverWatchProc *watchProc; /* Set up the notifier to watch * for events on this channel. */ Tcl_DriverGetHandleProc *getHandleProc; /* Get an OS handle from the channel * or NULL if not supported. */ Tcl_DriverClose2Proc *close2Proc; /* Procedure to call to close the * channel if the device supports * closing the read & write sides * independently. */ Tcl_DriverBlockModeProc *blockModeProc; /* Set blocking mode for the * raw channel. May be NULL. */ /* * Only valid in TCL_CHANNEL_VERSION_2 channels */ Tcl_DriverFlushProc *flushProc; /* Procedure to call to flush a * channel. May be NULL. */ Tcl_DriverHandlerProc *handlerProc; /* Procedure to call to handle a * channel event. This will be passed * up the stacked channel chain. */ } Tcl_ChannelType; /* * The following flags determine whether the blockModeProc above should * set the channel into blocking or nonblocking mode. They are passed * as arguments to the blockModeProc procedure in the above structure. */ #define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */ #define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking * mode. */ /* * Enum for different types of file paths. */ typedef enum Tcl_PathType { TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, TCL_PATH_VOLUME_RELATIVE } Tcl_PathType; /* * The following structure is used to pass glob type data amongst * the various glob routines and Tcl_FSMatchInDirectory. */ typedef struct Tcl_GlobTypeData { /* Corresponds to bcdpfls as in 'find -t' */ int type; /* Corresponds to file permissions */ int perm; /* Acceptable mac type */ Tcl_Obj* macType; /* Acceptable mac creator */ Tcl_Obj* macCreator; } Tcl_GlobTypeData; /* * type and permission definitions for glob command */ #define TCL_GLOB_TYPE_BLOCK (1<<0) #define TCL_GLOB_TYPE_CHAR (1<<1) #define TCL_GLOB_TYPE_DIR (1<<2) #define TCL_GLOB_TYPE_PIPE (1<<3) #define TCL_GLOB_TYPE_FILE (1<<4) #define TCL_GLOB_TYPE_LINK (1<<5) #define TCL_GLOB_TYPE_SOCK (1<<6) #define TCL_GLOB_PERM_RONLY (1<<0) #define TCL_GLOB_PERM_HIDDEN (1<<1) #define TCL_GLOB_PERM_R (1<<2) #define TCL_GLOB_PERM_W (1<<3) #define TCL_GLOB_PERM_X (1<<4) /* * Typedefs for the various filesystem operations: */ typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)); typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode)); typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, char *modeString, int permissions)); typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *result, Tcl_Obj *pathPtr, char *pattern, Tcl_GlobTypeData * types)); typedef Tcl_Obj* (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp)); typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)); typedef int (Tcl_FSCreateDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); typedef int (Tcl_FSDeleteFileProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); typedef int (Tcl_FSCopyDirectoryProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)); typedef int (Tcl_FSCopyFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)); typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr)); typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)); typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((ClientData clientData)); typedef Tcl_Obj* (Tcl_FSListVolumesProc) _ANSI_ARGS_((void)); /* We have to declare the utime structure here. */ struct utimbuf; typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, struct utimbuf *tval)); typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint)); typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)); typedef char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef)); typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)); typedef Tcl_Obj* (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj *toPtr)); typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj *pathPtr, CONST char * sym1, CONST char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr, Tcl_FSUnloadFileProc **unloadProcPtr)); typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, ClientData *clientDataPtr)); typedef Tcl_Obj* (Tcl_FSFilesystemPathTypeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); typedef Tcl_Obj* (Tcl_FSFilesystemSeparatorProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); typedef void (Tcl_FSFreeInternalRepProc) _ANSI_ARGS_((ClientData clientData)); typedef ClientData (Tcl_FSDupInternalRepProc) _ANSI_ARGS_((ClientData clientData)); typedef Tcl_Obj* (Tcl_FSInternalToNormalizedProc) _ANSI_ARGS_((ClientData clientData)); typedef ClientData (Tcl_FSCreateInternalRepProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); typedef struct Tcl_FSVersion_ *Tcl_FSVersion; /* *---------------------------------------------------------------- * Data structures related to hooking into the filesystem *---------------------------------------------------------------- */ /* * Filesystem version tag. This was introduced in 8.4. */ #define TCL_FILESYSTEM_VERSION_1 ((Tcl_FSVersion) 0x1) /* * struct Tcl_Filesystem: * * One such structure exists for each type (kind) of filesystem. * It collects together in one place all the functions that are * part of the specific filesystem. Tcl always accesses the * filesystem through one of these structures. * * Not all entries need be non-NULL; any which are NULL are simply * ignored. However, a complete filesystem should provide all of * these functions. The explanations in the structure show * the importance of each function. */ typedef struct Tcl_Filesystem { CONST char *typeName; /* The name of the filesystem. */ int structureLength; /* Length of this structure, so future * binary compatibility can be assured. */ Tcl_FSVersion version; /* Version of the filesystem type. */ Tcl_FSPathInFilesystemProc *pathInFilesystemProc; /* Function to check whether a path is in * this filesystem. This is the most * important filesystem procedure. */ Tcl_FSDupInternalRepProc *dupInternalRepProc; /* Function to duplicate internal fs rep. May * be NULL (but then fs is less efficient). */ Tcl_FSFreeInternalRepProc *freeInternalRepProc; /* Function to free internal fs rep. Must * be implemented, if internal representations * need freeing, otherwise it can be NULL. */ Tcl_FSInternalToNormalizedProc *internalToNormalizedProc; /* Function to convert internal representation * to a normalized path. Only required if * the fs creates pure path objects with no * string/path representation. */ Tcl_FSCreateInternalRepProc *createInternalRepProc; /* Function to create a filesystem-specific * internal representation. May be NULL * if paths have no internal representation, * or if the Tcl_FSPathInFilesystemProc * for this filesystem always immediately * creates an internal representation for * paths it accepts. */ Tcl_FSNormalizePathProc *normalizePathProc; /* Function to normalize a path. Should * be implemented for all filesystems * which can have multiple string * representations for the same path * object. */ Tcl_FSFilesystemPathTypeProc *filesystemPathTypeProc; /* Function to determine the type of a * path in this filesystem. May be NULL. */ Tcl_FSFilesystemSeparatorProc *filesystemSeparatorProc; /* Function to return the separator * character(s) for this filesystem. Must * be implemented. */ Tcl_FSStatProc *statProc; /* * Function to process a 'Tcl_FSStat()' * call. Must be implemented for any * reasonable filesystem. */ Tcl_FSAccessProc *accessProc; /* * Function to process a 'Tcl_FSAccess()' * call. Must be implemented for any * reasonable filesystem. */ Tcl_FSOpenFileChannelProc *openFileChannelProc; /* * Function to process a * 'Tcl_FSOpenFileChannel()' call. Must be * implemented for any reasonable * filesystem. */ Tcl_FSMatchInDirectoryProc *matchInDirectoryProc; /* Function to process a * 'Tcl_FSMatchInDirectory()'. If not * implemented, then glob and recursive * copy functionality will be lacking in * the filesystem. */ Tcl_FSUtimeProc *utimeProc; /* Function to process a * 'Tcl_FSUtime()' call. Required to * allow setting (not reading) of times * with 'file mtime', 'file atime' and * the open-r/open-w/fcopy implementation * of 'file copy'. */ Tcl_FSLinkProc *linkProc; /* Function to process a * 'Tcl_FSLink()' call. Should be * implemented only if the filesystem supports * links (reading or creating). */ Tcl_FSListVolumesProc *listVolumesProc; /* Function to list any filesystem volumes * added by this filesystem. Should be * implemented only if the filesystem adds * volumes at the head of the filesystem. */ Tcl_FSFileAttrStringsProc *fileAttrStringsProc; /* Function to list all attributes strings * which are valid for this filesystem. * If not implemented the filesystem will * not support the 'file attributes' command. * This allows arbitrary additional information * to be attached to files in the filesystem. */ Tcl_FSFileAttrsGetProc *fileAttrsGetProc; /* Function to process a * 'Tcl_FSFileAttrsGet()' call, used by * 'file attributes'. */ Tcl_FSFileAttrsSetProc *fileAttrsSetProc; /* Function to process a * 'Tcl_FSFileAttrsSet()' call, used by * 'file attributes'. */ Tcl_FSCreateDirectoryProc *createDirectoryProc; /* Function to process a * 'Tcl_FSCreateDirectory()' call. Should * be implemented unless the FS is * read-only. */ Tcl_FSRemoveDirectoryProc *removeDirectoryProc; /* Function to process a * 'Tcl_FSRemoveDirectory()' call. Should * be implemented unless the FS is * read-only. */ Tcl_FSDeleteFileProc *deleteFileProc; /* Function to process a * 'Tcl_FSDeleteFile()' call. Should * be implemented unless the FS is * read-only. */ Tcl_FSLstatProc *lstatProc; /* Function to process a * 'Tcl_FSLstat()' call. If not implemented, * Tcl will attempt to use the 'statProc' * defined above instead. */ Tcl_FSCopyFileProc *copyFileProc; /* Function to process a * 'Tcl_FSCopyFile()' call. If not * implemented Tcl will fall back * on open-r, open-w and fcopy as * a copying mechanism. */ Tcl_FSRenameFileProc *renameFileProc; /* Function to process a * 'Tcl_FSRenameFile()' call. If not * implemented, Tcl will fall back on * a copy and delete mechanism. */ Tcl_FSCopyDirectoryProc *copyDirectoryProc; /* Function to process a * 'Tcl_FSCopyDirectory()' call. If * not implemented, Tcl will fall back * on a recursive create-dir, file copy * mechanism. */ Tcl_FSLoadFileProc *loadFileProc; /* Function to process a * 'Tcl_FSLoadFile()' call. If not * implemented, Tcl will fall back on * a copy to native-temp followed by a * Tcl_FSLoadFile on that temporary copy. */ Tcl_FSGetCwdProc *getCwdProc; /* * Function to process a 'Tcl_FSGetCwd()' * call. Most filesystems need not * implement this. It will usually only be * called once, if 'getcwd' is called * before 'chdir'. May be NULL. */ Tcl_FSChdirProc *chdirProc; /* * Function to process a 'Tcl_FSChdir()' * call. If filesystems do not implement * this, it will be emulated by a series of * directory access checks. Otherwise, * virtual filesystems which do implement * it need only respond with a positive * return result if the dirName is a valid * directory in their filesystem. They * need not remember the result, since that * will be automatically remembered for use * by GetCwd. Real filesystems should * carry out the correct action (i.e. call * the correct system 'chdir' api). If not * implemented, then 'cd' and 'pwd' will * fail inside the filesystem. */ } Tcl_Filesystem; /* * The following structure represents the Notifier functions that * you can override with the Tcl_SetNotifier call. */ typedef struct Tcl_NotifierProcs { Tcl_SetTimerProc *setTimerProc; Tcl_WaitForEventProc *waitForEventProc; Tcl_CreateFileHandlerProc *createFileHandlerProc; Tcl_DeleteFileHandlerProc *deleteFileHandlerProc; } Tcl_NotifierProcs; /* * The following structure represents a user-defined encoding. It collects * together all the functions that are used by the specific encoding. */ typedef struct Tcl_EncodingType { CONST char *encodingName; /* The name of the encoding, e.g. "euc-jp". * This name is the unique key for this * encoding type. */ Tcl_EncodingConvertProc *toUtfProc; /* Procedure to convert from external * encoding into UTF-8. */ Tcl_EncodingConvertProc *fromUtfProc; /* Procedure to convert from UTF-8 into * external encoding. */ Tcl_EncodingFreeProc *freeProc; /* If non-NULL, procedure to call when this * encoding is deleted. */ ClientData clientData; /* Arbitrary value associated with encoding * type. Passed to conversion procedures. */ int nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This * number is used to determine the source * string length when the srcLen argument is * negative. Must be 1 or 2. */ } Tcl_EncodingType; /* * The following definitions are used as values for the conversion control * flags argument when converting text from one character set to another: * * TCL_ENCODING_START: Signifies that the source buffer is the first * block in a (potentially multi-block) input * stream. Tells the conversion procedure to * reset to an initial state and perform any * initialization that needs to occur before the * first byte is converted. If the source * buffer contains the entire input stream to be * converted, this flag should be set. * * TCL_ENCODING_END: Signifies that the source buffer is the last * block in a (potentially multi-block) input * stream. Tells the conversion routine to * perform any finalization that needs to occur * after the last byte is converted and then to * reset to an initial state. If the source * buffer contains the entire input stream to be * converted, this flag should be set. * * TCL_ENCODING_STOPONERROR: If set, then the converter will return * immediately upon encountering an invalid * byte sequence or a source character that has * no mapping in the target encoding. If clear, * then the converter will skip the problem, * substituting one or more "close" characters * in the destination buffer and then continue * to sonvert the source. */ #define TCL_ENCODING_START 0x01 #define TCL_ENCODING_END 0x02 #define TCL_ENCODING_STOPONERROR 0x04 /* *---------------------------------------------------------------- * The following data structures and declarations are for the new * Tcl parser. This stuff should all move to tcl.h eventually. *---------------------------------------------------------------- */ /* * For each word of a command, and for each piece of a word such as a * variable reference, one of the following structures is created to * describe the token. */ typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; * see below for valid types. */ char *start; /* First character in token. */ int size; /* Number of bytes in token. */ int numComponents; /* If this token is composed of other * tokens, this field tells how many of * them there are (including components of * components, etc.). The component tokens * immediately follow this one. */ } Tcl_Token; /* * Type values defined for Tcl_Token structures. These values are * defined as mask bits so that it's easy to check for collections of * types. * * TCL_TOKEN_WORD - The token describes one word of a command, * from the first non-blank character of * the word (which may be " or {) up to but * not including the space, semicolon, or * bracket that terminates the word. * NumComponents counts the total number of * sub-tokens that make up the word. This * includes, for example, sub-tokens of * TCL_TOKEN_VARIABLE tokens. * TCL_TOKEN_SIMPLE_WORD - This token is just like TCL_TOKEN_WORD * except that the word is guaranteed to * consist of a single TCL_TOKEN_TEXT * sub-token. * TCL_TOKEN_TEXT - The token describes a range of literal * text that is part of a word. * NumComponents is always 0. * TCL_TOKEN_BS - The token describes a backslash sequence * that must be collapsed. NumComponents * is always 0. * TCL_TOKEN_COMMAND - The token describes a command whose result * must be substituted into the word. The * token includes the enclosing brackets. * NumComponents is always 0. * TCL_TOKEN_VARIABLE - The token describes a variable * substitution, including the dollar sign, * variable name, and array index (if there * is one) up through the right * parentheses. NumComponents tells how * many additional tokens follow to * represent the variable name. The first * token will be a TCL_TOKEN_TEXT token * that describes the variable name. If * the variable is an array reference then * there will be one or more additional * tokens, of type TCL_TOKEN_TEXT, * TCL_TOKEN_BS, TCL_TOKEN_COMMAND, and * TCL_TOKEN_VARIABLE, that describe the * array index; numComponents counts the * total number of nested tokens that make * up the variable reference, including * sub-tokens of TCL_TOKEN_VARIABLE tokens. * TCL_TOKEN_SUB_EXPR - The token describes one subexpression of a * expression, from the first non-blank * character of the subexpression up to but not * including the space, brace, or bracket * that terminates the subexpression. * NumComponents counts the total number of * following subtokens that make up the * subexpression; this includes all subtokens * for any nested TCL_TOKEN_SUB_EXPR tokens. * For example, a numeric value used as a * primitive operand is described by a * TCL_TOKEN_SUB_EXPR token followed by a * TCL_TOKEN_TEXT token. A binary subexpression * is described by a TCL_TOKEN_SUB_EXPR token * followed by the TCL_TOKEN_OPERATOR token * for the operator, then TCL_TOKEN_SUB_EXPR * tokens for the left then the right operands. * TCL_TOKEN_OPERATOR - The token describes one expression operator. * An operator might be the name of a math * function such as "abs". A TCL_TOKEN_OPERATOR * token is always preceeded by one * TCL_TOKEN_SUB_EXPR token for the operator's * subexpression, and is followed by zero or * more TCL_TOKEN_SUB_EXPR tokens for the * operator's operands. NumComponents is * always 0. */ #define TCL_TOKEN_WORD 1 #define TCL_TOKEN_SIMPLE_WORD 2 #define TCL_TOKEN_TEXT 4 #define TCL_TOKEN_BS 8 #define TCL_TOKEN_COMMAND 16 #define TCL_TOKEN_VARIABLE 32 #define TCL_TOKEN_SUB_EXPR 64 #define TCL_TOKEN_OPERATOR 128 /* * Parsing error types. On any parsing error, one of these values * will be stored in the error field of the Tcl_Parse structure * defined below. */ #define TCL_PARSE_SUCCESS 0 #define TCL_PARSE_QUOTE_EXTRA 1 #define TCL_PARSE_BRACE_EXTRA 2 #define TCL_PARSE_MISSING_BRACE 3 #define TCL_PARSE_MISSING_BRACKET 4 #define TCL_PARSE_MISSING_PAREN 5 #define TCL_PARSE_MISSING_QUOTE 6 #define TCL_PARSE_MISSING_VAR_BRACE 7 #define TCL_PARSE_SYNTAX 8 #define TCL_PARSE_BAD_NUMBER 9 /* * A structure of the following type is filled in by Tcl_ParseCommand. * It describes a single command parsed from an input string. */ #define NUM_STATIC_TOKENS 20 typedef struct Tcl_Parse { char *commentStart; /* Pointer to # that begins the first of * one or more comments preceding the * command. */ int commentSize; /* Number of bytes in comments (up through * newline character that terminates the * last comment). If there were no * comments, this field is 0. */ char *commandStart; /* First character in first word of command. */ int commandSize; /* Number of bytes in command, including * first character of first word, up * through the terminating newline, * close bracket, or semicolon. */ int numWords; /* Total number of words in command. May * be 0. */ Tcl_Token *tokenPtr; /* Pointer to first token representing * the words of the command. Initially * points to staticTokens, but may change * to point to malloc-ed space if command * exceeds space in staticTokens. */ int numTokens; /* Total number of tokens in command. */ int tokensAvailable; /* Total number of tokens available at * *tokenPtr. */ int errorType; /* One of the parsing error types defined * above. */ /* * The fields below are intended only for the private use of the * parser. They should not be used by procedures that invoke * Tcl_ParseCommand. */ char *string; /* The original command string passed to * Tcl_ParseCommand. */ char *end; /* Points to the character just after the * last one in the command string. */ Tcl_Interp *interp; /* Interpreter to use for error reporting, * or NULL. */ char *term; /* Points to character in string that * terminated most recent token. Filled in * by ParseTokens. If an error occurs, * points to beginning of region where the * error occurred (e.g. the open brace if * the close brace is missing). */ int incomplete; /* This field is set to 1 by Tcl_ParseCommand * if the command appears to be incomplete. * This information is used by * Tcl_CommandComplete. */ Tcl_Token staticTokens[NUM_STATIC_TOKENS]; /* Initial space for tokens for command. * This space should be large enough to * accommodate most commands; dynamic * space is allocated for very large * commands that don't fit here. */ } Tcl_Parse; /* * The following definitions are the error codes returned by the conversion * routines: * * TCL_OK: All characters were converted. * * TCL_CONVERT_NOSPACE: The output buffer would not have been large * enough for all of the converted data; as many * characters as could fit were converted though. * * TCL_CONVERT_MULTIBYTE: The last few bytes in the source string were * the beginning of a multibyte sequence, but * more bytes were needed to complete this * sequence. A subsequent call to the conversion * routine should pass the beginning of this * unconverted sequence plus additional bytes * from the source stream to properly convert * the formerly split-up multibyte sequence. * * TCL_CONVERT_SYNTAX: The source stream contained an invalid * character sequence. This may occur if the * input stream has been damaged or if the input * encoding method was misidentified. This error * is reported only if TCL_ENCODING_STOPONERROR * was specified. * * TCL_CONVERT_UNKNOWN: The source string contained a character * that could not be represented in the target * encoding. This error is reported only if * TCL_ENCODING_STOPONERROR was specified. */ #define TCL_CONVERT_MULTIBYTE -1 #define TCL_CONVERT_SYNTAX -2 #define TCL_CONVERT_UNKNOWN -3 #define TCL_CONVERT_NOSPACE -4 /* * The maximum number of bytes that are necessary to represent a single * Unicode character in UTF-8. */ #define TCL_UTF_MAX 3 /* * This represents a Unicode character. Any changes to this should * also be reflected in regcustom.h. */ typedef unsigned short Tcl_UniChar; /* * Deprecated Tcl procedures: */ #ifndef TCL_NO_DEPRECATED #define Tcl_EvalObj(interp,objPtr) Tcl_EvalObjEx((interp),(objPtr),0) #define Tcl_GlobalEvalObj(interp,objPtr) \ Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) #endif /* * These function have been renamed. The old names are deprecated, but we * define these macros for backwards compatibilty. */ #define Tcl_Ckalloc Tcl_Alloc #define Tcl_Ckfree Tcl_Free #define Tcl_Ckrealloc Tcl_Realloc #define Tcl_Return Tcl_SetResult #define Tcl_TildeSubst Tcl_TranslateFileName #define panic Tcl_Panic #define panicVA Tcl_PanicVA /* * The following constant is used to test for older versions of Tcl * in the stubs tables. * * Jan Nijtman's plus patch uses 0xFCA1BACF, so we need to pick a different * value since the stubs tables don't match. */ #define TCL_STUB_MAGIC 0xFCA3BACF /* * The following function is required to be defined in all stubs aware * extensions. The function is actually implemented in the stub * library, not the main Tcl library, although there is a trivial * implementation in the main library in case an extension is statically * linked into an application. */ EXTERN CONST char * Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, CONST char *version, int exact)); #ifndef USE_TCL_STUBS /* * When not using stubs, make it a macro. */ #define Tcl_InitStubs(interp, version, exact) \ Tcl_PkgRequire(interp, "Tcl", version, exact) #endif /* * Include the public function declarations that are accessible via * the stubs table. */ #include "tclDecls.h" /* * Include platform specific public function declarations that are * accessible via the stubs table. */ #include "tclPlatDecls.h" /* * Public functions that are not accessible via the stubs table. */ EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv, Tcl_AppInitProc *appInitProc)); /* * Convenience declaration of Tcl_AppInit for backwards compatibility. * This function is not *implemented* by the tcl library, so the storage * class is neither DLLEXPORT nor DLLIMPORT */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS EXTERN int Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* RESOURCE_INCLUDED */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT /* * end block for C++ */ #ifdef __cplusplus } #endif #endif /* _TCL */ critlib/critcl_c/tclAppInit.c0000644000076500001200000001153207077165177016416 0ustar jcwadmin00000000000000/* * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit * procedure for Tcl applications (without Tk). * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclAppInit.c,v 1.9 2000/04/18 23:06:39 hobbs Exp $ */ #include "tcl.h" /* * The following variable is a special hack that is needed in order for * Sun shared libraries to be used for Tcl. */ extern int matherr(); int *tclDummyMathPtr = (int *) matherr; #ifdef TCL_TEST #include "tclInt.h" extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp)); extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #ifdef TCL_THREADS extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif #endif /* TCL_TEST */ #ifdef TCL_XT_TEST extern void XtToolkitInitialize _ANSI_ARGS_((void)); extern int Tclxttest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* *---------------------------------------------------------------------- * * main -- * * This is the main program for the application. * * Results: * None: Tcl_Main never returns here, so this procedure never * returns either. * * Side effects: * Whatever the application does. * *---------------------------------------------------------------------- */ int main(argc, argv) int argc; /* Number of command-line arguments. */ char **argv; /* Values of command-line arguments. */ { /* * The following #if block allows you to change the AppInit * function by using a #define of TCL_LOCAL_APPINIT instead * of rewriting this entire file. The #if checks for that * #define and uses Tcl_AppInit if it doesn't exist. */ #ifndef TCL_LOCAL_APPINIT #define TCL_LOCAL_APPINIT Tcl_AppInit #endif extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp)); /* * The following #if block allows you to change how Tcl finds the startup * script, prime the library or encoding paths, fiddle with the argv, * etc., without needing to rewrite Tcl_Main() */ #ifdef TCL_LOCAL_MAIN_HOOK extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); #endif #ifdef TCL_XT_TEST XtToolkitInitialize(); #endif #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); return 0; /* Needed only to prevent compiler warning. */ } /* *---------------------------------------------------------------------- * * Tcl_AppInit -- * * This procedure performs application-specific initialization. * Most applications, especially those that incorporate additional * packages, will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error * message in the interp's result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ int Tcl_AppInit(interp) Tcl_Interp *interp; /* Interpreter for application. */ { if (Tcl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #ifdef TCL_TEST #ifdef TCL_XT_TEST if (Tclxttest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #endif if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, (Tcl_PackageInitProc *) NULL); if (TclObjTest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #ifdef TCL_THREADS if (TclThread_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #endif if (Procbodytest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, Procbodytest_SafeInit); #endif /* TCL_TEST */ /* * Call the init procedures for included packages. Each call should * look like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * * where "Mod" is the name of the module. */ /* * Call Tcl_CreateCommand for application-specific commands, if * they weren't already created by the init procedures called above. */ /* * Specify a user-specific startup file to invoke if the application * is run interactively. Typically the startup file is "~/.apprc" * where "app" is the name of the application. If this line is deleted * then no user-specific startup file will be run under any conditions. */ Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); return TCL_OK; } critlib/critcl_c/tclDecls.h0000644000076500001200000045166407363030171016106 0ustar jcwadmin00000000000000/* * tclDecls.h -- * * Declarations of functions in the platform independent public Tcl API. * * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclDecls.h,v 1.65 2001/10/16 05:31:17 dgp Exp $ */ #ifndef _TCLDECLS #define _TCLDECLS /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tcl.decls script. */ /* !BEGIN!: Do not edit below this line. */ /* * Exported function declarations: */ /* 0 */ EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 1 */ EXTERN CONST char * Tcl_PkgRequireEx _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 2 */ EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 3 */ EXTERN char * Tcl_Alloc _ANSI_ARGS_((unsigned int size)); /* 4 */ EXTERN void Tcl_Free _ANSI_ARGS_((char * ptr)); /* 5 */ EXTERN char * Tcl_Realloc _ANSI_ARGS_((char * ptr, unsigned int size)); /* 6 */ EXTERN char * Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size, CONST char * file, int line)); /* 7 */ EXTERN int Tcl_DbCkfree _ANSI_ARGS_((char * ptr, CONST char * file, int line)); /* 8 */ EXTERN char * Tcl_DbCkrealloc _ANSI_ARGS_((char * ptr, unsigned int size, CONST char * file, int line)); #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ /* 9 */ EXTERN void Tcl_CreateFileHandler _ANSI_ARGS_((int fd, int mask, Tcl_FileProc * proc, ClientData clientData)); #endif /* UNIX */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ /* 10 */ EXTERN void Tcl_DeleteFileHandler _ANSI_ARGS_((int fd)); #endif /* UNIX */ /* 11 */ EXTERN void Tcl_SetTimer _ANSI_ARGS_((Tcl_Time * timePtr)); /* 12 */ EXTERN void Tcl_Sleep _ANSI_ARGS_((int ms)); /* 13 */ EXTERN int Tcl_WaitForEvent _ANSI_ARGS_((Tcl_Time * timePtr)); /* 14 */ EXTERN int Tcl_AppendAllObjTypes _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 15 */ EXTERN void Tcl_AppendStringsToObj _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr)); /* 16 */ EXTERN void Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj* objPtr, CONST char* bytes, int length)); /* 17 */ EXTERN Tcl_Obj * Tcl_ConcatObj _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 18 */ EXTERN int Tcl_ConvertToType _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_ObjType * typePtr)); /* 19 */ EXTERN void Tcl_DbDecrRefCount _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 20 */ EXTERN void Tcl_DbIncrRefCount _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 21 */ EXTERN int Tcl_DbIsShared _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 22 */ EXTERN Tcl_Obj * Tcl_DbNewBooleanObj _ANSI_ARGS_((int boolValue, CONST char * file, int line)); /* 23 */ EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj _ANSI_ARGS_(( CONST unsigned char * bytes, int length, CONST char * file, int line)); /* 24 */ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj _ANSI_ARGS_((double doubleValue, CONST char * file, int line)); /* 25 */ EXTERN Tcl_Obj * Tcl_DbNewListObj _ANSI_ARGS_((int objc, Tcl_Obj *CONST * objv, CONST char * file, int line)); /* 26 */ EXTERN Tcl_Obj * Tcl_DbNewLongObj _ANSI_ARGS_((long longValue, CONST char * file, int line)); /* 27 */ EXTERN Tcl_Obj * Tcl_DbNewObj _ANSI_ARGS_((CONST char * file, int line)); /* 28 */ EXTERN Tcl_Obj * Tcl_DbNewStringObj _ANSI_ARGS_((CONST char * bytes, int length, CONST char * file, int line)); /* 29 */ EXTERN Tcl_Obj * Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 30 */ EXTERN void TclFreeObj _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 31 */ EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * boolPtr)); /* 32 */ EXTERN int Tcl_GetBooleanFromObj _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * objPtr, int * boolPtr)); /* 33 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj _ANSI_ARGS_(( Tcl_Obj * objPtr, int * lengthPtr)); /* 34 */ EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, double * doublePtr)); /* 35 */ EXTERN int Tcl_GetDoubleFromObj _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * objPtr, double * doublePtr)); /* 36 */ EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, char ** tablePtr, char * msg, int flags, int * indexPtr)); /* 37 */ EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * intPtr)); /* 38 */ EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr)); /* 39 */ EXTERN int Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr)); /* 40 */ EXTERN Tcl_ObjType * Tcl_GetObjType _ANSI_ARGS_((char * typeName)); /* 41 */ EXTERN char * Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 42 */ EXTERN void Tcl_InvalidateStringRep _ANSI_ARGS_(( Tcl_Obj * objPtr)); /* 43 */ EXTERN int Tcl_ListObjAppendList _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * elemListPtr)); /* 44 */ EXTERN int Tcl_ListObjAppendElement _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * objPtr)); /* 45 */ EXTERN int Tcl_ListObjGetElements _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj *** objvPtr)); /* 46 */ EXTERN int Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj ** objPtrPtr)); /* 47 */ EXTERN int Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * intPtr)); /* 48 */ EXTERN int Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[])); /* 49 */ EXTERN Tcl_Obj * Tcl_NewBooleanObj _ANSI_ARGS_((int boolValue)); /* 50 */ EXTERN Tcl_Obj * Tcl_NewByteArrayObj _ANSI_ARGS_(( CONST unsigned char* bytes, int length)); /* 51 */ EXTERN Tcl_Obj * Tcl_NewDoubleObj _ANSI_ARGS_((double doubleValue)); /* 52 */ EXTERN Tcl_Obj * Tcl_NewIntObj _ANSI_ARGS_((int intValue)); /* 53 */ EXTERN Tcl_Obj * Tcl_NewListObj _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 54 */ EXTERN Tcl_Obj * Tcl_NewLongObj _ANSI_ARGS_((long longValue)); /* 55 */ EXTERN Tcl_Obj * Tcl_NewObj _ANSI_ARGS_((void)); /* 56 */ EXTERN Tcl_Obj * Tcl_NewStringObj _ANSI_ARGS_((CONST char * bytes, int length)); /* 57 */ EXTERN void Tcl_SetBooleanObj _ANSI_ARGS_((Tcl_Obj * objPtr, int boolValue)); /* 58 */ EXTERN unsigned char * Tcl_SetByteArrayLength _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 59 */ EXTERN void Tcl_SetByteArrayObj _ANSI_ARGS_((Tcl_Obj * objPtr, CONST unsigned char * bytes, int length)); /* 60 */ EXTERN void Tcl_SetDoubleObj _ANSI_ARGS_((Tcl_Obj * objPtr, double doubleValue)); /* 61 */ EXTERN void Tcl_SetIntObj _ANSI_ARGS_((Tcl_Obj * objPtr, int intValue)); /* 62 */ EXTERN void Tcl_SetListObj _ANSI_ARGS_((Tcl_Obj * objPtr, int objc, Tcl_Obj *CONST objv[])); /* 63 */ EXTERN void Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj * objPtr, long longValue)); /* 64 */ EXTERN void Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 65 */ EXTERN void Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj* objPtr, CONST char* bytes, int length)); /* 66 */ EXTERN void Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message)); /* 67 */ EXTERN void Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message, int length)); /* 68 */ EXTERN void Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp * interp)); /* 69 */ EXTERN void Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 70 */ EXTERN void Tcl_AppendResult _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 71 */ EXTERN Tcl_AsyncHandler Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc * proc, ClientData clientData)); /* 72 */ EXTERN void Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 73 */ EXTERN int Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp * interp, int code)); /* 74 */ EXTERN void Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 75 */ EXTERN int Tcl_AsyncReady _ANSI_ARGS_((void)); /* 76 */ EXTERN void Tcl_BackgroundError _ANSI_ARGS_((Tcl_Interp * interp)); /* 77 */ EXTERN char Tcl_Backslash _ANSI_ARGS_((CONST char * src, int * readPtr)); /* 78 */ EXTERN int Tcl_BadChannelOption _ANSI_ARGS_(( Tcl_Interp * interp, char * optionName, char * optionList)); /* 79 */ EXTERN void Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 80 */ EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_(( Tcl_IdleProc * idleProc, ClientData clientData)); /* 81 */ EXTERN int Tcl_Close _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 82 */ EXTERN int Tcl_CommandComplete _ANSI_ARGS_((char * cmd)); /* 83 */ EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc, char * CONST * argv)); /* 84 */ EXTERN int Tcl_ConvertElement _ANSI_ARGS_((CONST char * src, char * dst, int flags)); /* 85 */ EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_(( CONST char * src, int length, char * dst, int flags)); /* 86 */ EXTERN int Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp * slave, char * slaveCmd, Tcl_Interp * target, char * targetCmd, int argc, char ** argv)); /* 87 */ EXTERN int Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp * slave, char * slaveCmd, Tcl_Interp * target, char * targetCmd, int objc, Tcl_Obj *CONST objv[])); /* 88 */ EXTERN Tcl_Channel Tcl_CreateChannel _ANSI_ARGS_(( Tcl_ChannelType * typePtr, char * chanName, ClientData instanceData, int mask)); /* 89 */ EXTERN void Tcl_CreateChannelHandler _ANSI_ARGS_(( Tcl_Channel chan, int mask, Tcl_ChannelProc * proc, ClientData clientData)); /* 90 */ EXTERN void Tcl_CreateCloseHandler _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)); /* 91 */ EXTERN Tcl_Command Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 92 */ EXTERN void Tcl_CreateEventSource _ANSI_ARGS_(( Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)); /* 93 */ EXTERN void Tcl_CreateExitHandler _ANSI_ARGS_(( Tcl_ExitProc * proc, ClientData clientData)); /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp _ANSI_ARGS_((void)); /* 95 */ EXTERN void Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int numArgs, Tcl_ValueType * argTypes, Tcl_MathProc * proc, ClientData clientData)); /* 96 */ EXTERN Tcl_Command Tcl_CreateObjCommand _ANSI_ARGS_(( Tcl_Interp * interp, CONST char * cmdName, Tcl_ObjCmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 97 */ EXTERN Tcl_Interp * Tcl_CreateSlave _ANSI_ARGS_((Tcl_Interp * interp, char * slaveName, int isSafe)); /* 98 */ EXTERN Tcl_TimerToken Tcl_CreateTimerHandler _ANSI_ARGS_((int milliseconds, Tcl_TimerProc * proc, ClientData clientData)); /* 99 */ EXTERN Tcl_Trace Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp * interp, int level, Tcl_CmdTraceProc * proc, ClientData clientData)); /* 100 */ EXTERN void Tcl_DeleteAssocData _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 101 */ EXTERN void Tcl_DeleteChannelHandler _ANSI_ARGS_(( Tcl_Channel chan, Tcl_ChannelProc * proc, ClientData clientData)); /* 102 */ EXTERN void Tcl_DeleteCloseHandler _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)); /* 103 */ EXTERN int Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName)); /* 104 */ EXTERN int Tcl_DeleteCommandFromToken _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Command command)); /* 105 */ EXTERN void Tcl_DeleteEvents _ANSI_ARGS_(( Tcl_EventDeleteProc * proc, ClientData clientData)); /* 106 */ EXTERN void Tcl_DeleteEventSource _ANSI_ARGS_(( Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)); /* 107 */ EXTERN void Tcl_DeleteExitHandler _ANSI_ARGS_(( Tcl_ExitProc * proc, ClientData clientData)); /* 108 */ EXTERN void Tcl_DeleteHashEntry _ANSI_ARGS_(( Tcl_HashEntry * entryPtr)); /* 109 */ EXTERN void Tcl_DeleteHashTable _ANSI_ARGS_(( Tcl_HashTable * tablePtr)); /* 110 */ EXTERN void Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp * interp)); #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ /* 111 */ EXTERN void Tcl_DetachPids _ANSI_ARGS_((int numPids, Tcl_Pid * pidPtr)); #endif /* UNIX */ #ifdef __WIN32__ /* 111 */ EXTERN void Tcl_DetachPids _ANSI_ARGS_((int numPids, Tcl_Pid * pidPtr)); #endif /* __WIN32__ */ /* 112 */ EXTERN void Tcl_DeleteTimerHandler _ANSI_ARGS_(( Tcl_TimerToken token)); /* 113 */ EXTERN void Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Trace trace)); /* 114 */ EXTERN void Tcl_DontCallWhenDeleted _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 115 */ EXTERN int Tcl_DoOneEvent _ANSI_ARGS_((int flags)); /* 116 */ EXTERN void Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc * proc, ClientData clientData)); /* 117 */ EXTERN CONST char * Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * str, int length)); /* 118 */ EXTERN CONST char * Tcl_DStringAppendElement _ANSI_ARGS_(( Tcl_DString * dsPtr, CONST char * string)); /* 119 */ EXTERN void Tcl_DStringEndSublist _ANSI_ARGS_(( Tcl_DString * dsPtr)); /* 120 */ EXTERN void Tcl_DStringFree _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 121 */ EXTERN void Tcl_DStringGetResult _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 122 */ EXTERN void Tcl_DStringInit _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 123 */ EXTERN void Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 124 */ EXTERN void Tcl_DStringSetLength _ANSI_ARGS_(( Tcl_DString * dsPtr, int length)); /* 125 */ EXTERN void Tcl_DStringStartSublist _ANSI_ARGS_(( Tcl_DString * dsPtr)); /* 126 */ EXTERN int Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan)); /* 127 */ EXTERN char * Tcl_ErrnoId _ANSI_ARGS_((void)); /* 128 */ EXTERN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err)); /* 129 */ EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 130 */ EXTERN int Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp * interp, char * fileName)); /* 131 */ EXTERN int Tcl_EvalObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 132 */ EXTERN void Tcl_EventuallyFree _ANSI_ARGS_(( ClientData clientData, Tcl_FreeProc * freeProc)); /* 133 */ EXTERN void Tcl_Exit _ANSI_ARGS_((int status)); /* 134 */ EXTERN int Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp * interp, CONST char * hiddenCmdToken, CONST char * cmdName)); /* 135 */ EXTERN int Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * ptr)); /* 136 */ EXTERN int Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * ptr)); /* 137 */ EXTERN int Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, double * ptr)); /* 138 */ EXTERN int Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * ptr)); /* 139 */ EXTERN int Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, long * ptr)); /* 140 */ EXTERN int Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * ptr)); /* 141 */ EXTERN int Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr)); /* 142 */ EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 143 */ EXTERN void Tcl_Finalize _ANSI_ARGS_((void)); /* 144 */ EXTERN void Tcl_FindExecutable _ANSI_ARGS_((CONST char * argv0)); /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry _ANSI_ARGS_(( Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 146 */ EXTERN int Tcl_Flush _ANSI_ARGS_((Tcl_Channel chan)); /* 147 */ EXTERN void Tcl_FreeResult _ANSI_ARGS_((Tcl_Interp * interp)); /* 148 */ EXTERN int Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp * interp, char * slaveCmd, Tcl_Interp ** targetInterpPtr, char ** targetCmdPtr, int * argcPtr, char *** argvPtr)); /* 149 */ EXTERN int Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp * interp, char * slaveCmd, Tcl_Interp ** targetInterpPtr, char ** targetCmdPtr, int * objcPtr, Tcl_Obj *** objv)); /* 150 */ EXTERN ClientData Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc ** procPtr)); /* 151 */ EXTERN Tcl_Channel Tcl_GetChannel _ANSI_ARGS_((Tcl_Interp * interp, char * chanName, int * modePtr)); /* 152 */ EXTERN int Tcl_GetChannelBufferSize _ANSI_ARGS_(( Tcl_Channel chan)); /* 153 */ EXTERN int Tcl_GetChannelHandle _ANSI_ARGS_((Tcl_Channel chan, int direction, ClientData * handlePtr)); /* 154 */ EXTERN ClientData Tcl_GetChannelInstanceData _ANSI_ARGS_(( Tcl_Channel chan)); /* 155 */ EXTERN int Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */ EXTERN char * Tcl_GetChannelName _ANSI_ARGS_((Tcl_Channel chan)); /* 157 */ EXTERN int Tcl_GetChannelOption _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Channel chan, char * optionName, Tcl_DString * dsPtr)); /* 158 */ EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan)); /* 159 */ EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 160 */ EXTERN CONST char * Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 161 */ EXTERN int Tcl_GetErrno _ANSI_ARGS_((void)); /* 162 */ EXTERN char * Tcl_GetHostName _ANSI_ARGS_((void)); /* 163 */ EXTERN int Tcl_GetInterpPath _ANSI_ARGS_(( Tcl_Interp * askInterp, Tcl_Interp * slaveInterp)); /* 164 */ EXTERN Tcl_Interp * Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp * interp)); /* 165 */ EXTERN CONST char * Tcl_GetNameOfExecutable _ANSI_ARGS_((void)); /* 166 */ EXTERN Tcl_Obj * Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp * interp)); #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ /* 167 */ EXTERN int Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp * interp, char * str, int forWriting, int checkUsage, ClientData * filePtr)); #endif /* UNIX */ /* 168 */ EXTERN Tcl_PathType Tcl_GetPathType _ANSI_ARGS_((CONST char * path)); /* 169 */ EXTERN int Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan, Tcl_DString * dsPtr)); /* 170 */ EXTERN int Tcl_GetsObj _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 171 */ EXTERN int Tcl_GetServiceMode _ANSI_ARGS_((void)); /* 172 */ EXTERN Tcl_Interp * Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp * interp, char * slaveName)); /* 173 */ EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_((int type)); /* 174 */ EXTERN char * Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp * interp)); /* 175 */ EXTERN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 176 */ EXTERN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 177 */ EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp * interp, char * command)); /* 178 */ EXTERN int Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 179 */ EXTERN int Tcl_HideCommand _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, CONST char * hiddenCmdToken)); /* 180 */ EXTERN int Tcl_Init _ANSI_ARGS_((Tcl_Interp * interp)); /* 181 */ EXTERN void Tcl_InitHashTable _ANSI_ARGS_(( Tcl_HashTable * tablePtr, int keyType)); /* 182 */ EXTERN int Tcl_InputBlocked _ANSI_ARGS_((Tcl_Channel chan)); /* 183 */ EXTERN int Tcl_InputBuffered _ANSI_ARGS_((Tcl_Channel chan)); /* 184 */ EXTERN int Tcl_InterpDeleted _ANSI_ARGS_((Tcl_Interp * interp)); /* 185 */ EXTERN int Tcl_IsSafe _ANSI_ARGS_((Tcl_Interp * interp)); /* 186 */ EXTERN char * Tcl_JoinPath _ANSI_ARGS_((int argc, char ** argv, Tcl_DString * resultPtr)); /* 187 */ EXTERN int Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * addr, int type)); /* Slot 188 is reserved */ /* 189 */ EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle, int mode)); /* 190 */ EXTERN int Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp * interp)); /* 191 */ EXTERN Tcl_Channel Tcl_MakeTcpClientChannel _ANSI_ARGS_(( ClientData tcpSocket)); /* 192 */ EXTERN char * Tcl_Merge _ANSI_ARGS_((int argc, char * CONST * argv)); /* 193 */ EXTERN Tcl_HashEntry * Tcl_NextHashEntry _ANSI_ARGS_(( Tcl_HashSearch * searchPtr)); /* 194 */ EXTERN void Tcl_NotifyChannel _ANSI_ARGS_((Tcl_Channel channel, int mask)); /* 195 */ EXTERN Tcl_Obj * Tcl_ObjGetVar2 _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, int flags)); /* 196 */ EXTERN Tcl_Obj * Tcl_ObjSetVar2 _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, Tcl_Obj * newValuePtr, int flags)); #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ /* 197 */ EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_(( Tcl_Interp * interp, int argc, char ** argv, int flags)); #endif /* UNIX */ #ifdef __WIN32__ /* 197 */ EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_(( Tcl_Interp * interp, int argc, char ** argv, int flags)); #endif /* __WIN32__ */ /* 198 */ EXTERN Tcl_Channel Tcl_OpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * modeString, int permissions)); /* 199 */ EXTERN Tcl_Channel Tcl_OpenTcpClient _ANSI_ARGS_((Tcl_Interp * interp, int port, char * address, char * myaddr, int myport, int async)); /* 200 */ EXTERN Tcl_Channel Tcl_OpenTcpServer _ANSI_ARGS_((Tcl_Interp * interp, int port, char * host, Tcl_TcpAcceptProc * acceptProc, ClientData callbackData)); /* 201 */ EXTERN void Tcl_Preserve _ANSI_ARGS_((ClientData data)); /* 202 */ EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp * interp, double value, char * dst)); /* 203 */ EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * string)); /* 204 */ EXTERN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp)); /* 205 */ EXTERN void Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); /* 206 */ EXTERN int Tcl_Read _ANSI_ARGS_((Tcl_Channel chan, char * bufPtr, int toRead)); #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ /* 207 */ EXTERN void Tcl_ReapDetachedProcs _ANSI_ARGS_((void)); #endif /* UNIX */ #ifdef __WIN32__ /* 207 */ EXTERN void Tcl_ReapDetachedProcs _ANSI_ARGS_((void)); #endif /* __WIN32__ */ /* 208 */ EXTERN int Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp * interp, char * cmd, int flags)); /* 209 */ EXTERN int Tcl_RecordAndEvalObj _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * cmdPtr, int flags)); /* 210 */ EXTERN void Tcl_RegisterChannel _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 211 */ EXTERN void Tcl_RegisterObjType _ANSI_ARGS_(( Tcl_ObjType * typePtr)); /* 212 */ EXTERN Tcl_RegExp Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 213 */ EXTERN int Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * str, CONST char * start)); /* 214 */ EXTERN int Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp * interp, char * str, char * pattern)); /* 215 */ EXTERN void Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp, int index, char ** startPtr, char ** endPtr)); /* 216 */ EXTERN void Tcl_Release _ANSI_ARGS_((ClientData clientData)); /* 217 */ EXTERN void Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp * interp)); /* 218 */ EXTERN int Tcl_ScanElement _ANSI_ARGS_((CONST char * str, int * flagPtr)); /* 219 */ EXTERN int Tcl_ScanCountedElement _ANSI_ARGS_((CONST char * str, int length, int * flagPtr)); /* 220 */ EXTERN int Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan, int offset, int mode)); /* 221 */ EXTERN int Tcl_ServiceAll _ANSI_ARGS_((void)); /* 222 */ EXTERN int Tcl_ServiceEvent _ANSI_ARGS_((int flags)); /* 223 */ EXTERN void Tcl_SetAssocData _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 224 */ EXTERN void Tcl_SetChannelBufferSize _ANSI_ARGS_(( Tcl_Channel chan, int sz)); /* 225 */ EXTERN int Tcl_SetChannelOption _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Channel chan, char * optionName, char * newValue)); /* 226 */ EXTERN int Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 227 */ EXTERN void Tcl_SetErrno _ANSI_ARGS_((int err)); /* 228 */ EXTERN void Tcl_SetErrorCode _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 229 */ EXTERN void Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time * timePtr)); /* 230 */ EXTERN void Tcl_SetPanicProc _ANSI_ARGS_(( Tcl_PanicProc * panicProc)); /* 231 */ EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_(( Tcl_Interp * interp, int depth)); /* 232 */ EXTERN void Tcl_SetResult _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tcl_FreeProc * freeProc)); /* 233 */ EXTERN int Tcl_SetServiceMode _ANSI_ARGS_((int mode)); /* 234 */ EXTERN void Tcl_SetObjErrorCode _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 235 */ EXTERN void Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 236 */ EXTERN void Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 237 */ EXTERN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * newValue, int flags)); /* 238 */ EXTERN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, char * newValue, int flags)); /* 239 */ EXTERN char * Tcl_SignalId _ANSI_ARGS_((int sig)); /* 240 */ EXTERN char * Tcl_SignalMsg _ANSI_ARGS_((int sig)); /* 241 */ EXTERN void Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp * interp)); /* 242 */ EXTERN int Tcl_SplitList _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int * argcPtr, char *** argvPtr)); /* 243 */ EXTERN void Tcl_SplitPath _ANSI_ARGS_((CONST char * path, int * argcPtr, char *** argvPtr)); /* 244 */ EXTERN void Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp * interp, char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)); /* 245 */ EXTERN int Tcl_StringMatch _ANSI_ARGS_((CONST char * str, CONST char * pattern)); /* 246 */ EXTERN int Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan)); /* 247 */ EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */ EXTERN int Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 249 */ EXTERN char * Tcl_TranslateFileName _ANSI_ARGS_(( Tcl_Interp * interp, char * name, Tcl_DString * bufferPtr)); /* 250 */ EXTERN int Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan, char * str, int len, int atHead)); /* 251 */ EXTERN void Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 252 */ EXTERN int Tcl_UnregisterChannel _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Channel chan)); /* 253 */ EXTERN int Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 254 */ EXTERN int Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 255 */ EXTERN void Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */ EXTERN void Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 257 */ EXTERN void Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 258 */ EXTERN int Tcl_UpVar _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * varName, CONST char * localName, int flags)); /* 259 */ EXTERN int Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * part1, char * part2, CONST char * localName, int flags)); /* 260 */ EXTERN int Tcl_VarEval _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 261 */ EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */ EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 263 */ EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan, char * s, int slen)); /* 264 */ EXTERN void Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], char * message)); /* 265 */ EXTERN int Tcl_DumpActiveMemory _ANSI_ARGS_(( CONST char * fileName)); /* 266 */ EXTERN void Tcl_ValidateAllMemory _ANSI_ARGS_((CONST char * file, int line)); /* 267 */ EXTERN void Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 268 */ EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_(( Tcl_Obj * objPtr, va_list argList)); /* 269 */ EXTERN char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 270 */ EXTERN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp, char * str, char ** termPtr)); /* 271 */ EXTERN CONST char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 272 */ EXTERN CONST char * Tcl_PkgPresentEx _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 273 */ EXTERN int Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 274 */ EXTERN CONST char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 275 */ EXTERN void Tcl_SetErrorCodeVA _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 276 */ EXTERN int Tcl_VarEvalVA _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 277 */ EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 278 */ EXTERN void Tcl_PanicVA _ANSI_ARGS_((CONST char * format, va_list argList)); /* 279 */ EXTERN void Tcl_GetVersion _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 280 */ EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp * interp)); /* 281 */ EXTERN Tcl_Channel Tcl_StackChannel _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 282 */ EXTERN int Tcl_UnstackChannel _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 283 */ EXTERN Tcl_Channel Tcl_GetStackedChannel _ANSI_ARGS_((Tcl_Channel chan)); /* 284 */ EXTERN void Tcl_SetMainLoop _ANSI_ARGS_((Tcl_MainLoopProc * proc)); /* Slot 285 is reserved */ /* 286 */ EXTERN void Tcl_AppendObjToObj _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_Obj * appendObjPtr)); /* 287 */ EXTERN Tcl_Encoding Tcl_CreateEncoding _ANSI_ARGS_(( Tcl_EncodingType * typePtr)); /* 288 */ EXTERN void Tcl_CreateThreadExitHandler _ANSI_ARGS_(( Tcl_ExitProc * proc, ClientData clientData)); /* 289 */ EXTERN void Tcl_DeleteThreadExitHandler _ANSI_ARGS_(( Tcl_ExitProc * proc, ClientData clientData)); /* 290 */ EXTERN void Tcl_DiscardResult _ANSI_ARGS_(( Tcl_SavedResult * statePtr)); /* 291 */ EXTERN int Tcl_EvalEx _ANSI_ARGS_((Tcl_Interp * interp, char * script, int numBytes, int flags)); /* 292 */ EXTERN int Tcl_EvalObjv _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 293 */ EXTERN int Tcl_EvalObjEx _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 294 */ EXTERN void Tcl_ExitThread _ANSI_ARGS_((int status)); /* 295 */ EXTERN int Tcl_ExternalToUtf _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 296 */ EXTERN char * Tcl_ExternalToUtfDString _ANSI_ARGS_(( Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 297 */ EXTERN void Tcl_FinalizeThread _ANSI_ARGS_((void)); /* 298 */ EXTERN void Tcl_FinalizeNotifier _ANSI_ARGS_(( ClientData clientData)); /* 299 */ EXTERN void Tcl_FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding)); /* 300 */ EXTERN Tcl_ThreadId Tcl_GetCurrentThread _ANSI_ARGS_((void)); /* 301 */ EXTERN Tcl_Encoding Tcl_GetEncoding _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 302 */ EXTERN char * Tcl_GetEncodingName _ANSI_ARGS_(( Tcl_Encoding encoding)); /* 303 */ EXTERN void Tcl_GetEncodingNames _ANSI_ARGS_(( Tcl_Interp * interp)); /* 304 */ EXTERN int Tcl_GetIndexFromObjStruct _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * objPtr, char ** tablePtr, int offset, char * msg, int flags, int * indexPtr)); /* 305 */ EXTERN VOID * Tcl_GetThreadData _ANSI_ARGS_(( Tcl_ThreadDataKey * keyPtr, int size)); /* 306 */ EXTERN Tcl_Obj * Tcl_GetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 307 */ EXTERN ClientData Tcl_InitNotifier _ANSI_ARGS_((void)); /* 308 */ EXTERN void Tcl_MutexLock _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 309 */ EXTERN void Tcl_MutexUnlock _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 310 */ EXTERN void Tcl_ConditionNotify _ANSI_ARGS_(( Tcl_Condition * condPtr)); /* 311 */ EXTERN void Tcl_ConditionWait _ANSI_ARGS_(( Tcl_Condition * condPtr, Tcl_Mutex * mutexPtr, Tcl_Time * timePtr)); /* 312 */ EXTERN int Tcl_NumUtfChars _ANSI_ARGS_((CONST char * src, int len)); /* 313 */ EXTERN int Tcl_ReadChars _ANSI_ARGS_((Tcl_Channel channel, Tcl_Obj * objPtr, int charsToRead, int appendFlag)); /* 314 */ EXTERN void Tcl_RestoreResult _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 315 */ EXTERN void Tcl_SaveResult _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 316 */ EXTERN int Tcl_SetSystemEncoding _ANSI_ARGS_(( Tcl_Interp * interp, CONST char * name)); /* 317 */ EXTERN Tcl_Obj * Tcl_SetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, Tcl_Obj * newValuePtr, int flags)); /* 318 */ EXTERN void Tcl_ThreadAlert _ANSI_ARGS_((Tcl_ThreadId threadId)); /* 319 */ EXTERN void Tcl_ThreadQueueEvent _ANSI_ARGS_(( Tcl_ThreadId threadId, Tcl_Event* evPtr, Tcl_QueuePosition position)); /* 320 */ EXTERN Tcl_UniChar Tcl_UniCharAtIndex _ANSI_ARGS_((CONST char * src, int index)); /* 321 */ EXTERN Tcl_UniChar Tcl_UniCharToLower _ANSI_ARGS_((int ch)); /* 322 */ EXTERN Tcl_UniChar Tcl_UniCharToTitle _ANSI_ARGS_((int ch)); /* 323 */ EXTERN Tcl_UniChar Tcl_UniCharToUpper _ANSI_ARGS_((int ch)); /* 324 */ EXTERN int Tcl_UniCharToUtf _ANSI_ARGS_((int ch, char * buf)); /* 325 */ EXTERN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src, int index)); /* 326 */ EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src, int len)); /* 327 */ EXTERN int Tcl_UtfBackslash _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 328 */ EXTERN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ EXTERN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src, int ch)); /* 330 */ EXTERN char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src)); /* 331 */ EXTERN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 332 */ EXTERN int Tcl_UtfToExternal _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 333 */ EXTERN char * Tcl_UtfToExternalDString _ANSI_ARGS_(( Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 334 */ EXTERN int Tcl_UtfToLower _ANSI_ARGS_((char * src)); /* 335 */ EXTERN int Tcl_UtfToTitle _ANSI_ARGS_((char * src)); /* 336 */ EXTERN int Tcl_UtfToUniChar _ANSI_ARGS_((CONST char * src, Tcl_UniChar * chPtr)); /* 337 */ EXTERN int Tcl_UtfToUpper _ANSI_ARGS_((char * src)); /* 338 */ EXTERN int Tcl_WriteChars _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 339 */ EXTERN int Tcl_WriteObj _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 340 */ EXTERN char * Tcl_GetString _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 341 */ EXTERN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void)); /* 342 */ EXTERN void Tcl_SetDefaultEncodingDir _ANSI_ARGS_((char * path)); /* 343 */ EXTERN void Tcl_AlertNotifier _ANSI_ARGS_((ClientData clientData)); /* 344 */ EXTERN void Tcl_ServiceModeHook _ANSI_ARGS_((int mode)); /* 345 */ EXTERN int Tcl_UniCharIsAlnum _ANSI_ARGS_((int ch)); /* 346 */ EXTERN int Tcl_UniCharIsAlpha _ANSI_ARGS_((int ch)); /* 347 */ EXTERN int Tcl_UniCharIsDigit _ANSI_ARGS_((int ch)); /* 348 */ EXTERN int Tcl_UniCharIsLower _ANSI_ARGS_((int ch)); /* 349 */ EXTERN int Tcl_UniCharIsSpace _ANSI_ARGS_((int ch)); /* 350 */ EXTERN int Tcl_UniCharIsUpper _ANSI_ARGS_((int ch)); /* 351 */ EXTERN int Tcl_UniCharIsWordChar _ANSI_ARGS_((int ch)); /* 352 */ EXTERN int Tcl_UniCharLen _ANSI_ARGS_((Tcl_UniChar * str)); /* 353 */ EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 354 */ EXTERN char * Tcl_UniCharToUtfDString _ANSI_ARGS_(( CONST Tcl_UniChar * string, int numChars, Tcl_DString * dsPtr)); /* 355 */ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString _ANSI_ARGS_(( CONST char * string, int length, Tcl_DString * dsPtr)); /* 356 */ EXTERN Tcl_RegExp Tcl_GetRegExpFromObj _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * patObj, int flags)); /* 357 */ EXTERN Tcl_Obj * Tcl_EvalTokens _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 358 */ EXTERN void Tcl_FreeParse _ANSI_ARGS_((Tcl_Parse * parsePtr)); /* 359 */ EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, char * script, char * command, int length)); /* 360 */ EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 361 */ EXTERN int Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 362 */ EXTERN int Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr)); /* 363 */ EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_(( Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 364 */ EXTERN int Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 365 */ EXTERN char * Tcl_GetCwd _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 366 */ EXTERN int Tcl_Chdir _ANSI_ARGS_((CONST char * dirName)); /* 367 */ EXTERN int Tcl_Access _ANSI_ARGS_((CONST char * path, int mode)); /* 368 */ EXTERN int Tcl_Stat _ANSI_ARGS_((CONST char * path, struct stat * bufPtr)); /* 369 */ EXTERN int Tcl_UtfNcmp _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 370 */ EXTERN int Tcl_UtfNcasecmp _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 371 */ EXTERN int Tcl_StringCaseMatch _ANSI_ARGS_((CONST char * str, CONST char * pattern, int nocase)); /* 372 */ EXTERN int Tcl_UniCharIsControl _ANSI_ARGS_((int ch)); /* 373 */ EXTERN int Tcl_UniCharIsGraph _ANSI_ARGS_((int ch)); /* 374 */ EXTERN int Tcl_UniCharIsPrint _ANSI_ARGS_((int ch)); /* 375 */ EXTERN int Tcl_UniCharIsPunct _ANSI_ARGS_((int ch)); /* 376 */ EXTERN int Tcl_RegExpExecObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, Tcl_Obj * objPtr, int offset, int nmatches, int flags)); /* 377 */ EXTERN void Tcl_RegExpGetInfo _ANSI_ARGS_((Tcl_RegExp regexp, Tcl_RegExpInfo * infoPtr)); /* 378 */ EXTERN Tcl_Obj * Tcl_NewUnicodeObj _ANSI_ARGS_(( CONST Tcl_UniChar * unicode, int numChars)); /* 379 */ EXTERN void Tcl_SetUnicodeObj _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int numChars)); /* 380 */ EXTERN int Tcl_GetCharLength _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 381 */ EXTERN Tcl_UniChar Tcl_GetUniChar _ANSI_ARGS_((Tcl_Obj * objPtr, int index)); /* 382 */ EXTERN Tcl_UniChar * Tcl_GetUnicode _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 383 */ EXTERN Tcl_Obj * Tcl_GetRange _ANSI_ARGS_((Tcl_Obj * objPtr, int first, int last)); /* 384 */ EXTERN void Tcl_AppendUnicodeToObj _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int length)); /* 385 */ EXTERN int Tcl_RegExpMatchObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * stringObj, Tcl_Obj * patternObj)); /* 386 */ EXTERN void Tcl_SetNotifier _ANSI_ARGS_(( Tcl_NotifierProcs * notifierProcPtr)); /* 387 */ EXTERN Tcl_Mutex * Tcl_GetAllocMutex _ANSI_ARGS_((void)); /* 388 */ EXTERN int Tcl_GetChannelNames _ANSI_ARGS_((Tcl_Interp * interp)); /* 389 */ EXTERN int Tcl_GetChannelNamesEx _ANSI_ARGS_(( Tcl_Interp * interp, char * pattern)); /* 390 */ EXTERN int Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 391 */ EXTERN void Tcl_ConditionFinalize _ANSI_ARGS_(( Tcl_Condition * condPtr)); /* 392 */ EXTERN void Tcl_MutexFinalize _ANSI_ARGS_((Tcl_Mutex * mutex)); /* 393 */ EXTERN int Tcl_CreateThread _ANSI_ARGS_((Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); /* 394 */ EXTERN int Tcl_ReadRaw _ANSI_ARGS_((Tcl_Channel chan, char * dst, int bytesToRead)); /* 395 */ EXTERN int Tcl_WriteRaw _ANSI_ARGS_((Tcl_Channel chan, char * src, int srcLen)); /* 396 */ EXTERN Tcl_Channel Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */ EXTERN int Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan)); /* 398 */ EXTERN char * Tcl_ChannelName _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 399 */ EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 400 */ EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 401 */ EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 402 */ EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 403 */ EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 404 */ EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 405 */ EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 406 */ EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 407 */ EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 408 */ EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 409 */ EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 410 */ EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 411 */ EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 412 */ EXTERN int Tcl_JoinThread _ANSI_ARGS_((Tcl_ThreadId id, int* result)); /* 413 */ EXTERN int Tcl_IsChannelShared _ANSI_ARGS_((Tcl_Channel channel)); /* 414 */ EXTERN int Tcl_IsChannelRegistered _ANSI_ARGS_(( Tcl_Interp* interp, Tcl_Channel channel)); /* 415 */ EXTERN void Tcl_CutChannel _ANSI_ARGS_((Tcl_Channel channel)); /* 416 */ EXTERN void Tcl_SpliceChannel _ANSI_ARGS_((Tcl_Channel channel)); /* 417 */ EXTERN void Tcl_ClearChannelHandlers _ANSI_ARGS_(( Tcl_Channel channel)); /* 418 */ EXTERN int Tcl_IsChannelExisting _ANSI_ARGS_(( CONST char* channelName)); /* 419 */ EXTERN int Tcl_UniCharNcasecmp _ANSI_ARGS_(( CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 420 */ EXTERN int Tcl_UniCharCaseMatch _ANSI_ARGS_(( CONST Tcl_UniChar * ustr, CONST Tcl_UniChar * pattern, int nocase)); /* 421 */ EXTERN Tcl_HashEntry * Tcl_FindHashEntry _ANSI_ARGS_(( Tcl_HashTable * tablePtr, CONST char * key)); /* 422 */ EXTERN Tcl_HashEntry * Tcl_CreateHashEntry _ANSI_ARGS_(( Tcl_HashTable * tablePtr, CONST char * key, int * newPtr)); /* 423 */ EXTERN void Tcl_InitCustomHashTable _ANSI_ARGS_(( Tcl_HashTable * tablePtr, int keyType, Tcl_HashKeyType * typePtr)); /* 424 */ EXTERN void Tcl_InitObjHashTable _ANSI_ARGS_(( Tcl_HashTable * tablePtr)); /* 425 */ EXTERN ClientData Tcl_CommandTraceInfo _ANSI_ARGS_(( Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * procPtr, ClientData prevClientData)); /* 426 */ EXTERN int Tcl_TraceCommand _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 427 */ EXTERN void Tcl_UntraceCommand _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 428 */ EXTERN char * Tcl_AttemptAlloc _ANSI_ARGS_((unsigned int size)); /* 429 */ EXTERN char * Tcl_AttemptDbCkalloc _ANSI_ARGS_((unsigned int size, char * file, int line)); /* 430 */ EXTERN char * Tcl_AttemptRealloc _ANSI_ARGS_((char * ptr, unsigned int size)); /* 431 */ EXTERN char * Tcl_AttemptDbCkrealloc _ANSI_ARGS_((char * ptr, unsigned int size, char * file, int line)); /* 432 */ EXTERN int Tcl_AttemptSetObjLength _ANSI_ARGS_(( Tcl_Obj * objPtr, int length)); /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread _ANSI_ARGS_(( Tcl_Channel channel)); /* 434 */ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 435 */ EXTERN int Tcl_GetMathFuncInfo _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int * numArgsPtr, Tcl_ValueType ** argTypesPtr, Tcl_MathProc ** procPtr, ClientData * clientDataPtr)); /* 436 */ EXTERN Tcl_Obj * Tcl_ListMathFuncs _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pattern)); /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 438 */ EXTERN int Tcl_DetachChannel _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel channel)); /* 439 */ EXTERN int Tcl_IsStandardChannel _ANSI_ARGS_(( Tcl_Channel channel)); /* 440 */ EXTERN int Tcl_FSCopyFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 441 */ EXTERN int Tcl_FSCopyDirectory _ANSI_ARGS_(( Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)); /* 442 */ EXTERN int Tcl_FSCreateDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 443 */ EXTERN int Tcl_FSDeleteFile _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 444 */ EXTERN int Tcl_FSLoadFile _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * sym1, CONST char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr, Tcl_FSUnloadFileProc ** unloadProcPtr)); /* 445 */ EXTERN int Tcl_FSMatchInDirectory _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * result, Tcl_Obj * pathPtr, char * pattern, Tcl_GlobTypeData * types)); /* 446 */ EXTERN Tcl_Obj* Tcl_FSLink _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj * toPtr)); /* 447 */ EXTERN int Tcl_FSRemoveDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 448 */ EXTERN int Tcl_FSRenameFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 449 */ EXTERN int Tcl_FSLstat _ANSI_ARGS_((Tcl_Obj * pathPtr, struct stat * buf)); /* 450 */ EXTERN int Tcl_FSUtime _ANSI_ARGS_((Tcl_Obj * pathPtr, struct utimbuf * tval)); /* 451 */ EXTERN int Tcl_FSFileAttrsGet _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 452 */ EXTERN int Tcl_FSFileAttrsSet _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj * objPtr)); /* 453 */ EXTERN char** Tcl_FSFileAttrStrings _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 454 */ EXTERN int Tcl_FSStat _ANSI_ARGS_((Tcl_Obj * pathPtr, struct stat * buf)); /* 455 */ EXTERN int Tcl_FSAccess _ANSI_ARGS_((Tcl_Obj * pathPtr, int mode)); /* 456 */ EXTERN Tcl_Channel Tcl_FSOpenFileChannel _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * pathPtr, char * modeString, int permissions)); /* 457 */ EXTERN Tcl_Obj* Tcl_FSGetCwd _ANSI_ARGS_((Tcl_Interp * interp)); /* 458 */ EXTERN int Tcl_FSChdir _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 459 */ EXTERN int Tcl_FSConvertToPathType _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * pathPtr)); /* 460 */ EXTERN Tcl_Obj* Tcl_FSJoinPath _ANSI_ARGS_((Tcl_Obj * listObj, int elements)); /* 461 */ EXTERN Tcl_Obj* Tcl_FSSplitPath _ANSI_ARGS_((Tcl_Obj* pathPtr, int * lenPtr)); /* 462 */ EXTERN int Tcl_FSEqualPaths _ANSI_ARGS_((Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)); /* 463 */ EXTERN Tcl_Obj* Tcl_FSGetNormalizedPath _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj* pathObjPtr)); /* 464 */ EXTERN Tcl_Obj* Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj * basePtr, int objc, Tcl_Obj *CONST objv[])); /* 465 */ EXTERN ClientData Tcl_FSGetInternalRep _ANSI_ARGS_(( Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr)); /* 466 */ EXTERN Tcl_Obj* Tcl_FSGetTranslatedPath _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 467 */ EXTERN int Tcl_FSEvalFile _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * fileName)); /* 468 */ EXTERN Tcl_Obj* Tcl_FSNewNativePath _ANSI_ARGS_(( Tcl_Obj* fromFilesystem, ClientData clientData)); /* 469 */ EXTERN char* Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 470 */ EXTERN Tcl_Obj* Tcl_FSFileSystemInfo _ANSI_ARGS_(( Tcl_Obj* pathObjPtr)); /* 471 */ EXTERN Tcl_Obj* Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 472 */ EXTERN Tcl_Obj* Tcl_FSListVolumes _ANSI_ARGS_((void)); /* 473 */ EXTERN int Tcl_FSRegister _ANSI_ARGS_((ClientData clientData, Tcl_Filesystem * fsPtr)); /* 474 */ EXTERN int Tcl_FSUnregister _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 475 */ EXTERN ClientData Tcl_FSData _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 476 */ EXTERN char* Tcl_FSGetTranslatedStringPath _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 477 */ EXTERN Tcl_Filesystem* Tcl_FSGetFileSystemForPath _ANSI_ARGS_(( Tcl_Obj* pathObjPtr)); /* 478 */ EXTERN Tcl_PathType Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); /* 479 */ EXTERN int Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan)); /* 480 */ EXTERN void Tcl_FSMountsChanged _ANSI_ARGS_(( Tcl_Filesystem * fsPtr)); /* 481 */ EXTERN int Tcl_EvalTokensStandard _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; struct TclIntStubs *tclIntStubs; struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; typedef struct TclStubs { int magic; struct TclStubHooks *hooks; int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 0 */ CONST char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */ void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 2 */ char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */ void (*tcl_Free) _ANSI_ARGS_((char * ptr)); /* 4 */ char * (*tcl_Realloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 5 */ char * (*tcl_DbCkalloc) _ANSI_ARGS_((unsigned int size, CONST char * file, int line)); /* 6 */ int (*tcl_DbCkfree) _ANSI_ARGS_((char * ptr, CONST char * file, int line)); /* 7 */ char * (*tcl_DbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, CONST char * file, int line)); /* 8 */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ void (*tcl_CreateFileHandler) _ANSI_ARGS_((int fd, int mask, Tcl_FileProc * proc, ClientData clientData)); /* 9 */ #endif /* UNIX */ #ifdef __WIN32__ void *reserved9; #endif /* __WIN32__ */ #ifdef MAC_TCL void *reserved9; #endif /* MAC_TCL */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) _ANSI_ARGS_((int fd)); /* 10 */ #endif /* UNIX */ #ifdef __WIN32__ void *reserved10; #endif /* __WIN32__ */ #ifdef MAC_TCL void *reserved10; #endif /* MAC_TCL */ void (*tcl_SetTimer) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 11 */ void (*tcl_Sleep) _ANSI_ARGS_((int ms)); /* 12 */ int (*tcl_WaitForEvent) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 13 */ int (*tcl_AppendAllObjTypes) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 14 */ void (*tcl_AppendStringsToObj) _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr)); /* 15 */ void (*tcl_AppendToObj) _ANSI_ARGS_((Tcl_Obj* objPtr, CONST char* bytes, int length)); /* 16 */ Tcl_Obj * (*tcl_ConcatObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 17 */ int (*tcl_ConvertToType) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_ObjType * typePtr)); /* 18 */ void (*tcl_DbDecrRefCount) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 19 */ void (*tcl_DbIncrRefCount) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 20 */ int (*tcl_DbIsShared) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 21 */ Tcl_Obj * (*tcl_DbNewBooleanObj) _ANSI_ARGS_((int boolValue, CONST char * file, int line)); /* 22 */ Tcl_Obj * (*tcl_DbNewByteArrayObj) _ANSI_ARGS_((CONST unsigned char * bytes, int length, CONST char * file, int line)); /* 23 */ Tcl_Obj * (*tcl_DbNewDoubleObj) _ANSI_ARGS_((double doubleValue, CONST char * file, int line)); /* 24 */ Tcl_Obj * (*tcl_DbNewListObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST * objv, CONST char * file, int line)); /* 25 */ Tcl_Obj * (*tcl_DbNewLongObj) _ANSI_ARGS_((long longValue, CONST char * file, int line)); /* 26 */ Tcl_Obj * (*tcl_DbNewObj) _ANSI_ARGS_((CONST char * file, int line)); /* 27 */ Tcl_Obj * (*tcl_DbNewStringObj) _ANSI_ARGS_((CONST char * bytes, int length, CONST char * file, int line)); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 29 */ void (*tclFreeObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 30 */ int (*tcl_GetBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * boolPtr)); /* 31 */ int (*tcl_GetBooleanFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * boolPtr)); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 33 */ int (*tcl_GetDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, double * doublePtr)); /* 34 */ int (*tcl_GetDoubleFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * doublePtr)); /* 35 */ int (*tcl_GetIndexFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, char ** tablePtr, char * msg, int flags, int * indexPtr)); /* 36 */ int (*tcl_GetInt) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * intPtr)); /* 37 */ int (*tcl_GetIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr)); /* 38 */ int (*tcl_GetLongFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr)); /* 39 */ Tcl_ObjType * (*tcl_GetObjType) _ANSI_ARGS_((char * typeName)); /* 40 */ char * (*tcl_GetStringFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 41 */ void (*tcl_InvalidateStringRep) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 42 */ int (*tcl_ListObjAppendList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * elemListPtr)); /* 43 */ int (*tcl_ListObjAppendElement) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * objPtr)); /* 44 */ int (*tcl_ListObjGetElements) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj *** objvPtr)); /* 45 */ int (*tcl_ListObjIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj ** objPtrPtr)); /* 46 */ int (*tcl_ListObjLength) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * intPtr)); /* 47 */ int (*tcl_ListObjReplace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[])); /* 48 */ Tcl_Obj * (*tcl_NewBooleanObj) _ANSI_ARGS_((int boolValue)); /* 49 */ Tcl_Obj * (*tcl_NewByteArrayObj) _ANSI_ARGS_((CONST unsigned char* bytes, int length)); /* 50 */ Tcl_Obj * (*tcl_NewDoubleObj) _ANSI_ARGS_((double doubleValue)); /* 51 */ Tcl_Obj * (*tcl_NewIntObj) _ANSI_ARGS_((int intValue)); /* 52 */ Tcl_Obj * (*tcl_NewListObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 53 */ Tcl_Obj * (*tcl_NewLongObj) _ANSI_ARGS_((long longValue)); /* 54 */ Tcl_Obj * (*tcl_NewObj) _ANSI_ARGS_((void)); /* 55 */ Tcl_Obj * (*tcl_NewStringObj) _ANSI_ARGS_((CONST char * bytes, int length)); /* 56 */ void (*tcl_SetBooleanObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int boolValue)); /* 57 */ unsigned char * (*tcl_SetByteArrayLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 58 */ void (*tcl_SetByteArrayObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST unsigned char * bytes, int length)); /* 59 */ void (*tcl_SetDoubleObj) _ANSI_ARGS_((Tcl_Obj * objPtr, double doubleValue)); /* 60 */ void (*tcl_SetIntObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int intValue)); /* 61 */ void (*tcl_SetListObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int objc, Tcl_Obj *CONST objv[])); /* 62 */ void (*tcl_SetLongObj) _ANSI_ARGS_((Tcl_Obj * objPtr, long longValue)); /* 63 */ void (*tcl_SetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 64 */ void (*tcl_SetStringObj) _ANSI_ARGS_((Tcl_Obj* objPtr, CONST char* bytes, int length)); /* 65 */ void (*tcl_AddErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message)); /* 66 */ void (*tcl_AddObjErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message, int length)); /* 67 */ void (*tcl_AllowExceptions) _ANSI_ARGS_((Tcl_Interp * interp)); /* 68 */ void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 69 */ void (*tcl_AppendResult) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 70 */ Tcl_AsyncHandler (*tcl_AsyncCreate) _ANSI_ARGS_((Tcl_AsyncProc * proc, ClientData clientData)); /* 71 */ void (*tcl_AsyncDelete) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 72 */ int (*tcl_AsyncInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int code)); /* 73 */ void (*tcl_AsyncMark) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 74 */ int (*tcl_AsyncReady) _ANSI_ARGS_((void)); /* 75 */ void (*tcl_BackgroundError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 76 */ char (*tcl_Backslash) _ANSI_ARGS_((CONST char * src, int * readPtr)); /* 77 */ int (*tcl_BadChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, char * optionName, char * optionList)); /* 78 */ void (*tcl_CallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 79 */ void (*tcl_CancelIdleCall) _ANSI_ARGS_((Tcl_IdleProc * idleProc, ClientData clientData)); /* 80 */ int (*tcl_Close) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 81 */ int (*tcl_CommandComplete) _ANSI_ARGS_((char * cmd)); /* 82 */ char * (*tcl_Concat) _ANSI_ARGS_((int argc, char * CONST * argv)); /* 83 */ int (*tcl_ConvertElement) _ANSI_ARGS_((CONST char * src, char * dst, int flags)); /* 84 */ int (*tcl_ConvertCountedElement) _ANSI_ARGS_((CONST char * src, int length, char * dst, int flags)); /* 85 */ int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp * slave, char * slaveCmd, Tcl_Interp * target, char * targetCmd, int argc, char ** argv)); /* 86 */ int (*tcl_CreateAliasObj) _ANSI_ARGS_((Tcl_Interp * slave, char * slaveCmd, Tcl_Interp * target, char * targetCmd, int objc, Tcl_Obj *CONST objv[])); /* 87 */ Tcl_Channel (*tcl_CreateChannel) _ANSI_ARGS_((Tcl_ChannelType * typePtr, char * chanName, ClientData instanceData, int mask)); /* 88 */ void (*tcl_CreateChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, int mask, Tcl_ChannelProc * proc, ClientData clientData)); /* 89 */ void (*tcl_CreateCloseHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)); /* 90 */ Tcl_Command (*tcl_CreateCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 91 */ void (*tcl_CreateEventSource) _ANSI_ARGS_((Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)); /* 92 */ void (*tcl_CreateExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 93 */ Tcl_Interp * (*tcl_CreateInterp) _ANSI_ARGS_((void)); /* 94 */ void (*tcl_CreateMathFunc) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int numArgs, Tcl_ValueType * argTypes, Tcl_MathProc * proc, ClientData clientData)); /* 95 */ Tcl_Command (*tcl_CreateObjCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_ObjCmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 96 */ Tcl_Interp * (*tcl_CreateSlave) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveName, int isSafe)); /* 97 */ Tcl_TimerToken (*tcl_CreateTimerHandler) _ANSI_ARGS_((int milliseconds, Tcl_TimerProc * proc, ClientData clientData)); /* 98 */ Tcl_Trace (*tcl_CreateTrace) _ANSI_ARGS_((Tcl_Interp * interp, int level, Tcl_CmdTraceProc * proc, ClientData clientData)); /* 99 */ void (*tcl_DeleteAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 100 */ void (*tcl_DeleteChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_ChannelProc * proc, ClientData clientData)); /* 101 */ void (*tcl_DeleteCloseHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)); /* 102 */ int (*tcl_DeleteCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName)); /* 103 */ int (*tcl_DeleteCommandFromToken) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 104 */ void (*tcl_DeleteEvents) _ANSI_ARGS_((Tcl_EventDeleteProc * proc, ClientData clientData)); /* 105 */ void (*tcl_DeleteEventSource) _ANSI_ARGS_((Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)); /* 106 */ void (*tcl_DeleteExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 107 */ void (*tcl_DeleteHashEntry) _ANSI_ARGS_((Tcl_HashEntry * entryPtr)); /* 108 */ void (*tcl_DeleteHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 109 */ void (*tcl_DeleteInterp) _ANSI_ARGS_((Tcl_Interp * interp)); /* 110 */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ void (*tcl_DetachPids) _ANSI_ARGS_((int numPids, Tcl_Pid * pidPtr)); /* 111 */ #endif /* UNIX */ #ifdef __WIN32__ void (*tcl_DetachPids) _ANSI_ARGS_((int numPids, Tcl_Pid * pidPtr)); /* 111 */ #endif /* __WIN32__ */ #ifdef MAC_TCL void *reserved111; #endif /* MAC_TCL */ void (*tcl_DeleteTimerHandler) _ANSI_ARGS_((Tcl_TimerToken token)); /* 112 */ void (*tcl_DeleteTrace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Trace trace)); /* 113 */ void (*tcl_DontCallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 114 */ int (*tcl_DoOneEvent) _ANSI_ARGS_((int flags)); /* 115 */ void (*tcl_DoWhenIdle) _ANSI_ARGS_((Tcl_IdleProc * proc, ClientData clientData)); /* 116 */ CONST char * (*tcl_DStringAppend) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * str, int length)); /* 117 */ CONST char * (*tcl_DStringAppendElement) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * string)); /* 118 */ void (*tcl_DStringEndSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 119 */ void (*tcl_DStringFree) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 120 */ void (*tcl_DStringGetResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 121 */ void (*tcl_DStringInit) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 122 */ void (*tcl_DStringResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 123 */ void (*tcl_DStringSetLength) _ANSI_ARGS_((Tcl_DString * dsPtr, int length)); /* 124 */ void (*tcl_DStringStartSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 125 */ int (*tcl_Eof) _ANSI_ARGS_((Tcl_Channel chan)); /* 126 */ char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */ char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */ int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 129 */ int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName)); /* 130 */ int (*tcl_EvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 131 */ void (*tcl_EventuallyFree) _ANSI_ARGS_((ClientData clientData, Tcl_FreeProc * freeProc)); /* 132 */ void (*tcl_Exit) _ANSI_ARGS_((int status)); /* 133 */ int (*tcl_ExposeCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * hiddenCmdToken, CONST char * cmdName)); /* 134 */ int (*tcl_ExprBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * ptr)); /* 135 */ int (*tcl_ExprBooleanObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * ptr)); /* 136 */ int (*tcl_ExprDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, double * ptr)); /* 137 */ int (*tcl_ExprDoubleObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * ptr)); /* 138 */ int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, long * ptr)); /* 139 */ int (*tcl_ExprLongObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * ptr)); /* 140 */ int (*tcl_ExprObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr)); /* 141 */ int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 142 */ void (*tcl_Finalize) _ANSI_ARGS_((void)); /* 143 */ void (*tcl_FindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 144 */ Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 145 */ int (*tcl_Flush) _ANSI_ARGS_((Tcl_Channel chan)); /* 146 */ void (*tcl_FreeResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 147 */ int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveCmd, Tcl_Interp ** targetInterpPtr, char ** targetCmdPtr, int * argcPtr, char *** argvPtr)); /* 148 */ int (*tcl_GetAliasObj) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveCmd, Tcl_Interp ** targetInterpPtr, char ** targetCmdPtr, int * objcPtr, Tcl_Obj *** objv)); /* 149 */ ClientData (*tcl_GetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc ** procPtr)); /* 150 */ Tcl_Channel (*tcl_GetChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * chanName, int * modePtr)); /* 151 */ int (*tcl_GetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan)); /* 152 */ int (*tcl_GetChannelHandle) _ANSI_ARGS_((Tcl_Channel chan, int direction, ClientData * handlePtr)); /* 153 */ ClientData (*tcl_GetChannelInstanceData) _ANSI_ARGS_((Tcl_Channel chan)); /* 154 */ int (*tcl_GetChannelMode) _ANSI_ARGS_((Tcl_Channel chan)); /* 155 */ char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */ int (*tcl_GetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, char * optionName, Tcl_DString * dsPtr)); /* 157 */ Tcl_ChannelType * (*tcl_GetChannelType) _ANSI_ARGS_((Tcl_Channel chan)); /* 158 */ int (*tcl_GetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 159 */ CONST char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */ int (*tcl_GetErrno) _ANSI_ARGS_((void)); /* 161 */ char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */ int (*tcl_GetInterpPath) _ANSI_ARGS_((Tcl_Interp * askInterp, Tcl_Interp * slaveInterp)); /* 163 */ Tcl_Interp * (*tcl_GetMaster) _ANSI_ARGS_((Tcl_Interp * interp)); /* 164 */ CONST char * (*tcl_GetNameOfExecutable) _ANSI_ARGS_((void)); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 166 */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int forWriting, int checkUsage, ClientData * filePtr)); /* 167 */ #endif /* UNIX */ #ifdef __WIN32__ void *reserved167; #endif /* __WIN32__ */ #ifdef MAC_TCL void *reserved167; #endif /* MAC_TCL */ Tcl_PathType (*tcl_GetPathType) _ANSI_ARGS_((CONST char * path)); /* 168 */ int (*tcl_Gets) _ANSI_ARGS_((Tcl_Channel chan, Tcl_DString * dsPtr)); /* 169 */ int (*tcl_GetsObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 170 */ int (*tcl_GetServiceMode) _ANSI_ARGS_((void)); /* 171 */ Tcl_Interp * (*tcl_GetSlave) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveName)); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) _ANSI_ARGS_((int type)); /* 173 */ char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */ char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 175 */ char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 176 */ int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * command)); /* 177 */ int (*tcl_GlobalEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 178 */ int (*tcl_HideCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, CONST char * hiddenCmdToken)); /* 179 */ int (*tcl_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 180 */ void (*tcl_InitHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr, int keyType)); /* 181 */ int (*tcl_InputBlocked) _ANSI_ARGS_((Tcl_Channel chan)); /* 182 */ int (*tcl_InputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 183 */ int (*tcl_InterpDeleted) _ANSI_ARGS_((Tcl_Interp * interp)); /* 184 */ int (*tcl_IsSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 185 */ char * (*tcl_JoinPath) _ANSI_ARGS_((int argc, char ** argv, Tcl_DString * resultPtr)); /* 186 */ int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * addr, int type)); /* 187 */ void *reserved188; Tcl_Channel (*tcl_MakeFileChannel) _ANSI_ARGS_((ClientData handle, int mode)); /* 189 */ int (*tcl_MakeSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 190 */ Tcl_Channel (*tcl_MakeTcpClientChannel) _ANSI_ARGS_((ClientData tcpSocket)); /* 191 */ char * (*tcl_Merge) _ANSI_ARGS_((int argc, char * CONST * argv)); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) _ANSI_ARGS_((Tcl_HashSearch * searchPtr)); /* 193 */ void (*tcl_NotifyChannel) _ANSI_ARGS_((Tcl_Channel channel, int mask)); /* 194 */ Tcl_Obj * (*tcl_ObjGetVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, int flags)); /* 195 */ Tcl_Obj * (*tcl_ObjSetVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, Tcl_Obj * newValuePtr, int flags)); /* 196 */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 197 */ #endif /* UNIX */ #ifdef __WIN32__ Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 197 */ #endif /* __WIN32__ */ #ifdef MAC_TCL void *reserved197; #endif /* MAC_TCL */ Tcl_Channel (*tcl_OpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * modeString, int permissions)); /* 198 */ Tcl_Channel (*tcl_OpenTcpClient) _ANSI_ARGS_((Tcl_Interp * interp, int port, char * address, char * myaddr, int myport, int async)); /* 199 */ Tcl_Channel (*tcl_OpenTcpServer) _ANSI_ARGS_((Tcl_Interp * interp, int port, char * host, Tcl_TcpAcceptProc * acceptProc, ClientData callbackData)); /* 200 */ void (*tcl_Preserve) _ANSI_ARGS_((ClientData data)); /* 201 */ void (*tcl_PrintDouble) _ANSI_ARGS_((Tcl_Interp * interp, double value, char * dst)); /* 202 */ int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * string)); /* 203 */ char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */ void (*tcl_QueueEvent) _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); /* 205 */ int (*tcl_Read) _ANSI_ARGS_((Tcl_Channel chan, char * bufPtr, int toRead)); /* 206 */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ void (*tcl_ReapDetachedProcs) _ANSI_ARGS_((void)); /* 207 */ #endif /* UNIX */ #ifdef __WIN32__ void (*tcl_ReapDetachedProcs) _ANSI_ARGS_((void)); /* 207 */ #endif /* __WIN32__ */ #ifdef MAC_TCL void *reserved207; #endif /* MAC_TCL */ int (*tcl_RecordAndEval) _ANSI_ARGS_((Tcl_Interp * interp, char * cmd, int flags)); /* 208 */ int (*tcl_RecordAndEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * cmdPtr, int flags)); /* 209 */ void (*tcl_RegisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 210 */ void (*tcl_RegisterObjType) _ANSI_ARGS_((Tcl_ObjType * typePtr)); /* 211 */ Tcl_RegExp (*tcl_RegExpCompile) _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 212 */ int (*tcl_RegExpExec) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * str, CONST char * start)); /* 213 */ int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char * pattern)); /* 214 */ void (*tcl_RegExpRange) _ANSI_ARGS_((Tcl_RegExp regexp, int index, char ** startPtr, char ** endPtr)); /* 215 */ void (*tcl_Release) _ANSI_ARGS_((ClientData clientData)); /* 216 */ void (*tcl_ResetResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 217 */ int (*tcl_ScanElement) _ANSI_ARGS_((CONST char * str, int * flagPtr)); /* 218 */ int (*tcl_ScanCountedElement) _ANSI_ARGS_((CONST char * str, int length, int * flagPtr)); /* 219 */ int (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, int offset, int mode)); /* 220 */ int (*tcl_ServiceAll) _ANSI_ARGS_((void)); /* 221 */ int (*tcl_ServiceEvent) _ANSI_ARGS_((int flags)); /* 222 */ void (*tcl_SetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 223 */ void (*tcl_SetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan, int sz)); /* 224 */ int (*tcl_SetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, char * optionName, char * newValue)); /* 225 */ int (*tcl_SetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 226 */ void (*tcl_SetErrno) _ANSI_ARGS_((int err)); /* 227 */ void (*tcl_SetErrorCode) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 228 */ void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 229 */ void (*tcl_SetPanicProc) _ANSI_ARGS_((Tcl_PanicProc * panicProc)); /* 230 */ int (*tcl_SetRecursionLimit) _ANSI_ARGS_((Tcl_Interp * interp, int depth)); /* 231 */ void (*tcl_SetResult) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tcl_FreeProc * freeProc)); /* 232 */ int (*tcl_SetServiceMode) _ANSI_ARGS_((int mode)); /* 233 */ void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 234 */ void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 235 */ void (*tcl_SetStdChannel) _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 236 */ char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * newValue, int flags)); /* 237 */ char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, char * newValue, int flags)); /* 238 */ char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */ char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */ void (*tcl_SourceRCFile) _ANSI_ARGS_((Tcl_Interp * interp)); /* 241 */ int (*tcl_SplitList) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int * argcPtr, char *** argvPtr)); /* 242 */ void (*tcl_SplitPath) _ANSI_ARGS_((CONST char * path, int * argcPtr, char *** argvPtr)); /* 243 */ void (*tcl_StaticPackage) _ANSI_ARGS_((Tcl_Interp * interp, char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)); /* 244 */ int (*tcl_StringMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern)); /* 245 */ int (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */ int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */ int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */ char * (*tcl_TranslateFileName) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_DString * bufferPtr)); /* 249 */ int (*tcl_Ungets) _ANSI_ARGS_((Tcl_Channel chan, char * str, int len, int atHead)); /* 250 */ void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 251 */ int (*tcl_UnregisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 252 */ int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 253 */ int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 254 */ void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */ void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */ void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 257 */ int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * varName, CONST char * localName, int flags)); /* 258 */ int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * part1, char * part2, CONST char * localName, int flags)); /* 259 */ int (*tcl_VarEval) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 260 */ ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */ ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */ int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, char * s, int slen)); /* 263 */ void (*tcl_WrongNumArgs) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], char * message)); /* 264 */ int (*tcl_DumpActiveMemory) _ANSI_ARGS_((CONST char * fileName)); /* 265 */ void (*tcl_ValidateAllMemory) _ANSI_ARGS_((CONST char * file, int line)); /* 266 */ void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 267 */ void (*tcl_AppendStringsToObjVA) _ANSI_ARGS_((Tcl_Obj * objPtr, va_list argList)); /* 268 */ char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */ char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char ** termPtr)); /* 270 */ CONST char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */ CONST char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */ int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 273 */ CONST char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 274 */ void (*tcl_SetErrorCodeVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 275 */ int (*tcl_VarEvalVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 276 */ Tcl_Pid (*tcl_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 277 */ void (*tcl_PanicVA) _ANSI_ARGS_((CONST char * format, va_list argList)); /* 278 */ void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */ void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */ Tcl_Channel (*tcl_StackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */ int (*tcl_UnstackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 282 */ Tcl_Channel (*tcl_GetStackedChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 283 */ void (*tcl_SetMainLoop) _ANSI_ARGS_((Tcl_MainLoopProc * proc)); /* 284 */ void *reserved285; void (*tcl_AppendObjToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_Obj * appendObjPtr)); /* 286 */ Tcl_Encoding (*tcl_CreateEncoding) _ANSI_ARGS_((Tcl_EncodingType * typePtr)); /* 287 */ void (*tcl_CreateThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 288 */ void (*tcl_DeleteThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 289 */ void (*tcl_DiscardResult) _ANSI_ARGS_((Tcl_SavedResult * statePtr)); /* 290 */ int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp * interp, char * script, int numBytes, int flags)); /* 291 */ int (*tcl_EvalObjv) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 292 */ int (*tcl_EvalObjEx) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 293 */ void (*tcl_ExitThread) _ANSI_ARGS_((int status)); /* 294 */ int (*tcl_ExternalToUtf) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 295 */ char * (*tcl_ExternalToUtfDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 296 */ void (*tcl_FinalizeThread) _ANSI_ARGS_((void)); /* 297 */ void (*tcl_FinalizeNotifier) _ANSI_ARGS_((ClientData clientData)); /* 298 */ void (*tcl_FreeEncoding) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) _ANSI_ARGS_((void)); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 301 */ char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */ void (*tcl_GetEncodingNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 303 */ int (*tcl_GetIndexFromObjStruct) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, char ** tablePtr, int offset, char * msg, int flags, int * indexPtr)); /* 304 */ VOID * (*tcl_GetThreadData) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr, int size)); /* 305 */ Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 306 */ ClientData (*tcl_InitNotifier) _ANSI_ARGS_((void)); /* 307 */ void (*tcl_MutexLock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 308 */ void (*tcl_MutexUnlock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 309 */ void (*tcl_ConditionNotify) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 310 */ void (*tcl_ConditionWait) _ANSI_ARGS_((Tcl_Condition * condPtr, Tcl_Mutex * mutexPtr, Tcl_Time * timePtr)); /* 311 */ int (*tcl_NumUtfChars) _ANSI_ARGS_((CONST char * src, int len)); /* 312 */ int (*tcl_ReadChars) _ANSI_ARGS_((Tcl_Channel channel, Tcl_Obj * objPtr, int charsToRead, int appendFlag)); /* 313 */ void (*tcl_RestoreResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 314 */ void (*tcl_SaveResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 315 */ int (*tcl_SetSystemEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 316 */ Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */ void (*tcl_ThreadAlert) _ANSI_ARGS_((Tcl_ThreadId threadId)); /* 318 */ void (*tcl_ThreadQueueEvent) _ANSI_ARGS_((Tcl_ThreadId threadId, Tcl_Event* evPtr, Tcl_QueuePosition position)); /* 319 */ Tcl_UniChar (*tcl_UniCharAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 320 */ Tcl_UniChar (*tcl_UniCharToLower) _ANSI_ARGS_((int ch)); /* 321 */ Tcl_UniChar (*tcl_UniCharToTitle) _ANSI_ARGS_((int ch)); /* 322 */ Tcl_UniChar (*tcl_UniCharToUpper) _ANSI_ARGS_((int ch)); /* 323 */ int (*tcl_UniCharToUtf) _ANSI_ARGS_((int ch, char * buf)); /* 324 */ char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */ int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int len)); /* 326 */ int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 327 */ char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */ char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */ char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */ int (*tcl_UtfToExternal) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 332 */ char * (*tcl_UtfToExternalDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 333 */ int (*tcl_UtfToLower) _ANSI_ARGS_((char * src)); /* 334 */ int (*tcl_UtfToTitle) _ANSI_ARGS_((char * src)); /* 335 */ int (*tcl_UtfToUniChar) _ANSI_ARGS_((CONST char * src, Tcl_UniChar * chPtr)); /* 336 */ int (*tcl_UtfToUpper) _ANSI_ARGS_((char * src)); /* 337 */ int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */ int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */ char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */ char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */ void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((char * path)); /* 342 */ void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */ void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */ int (*tcl_UniCharIsAlnum) _ANSI_ARGS_((int ch)); /* 345 */ int (*tcl_UniCharIsAlpha) _ANSI_ARGS_((int ch)); /* 346 */ int (*tcl_UniCharIsDigit) _ANSI_ARGS_((int ch)); /* 347 */ int (*tcl_UniCharIsLower) _ANSI_ARGS_((int ch)); /* 348 */ int (*tcl_UniCharIsSpace) _ANSI_ARGS_((int ch)); /* 349 */ int (*tcl_UniCharIsUpper) _ANSI_ARGS_((int ch)); /* 350 */ int (*tcl_UniCharIsWordChar) _ANSI_ARGS_((int ch)); /* 351 */ int (*tcl_UniCharLen) _ANSI_ARGS_((Tcl_UniChar * str)); /* 352 */ int (*tcl_UniCharNcmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 353 */ char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * string, int numChars, Tcl_DString * dsPtr)); /* 354 */ Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * string, int length, Tcl_DString * dsPtr)); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * patObj, int flags)); /* 356 */ Tcl_Obj * (*tcl_EvalTokens) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 357 */ void (*tcl_FreeParse) _ANSI_ARGS_((Tcl_Parse * parsePtr)); /* 358 */ void (*tcl_LogCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * script, char * command, int length)); /* 359 */ int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 360 */ int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */ int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */ int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 363 */ int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */ char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 365 */ int (*tcl_Chdir) _ANSI_ARGS_((CONST char * dirName)); /* 366 */ int (*tcl_Access) _ANSI_ARGS_((CONST char * path, int mode)); /* 367 */ int (*tcl_Stat) _ANSI_ARGS_((CONST char * path, struct stat * bufPtr)); /* 368 */ int (*tcl_UtfNcmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 369 */ int (*tcl_UtfNcasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 370 */ int (*tcl_StringCaseMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern, int nocase)); /* 371 */ int (*tcl_UniCharIsControl) _ANSI_ARGS_((int ch)); /* 372 */ int (*tcl_UniCharIsGraph) _ANSI_ARGS_((int ch)); /* 373 */ int (*tcl_UniCharIsPrint) _ANSI_ARGS_((int ch)); /* 374 */ int (*tcl_UniCharIsPunct) _ANSI_ARGS_((int ch)); /* 375 */ int (*tcl_RegExpExecObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, Tcl_Obj * objPtr, int offset, int nmatches, int flags)); /* 376 */ void (*tcl_RegExpGetInfo) _ANSI_ARGS_((Tcl_RegExp regexp, Tcl_RegExpInfo * infoPtr)); /* 377 */ Tcl_Obj * (*tcl_NewUnicodeObj) _ANSI_ARGS_((CONST Tcl_UniChar * unicode, int numChars)); /* 378 */ void (*tcl_SetUnicodeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int numChars)); /* 379 */ int (*tcl_GetCharLength) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 380 */ Tcl_UniChar (*tcl_GetUniChar) _ANSI_ARGS_((Tcl_Obj * objPtr, int index)); /* 381 */ Tcl_UniChar * (*tcl_GetUnicode) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 382 */ Tcl_Obj * (*tcl_GetRange) _ANSI_ARGS_((Tcl_Obj * objPtr, int first, int last)); /* 383 */ void (*tcl_AppendUnicodeToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int length)); /* 384 */ int (*tcl_RegExpMatchObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * stringObj, Tcl_Obj * patternObj)); /* 385 */ void (*tcl_SetNotifier) _ANSI_ARGS_((Tcl_NotifierProcs * notifierProcPtr)); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) _ANSI_ARGS_((void)); /* 387 */ int (*tcl_GetChannelNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 388 */ int (*tcl_GetChannelNamesEx) _ANSI_ARGS_((Tcl_Interp * interp, char * pattern)); /* 389 */ int (*tcl_ProcObjCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 390 */ void (*tcl_ConditionFinalize) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 391 */ void (*tcl_MutexFinalize) _ANSI_ARGS_((Tcl_Mutex * mutex)); /* 392 */ int (*tcl_CreateThread) _ANSI_ARGS_((Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); /* 393 */ int (*tcl_ReadRaw) _ANSI_ARGS_((Tcl_Channel chan, char * dst, int bytesToRead)); /* 394 */ int (*tcl_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, char * src, int srcLen)); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 396 */ int (*tcl_ChannelBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */ char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 399 */ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 400 */ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 401 */ Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 402 */ Tcl_DriverInputProc * (*tcl_ChannelInputProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 403 */ Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 404 */ Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 405 */ Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 406 */ Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 407 */ Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 408 */ Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 409 */ Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 410 */ Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 411 */ int (*tcl_JoinThread) _ANSI_ARGS_((Tcl_ThreadId id, int* result)); /* 412 */ int (*tcl_IsChannelShared) _ANSI_ARGS_((Tcl_Channel channel)); /* 413 */ int (*tcl_IsChannelRegistered) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel channel)); /* 414 */ void (*tcl_CutChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 415 */ void (*tcl_SpliceChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 416 */ void (*tcl_ClearChannelHandlers) _ANSI_ARGS_((Tcl_Channel channel)); /* 417 */ int (*tcl_IsChannelExisting) _ANSI_ARGS_((CONST char* channelName)); /* 418 */ int (*tcl_UniCharNcasecmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 419 */ int (*tcl_UniCharCaseMatch) _ANSI_ARGS_((CONST Tcl_UniChar * ustr, CONST Tcl_UniChar * pattern, int nocase)); /* 420 */ Tcl_HashEntry * (*tcl_FindHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key)); /* 421 */ Tcl_HashEntry * (*tcl_CreateHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key, int * newPtr)); /* 422 */ void (*tcl_InitCustomHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr, int keyType, Tcl_HashKeyType * typePtr)); /* 423 */ void (*tcl_InitObjHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 424 */ ClientData (*tcl_CommandTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * procPtr, ClientData prevClientData)); /* 425 */ int (*tcl_TraceCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 426 */ void (*tcl_UntraceCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 427 */ char * (*tcl_AttemptAlloc) _ANSI_ARGS_((unsigned int size)); /* 428 */ char * (*tcl_AttemptDbCkalloc) _ANSI_ARGS_((unsigned int size, char * file, int line)); /* 429 */ char * (*tcl_AttemptRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 430 */ char * (*tcl_AttemptDbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, char * file, int line)); /* 431 */ int (*tcl_AttemptSetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) _ANSI_ARGS_((Tcl_Channel channel)); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 434 */ int (*tcl_GetMathFuncInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int * numArgsPtr, Tcl_ValueType ** argTypesPtr, Tcl_MathProc ** procPtr, ClientData * clientDataPtr)); /* 435 */ Tcl_Obj * (*tcl_ListMathFuncs) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pattern)); /* 436 */ Tcl_Obj * (*tcl_SubstObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 437 */ int (*tcl_DetachChannel) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel channel)); /* 438 */ int (*tcl_IsStandardChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 439 */ int (*tcl_FSCopyFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 440 */ int (*tcl_FSCopyDirectory) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)); /* 441 */ int (*tcl_FSCreateDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 442 */ int (*tcl_FSDeleteFile) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 443 */ int (*tcl_FSLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * sym1, CONST char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr, Tcl_FSUnloadFileProc ** unloadProcPtr)); /* 444 */ int (*tcl_FSMatchInDirectory) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * result, Tcl_Obj * pathPtr, char * pattern, Tcl_GlobTypeData * types)); /* 445 */ Tcl_Obj* (*tcl_FSLink) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj * toPtr)); /* 446 */ int (*tcl_FSRemoveDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 447 */ int (*tcl_FSRenameFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 448 */ int (*tcl_FSLstat) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct stat * buf)); /* 449 */ int (*tcl_FSUtime) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct utimbuf * tval)); /* 450 */ int (*tcl_FSFileAttrsGet) _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 451 */ int (*tcl_FSFileAttrsSet) _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj * objPtr)); /* 452 */ char** (*tcl_FSFileAttrStrings) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 453 */ int (*tcl_FSStat) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct stat * buf)); /* 454 */ int (*tcl_FSAccess) _ANSI_ARGS_((Tcl_Obj * pathPtr, int mode)); /* 455 */ Tcl_Channel (*tcl_FSOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, char * modeString, int permissions)); /* 456 */ Tcl_Obj* (*tcl_FSGetCwd) _ANSI_ARGS_((Tcl_Interp * interp)); /* 457 */ int (*tcl_FSChdir) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 458 */ int (*tcl_FSConvertToPathType) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr)); /* 459 */ Tcl_Obj* (*tcl_FSJoinPath) _ANSI_ARGS_((Tcl_Obj * listObj, int elements)); /* 460 */ Tcl_Obj* (*tcl_FSSplitPath) _ANSI_ARGS_((Tcl_Obj* pathPtr, int * lenPtr)); /* 461 */ int (*tcl_FSEqualPaths) _ANSI_ARGS_((Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)); /* 462 */ Tcl_Obj* (*tcl_FSGetNormalizedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathObjPtr)); /* 463 */ Tcl_Obj* (*tcl_FSJoinToPath) _ANSI_ARGS_((Tcl_Obj * basePtr, int objc, Tcl_Obj *CONST objv[])); /* 464 */ ClientData (*tcl_FSGetInternalRep) _ANSI_ARGS_((Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr)); /* 465 */ Tcl_Obj* (*tcl_FSGetTranslatedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 466 */ int (*tcl_FSEvalFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * fileName)); /* 467 */ Tcl_Obj* (*tcl_FSNewNativePath) _ANSI_ARGS_((Tcl_Obj* fromFilesystem, ClientData clientData)); /* 468 */ char* (*tcl_FSGetNativePath) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 469 */ Tcl_Obj* (*tcl_FSFileSystemInfo) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 470 */ Tcl_Obj* (*tcl_FSPathSeparator) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 471 */ Tcl_Obj* (*tcl_FSListVolumes) _ANSI_ARGS_((void)); /* 472 */ int (*tcl_FSRegister) _ANSI_ARGS_((ClientData clientData, Tcl_Filesystem * fsPtr)); /* 473 */ int (*tcl_FSUnregister) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 474 */ ClientData (*tcl_FSData) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 475 */ char* (*tcl_FSGetTranslatedStringPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 476 */ Tcl_Filesystem* (*tcl_FSGetFileSystemForPath) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 477 */ Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); /* 478 */ int (*tcl_OutputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 479 */ void (*tcl_FSMountsChanged) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 480 */ int (*tcl_EvalTokensStandard) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 481 */ } TclStubs; #ifdef __cplusplus extern "C" { #endif extern TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) /* * Inline function declarations: */ #ifndef Tcl_PkgProvideEx #define Tcl_PkgProvideEx \ (tclStubsPtr->tcl_PkgProvideEx) /* 0 */ #endif #ifndef Tcl_PkgRequireEx #define Tcl_PkgRequireEx \ (tclStubsPtr->tcl_PkgRequireEx) /* 1 */ #endif #ifndef Tcl_Panic #define Tcl_Panic \ (tclStubsPtr->tcl_Panic) /* 2 */ #endif #ifndef Tcl_Alloc #define Tcl_Alloc \ (tclStubsPtr->tcl_Alloc) /* 3 */ #endif #ifndef Tcl_Free #define Tcl_Free \ (tclStubsPtr->tcl_Free) /* 4 */ #endif #ifndef Tcl_Realloc #define Tcl_Realloc \ (tclStubsPtr->tcl_Realloc) /* 5 */ #endif #ifndef Tcl_DbCkalloc #define Tcl_DbCkalloc \ (tclStubsPtr->tcl_DbCkalloc) /* 6 */ #endif #ifndef Tcl_DbCkfree #define Tcl_DbCkfree \ (tclStubsPtr->tcl_DbCkfree) /* 7 */ #endif #ifndef Tcl_DbCkrealloc #define Tcl_DbCkrealloc \ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */ #endif #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ #ifndef Tcl_CreateFileHandler #define Tcl_CreateFileHandler \ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ #endif #endif /* UNIX */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ #ifndef Tcl_DeleteFileHandler #define Tcl_DeleteFileHandler \ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */ #endif #endif /* UNIX */ #ifndef Tcl_SetTimer #define Tcl_SetTimer \ (tclStubsPtr->tcl_SetTimer) /* 11 */ #endif #ifndef Tcl_Sleep #define Tcl_Sleep \ (tclStubsPtr->tcl_Sleep) /* 12 */ #endif #ifndef Tcl_WaitForEvent #define Tcl_WaitForEvent \ (tclStubsPtr->tcl_WaitForEvent) /* 13 */ #endif #ifndef Tcl_AppendAllObjTypes #define Tcl_AppendAllObjTypes \ (tclStubsPtr->tcl_AppendAllObjTypes) /* 14 */ #endif #ifndef Tcl_AppendStringsToObj #define Tcl_AppendStringsToObj \ (tclStubsPtr->tcl_AppendStringsToObj) /* 15 */ #endif #ifndef Tcl_AppendToObj #define Tcl_AppendToObj \ (tclStubsPtr->tcl_AppendToObj) /* 16 */ #endif #ifndef Tcl_ConcatObj #define Tcl_ConcatObj \ (tclStubsPtr->tcl_ConcatObj) /* 17 */ #endif #ifndef Tcl_ConvertToType #define Tcl_ConvertToType \ (tclStubsPtr->tcl_ConvertToType) /* 18 */ #endif #ifndef Tcl_DbDecrRefCount #define Tcl_DbDecrRefCount \ (tclStubsPtr->tcl_DbDecrRefCount) /* 19 */ #endif #ifndef Tcl_DbIncrRefCount #define Tcl_DbIncrRefCount \ (tclStubsPtr->tcl_DbIncrRefCount) /* 20 */ #endif #ifndef Tcl_DbIsShared #define Tcl_DbIsShared \ (tclStubsPtr->tcl_DbIsShared) /* 21 */ #endif #ifndef Tcl_DbNewBooleanObj #define Tcl_DbNewBooleanObj \ (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */ #endif #ifndef Tcl_DbNewByteArrayObj #define Tcl_DbNewByteArrayObj \ (tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */ #endif #ifndef Tcl_DbNewDoubleObj #define Tcl_DbNewDoubleObj \ (tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */ #endif #ifndef Tcl_DbNewListObj #define Tcl_DbNewListObj \ (tclStubsPtr->tcl_DbNewListObj) /* 25 */ #endif #ifndef Tcl_DbNewLongObj #define Tcl_DbNewLongObj \ (tclStubsPtr->tcl_DbNewLongObj) /* 26 */ #endif #ifndef Tcl_DbNewObj #define Tcl_DbNewObj \ (tclStubsPtr->tcl_DbNewObj) /* 27 */ #endif #ifndef Tcl_DbNewStringObj #define Tcl_DbNewStringObj \ (tclStubsPtr->tcl_DbNewStringObj) /* 28 */ #endif #ifndef Tcl_DuplicateObj #define Tcl_DuplicateObj \ (tclStubsPtr->tcl_DuplicateObj) /* 29 */ #endif #ifndef TclFreeObj #define TclFreeObj \ (tclStubsPtr->tclFreeObj) /* 30 */ #endif #ifndef Tcl_GetBoolean #define Tcl_GetBoolean \ (tclStubsPtr->tcl_GetBoolean) /* 31 */ #endif #ifndef Tcl_GetBooleanFromObj #define Tcl_GetBooleanFromObj \ (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */ #endif #ifndef Tcl_GetByteArrayFromObj #define Tcl_GetByteArrayFromObj \ (tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */ #endif #ifndef Tcl_GetDouble #define Tcl_GetDouble \ (tclStubsPtr->tcl_GetDouble) /* 34 */ #endif #ifndef Tcl_GetDoubleFromObj #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ #endif #ifndef Tcl_GetIndexFromObj #define Tcl_GetIndexFromObj \ (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */ #endif #ifndef Tcl_GetInt #define Tcl_GetInt \ (tclStubsPtr->tcl_GetInt) /* 37 */ #endif #ifndef Tcl_GetIntFromObj #define Tcl_GetIntFromObj \ (tclStubsPtr->tcl_GetIntFromObj) /* 38 */ #endif #ifndef Tcl_GetLongFromObj #define Tcl_GetLongFromObj \ (tclStubsPtr->tcl_GetLongFromObj) /* 39 */ #endif #ifndef Tcl_GetObjType #define Tcl_GetObjType \ (tclStubsPtr->tcl_GetObjType) /* 40 */ #endif #ifndef Tcl_GetStringFromObj #define Tcl_GetStringFromObj \ (tclStubsPtr->tcl_GetStringFromObj) /* 41 */ #endif #ifndef Tcl_InvalidateStringRep #define Tcl_InvalidateStringRep \ (tclStubsPtr->tcl_InvalidateStringRep) /* 42 */ #endif #ifndef Tcl_ListObjAppendList #define Tcl_ListObjAppendList \ (tclStubsPtr->tcl_ListObjAppendList) /* 43 */ #endif #ifndef Tcl_ListObjAppendElement #define Tcl_ListObjAppendElement \ (tclStubsPtr->tcl_ListObjAppendElement) /* 44 */ #endif #ifndef Tcl_ListObjGetElements #define Tcl_ListObjGetElements \ (tclStubsPtr->tcl_ListObjGetElements) /* 45 */ #endif #ifndef Tcl_ListObjIndex #define Tcl_ListObjIndex \ (tclStubsPtr->tcl_ListObjIndex) /* 46 */ #endif #ifndef Tcl_ListObjLength #define Tcl_ListObjLength \ (tclStubsPtr->tcl_ListObjLength) /* 47 */ #endif #ifndef Tcl_ListObjReplace #define Tcl_ListObjReplace \ (tclStubsPtr->tcl_ListObjReplace) /* 48 */ #endif #ifndef Tcl_NewBooleanObj #define Tcl_NewBooleanObj \ (tclStubsPtr->tcl_NewBooleanObj) /* 49 */ #endif #ifndef Tcl_NewByteArrayObj #define Tcl_NewByteArrayObj \ (tclStubsPtr->tcl_NewByteArrayObj) /* 50 */ #endif #ifndef Tcl_NewDoubleObj #define Tcl_NewDoubleObj \ (tclStubsPtr->tcl_NewDoubleObj) /* 51 */ #endif #ifndef Tcl_NewIntObj #define Tcl_NewIntObj \ (tclStubsPtr->tcl_NewIntObj) /* 52 */ #endif #ifndef Tcl_NewListObj #define Tcl_NewListObj \ (tclStubsPtr->tcl_NewListObj) /* 53 */ #endif #ifndef Tcl_NewLongObj #define Tcl_NewLongObj \ (tclStubsPtr->tcl_NewLongObj) /* 54 */ #endif #ifndef Tcl_NewObj #define Tcl_NewObj \ (tclStubsPtr->tcl_NewObj) /* 55 */ #endif #ifndef Tcl_NewStringObj #define Tcl_NewStringObj \ (tclStubsPtr->tcl_NewStringObj) /* 56 */ #endif #ifndef Tcl_SetBooleanObj #define Tcl_SetBooleanObj \ (tclStubsPtr->tcl_SetBooleanObj) /* 57 */ #endif #ifndef Tcl_SetByteArrayLength #define Tcl_SetByteArrayLength \ (tclStubsPtr->tcl_SetByteArrayLength) /* 58 */ #endif #ifndef Tcl_SetByteArrayObj #define Tcl_SetByteArrayObj \ (tclStubsPtr->tcl_SetByteArrayObj) /* 59 */ #endif #ifndef Tcl_SetDoubleObj #define Tcl_SetDoubleObj \ (tclStubsPtr->tcl_SetDoubleObj) /* 60 */ #endif #ifndef Tcl_SetIntObj #define Tcl_SetIntObj \ (tclStubsPtr->tcl_SetIntObj) /* 61 */ #endif #ifndef Tcl_SetListObj #define Tcl_SetListObj \ (tclStubsPtr->tcl_SetListObj) /* 62 */ #endif #ifndef Tcl_SetLongObj #define Tcl_SetLongObj \ (tclStubsPtr->tcl_SetLongObj) /* 63 */ #endif #ifndef Tcl_SetObjLength #define Tcl_SetObjLength \ (tclStubsPtr->tcl_SetObjLength) /* 64 */ #endif #ifndef Tcl_SetStringObj #define Tcl_SetStringObj \ (tclStubsPtr->tcl_SetStringObj) /* 65 */ #endif #ifndef Tcl_AddErrorInfo #define Tcl_AddErrorInfo \ (tclStubsPtr->tcl_AddErrorInfo) /* 66 */ #endif #ifndef Tcl_AddObjErrorInfo #define Tcl_AddObjErrorInfo \ (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */ #endif #ifndef Tcl_AllowExceptions #define Tcl_AllowExceptions \ (tclStubsPtr->tcl_AllowExceptions) /* 68 */ #endif #ifndef Tcl_AppendElement #define Tcl_AppendElement \ (tclStubsPtr->tcl_AppendElement) /* 69 */ #endif #ifndef Tcl_AppendResult #define Tcl_AppendResult \ (tclStubsPtr->tcl_AppendResult) /* 70 */ #endif #ifndef Tcl_AsyncCreate #define Tcl_AsyncCreate \ (tclStubsPtr->tcl_AsyncCreate) /* 71 */ #endif #ifndef Tcl_AsyncDelete #define Tcl_AsyncDelete \ (tclStubsPtr->tcl_AsyncDelete) /* 72 */ #endif #ifndef Tcl_AsyncInvoke #define Tcl_AsyncInvoke \ (tclStubsPtr->tcl_AsyncInvoke) /* 73 */ #endif #ifndef Tcl_AsyncMark #define Tcl_AsyncMark \ (tclStubsPtr->tcl_AsyncMark) /* 74 */ #endif #ifndef Tcl_AsyncReady #define Tcl_AsyncReady \ (tclStubsPtr->tcl_AsyncReady) /* 75 */ #endif #ifndef Tcl_BackgroundError #define Tcl_BackgroundError \ (tclStubsPtr->tcl_BackgroundError) /* 76 */ #endif #ifndef Tcl_Backslash #define Tcl_Backslash \ (tclStubsPtr->tcl_Backslash) /* 77 */ #endif #ifndef Tcl_BadChannelOption #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #endif #ifndef Tcl_CallWhenDeleted #define Tcl_CallWhenDeleted \ (tclStubsPtr->tcl_CallWhenDeleted) /* 79 */ #endif #ifndef Tcl_CancelIdleCall #define Tcl_CancelIdleCall \ (tclStubsPtr->tcl_CancelIdleCall) /* 80 */ #endif #ifndef Tcl_Close #define Tcl_Close \ (tclStubsPtr->tcl_Close) /* 81 */ #endif #ifndef Tcl_CommandComplete #define Tcl_CommandComplete \ (tclStubsPtr->tcl_CommandComplete) /* 82 */ #endif #ifndef Tcl_Concat #define Tcl_Concat \ (tclStubsPtr->tcl_Concat) /* 83 */ #endif #ifndef Tcl_ConvertElement #define Tcl_ConvertElement \ (tclStubsPtr->tcl_ConvertElement) /* 84 */ #endif #ifndef Tcl_ConvertCountedElement #define Tcl_ConvertCountedElement \ (tclStubsPtr->tcl_ConvertCountedElement) /* 85 */ #endif #ifndef Tcl_CreateAlias #define Tcl_CreateAlias \ (tclStubsPtr->tcl_CreateAlias) /* 86 */ #endif #ifndef Tcl_CreateAliasObj #define Tcl_CreateAliasObj \ (tclStubsPtr->tcl_CreateAliasObj) /* 87 */ #endif #ifndef Tcl_CreateChannel #define Tcl_CreateChannel \ (tclStubsPtr->tcl_CreateChannel) /* 88 */ #endif #ifndef Tcl_CreateChannelHandler #define Tcl_CreateChannelHandler \ (tclStubsPtr->tcl_CreateChannelHandler) /* 89 */ #endif #ifndef Tcl_CreateCloseHandler #define Tcl_CreateCloseHandler \ (tclStubsPtr->tcl_CreateCloseHandler) /* 90 */ #endif #ifndef Tcl_CreateCommand #define Tcl_CreateCommand \ (tclStubsPtr->tcl_CreateCommand) /* 91 */ #endif #ifndef Tcl_CreateEventSource #define Tcl_CreateEventSource \ (tclStubsPtr->tcl_CreateEventSource) /* 92 */ #endif #ifndef Tcl_CreateExitHandler #define Tcl_CreateExitHandler \ (tclStubsPtr->tcl_CreateExitHandler) /* 93 */ #endif #ifndef Tcl_CreateInterp #define Tcl_CreateInterp \ (tclStubsPtr->tcl_CreateInterp) /* 94 */ #endif #ifndef Tcl_CreateMathFunc #define Tcl_CreateMathFunc \ (tclStubsPtr->tcl_CreateMathFunc) /* 95 */ #endif #ifndef Tcl_CreateObjCommand #define Tcl_CreateObjCommand \ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */ #endif #ifndef Tcl_CreateSlave #define Tcl_CreateSlave \ (tclStubsPtr->tcl_CreateSlave) /* 97 */ #endif #ifndef Tcl_CreateTimerHandler #define Tcl_CreateTimerHandler \ (tclStubsPtr->tcl_CreateTimerHandler) /* 98 */ #endif #ifndef Tcl_CreateTrace #define Tcl_CreateTrace \ (tclStubsPtr->tcl_CreateTrace) /* 99 */ #endif #ifndef Tcl_DeleteAssocData #define Tcl_DeleteAssocData \ (tclStubsPtr->tcl_DeleteAssocData) /* 100 */ #endif #ifndef Tcl_DeleteChannelHandler #define Tcl_DeleteChannelHandler \ (tclStubsPtr->tcl_DeleteChannelHandler) /* 101 */ #endif #ifndef Tcl_DeleteCloseHandler #define Tcl_DeleteCloseHandler \ (tclStubsPtr->tcl_DeleteCloseHandler) /* 102 */ #endif #ifndef Tcl_DeleteCommand #define Tcl_DeleteCommand \ (tclStubsPtr->tcl_DeleteCommand) /* 103 */ #endif #ifndef Tcl_DeleteCommandFromToken #define Tcl_DeleteCommandFromToken \ (tclStubsPtr->tcl_DeleteCommandFromToken) /* 104 */ #endif #ifndef Tcl_DeleteEvents #define Tcl_DeleteEvents \ (tclStubsPtr->tcl_DeleteEvents) /* 105 */ #endif #ifndef Tcl_DeleteEventSource #define Tcl_DeleteEventSource \ (tclStubsPtr->tcl_DeleteEventSource) /* 106 */ #endif #ifndef Tcl_DeleteExitHandler #define Tcl_DeleteExitHandler \ (tclStubsPtr->tcl_DeleteExitHandler) /* 107 */ #endif #ifndef Tcl_DeleteHashEntry #define Tcl_DeleteHashEntry \ (tclStubsPtr->tcl_DeleteHashEntry) /* 108 */ #endif #ifndef Tcl_DeleteHashTable #define Tcl_DeleteHashTable \ (tclStubsPtr->tcl_DeleteHashTable) /* 109 */ #endif #ifndef Tcl_DeleteInterp #define Tcl_DeleteInterp \ (tclStubsPtr->tcl_DeleteInterp) /* 110 */ #endif #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ #ifndef Tcl_DetachPids #define Tcl_DetachPids \ (tclStubsPtr->tcl_DetachPids) /* 111 */ #endif #endif /* UNIX */ #ifdef __WIN32__ #ifndef Tcl_DetachPids #define Tcl_DetachPids \ (tclStubsPtr->tcl_DetachPids) /* 111 */ #endif #endif /* __WIN32__ */ #ifndef Tcl_DeleteTimerHandler #define Tcl_DeleteTimerHandler \ (tclStubsPtr->tcl_DeleteTimerHandler) /* 112 */ #endif #ifndef Tcl_DeleteTrace #define Tcl_DeleteTrace \ (tclStubsPtr->tcl_DeleteTrace) /* 113 */ #endif #ifndef Tcl_DontCallWhenDeleted #define Tcl_DontCallWhenDeleted \ (tclStubsPtr->tcl_DontCallWhenDeleted) /* 114 */ #endif #ifndef Tcl_DoOneEvent #define Tcl_DoOneEvent \ (tclStubsPtr->tcl_DoOneEvent) /* 115 */ #endif #ifndef Tcl_DoWhenIdle #define Tcl_DoWhenIdle \ (tclStubsPtr->tcl_DoWhenIdle) /* 116 */ #endif #ifndef Tcl_DStringAppend #define Tcl_DStringAppend \ (tclStubsPtr->tcl_DStringAppend) /* 117 */ #endif #ifndef Tcl_DStringAppendElement #define Tcl_DStringAppendElement \ (tclStubsPtr->tcl_DStringAppendElement) /* 118 */ #endif #ifndef Tcl_DStringEndSublist #define Tcl_DStringEndSublist \ (tclStubsPtr->tcl_DStringEndSublist) /* 119 */ #endif #ifndef Tcl_DStringFree #define Tcl_DStringFree \ (tclStubsPtr->tcl_DStringFree) /* 120 */ #endif #ifndef Tcl_DStringGetResult #define Tcl_DStringGetResult \ (tclStubsPtr->tcl_DStringGetResult) /* 121 */ #endif #ifndef Tcl_DStringInit #define Tcl_DStringInit \ (tclStubsPtr->tcl_DStringInit) /* 122 */ #endif #ifndef Tcl_DStringResult #define Tcl_DStringResult \ (tclStubsPtr->tcl_DStringResult) /* 123 */ #endif #ifndef Tcl_DStringSetLength #define Tcl_DStringSetLength \ (tclStubsPtr->tcl_DStringSetLength) /* 124 */ #endif #ifndef Tcl_DStringStartSublist #define Tcl_DStringStartSublist \ (tclStubsPtr->tcl_DStringStartSublist) /* 125 */ #endif #ifndef Tcl_Eof #define Tcl_Eof \ (tclStubsPtr->tcl_Eof) /* 126 */ #endif #ifndef Tcl_ErrnoId #define Tcl_ErrnoId \ (tclStubsPtr->tcl_ErrnoId) /* 127 */ #endif #ifndef Tcl_ErrnoMsg #define Tcl_ErrnoMsg \ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ #endif #ifndef Tcl_Eval #define Tcl_Eval \ (tclStubsPtr->tcl_Eval) /* 129 */ #endif #ifndef Tcl_EvalFile #define Tcl_EvalFile \ (tclStubsPtr->tcl_EvalFile) /* 130 */ #endif #ifndef Tcl_EvalObj #define Tcl_EvalObj \ (tclStubsPtr->tcl_EvalObj) /* 131 */ #endif #ifndef Tcl_EventuallyFree #define Tcl_EventuallyFree \ (tclStubsPtr->tcl_EventuallyFree) /* 132 */ #endif #ifndef Tcl_Exit #define Tcl_Exit \ (tclStubsPtr->tcl_Exit) /* 133 */ #endif #ifndef Tcl_ExposeCommand #define Tcl_ExposeCommand \ (tclStubsPtr->tcl_ExposeCommand) /* 134 */ #endif #ifndef Tcl_ExprBoolean #define Tcl_ExprBoolean \ (tclStubsPtr->tcl_ExprBoolean) /* 135 */ #endif #ifndef Tcl_ExprBooleanObj #define Tcl_ExprBooleanObj \ (tclStubsPtr->tcl_ExprBooleanObj) /* 136 */ #endif #ifndef Tcl_ExprDouble #define Tcl_ExprDouble \ (tclStubsPtr->tcl_ExprDouble) /* 137 */ #endif #ifndef Tcl_ExprDoubleObj #define Tcl_ExprDoubleObj \ (tclStubsPtr->tcl_ExprDoubleObj) /* 138 */ #endif #ifndef Tcl_ExprLong #define Tcl_ExprLong \ (tclStubsPtr->tcl_ExprLong) /* 139 */ #endif #ifndef Tcl_ExprLongObj #define Tcl_ExprLongObj \ (tclStubsPtr->tcl_ExprLongObj) /* 140 */ #endif #ifndef Tcl_ExprObj #define Tcl_ExprObj \ (tclStubsPtr->tcl_ExprObj) /* 141 */ #endif #ifndef Tcl_ExprString #define Tcl_ExprString \ (tclStubsPtr->tcl_ExprString) /* 142 */ #endif #ifndef Tcl_Finalize #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ #endif #ifndef Tcl_FindExecutable #define Tcl_FindExecutable \ (tclStubsPtr->tcl_FindExecutable) /* 144 */ #endif #ifndef Tcl_FirstHashEntry #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #endif #ifndef Tcl_Flush #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ #endif #ifndef Tcl_FreeResult #define Tcl_FreeResult \ (tclStubsPtr->tcl_FreeResult) /* 147 */ #endif #ifndef Tcl_GetAlias #define Tcl_GetAlias \ (tclStubsPtr->tcl_GetAlias) /* 148 */ #endif #ifndef Tcl_GetAliasObj #define Tcl_GetAliasObj \ (tclStubsPtr->tcl_GetAliasObj) /* 149 */ #endif #ifndef Tcl_GetAssocData #define Tcl_GetAssocData \ (tclStubsPtr->tcl_GetAssocData) /* 150 */ #endif #ifndef Tcl_GetChannel #define Tcl_GetChannel \ (tclStubsPtr->tcl_GetChannel) /* 151 */ #endif #ifndef Tcl_GetChannelBufferSize #define Tcl_GetChannelBufferSize \ (tclStubsPtr->tcl_GetChannelBufferSize) /* 152 */ #endif #ifndef Tcl_GetChannelHandle #define Tcl_GetChannelHandle \ (tclStubsPtr->tcl_GetChannelHandle) /* 153 */ #endif #ifndef Tcl_GetChannelInstanceData #define Tcl_GetChannelInstanceData \ (tclStubsPtr->tcl_GetChannelInstanceData) /* 154 */ #endif #ifndef Tcl_GetChannelMode #define Tcl_GetChannelMode \ (tclStubsPtr->tcl_GetChannelMode) /* 155 */ #endif #ifndef Tcl_GetChannelName #define Tcl_GetChannelName \ (tclStubsPtr->tcl_GetChannelName) /* 156 */ #endif #ifndef Tcl_GetChannelOption #define Tcl_GetChannelOption \ (tclStubsPtr->tcl_GetChannelOption) /* 157 */ #endif #ifndef Tcl_GetChannelType #define Tcl_GetChannelType \ (tclStubsPtr->tcl_GetChannelType) /* 158 */ #endif #ifndef Tcl_GetCommandInfo #define Tcl_GetCommandInfo \ (tclStubsPtr->tcl_GetCommandInfo) /* 159 */ #endif #ifndef Tcl_GetCommandName #define Tcl_GetCommandName \ (tclStubsPtr->tcl_GetCommandName) /* 160 */ #endif #ifndef Tcl_GetErrno #define Tcl_GetErrno \ (tclStubsPtr->tcl_GetErrno) /* 161 */ #endif #ifndef Tcl_GetHostName #define Tcl_GetHostName \ (tclStubsPtr->tcl_GetHostName) /* 162 */ #endif #ifndef Tcl_GetInterpPath #define Tcl_GetInterpPath \ (tclStubsPtr->tcl_GetInterpPath) /* 163 */ #endif #ifndef Tcl_GetMaster #define Tcl_GetMaster \ (tclStubsPtr->tcl_GetMaster) /* 164 */ #endif #ifndef Tcl_GetNameOfExecutable #define Tcl_GetNameOfExecutable \ (tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */ #endif #ifndef Tcl_GetObjResult #define Tcl_GetObjResult \ (tclStubsPtr->tcl_GetObjResult) /* 166 */ #endif #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ #ifndef Tcl_GetOpenFile #define Tcl_GetOpenFile \ (tclStubsPtr->tcl_GetOpenFile) /* 167 */ #endif #endif /* UNIX */ #ifndef Tcl_GetPathType #define Tcl_GetPathType \ (tclStubsPtr->tcl_GetPathType) /* 168 */ #endif #ifndef Tcl_Gets #define Tcl_Gets \ (tclStubsPtr->tcl_Gets) /* 169 */ #endif #ifndef Tcl_GetsObj #define Tcl_GetsObj \ (tclStubsPtr->tcl_GetsObj) /* 170 */ #endif #ifndef Tcl_GetServiceMode #define Tcl_GetServiceMode \ (tclStubsPtr->tcl_GetServiceMode) /* 171 */ #endif #ifndef Tcl_GetSlave #define Tcl_GetSlave \ (tclStubsPtr->tcl_GetSlave) /* 172 */ #endif #ifndef Tcl_GetStdChannel #define Tcl_GetStdChannel \ (tclStubsPtr->tcl_GetStdChannel) /* 173 */ #endif #ifndef Tcl_GetStringResult #define Tcl_GetStringResult \ (tclStubsPtr->tcl_GetStringResult) /* 174 */ #endif #ifndef Tcl_GetVar #define Tcl_GetVar \ (tclStubsPtr->tcl_GetVar) /* 175 */ #endif #ifndef Tcl_GetVar2 #define Tcl_GetVar2 \ (tclStubsPtr->tcl_GetVar2) /* 176 */ #endif #ifndef Tcl_GlobalEval #define Tcl_GlobalEval \ (tclStubsPtr->tcl_GlobalEval) /* 177 */ #endif #ifndef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj \ (tclStubsPtr->tcl_GlobalEvalObj) /* 178 */ #endif #ifndef Tcl_HideCommand #define Tcl_HideCommand \ (tclStubsPtr->tcl_HideCommand) /* 179 */ #endif #ifndef Tcl_Init #define Tcl_Init \ (tclStubsPtr->tcl_Init) /* 180 */ #endif #ifndef Tcl_InitHashTable #define Tcl_InitHashTable \ (tclStubsPtr->tcl_InitHashTable) /* 181 */ #endif #ifndef Tcl_InputBlocked #define Tcl_InputBlocked \ (tclStubsPtr->tcl_InputBlocked) /* 182 */ #endif #ifndef Tcl_InputBuffered #define Tcl_InputBuffered \ (tclStubsPtr->tcl_InputBuffered) /* 183 */ #endif #ifndef Tcl_InterpDeleted #define Tcl_InterpDeleted \ (tclStubsPtr->tcl_InterpDeleted) /* 184 */ #endif #ifndef Tcl_IsSafe #define Tcl_IsSafe \ (tclStubsPtr->tcl_IsSafe) /* 185 */ #endif #ifndef Tcl_JoinPath #define Tcl_JoinPath \ (tclStubsPtr->tcl_JoinPath) /* 186 */ #endif #ifndef Tcl_LinkVar #define Tcl_LinkVar \ (tclStubsPtr->tcl_LinkVar) /* 187 */ #endif /* Slot 188 is reserved */ #ifndef Tcl_MakeFileChannel #define Tcl_MakeFileChannel \ (tclStubsPtr->tcl_MakeFileChannel) /* 189 */ #endif #ifndef Tcl_MakeSafe #define Tcl_MakeSafe \ (tclStubsPtr->tcl_MakeSafe) /* 190 */ #endif #ifndef Tcl_MakeTcpClientChannel #define Tcl_MakeTcpClientChannel \ (tclStubsPtr->tcl_MakeTcpClientChannel) /* 191 */ #endif #ifndef Tcl_Merge #define Tcl_Merge \ (tclStubsPtr->tcl_Merge) /* 192 */ #endif #ifndef Tcl_NextHashEntry #define Tcl_NextHashEntry \ (tclStubsPtr->tcl_NextHashEntry) /* 193 */ #endif #ifndef Tcl_NotifyChannel #define Tcl_NotifyChannel \ (tclStubsPtr->tcl_NotifyChannel) /* 194 */ #endif #ifndef Tcl_ObjGetVar2 #define Tcl_ObjGetVar2 \ (tclStubsPtr->tcl_ObjGetVar2) /* 195 */ #endif #ifndef Tcl_ObjSetVar2 #define Tcl_ObjSetVar2 \ (tclStubsPtr->tcl_ObjSetVar2) /* 196 */ #endif #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ #ifndef Tcl_OpenCommandChannel #define Tcl_OpenCommandChannel \ (tclStubsPtr->tcl_OpenCommandChannel) /* 197 */ #endif #endif /* UNIX */ #ifdef __WIN32__ #ifndef Tcl_OpenCommandChannel #define Tcl_OpenCommandChannel \ (tclStubsPtr->tcl_OpenCommandChannel) /* 197 */ #endif #endif /* __WIN32__ */ #ifndef Tcl_OpenFileChannel #define Tcl_OpenFileChannel \ (tclStubsPtr->tcl_OpenFileChannel) /* 198 */ #endif #ifndef Tcl_OpenTcpClient #define Tcl_OpenTcpClient \ (tclStubsPtr->tcl_OpenTcpClient) /* 199 */ #endif #ifndef Tcl_OpenTcpServer #define Tcl_OpenTcpServer \ (tclStubsPtr->tcl_OpenTcpServer) /* 200 */ #endif #ifndef Tcl_Preserve #define Tcl_Preserve \ (tclStubsPtr->tcl_Preserve) /* 201 */ #endif #ifndef Tcl_PrintDouble #define Tcl_PrintDouble \ (tclStubsPtr->tcl_PrintDouble) /* 202 */ #endif #ifndef Tcl_PutEnv #define Tcl_PutEnv \ (tclStubsPtr->tcl_PutEnv) /* 203 */ #endif #ifndef Tcl_PosixError #define Tcl_PosixError \ (tclStubsPtr->tcl_PosixError) /* 204 */ #endif #ifndef Tcl_QueueEvent #define Tcl_QueueEvent \ (tclStubsPtr->tcl_QueueEvent) /* 205 */ #endif #ifndef Tcl_Read #define Tcl_Read \ (tclStubsPtr->tcl_Read) /* 206 */ #endif #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ #ifndef Tcl_ReapDetachedProcs #define Tcl_ReapDetachedProcs \ (tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */ #endif #endif /* UNIX */ #ifdef __WIN32__ #ifndef Tcl_ReapDetachedProcs #define Tcl_ReapDetachedProcs \ (tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */ #endif #endif /* __WIN32__ */ #ifndef Tcl_RecordAndEval #define Tcl_RecordAndEval \ (tclStubsPtr->tcl_RecordAndEval) /* 208 */ #endif #ifndef Tcl_RecordAndEvalObj #define Tcl_RecordAndEvalObj \ (tclStubsPtr->tcl_RecordAndEvalObj) /* 209 */ #endif #ifndef Tcl_RegisterChannel #define Tcl_RegisterChannel \ (tclStubsPtr->tcl_RegisterChannel) /* 210 */ #endif #ifndef Tcl_RegisterObjType #define Tcl_RegisterObjType \ (tclStubsPtr->tcl_RegisterObjType) /* 211 */ #endif #ifndef Tcl_RegExpCompile #define Tcl_RegExpCompile \ (tclStubsPtr->tcl_RegExpCompile) /* 212 */ #endif #ifndef Tcl_RegExpExec #define Tcl_RegExpExec \ (tclStubsPtr->tcl_RegExpExec) /* 213 */ #endif #ifndef Tcl_RegExpMatch #define Tcl_RegExpMatch \ (tclStubsPtr->tcl_RegExpMatch) /* 214 */ #endif #ifndef Tcl_RegExpRange #define Tcl_RegExpRange \ (tclStubsPtr->tcl_RegExpRange) /* 215 */ #endif #ifndef Tcl_Release #define Tcl_Release \ (tclStubsPtr->tcl_Release) /* 216 */ #endif #ifndef Tcl_ResetResult #define Tcl_ResetResult \ (tclStubsPtr->tcl_ResetResult) /* 217 */ #endif #ifndef Tcl_ScanElement #define Tcl_ScanElement \ (tclStubsPtr->tcl_ScanElement) /* 218 */ #endif #ifndef Tcl_ScanCountedElement #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ #endif #ifndef Tcl_Seek #define Tcl_Seek \ (tclStubsPtr->tcl_Seek) /* 220 */ #endif #ifndef Tcl_ServiceAll #define Tcl_ServiceAll \ (tclStubsPtr->tcl_ServiceAll) /* 221 */ #endif #ifndef Tcl_ServiceEvent #define Tcl_ServiceEvent \ (tclStubsPtr->tcl_ServiceEvent) /* 222 */ #endif #ifndef Tcl_SetAssocData #define Tcl_SetAssocData \ (tclStubsPtr->tcl_SetAssocData) /* 223 */ #endif #ifndef Tcl_SetChannelBufferSize #define Tcl_SetChannelBufferSize \ (tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */ #endif #ifndef Tcl_SetChannelOption #define Tcl_SetChannelOption \ (tclStubsPtr->tcl_SetChannelOption) /* 225 */ #endif #ifndef Tcl_SetCommandInfo #define Tcl_SetCommandInfo \ (tclStubsPtr->tcl_SetCommandInfo) /* 226 */ #endif #ifndef Tcl_SetErrno #define Tcl_SetErrno \ (tclStubsPtr->tcl_SetErrno) /* 227 */ #endif #ifndef Tcl_SetErrorCode #define Tcl_SetErrorCode \ (tclStubsPtr->tcl_SetErrorCode) /* 228 */ #endif #ifndef Tcl_SetMaxBlockTime #define Tcl_SetMaxBlockTime \ (tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */ #endif #ifndef Tcl_SetPanicProc #define Tcl_SetPanicProc \ (tclStubsPtr->tcl_SetPanicProc) /* 230 */ #endif #ifndef Tcl_SetRecursionLimit #define Tcl_SetRecursionLimit \ (tclStubsPtr->tcl_SetRecursionLimit) /* 231 */ #endif #ifndef Tcl_SetResult #define Tcl_SetResult \ (tclStubsPtr->tcl_SetResult) /* 232 */ #endif #ifndef Tcl_SetServiceMode #define Tcl_SetServiceMode \ (tclStubsPtr->tcl_SetServiceMode) /* 233 */ #endif #ifndef Tcl_SetObjErrorCode #define Tcl_SetObjErrorCode \ (tclStubsPtr->tcl_SetObjErrorCode) /* 234 */ #endif #ifndef Tcl_SetObjResult #define Tcl_SetObjResult \ (tclStubsPtr->tcl_SetObjResult) /* 235 */ #endif #ifndef Tcl_SetStdChannel #define Tcl_SetStdChannel \ (tclStubsPtr->tcl_SetStdChannel) /* 236 */ #endif #ifndef Tcl_SetVar #define Tcl_SetVar \ (tclStubsPtr->tcl_SetVar) /* 237 */ #endif #ifndef Tcl_SetVar2 #define Tcl_SetVar2 \ (tclStubsPtr->tcl_SetVar2) /* 238 */ #endif #ifndef Tcl_SignalId #define Tcl_SignalId \ (tclStubsPtr->tcl_SignalId) /* 239 */ #endif #ifndef Tcl_SignalMsg #define Tcl_SignalMsg \ (tclStubsPtr->tcl_SignalMsg) /* 240 */ #endif #ifndef Tcl_SourceRCFile #define Tcl_SourceRCFile \ (tclStubsPtr->tcl_SourceRCFile) /* 241 */ #endif #ifndef Tcl_SplitList #define Tcl_SplitList \ (tclStubsPtr->tcl_SplitList) /* 242 */ #endif #ifndef Tcl_SplitPath #define Tcl_SplitPath \ (tclStubsPtr->tcl_SplitPath) /* 243 */ #endif #ifndef Tcl_StaticPackage #define Tcl_StaticPackage \ (tclStubsPtr->tcl_StaticPackage) /* 244 */ #endif #ifndef Tcl_StringMatch #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ #endif #ifndef Tcl_Tell #define Tcl_Tell \ (tclStubsPtr->tcl_Tell) /* 246 */ #endif #ifndef Tcl_TraceVar #define Tcl_TraceVar \ (tclStubsPtr->tcl_TraceVar) /* 247 */ #endif #ifndef Tcl_TraceVar2 #define Tcl_TraceVar2 \ (tclStubsPtr->tcl_TraceVar2) /* 248 */ #endif #ifndef Tcl_TranslateFileName #define Tcl_TranslateFileName \ (tclStubsPtr->tcl_TranslateFileName) /* 249 */ #endif #ifndef Tcl_Ungets #define Tcl_Ungets \ (tclStubsPtr->tcl_Ungets) /* 250 */ #endif #ifndef Tcl_UnlinkVar #define Tcl_UnlinkVar \ (tclStubsPtr->tcl_UnlinkVar) /* 251 */ #endif #ifndef Tcl_UnregisterChannel #define Tcl_UnregisterChannel \ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */ #endif #ifndef Tcl_UnsetVar #define Tcl_UnsetVar \ (tclStubsPtr->tcl_UnsetVar) /* 253 */ #endif #ifndef Tcl_UnsetVar2 #define Tcl_UnsetVar2 \ (tclStubsPtr->tcl_UnsetVar2) /* 254 */ #endif #ifndef Tcl_UntraceVar #define Tcl_UntraceVar \ (tclStubsPtr->tcl_UntraceVar) /* 255 */ #endif #ifndef Tcl_UntraceVar2 #define Tcl_UntraceVar2 \ (tclStubsPtr->tcl_UntraceVar2) /* 256 */ #endif #ifndef Tcl_UpdateLinkedVar #define Tcl_UpdateLinkedVar \ (tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */ #endif #ifndef Tcl_UpVar #define Tcl_UpVar \ (tclStubsPtr->tcl_UpVar) /* 258 */ #endif #ifndef Tcl_UpVar2 #define Tcl_UpVar2 \ (tclStubsPtr->tcl_UpVar2) /* 259 */ #endif #ifndef Tcl_VarEval #define Tcl_VarEval \ (tclStubsPtr->tcl_VarEval) /* 260 */ #endif #ifndef Tcl_VarTraceInfo #define Tcl_VarTraceInfo \ (tclStubsPtr->tcl_VarTraceInfo) /* 261 */ #endif #ifndef Tcl_VarTraceInfo2 #define Tcl_VarTraceInfo2 \ (tclStubsPtr->tcl_VarTraceInfo2) /* 262 */ #endif #ifndef Tcl_Write #define Tcl_Write \ (tclStubsPtr->tcl_Write) /* 263 */ #endif #ifndef Tcl_WrongNumArgs #define Tcl_WrongNumArgs \ (tclStubsPtr->tcl_WrongNumArgs) /* 264 */ #endif #ifndef Tcl_DumpActiveMemory #define Tcl_DumpActiveMemory \ (tclStubsPtr->tcl_DumpActiveMemory) /* 265 */ #endif #ifndef Tcl_ValidateAllMemory #define Tcl_ValidateAllMemory \ (tclStubsPtr->tcl_ValidateAllMemory) /* 266 */ #endif #ifndef Tcl_AppendResultVA #define Tcl_AppendResultVA \ (tclStubsPtr->tcl_AppendResultVA) /* 267 */ #endif #ifndef Tcl_AppendStringsToObjVA #define Tcl_AppendStringsToObjVA \ (tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */ #endif #ifndef Tcl_HashStats #define Tcl_HashStats \ (tclStubsPtr->tcl_HashStats) /* 269 */ #endif #ifndef Tcl_ParseVar #define Tcl_ParseVar \ (tclStubsPtr->tcl_ParseVar) /* 270 */ #endif #ifndef Tcl_PkgPresent #define Tcl_PkgPresent \ (tclStubsPtr->tcl_PkgPresent) /* 271 */ #endif #ifndef Tcl_PkgPresentEx #define Tcl_PkgPresentEx \ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */ #endif #ifndef Tcl_PkgProvide #define Tcl_PkgProvide \ (tclStubsPtr->tcl_PkgProvide) /* 273 */ #endif #ifndef Tcl_PkgRequire #define Tcl_PkgRequire \ (tclStubsPtr->tcl_PkgRequire) /* 274 */ #endif #ifndef Tcl_SetErrorCodeVA #define Tcl_SetErrorCodeVA \ (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ #endif #ifndef Tcl_VarEvalVA #define Tcl_VarEvalVA \ (tclStubsPtr->tcl_VarEvalVA) /* 276 */ #endif #ifndef Tcl_WaitPid #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ #endif #ifndef Tcl_PanicVA #define Tcl_PanicVA \ (tclStubsPtr->tcl_PanicVA) /* 278 */ #endif #ifndef Tcl_GetVersion #define Tcl_GetVersion \ (tclStubsPtr->tcl_GetVersion) /* 279 */ #endif #ifndef Tcl_InitMemory #define Tcl_InitMemory \ (tclStubsPtr->tcl_InitMemory) /* 280 */ #endif #ifndef Tcl_StackChannel #define Tcl_StackChannel \ (tclStubsPtr->tcl_StackChannel) /* 281 */ #endif #ifndef Tcl_UnstackChannel #define Tcl_UnstackChannel \ (tclStubsPtr->tcl_UnstackChannel) /* 282 */ #endif #ifndef Tcl_GetStackedChannel #define Tcl_GetStackedChannel \ (tclStubsPtr->tcl_GetStackedChannel) /* 283 */ #endif #ifndef Tcl_SetMainLoop #define Tcl_SetMainLoop \ (tclStubsPtr->tcl_SetMainLoop) /* 284 */ #endif /* Slot 285 is reserved */ #ifndef Tcl_AppendObjToObj #define Tcl_AppendObjToObj \ (tclStubsPtr->tcl_AppendObjToObj) /* 286 */ #endif #ifndef Tcl_CreateEncoding #define Tcl_CreateEncoding \ (tclStubsPtr->tcl_CreateEncoding) /* 287 */ #endif #ifndef Tcl_CreateThreadExitHandler #define Tcl_CreateThreadExitHandler \ (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #endif #ifndef Tcl_DeleteThreadExitHandler #define Tcl_DeleteThreadExitHandler \ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */ #endif #ifndef Tcl_DiscardResult #define Tcl_DiscardResult \ (tclStubsPtr->tcl_DiscardResult) /* 290 */ #endif #ifndef Tcl_EvalEx #define Tcl_EvalEx \ (tclStubsPtr->tcl_EvalEx) /* 291 */ #endif #ifndef Tcl_EvalObjv #define Tcl_EvalObjv \ (tclStubsPtr->tcl_EvalObjv) /* 292 */ #endif #ifndef Tcl_EvalObjEx #define Tcl_EvalObjEx \ (tclStubsPtr->tcl_EvalObjEx) /* 293 */ #endif #ifndef Tcl_ExitThread #define Tcl_ExitThread \ (tclStubsPtr->tcl_ExitThread) /* 294 */ #endif #ifndef Tcl_ExternalToUtf #define Tcl_ExternalToUtf \ (tclStubsPtr->tcl_ExternalToUtf) /* 295 */ #endif #ifndef Tcl_ExternalToUtfDString #define Tcl_ExternalToUtfDString \ (tclStubsPtr->tcl_ExternalToUtfDString) /* 296 */ #endif #ifndef Tcl_FinalizeThread #define Tcl_FinalizeThread \ (tclStubsPtr->tcl_FinalizeThread) /* 297 */ #endif #ifndef Tcl_FinalizeNotifier #define Tcl_FinalizeNotifier \ (tclStubsPtr->tcl_FinalizeNotifier) /* 298 */ #endif #ifndef Tcl_FreeEncoding #define Tcl_FreeEncoding \ (tclStubsPtr->tcl_FreeEncoding) /* 299 */ #endif #ifndef Tcl_GetCurrentThread #define Tcl_GetCurrentThread \ (tclStubsPtr->tcl_GetCurrentThread) /* 300 */ #endif #ifndef Tcl_GetEncoding #define Tcl_GetEncoding \ (tclStubsPtr->tcl_GetEncoding) /* 301 */ #endif #ifndef Tcl_GetEncodingName #define Tcl_GetEncodingName \ (tclStubsPtr->tcl_GetEncodingName) /* 302 */ #endif #ifndef Tcl_GetEncodingNames #define Tcl_GetEncodingNames \ (tclStubsPtr->tcl_GetEncodingNames) /* 303 */ #endif #ifndef Tcl_GetIndexFromObjStruct #define Tcl_GetIndexFromObjStruct \ (tclStubsPtr->tcl_GetIndexFromObjStruct) /* 304 */ #endif #ifndef Tcl_GetThreadData #define Tcl_GetThreadData \ (tclStubsPtr->tcl_GetThreadData) /* 305 */ #endif #ifndef Tcl_GetVar2Ex #define Tcl_GetVar2Ex \ (tclStubsPtr->tcl_GetVar2Ex) /* 306 */ #endif #ifndef Tcl_InitNotifier #define Tcl_InitNotifier \ (tclStubsPtr->tcl_InitNotifier) /* 307 */ #endif #ifndef Tcl_MutexLock #define Tcl_MutexLock \ (tclStubsPtr->tcl_MutexLock) /* 308 */ #endif #ifndef Tcl_MutexUnlock #define Tcl_MutexUnlock \ (tclStubsPtr->tcl_MutexUnlock) /* 309 */ #endif #ifndef Tcl_ConditionNotify #define Tcl_ConditionNotify \ (tclStubsPtr->tcl_ConditionNotify) /* 310 */ #endif #ifndef Tcl_ConditionWait #define Tcl_ConditionWait \ (tclStubsPtr->tcl_ConditionWait) /* 311 */ #endif #ifndef Tcl_NumUtfChars #define Tcl_NumUtfChars \ (tclStubsPtr->tcl_NumUtfChars) /* 312 */ #endif #ifndef Tcl_ReadChars #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ #endif #ifndef Tcl_RestoreResult #define Tcl_RestoreResult \ (tclStubsPtr->tcl_RestoreResult) /* 314 */ #endif #ifndef Tcl_SaveResult #define Tcl_SaveResult \ (tclStubsPtr->tcl_SaveResult) /* 315 */ #endif #ifndef Tcl_SetSystemEncoding #define Tcl_SetSystemEncoding \ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */ #endif #ifndef Tcl_SetVar2Ex #define Tcl_SetVar2Ex \ (tclStubsPtr->tcl_SetVar2Ex) /* 317 */ #endif #ifndef Tcl_ThreadAlert #define Tcl_ThreadAlert \ (tclStubsPtr->tcl_ThreadAlert) /* 318 */ #endif #ifndef Tcl_ThreadQueueEvent #define Tcl_ThreadQueueEvent \ (tclStubsPtr->tcl_ThreadQueueEvent) /* 319 */ #endif #ifndef Tcl_UniCharAtIndex #define Tcl_UniCharAtIndex \ (tclStubsPtr->tcl_UniCharAtIndex) /* 320 */ #endif #ifndef Tcl_UniCharToLower #define Tcl_UniCharToLower \ (tclStubsPtr->tcl_UniCharToLower) /* 321 */ #endif #ifndef Tcl_UniCharToTitle #define Tcl_UniCharToTitle \ (tclStubsPtr->tcl_UniCharToTitle) /* 322 */ #endif #ifndef Tcl_UniCharToUpper #define Tcl_UniCharToUpper \ (tclStubsPtr->tcl_UniCharToUpper) /* 323 */ #endif #ifndef Tcl_UniCharToUtf #define Tcl_UniCharToUtf \ (tclStubsPtr->tcl_UniCharToUtf) /* 324 */ #endif #ifndef Tcl_UtfAtIndex #define Tcl_UtfAtIndex \ (tclStubsPtr->tcl_UtfAtIndex) /* 325 */ #endif #ifndef Tcl_UtfCharComplete #define Tcl_UtfCharComplete \ (tclStubsPtr->tcl_UtfCharComplete) /* 326 */ #endif #ifndef Tcl_UtfBackslash #define Tcl_UtfBackslash \ (tclStubsPtr->tcl_UtfBackslash) /* 327 */ #endif #ifndef Tcl_UtfFindFirst #define Tcl_UtfFindFirst \ (tclStubsPtr->tcl_UtfFindFirst) /* 328 */ #endif #ifndef Tcl_UtfFindLast #define Tcl_UtfFindLast \ (tclStubsPtr->tcl_UtfFindLast) /* 329 */ #endif #ifndef Tcl_UtfNext #define Tcl_UtfNext \ (tclStubsPtr->tcl_UtfNext) /* 330 */ #endif #ifndef Tcl_UtfPrev #define Tcl_UtfPrev \ (tclStubsPtr->tcl_UtfPrev) /* 331 */ #endif #ifndef Tcl_UtfToExternal #define Tcl_UtfToExternal \ (tclStubsPtr->tcl_UtfToExternal) /* 332 */ #endif #ifndef Tcl_UtfToExternalDString #define Tcl_UtfToExternalDString \ (tclStubsPtr->tcl_UtfToExternalDString) /* 333 */ #endif #ifndef Tcl_UtfToLower #define Tcl_UtfToLower \ (tclStubsPtr->tcl_UtfToLower) /* 334 */ #endif #ifndef Tcl_UtfToTitle #define Tcl_UtfToTitle \ (tclStubsPtr->tcl_UtfToTitle) /* 335 */ #endif #ifndef Tcl_UtfToUniChar #define Tcl_UtfToUniChar \ (tclStubsPtr->tcl_UtfToUniChar) /* 336 */ #endif #ifndef Tcl_UtfToUpper #define Tcl_UtfToUpper \ (tclStubsPtr->tcl_UtfToUpper) /* 337 */ #endif #ifndef Tcl_WriteChars #define Tcl_WriteChars \ (tclStubsPtr->tcl_WriteChars) /* 338 */ #endif #ifndef Tcl_WriteObj #define Tcl_WriteObj \ (tclStubsPtr->tcl_WriteObj) /* 339 */ #endif #ifndef Tcl_GetString #define Tcl_GetString \ (tclStubsPtr->tcl_GetString) /* 340 */ #endif #ifndef Tcl_GetDefaultEncodingDir #define Tcl_GetDefaultEncodingDir \ (tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */ #endif #ifndef Tcl_SetDefaultEncodingDir #define Tcl_SetDefaultEncodingDir \ (tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */ #endif #ifndef Tcl_AlertNotifier #define Tcl_AlertNotifier \ (tclStubsPtr->tcl_AlertNotifier) /* 343 */ #endif #ifndef Tcl_ServiceModeHook #define Tcl_ServiceModeHook \ (tclStubsPtr->tcl_ServiceModeHook) /* 344 */ #endif #ifndef Tcl_UniCharIsAlnum #define Tcl_UniCharIsAlnum \ (tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */ #endif #ifndef Tcl_UniCharIsAlpha #define Tcl_UniCharIsAlpha \ (tclStubsPtr->tcl_UniCharIsAlpha) /* 346 */ #endif #ifndef Tcl_UniCharIsDigit #define Tcl_UniCharIsDigit \ (tclStubsPtr->tcl_UniCharIsDigit) /* 347 */ #endif #ifndef Tcl_UniCharIsLower #define Tcl_UniCharIsLower \ (tclStubsPtr->tcl_UniCharIsLower) /* 348 */ #endif #ifndef Tcl_UniCharIsSpace #define Tcl_UniCharIsSpace \ (tclStubsPtr->tcl_UniCharIsSpace) /* 349 */ #endif #ifndef Tcl_UniCharIsUpper #define Tcl_UniCharIsUpper \ (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #endif #ifndef Tcl_UniCharIsWordChar #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ #endif #ifndef Tcl_UniCharLen #define Tcl_UniCharLen \ (tclStubsPtr->tcl_UniCharLen) /* 352 */ #endif #ifndef Tcl_UniCharNcmp #define Tcl_UniCharNcmp \ (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ #endif #ifndef Tcl_UniCharToUtfDString #define Tcl_UniCharToUtfDString \ (tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */ #endif #ifndef Tcl_UtfToUniCharDString #define Tcl_UtfToUniCharDString \ (tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */ #endif #ifndef Tcl_GetRegExpFromObj #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ #endif #ifndef Tcl_EvalTokens #define Tcl_EvalTokens \ (tclStubsPtr->tcl_EvalTokens) /* 357 */ #endif #ifndef Tcl_FreeParse #define Tcl_FreeParse \ (tclStubsPtr->tcl_FreeParse) /* 358 */ #endif #ifndef Tcl_LogCommandInfo #define Tcl_LogCommandInfo \ (tclStubsPtr->tcl_LogCommandInfo) /* 359 */ #endif #ifndef Tcl_ParseBraces #define Tcl_ParseBraces \ (tclStubsPtr->tcl_ParseBraces) /* 360 */ #endif #ifndef Tcl_ParseCommand #define Tcl_ParseCommand \ (tclStubsPtr->tcl_ParseCommand) /* 361 */ #endif #ifndef Tcl_ParseExpr #define Tcl_ParseExpr \ (tclStubsPtr->tcl_ParseExpr) /* 362 */ #endif #ifndef Tcl_ParseQuotedString #define Tcl_ParseQuotedString \ (tclStubsPtr->tcl_ParseQuotedString) /* 363 */ #endif #ifndef Tcl_ParseVarName #define Tcl_ParseVarName \ (tclStubsPtr->tcl_ParseVarName) /* 364 */ #endif #ifndef Tcl_GetCwd #define Tcl_GetCwd \ (tclStubsPtr->tcl_GetCwd) /* 365 */ #endif #ifndef Tcl_Chdir #define Tcl_Chdir \ (tclStubsPtr->tcl_Chdir) /* 366 */ #endif #ifndef Tcl_Access #define Tcl_Access \ (tclStubsPtr->tcl_Access) /* 367 */ #endif #ifndef Tcl_Stat #define Tcl_Stat \ (tclStubsPtr->tcl_Stat) /* 368 */ #endif #ifndef Tcl_UtfNcmp #define Tcl_UtfNcmp \ (tclStubsPtr->tcl_UtfNcmp) /* 369 */ #endif #ifndef Tcl_UtfNcasecmp #define Tcl_UtfNcasecmp \ (tclStubsPtr->tcl_UtfNcasecmp) /* 370 */ #endif #ifndef Tcl_StringCaseMatch #define Tcl_StringCaseMatch \ (tclStubsPtr->tcl_StringCaseMatch) /* 371 */ #endif #ifndef Tcl_UniCharIsControl #define Tcl_UniCharIsControl \ (tclStubsPtr->tcl_UniCharIsControl) /* 372 */ #endif #ifndef Tcl_UniCharIsGraph #define Tcl_UniCharIsGraph \ (tclStubsPtr->tcl_UniCharIsGraph) /* 373 */ #endif #ifndef Tcl_UniCharIsPrint #define Tcl_UniCharIsPrint \ (tclStubsPtr->tcl_UniCharIsPrint) /* 374 */ #endif #ifndef Tcl_UniCharIsPunct #define Tcl_UniCharIsPunct \ (tclStubsPtr->tcl_UniCharIsPunct) /* 375 */ #endif #ifndef Tcl_RegExpExecObj #define Tcl_RegExpExecObj \ (tclStubsPtr->tcl_RegExpExecObj) /* 376 */ #endif #ifndef Tcl_RegExpGetInfo #define Tcl_RegExpGetInfo \ (tclStubsPtr->tcl_RegExpGetInfo) /* 377 */ #endif #ifndef Tcl_NewUnicodeObj #define Tcl_NewUnicodeObj \ (tclStubsPtr->tcl_NewUnicodeObj) /* 378 */ #endif #ifndef Tcl_SetUnicodeObj #define Tcl_SetUnicodeObj \ (tclStubsPtr->tcl_SetUnicodeObj) /* 379 */ #endif #ifndef Tcl_GetCharLength #define Tcl_GetCharLength \ (tclStubsPtr->tcl_GetCharLength) /* 380 */ #endif #ifndef Tcl_GetUniChar #define Tcl_GetUniChar \ (tclStubsPtr->tcl_GetUniChar) /* 381 */ #endif #ifndef Tcl_GetUnicode #define Tcl_GetUnicode \ (tclStubsPtr->tcl_GetUnicode) /* 382 */ #endif #ifndef Tcl_GetRange #define Tcl_GetRange \ (tclStubsPtr->tcl_GetRange) /* 383 */ #endif #ifndef Tcl_AppendUnicodeToObj #define Tcl_AppendUnicodeToObj \ (tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */ #endif #ifndef Tcl_RegExpMatchObj #define Tcl_RegExpMatchObj \ (tclStubsPtr->tcl_RegExpMatchObj) /* 385 */ #endif #ifndef Tcl_SetNotifier #define Tcl_SetNotifier \ (tclStubsPtr->tcl_SetNotifier) /* 386 */ #endif #ifndef Tcl_GetAllocMutex #define Tcl_GetAllocMutex \ (tclStubsPtr->tcl_GetAllocMutex) /* 387 */ #endif #ifndef Tcl_GetChannelNames #define Tcl_GetChannelNames \ (tclStubsPtr->tcl_GetChannelNames) /* 388 */ #endif #ifndef Tcl_GetChannelNamesEx #define Tcl_GetChannelNamesEx \ (tclStubsPtr->tcl_GetChannelNamesEx) /* 389 */ #endif #ifndef Tcl_ProcObjCmd #define Tcl_ProcObjCmd \ (tclStubsPtr->tcl_ProcObjCmd) /* 390 */ #endif #ifndef Tcl_ConditionFinalize #define Tcl_ConditionFinalize \ (tclStubsPtr->tcl_ConditionFinalize) /* 391 */ #endif #ifndef Tcl_MutexFinalize #define Tcl_MutexFinalize \ (tclStubsPtr->tcl_MutexFinalize) /* 392 */ #endif #ifndef Tcl_CreateThread #define Tcl_CreateThread \ (tclStubsPtr->tcl_CreateThread) /* 393 */ #endif #ifndef Tcl_ReadRaw #define Tcl_ReadRaw \ (tclStubsPtr->tcl_ReadRaw) /* 394 */ #endif #ifndef Tcl_WriteRaw #define Tcl_WriteRaw \ (tclStubsPtr->tcl_WriteRaw) /* 395 */ #endif #ifndef Tcl_GetTopChannel #define Tcl_GetTopChannel \ (tclStubsPtr->tcl_GetTopChannel) /* 396 */ #endif #ifndef Tcl_ChannelBuffered #define Tcl_ChannelBuffered \ (tclStubsPtr->tcl_ChannelBuffered) /* 397 */ #endif #ifndef Tcl_ChannelName #define Tcl_ChannelName \ (tclStubsPtr->tcl_ChannelName) /* 398 */ #endif #ifndef Tcl_ChannelVersion #define Tcl_ChannelVersion \ (tclStubsPtr->tcl_ChannelVersion) /* 399 */ #endif #ifndef Tcl_ChannelBlockModeProc #define Tcl_ChannelBlockModeProc \ (tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */ #endif #ifndef Tcl_ChannelCloseProc #define Tcl_ChannelCloseProc \ (tclStubsPtr->tcl_ChannelCloseProc) /* 401 */ #endif #ifndef Tcl_ChannelClose2Proc #define Tcl_ChannelClose2Proc \ (tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */ #endif #ifndef Tcl_ChannelInputProc #define Tcl_ChannelInputProc \ (tclStubsPtr->tcl_ChannelInputProc) /* 403 */ #endif #ifndef Tcl_ChannelOutputProc #define Tcl_ChannelOutputProc \ (tclStubsPtr->tcl_ChannelOutputProc) /* 404 */ #endif #ifndef Tcl_ChannelSeekProc #define Tcl_ChannelSeekProc \ (tclStubsPtr->tcl_ChannelSeekProc) /* 405 */ #endif #ifndef Tcl_ChannelSetOptionProc #define Tcl_ChannelSetOptionProc \ (tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */ #endif #ifndef Tcl_ChannelGetOptionProc #define Tcl_ChannelGetOptionProc \ (tclStubsPtr->tcl_ChannelGetOptionProc) /* 407 */ #endif #ifndef Tcl_ChannelWatchProc #define Tcl_ChannelWatchProc \ (tclStubsPtr->tcl_ChannelWatchProc) /* 408 */ #endif #ifndef Tcl_ChannelGetHandleProc #define Tcl_ChannelGetHandleProc \ (tclStubsPtr->tcl_ChannelGetHandleProc) /* 409 */ #endif #ifndef Tcl_ChannelFlushProc #define Tcl_ChannelFlushProc \ (tclStubsPtr->tcl_ChannelFlushProc) /* 410 */ #endif #ifndef Tcl_ChannelHandlerProc #define Tcl_ChannelHandlerProc \ (tclStubsPtr->tcl_ChannelHandlerProc) /* 411 */ #endif #ifndef Tcl_JoinThread #define Tcl_JoinThread \ (tclStubsPtr->tcl_JoinThread) /* 412 */ #endif #ifndef Tcl_IsChannelShared #define Tcl_IsChannelShared \ (tclStubsPtr->tcl_IsChannelShared) /* 413 */ #endif #ifndef Tcl_IsChannelRegistered #define Tcl_IsChannelRegistered \ (tclStubsPtr->tcl_IsChannelRegistered) /* 414 */ #endif #ifndef Tcl_CutChannel #define Tcl_CutChannel \ (tclStubsPtr->tcl_CutChannel) /* 415 */ #endif #ifndef Tcl_SpliceChannel #define Tcl_SpliceChannel \ (tclStubsPtr->tcl_SpliceChannel) /* 416 */ #endif #ifndef Tcl_ClearChannelHandlers #define Tcl_ClearChannelHandlers \ (tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */ #endif #ifndef Tcl_IsChannelExisting #define Tcl_IsChannelExisting \ (tclStubsPtr->tcl_IsChannelExisting) /* 418 */ #endif #ifndef Tcl_UniCharNcasecmp #define Tcl_UniCharNcasecmp \ (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ #endif #ifndef Tcl_UniCharCaseMatch #define Tcl_UniCharCaseMatch \ (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ #endif #ifndef Tcl_FindHashEntry #define Tcl_FindHashEntry \ (tclStubsPtr->tcl_FindHashEntry) /* 421 */ #endif #ifndef Tcl_CreateHashEntry #define Tcl_CreateHashEntry \ (tclStubsPtr->tcl_CreateHashEntry) /* 422 */ #endif #ifndef Tcl_InitCustomHashTable #define Tcl_InitCustomHashTable \ (tclStubsPtr->tcl_InitCustomHashTable) /* 423 */ #endif #ifndef Tcl_InitObjHashTable #define Tcl_InitObjHashTable \ (tclStubsPtr->tcl_InitObjHashTable) /* 424 */ #endif #ifndef Tcl_CommandTraceInfo #define Tcl_CommandTraceInfo \ (tclStubsPtr->tcl_CommandTraceInfo) /* 425 */ #endif #ifndef Tcl_TraceCommand #define Tcl_TraceCommand \ (tclStubsPtr->tcl_TraceCommand) /* 426 */ #endif #ifndef Tcl_UntraceCommand #define Tcl_UntraceCommand \ (tclStubsPtr->tcl_UntraceCommand) /* 427 */ #endif #ifndef Tcl_AttemptAlloc #define Tcl_AttemptAlloc \ (tclStubsPtr->tcl_AttemptAlloc) /* 428 */ #endif #ifndef Tcl_AttemptDbCkalloc #define Tcl_AttemptDbCkalloc \ (tclStubsPtr->tcl_AttemptDbCkalloc) /* 429 */ #endif #ifndef Tcl_AttemptRealloc #define Tcl_AttemptRealloc \ (tclStubsPtr->tcl_AttemptRealloc) /* 430 */ #endif #ifndef Tcl_AttemptDbCkrealloc #define Tcl_AttemptDbCkrealloc \ (tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */ #endif #ifndef Tcl_AttemptSetObjLength #define Tcl_AttemptSetObjLength \ (tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */ #endif #ifndef Tcl_GetChannelThread #define Tcl_GetChannelThread \ (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #endif #ifndef Tcl_GetUnicodeFromObj #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ #endif #ifndef Tcl_GetMathFuncInfo #define Tcl_GetMathFuncInfo \ (tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */ #endif #ifndef Tcl_ListMathFuncs #define Tcl_ListMathFuncs \ (tclStubsPtr->tcl_ListMathFuncs) /* 436 */ #endif #ifndef Tcl_SubstObj #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #endif #ifndef Tcl_DetachChannel #define Tcl_DetachChannel \ (tclStubsPtr->tcl_DetachChannel) /* 438 */ #endif #ifndef Tcl_IsStandardChannel #define Tcl_IsStandardChannel \ (tclStubsPtr->tcl_IsStandardChannel) /* 439 */ #endif #ifndef Tcl_FSCopyFile #define Tcl_FSCopyFile \ (tclStubsPtr->tcl_FSCopyFile) /* 440 */ #endif #ifndef Tcl_FSCopyDirectory #define Tcl_FSCopyDirectory \ (tclStubsPtr->tcl_FSCopyDirectory) /* 441 */ #endif #ifndef Tcl_FSCreateDirectory #define Tcl_FSCreateDirectory \ (tclStubsPtr->tcl_FSCreateDirectory) /* 442 */ #endif #ifndef Tcl_FSDeleteFile #define Tcl_FSDeleteFile \ (tclStubsPtr->tcl_FSDeleteFile) /* 443 */ #endif #ifndef Tcl_FSLoadFile #define Tcl_FSLoadFile \ (tclStubsPtr->tcl_FSLoadFile) /* 444 */ #endif #ifndef Tcl_FSMatchInDirectory #define Tcl_FSMatchInDirectory \ (tclStubsPtr->tcl_FSMatchInDirectory) /* 445 */ #endif #ifndef Tcl_FSLink #define Tcl_FSLink \ (tclStubsPtr->tcl_FSLink) /* 446 */ #endif #ifndef Tcl_FSRemoveDirectory #define Tcl_FSRemoveDirectory \ (tclStubsPtr->tcl_FSRemoveDirectory) /* 447 */ #endif #ifndef Tcl_FSRenameFile #define Tcl_FSRenameFile \ (tclStubsPtr->tcl_FSRenameFile) /* 448 */ #endif #ifndef Tcl_FSLstat #define Tcl_FSLstat \ (tclStubsPtr->tcl_FSLstat) /* 449 */ #endif #ifndef Tcl_FSUtime #define Tcl_FSUtime \ (tclStubsPtr->tcl_FSUtime) /* 450 */ #endif #ifndef Tcl_FSFileAttrsGet #define Tcl_FSFileAttrsGet \ (tclStubsPtr->tcl_FSFileAttrsGet) /* 451 */ #endif #ifndef Tcl_FSFileAttrsSet #define Tcl_FSFileAttrsSet \ (tclStubsPtr->tcl_FSFileAttrsSet) /* 452 */ #endif #ifndef Tcl_FSFileAttrStrings #define Tcl_FSFileAttrStrings \ (tclStubsPtr->tcl_FSFileAttrStrings) /* 453 */ #endif #ifndef Tcl_FSStat #define Tcl_FSStat \ (tclStubsPtr->tcl_FSStat) /* 454 */ #endif #ifndef Tcl_FSAccess #define Tcl_FSAccess \ (tclStubsPtr->tcl_FSAccess) /* 455 */ #endif #ifndef Tcl_FSOpenFileChannel #define Tcl_FSOpenFileChannel \ (tclStubsPtr->tcl_FSOpenFileChannel) /* 456 */ #endif #ifndef Tcl_FSGetCwd #define Tcl_FSGetCwd \ (tclStubsPtr->tcl_FSGetCwd) /* 457 */ #endif #ifndef Tcl_FSChdir #define Tcl_FSChdir \ (tclStubsPtr->tcl_FSChdir) /* 458 */ #endif #ifndef Tcl_FSConvertToPathType #define Tcl_FSConvertToPathType \ (tclStubsPtr->tcl_FSConvertToPathType) /* 459 */ #endif #ifndef Tcl_FSJoinPath #define Tcl_FSJoinPath \ (tclStubsPtr->tcl_FSJoinPath) /* 460 */ #endif #ifndef Tcl_FSSplitPath #define Tcl_FSSplitPath \ (tclStubsPtr->tcl_FSSplitPath) /* 461 */ #endif #ifndef Tcl_FSEqualPaths #define Tcl_FSEqualPaths \ (tclStubsPtr->tcl_FSEqualPaths) /* 462 */ #endif #ifndef Tcl_FSGetNormalizedPath #define Tcl_FSGetNormalizedPath \ (tclStubsPtr->tcl_FSGetNormalizedPath) /* 463 */ #endif #ifndef Tcl_FSJoinToPath #define Tcl_FSJoinToPath \ (tclStubsPtr->tcl_FSJoinToPath) /* 464 */ #endif #ifndef Tcl_FSGetInternalRep #define Tcl_FSGetInternalRep \ (tclStubsPtr->tcl_FSGetInternalRep) /* 465 */ #endif #ifndef Tcl_FSGetTranslatedPath #define Tcl_FSGetTranslatedPath \ (tclStubsPtr->tcl_FSGetTranslatedPath) /* 466 */ #endif #ifndef Tcl_FSEvalFile #define Tcl_FSEvalFile \ (tclStubsPtr->tcl_FSEvalFile) /* 467 */ #endif #ifndef Tcl_FSNewNativePath #define Tcl_FSNewNativePath \ (tclStubsPtr->tcl_FSNewNativePath) /* 468 */ #endif #ifndef Tcl_FSGetNativePath #define Tcl_FSGetNativePath \ (tclStubsPtr->tcl_FSGetNativePath) /* 469 */ #endif #ifndef Tcl_FSFileSystemInfo #define Tcl_FSFileSystemInfo \ (tclStubsPtr->tcl_FSFileSystemInfo) /* 470 */ #endif #ifndef Tcl_FSPathSeparator #define Tcl_FSPathSeparator \ (tclStubsPtr->tcl_FSPathSeparator) /* 471 */ #endif #ifndef Tcl_FSListVolumes #define Tcl_FSListVolumes \ (tclStubsPtr->tcl_FSListVolumes) /* 472 */ #endif #ifndef Tcl_FSRegister #define Tcl_FSRegister \ (tclStubsPtr->tcl_FSRegister) /* 473 */ #endif #ifndef Tcl_FSUnregister #define Tcl_FSUnregister \ (tclStubsPtr->tcl_FSUnregister) /* 474 */ #endif #ifndef Tcl_FSData #define Tcl_FSData \ (tclStubsPtr->tcl_FSData) /* 475 */ #endif #ifndef Tcl_FSGetTranslatedStringPath #define Tcl_FSGetTranslatedStringPath \ (tclStubsPtr->tcl_FSGetTranslatedStringPath) /* 476 */ #endif #ifndef Tcl_FSGetFileSystemForPath #define Tcl_FSGetFileSystemForPath \ (tclStubsPtr->tcl_FSGetFileSystemForPath) /* 477 */ #endif #ifndef Tcl_FSGetPathType #define Tcl_FSGetPathType \ (tclStubsPtr->tcl_FSGetPathType) /* 478 */ #endif #ifndef Tcl_OutputBuffered #define Tcl_OutputBuffered \ (tclStubsPtr->tcl_OutputBuffered) /* 479 */ #endif #ifndef Tcl_FSMountsChanged #define Tcl_FSMountsChanged \ (tclStubsPtr->tcl_FSMountsChanged) /* 480 */ #endif #ifndef Tcl_EvalTokensStandard #define Tcl_EvalTokensStandard \ (tclStubsPtr->tcl_EvalTokensStandard) /* 481 */ #endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLDECLS */ critlib/critcl_c/tclPlatDecls.h0000644000076500001200000001152207354610511016712 0ustar jcwadmin00000000000000/* * tclPlatDecls.h -- * * Declarations of platform specific Tcl APIs. * * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * * RCS: @(#) $Id: tclPlatDecls.h,v 1.12 2001/09/09 22:45:13 davygrvy Exp $ */ #ifndef _TCLPLATDECLS #define _TCLPLATDECLS /* * Pull in the definition of TCHAR. Hopefully the compile flags * of the core are matching against your project build for these * public functions. BE AWARE. */ #if defined(__WIN32__) && !defined(_TCHAR_DEFINED) # include # ifndef _TCHAR_DEFINED /* Borland seems to forget to set this. */ typedef _TCHAR TCHAR; # define _TCHAR_DEFINED # endif #endif /* !BEGIN!: Do not edit below this line. */ /* * Exported function declarations: */ #ifdef __WIN32__ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar _ANSI_ARGS_((CONST char * str, int len, Tcl_DString * dsPtr)); /* 1 */ EXTERN char * Tcl_WinTCharToUtf _ANSI_ARGS_((CONST TCHAR * str, int len, Tcl_DString * dsPtr)); #endif /* __WIN32__ */ #ifdef MAC_TCL /* 0 */ EXTERN void Tcl_MacSetEventProc _ANSI_ARGS_(( Tcl_MacConvertEventPtr procPtr)); /* 1 */ EXTERN char * Tcl_MacConvertTextResource _ANSI_ARGS_(( Handle resource)); /* 2 */ EXTERN int Tcl_MacEvalResource _ANSI_ARGS_((Tcl_Interp * interp, char * resourceName, int resourceNumber, char * fileName)); /* 3 */ EXTERN Handle Tcl_MacFindResource _ANSI_ARGS_((Tcl_Interp * interp, long resourceType, char * resourceName, int resourceNumber, char * resFileRef, int * releaseIt)); /* 4 */ EXTERN int Tcl_GetOSTypeFromObj _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * objPtr, OSType * osTypePtr)); /* 5 */ EXTERN void Tcl_SetOSTypeObj _ANSI_ARGS_((Tcl_Obj * objPtr, OSType osType)); /* 6 */ EXTERN Tcl_Obj * Tcl_NewOSTypeObj _ANSI_ARGS_((OSType osType)); /* 7 */ EXTERN int strncasecmp _ANSI_ARGS_((CONST char * s1, CONST char * s2, size_t n)); /* 8 */ EXTERN int strcasecmp _ANSI_ARGS_((CONST char * s1, CONST char * s2)); #endif /* MAC_TCL */ typedef struct TclPlatStubs { int magic; struct TclPlatStubHooks *hooks; #ifdef __WIN32__ TCHAR * (*tcl_WinUtfToTChar) _ANSI_ARGS_((CONST char * str, int len, Tcl_DString * dsPtr)); /* 0 */ char * (*tcl_WinTCharToUtf) _ANSI_ARGS_((CONST TCHAR * str, int len, Tcl_DString * dsPtr)); /* 1 */ #endif /* __WIN32__ */ #ifdef MAC_TCL void (*tcl_MacSetEventProc) _ANSI_ARGS_((Tcl_MacConvertEventPtr procPtr)); /* 0 */ char * (*tcl_MacConvertTextResource) _ANSI_ARGS_((Handle resource)); /* 1 */ int (*tcl_MacEvalResource) _ANSI_ARGS_((Tcl_Interp * interp, char * resourceName, int resourceNumber, char * fileName)); /* 2 */ Handle (*tcl_MacFindResource) _ANSI_ARGS_((Tcl_Interp * interp, long resourceType, char * resourceName, int resourceNumber, char * resFileRef, int * releaseIt)); /* 3 */ int (*tcl_GetOSTypeFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, OSType * osTypePtr)); /* 4 */ void (*tcl_SetOSTypeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, OSType osType)); /* 5 */ Tcl_Obj * (*tcl_NewOSTypeObj) _ANSI_ARGS_((OSType osType)); /* 6 */ int (*strncasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, size_t n)); /* 7 */ int (*strcasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2)); /* 8 */ #endif /* MAC_TCL */ } TclPlatStubs; #ifdef __cplusplus extern "C" { #endif extern TclPlatStubs *tclPlatStubsPtr; #ifdef __cplusplus } #endif #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) /* * Inline function declarations: */ #ifdef __WIN32__ #ifndef Tcl_WinUtfToTChar #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ #endif #ifndef Tcl_WinTCharToUtf #define Tcl_WinTCharToUtf \ (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */ #endif #endif /* __WIN32__ */ #ifdef MAC_TCL #ifndef Tcl_MacSetEventProc #define Tcl_MacSetEventProc \ (tclPlatStubsPtr->tcl_MacSetEventProc) /* 0 */ #endif #ifndef Tcl_MacConvertTextResource #define Tcl_MacConvertTextResource \ (tclPlatStubsPtr->tcl_MacConvertTextResource) /* 1 */ #endif #ifndef Tcl_MacEvalResource #define Tcl_MacEvalResource \ (tclPlatStubsPtr->tcl_MacEvalResource) /* 2 */ #endif #ifndef Tcl_MacFindResource #define Tcl_MacFindResource \ (tclPlatStubsPtr->tcl_MacFindResource) /* 3 */ #endif #ifndef Tcl_GetOSTypeFromObj #define Tcl_GetOSTypeFromObj \ (tclPlatStubsPtr->tcl_GetOSTypeFromObj) /* 4 */ #endif #ifndef Tcl_SetOSTypeObj #define Tcl_SetOSTypeObj \ (tclPlatStubsPtr->tcl_SetOSTypeObj) /* 5 */ #endif #ifndef Tcl_NewOSTypeObj #define Tcl_NewOSTypeObj \ (tclPlatStubsPtr->tcl_NewOSTypeObj) /* 6 */ #endif #ifndef strncasecmp #define strncasecmp \ (tclPlatStubsPtr->strncasecmp) /* 7 */ #endif #ifndef strcasecmp #define strcasecmp \ (tclPlatStubsPtr->strcasecmp) /* 8 */ #endif #endif /* MAC_TCL */ #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLPLATDECLS */ critlib/dyncall.README0000644000076500001200000000337407377017763014733 0ustar jcwadmin00000000000000Calling functions in arbitrary dynamic libraries ================================================ Rev 0.11: Added support for Windows (by Scott Beasley) Rev 0.10: Initial release This package defines commands to make calls through the Unix "dl*" API. The current version has only been tried under Linux, other systems will most likely require changes (on some this may not be feasible at all). There are a number of procs, described as sample calls below: set lib [dynopen file] open a shared library and return a handle for it will return zero if the library cannot be loaded set sym [dynsym $lib funcname] lookup a function, and return a call handle for it will return zero if the named function is not found dynclose $lib closes a shared library (do not call anything in it after this) puts [dynerror] returns last error, if any, and also clears it set result [dyncall $sym args] call the specified function with args as given Passing arguments to the function will require some work (in some cases a lot of work). The idea is to use "binary format ..." to create a binary data structure of the right form. This data structure represents 0..10 integer arguments, passed to the function by dyncall. More functions will need to be added to this package, to make it possible to access, construct, and de-construct complex data structures. Details for this have not yet been worked out (libffi and several other libraries are available, and might be a better way to proceed for complicated use). Code like this has to come with a huge bright red flashing warning sign, saying that it is *trivial* to crash the system with dynlib. Even the test sample crashes, if used in combination with a statically-linked Tcl. critlib/dyncall.tcl0000644000076500001200000000450607377020300014533 0ustar jcwadmin00000000000000# Call routines in shared libraries (DLLs) package provide dyncall 0.11 package require critcl if {$tcl_platform(platform) == "windows"} { critcl::ccode { #include } critcl::cproc dynopen {char* name} long { return (long) LoadLibrary (name); } critcl::cproc dynerror {} string { char s[250]; FormatMessage(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM, 0, GetLastError(), 0, s, sizeof s - 1, 0); return strcpy(Tcl_Alloc(strlen(s) + 1), s); } critcl::cproc dynsym {long handle char* symbol} long { return (long) GetProcAddress((HINSTANCE) handle, symbol); } critcl::cproc dynclose {long handle} void { FreeLibrary((HINSTANCE) handle); } } else { critcl::clibraries -ldl critcl::ccode { #include } critcl::cproc dynopen {char* name} long { return (long) dlopen(name, RTLD_NOW | RTLD_GLOBAL); } critcl::cproc dynerror {} string { char *s = dlerror(); return strcpy(Tcl_Alloc(strlen(s) + 1), s); } critcl::cproc dynsym {long handle char* symbol} long { return (long) dlsym((void*) handle, symbol); } critcl::cproc dynclose {long handle} void { dlclose((void*) handle); } } critcl::ccommand dyncall {dummy ip objc objv} { int r, len; long symptr; unsigned char* args; struct av { int v[10]; } avec; typedef int (*func)(struct av); if (objc != 3) { Tcl_WrongNumArgs(ip, 1, objv, "symptr args"); return TCL_ERROR; } if (Tcl_GetLongFromObj(ip, objv[1], &symptr) != TCL_OK) return TCL_ERROR; args = Tcl_GetByteArrayFromObj(objv[2], &len); if (len % sizeof (int) != 0 || len > sizeof avec) { Tcl_SetResult(ip, "args must hold 0..10 int-sized values", TCL_STATIC); return TCL_ERROR; } memcpy(avec.v, args, len); r = ((func) symptr)(avec); Tcl_SetObjResult(ip, Tcl_NewIntObj(r)); return TCL_OK; } if {[info exists pkgtest] && $pkgtest} { # test disabled, because loading libc.so.6 crashes TclKit, which is static if {0} { puts "sec = [clock seconds]" set lib [dynopen /lib/libc.so.6] puts "lib = $lib" set sym [dynsym $lib geteuid] puts "sym = $sym" set val [dyncall $sym [binary format i 0]] puts "val = $val" dynclose $lib } # instead make a harmless call which fails to prove that it ran catch dyncall err puts $err } critlib/hexdump.README0000644000076500001200000000064607375744006014751 0ustar jcwadmin00000000000000An efficient hexdump utility ============================ Rev 0.10: Initial release This package defines a "hexdump" command, which converts a string handed to it to a readable, 16-byte/line text format. It was written by Matt Newman and part of his "pwb" (programmer's work bench) extension in TclKit. This can also be coded in pure Tcl of course, but heck... it exists, it works, and it is indeed extremely fast. critlib/hexdump.tcl0000644000076500001200000000412707376413526014575 0ustar jcwadmin00000000000000# Quick hex dump in C, from Matt Newman's "pwb" for TclKit package provide hexdump 0.10 package require critcl critcl::ccommand hexdump {dummy interp objc objv} { static char hex[] = "0123456789abcdef"; Tcl_Obj *objPtr; unsigned char *scp, *dcp; unsigned char c1 = '\0'; char *prefix = NULL; int sclen, dclen, plen = 0, i, idx, count; unsigned val; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "data ?prefix?"); return TCL_ERROR; } scp = Tcl_GetByteArrayFromObj( objv[1], &sclen); if (objc > 2) prefix = Tcl_GetStringFromObj( objv[2], &plen); /* * Max line length = (64 +strlen(prefix)) * and 16 bytes output per line... */ objPtr = Tcl_NewByteArrayObj( &c1, 0); Tcl_SetByteArrayLength( objPtr, (64+plen) * (1+sclen/16) + 1); dcp = Tcl_GetByteArrayFromObj( objPtr, NULL); dclen = idx = 0; while (idx < sclen) { if (idx > 0) dcp[dclen++] = '\n'; /* Output Line Prefix */ if (plen) { strncpy( (char*) &dcp[dclen], prefix, plen); dclen += plen; } /* Output Offset in Hex */ val = idx; for (i = 32; i > 0;i -= 4) { dcp[dclen++] = hex[ (val >> (i-4)) & 0xf ]; } dcp[dclen++] = ' '; /* Output 4 data blocks of 4 bytes hex */ count = idx; for (i = 1; i <= 16; i++,count++) { if ( count >= sclen ) { dcp[dclen++] = ' '; dcp[dclen++] = ' '; } else { dcp[dclen++] = hex[ (scp[count] >> 4) & 0xf]; dcp[dclen++] = hex[ scp[count] & 0xf]; } if ( (i % 4) == 0 ) dcp[dclen++] = ' '; } dcp[dclen++] = '*'; /* Output 16 bytes as printable ASCI */ count = idx; for (i = 1; i <= 16; i++,count++) { if ( count >= sclen ) dcp[dclen++] = ' '; else if ( scp[count] < 32 || scp[count] > 126 ) dcp[dclen++] = '.'; else dcp[dclen++] = scp[count]; } dcp[dclen++] = '*'; idx += 16; } Tcl_SetByteArrayLength( objPtr, dclen); Tcl_SetObjResult( interp, objPtr); return TCL_OK; } if {[info exists pkgtest] && $pkgtest} { set fd [open [info script]] set data [read $fd 345] close $fd puts [hexdump $data] } critlib/ideas.txt0000644000076500001200000000373007410161270014225 0ustar jcwadmin00000000000000November 2001 CriTcl is pretty exciting stuff. It has radically changed the way I mix Tcl and C code these days. It opens up a whole range of options for the future, both as development tool and for greatly simplifying deployment. Below is a list of things which have come to mind or have been suggested so far. If you have more suggestions or comments or, better still, would like to participate in the evolution of this package in any way, please get in touch - or create a page about your plans/work on the Tcl'ers Wiki with a reference to it in http://mini.net/tcl/2516.html - I'll do my best to accommodate you and to adapt/integrate things where possible. -- Jean-Claude Wippler DEVELOPMENT USES: - the most obvious one: surgical replacement of hot spots with C code - support more platforms, more compilers, verify with all Tcl's >= 8.1 - CriTcl as test bench for trying out new C features to be added to Tcl - hide sensitive keys or proprietary algorithms in C code - add package to report compiler's type width/alignment choices - use C code to poke at Tcl's internals ENHANCED DEPLOYMENT: - automatically create a custom tclsh or wish (solved: critbind) - automatically wrap scripts and generated libs for use elsewhere (could be a tar.gz, or a scripted doc for TclKit, or in *Wrap-style) - combination of above two: auto-generate standalone application WEAKNESSES TO FIX: - make automatic recompilation work when "outdir" is set - restore outdir after each package (e.g. typcl during pkgtest) - allow "define; call; define; call" to work, also interactively RADICAL IDEAS: - redo parts of the Tcl core with CriTcl and ultimately replace them - deploy major extensions with CriTcl (and why not, ehm... Tk?) - parse C headers and generate bindings on-the-fly (SWIG-like) (gcc's -dD, -dM, and -dN can help with the extraction) - parse std include files to create a very rich interface to the OS - package for access to machine code (GNU Lightning comes to mind) critlib/ihash.README0000644000076500001200000000303107375744043014363 0ustar jcwadmin00000000000000Another way to provide hash-type performance for Tcl data collections ===================================================================== Rev 0.11: Quicker test code Rev 0.10: Initial release The http://mini.net/tcl/2485.html page is a good spot to comment on this. This demo illustrates an experimental "ihash" command and datatype for Tcl, which uses the usual even-odd representation to store data, plus an internal integer map vector to represent the hashing layer placed on top. Even-odd lists (lists with even elements being the keys and odd elements being the values) will be called "interleaved lists" from now on ("ilists" in short), which is also which this command is called "ihash". Differences between ihash objects and arrays: * when looking up a key which is missing, an empty string is returned * unsetting non-existent keys is not an error but silently ignored * there is an "exists" option to properly test for presence of a key * ihash entries are not variables, this model does not support traces * order can be preserved, though inserts/deletes will take O(N) time * memory overhead is less than arrays (2 ints/item, plus free slots) Performance-wise, the test output seems to indicate the following: * access is similar (the difference looks like just call overhead) * creation from a list is many times faster than for arrays * full traversal takes the same amount of time for both * full traversal of the list is obviously faster for ihashes Note: set/unset performance has not been measured. critlib/ihash.tcl0000644000076500001200000003552007376413535014220 0ustar jcwadmin00000000000000# Hashed data access based on interleaved (even-odd) lists package provide ihash 0.11 package require critcl critcl::ccode { #include #include #include typedef struct { Tcl_Obj* data; int* hvec; Tcl_Interp* interp; int spare; int poly; int size; } HashInfo; /* * The following contains code derived from Python's dictionaries, hence: * Copyright 1991-1995 by Stichting Mathematisch Centrum, Amsterdam, * The Netherlands. * Reduced and turned into a fast C++ class by Christian Tismer, hence: * Copyright 1999 by Christian Tismer. * Extracted, vectorized, and simplified further by Jean-Claude Wippler. */ /* Table of irreducible polynomials to cycle through GF(2^n)-{0}, 2<=n<=30 */ static long s_polys[] = { 4 + 3, 8 + 3, 16 + 3, 32 + 5, 64 + 3, 128 + 3, 256 + 29, 512 + 17, 1024 + 9, 2048 + 5, 4096 + 83, 8192 + 27, 16384 + 43, 32768 + 3, 65536 + 45, 131072 + 9, 262144 + 39, 524288 + 39, 1048576 + 9, 2097152 + 5, 4194304 + 3, 8388608 + 33, 16777216 + 27, 33554432 + 9, 67108864 + 71, 134217728 + 39, 268435456 + 9, 536870912 + 5, 1073741824 + 83, 0 }; #define IS_UNUSED(p,i) ((p)->hvec[i+(p)->size] < 0 && (p)->hvec[(i)] == 0) #define IS_DUMMY(p,i) ((p)->hvec[i+(p)->size] < 0 && (p)->hvec[(i)] < 0) #define IS_ACTIVE(p,i) ((p)->hvec[i+(p)->size] >= 0) /* a quick-and-dirty hash for now, look for a better one (Tcl type-aware) */ static int hash_calc(Tcl_Obj *obj) { int hash = 0, total; char *str = Tcl_GetStringFromObj(obj, &total); if (total > 0) { const unsigned char* p = (unsigned char*) str; int len = total; long x = *p << 7; /* modifications are risky, this code avoid scanning huge blobs */ if (len > 200) len = 100; while (--len >= 0) x = (1000003 * x) ^ *p++; if (total > 200) { len = 100; p += total - 200; while (--len >= 0) x = (1000003 * x) ^ *p++; } hash = x ^ total; } if (hash == 0) hash = -1; return hash; } static int hash_keysame(HashInfo *hi, int row, Tcl_Obj *obj) { Tcl_Obj *item; char *so, *si; int no, ni, r = hi->hvec[row+hi->size]; if (Tcl_ListObjIndex(hi->interp, hi->data, r, &item) != TCL_OK) return 0; so = Tcl_GetStringFromObj(obj, &no); si = Tcl_GetStringFromObj(item, &ni); return no == ni && memcmp(so, si, no) == 0; } static int hash_lookdict(HashInfo *hi, int hash, Tcl_Obj *obj) { const unsigned int mask = hi->size - 1; /* We must come up with (i, incr) such that 0 <= i < _size and 0 < incr < _size and both are a function of hash */ int i = mask & ~hash, freeslot; unsigned incr; /* We use ~hash instead of hash, as degenerate hash functions, such as for ints , can have lots of leading zeros. It's not really a performance risk, but better safe than sorry. */ if (IS_UNUSED(hi, i) || hi->hvec[i] == hash && hash_keysame(hi, i, obj)) return i; freeslot = IS_DUMMY(hi, i) ? i : -1; /* Derive incr from hash, just to make it more arbitrary. Note that incr must not be 0, or we will get into an infinite loop.*/ incr = (hash ^ ((unsigned long) hash >> 3)) & mask; if (!incr) incr = mask; for (;;) { i = (i+incr) & mask; if (IS_UNUSED(hi, i)) return freeslot != -1 ? freeslot : i; if (hi->hvec[i] == hash && hash_keysame(hi, i, obj)) return i; if (freeslot == -1 && IS_DUMMY(hi, i)) freeslot = i; /* Cycle through GF(2^n)-{0} */ incr = incr << 1; if (incr > mask) incr ^= hi->poly; /* This will implicitely clear the highest bit */ } } static int hash_insertdict(HashInfo *hi, int index) { int oc, hash, i; Tcl_Obj **ov; if (Tcl_ListObjGetElements(hi->interp, hi->data, &oc, &ov) != TCL_OK) return TCL_ERROR; /* cannot happen */ assert(0 <= index && index < oc); hash = hash_calc(ov[index]); i = hash_lookdict(hi, hash, ov[index]); if (IS_DUMMY(hi, i)) --hi->spare; assert(hi->spare >= 0); hi->hvec[i] = hash; hi->hvec[i+hi->size] = index; return TCL_OK; } /* * to avoid adjusting all row positions, the last entry is copied * over the deleted one with just its row position being adjusted */ static int hash_deleteswap(HashInfo *hi, int pos) { int oc, hash, i; Tcl_Obj **ov; if (Tcl_ListObjGetElements(hi->interp, hi->data, &oc, &ov) != TCL_OK) return TCL_ERROR; /* cannot happen */ assert(0 <= pos && pos < oc); hash = hash_calc(ov[pos]); i = hash_lookdict(hi, hash, ov[pos]); assert(IS_ACTIVE(hi, i)); assert(hi->hvec[i+hi->size] == pos); hi->hvec[i] = -1; hi->hvec[i+hi->size] = -1; assert(IS_DUMMY(hi, i)); ++hi->spare; /* if not last element, place the last pair over the deleted one */ if (pos < oc - 2) { Tcl_Obj* tmp[2]; /* calc hash and index of last pair in the list before it is modified */ hash = hash_calc(ov[oc-2]); i = hash_lookdict(hi, hash, ov[oc-2]); /* fix the hash map to point to the new location of that ending pair */ assert(IS_ACTIVE(hi, i)); hi->hvec[i+hi->size] = pos; /* copy last two over deleted pair, then delete last two */ tmp[0] = ov[oc-2]; tmp[1] = ov[oc-1]; if (Tcl_ListObjReplace(hi->interp, hi->data, pos, 2, 2, tmp) != TCL_OK || Tcl_ListObjReplace(hi->interp, hi->data, oc - 2, 2, 0, NULL) != TCL_OK) return TCL_ERROR; /* cannot happen */ } return TCL_OK; } static int hash_dictresize(HashInfo *hi, int minused) { int i, newsize, newpoly, len; for (i = 0, newsize = 4; ; i++, newsize <<= 1) { if (s_polys[i] == 0) { Tcl_SetResult(hi->interp, "cannot determine hash polynomial", TCL_STATIC); return TCL_ERROR; } if (newsize > minused) { newpoly = s_polys[i]; break; } } if (newsize != hi->size) { free(hi->hvec); hi->hvec = malloc(newsize * sizeof *hi->hvec * 2); for (i = 0; i < newsize; ++i) { hi->hvec[i] = 0; hi->hvec[i+newsize] = -1; } hi->size = newsize; hi->poly = newpoly; hi->spare = 0; if (Tcl_ListObjLength(hi->interp, hi->data, &len) != TCL_OK) return TCL_ERROR; for (i = 0; i < len; i += 2) hash_insertdict(hi, i); } return TCL_OK; } static int hash_lookup(HashInfo *hi, Tcl_Obj *obj) { int hash = hash_calc(obj); int i = hash_lookdict(hi, hash, obj); int row = hi->hvec[i+hi->size]; return row >= 0 && hash_keysame(hi, i, obj) ? row : -1; } static Tcl_ObjType hash_type; /* fast internal access representation */ static void hash_free_rep(Tcl_Obj *obj) { HashInfo* hi = (HashInfo*) obj->internalRep.otherValuePtr; Tcl_DecrRefCount(hi->data); free(hi->hvec); free(hi); } static void hash_dup_rep(Tcl_Obj *obj, Tcl_Obj* dup) { HashInfo* hi = (HashInfo*) obj->internalRep.otherValuePtr; HashInfo* hd = memcpy(malloc(sizeof *hi), hi, sizeof *hi); int hvsize = hi->size * sizeof *hi->hvec * 2; Tcl_IncrRefCount(hd->data); hd->hvec = memcpy(malloc(hvsize), hi->hvec, hvsize); dup->bytes = NULL; dup->internalRep.otherValuePtr = hd; dup->typePtr = &hash_type; } static void hash_string_rep(Tcl_Obj *obj) { HashInfo* hi = (HashInfo*) obj->internalRep.otherValuePtr; /* "steal" the list's string representation when we need one */ obj->bytes = Tcl_GetStringFromObj(hi->data, &obj->length); hi->data->bytes = NULL; } static int hash_from_any(Tcl_Interp *ip, Tcl_Obj *obj) { int oc; Tcl_Obj **ov; HashInfo hi; memset(&hi, 0, sizeof hi); hi.data = Tcl_DuplicateObj(obj); Tcl_IncrRefCount(hi.data); if (ip == NULL || Tcl_ListObjGetElements(ip, hi.data, &oc, &ov) != TCL_OK) { Tcl_DecrRefCount(hi.data); return TCL_ERROR; } if (oc % 2) { Tcl_WrongNumArgs(ip, 0, ov, "(hash) odd number of elements"); Tcl_DecrRefCount(hi.data); return TCL_ERROR; } if (hash_dictresize(&hi, oc) != TCL_OK) return TCL_ERROR; hi.interp = ip; obj->bytes = NULL; if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) obj->typePtr->freeIntRepProc(obj); obj->internalRep.otherValuePtr = memcpy(malloc(sizeof hi), &hi, sizeof hi); obj->typePtr = &hash_type; return TCL_OK; } static Tcl_ObjType hash_type = { "hash", hash_free_rep, hash_dup_rep, hash_string_rep, hash_from_any }; } critcl::ccommand ihash {dummy ip objc objv} { HashInfo *hi; int i, oc, index, len, pos; Tcl_Obj **ov, *obj; static char* cmds[] = { /* careful: changes to this list will affect the code below */ "length", "keys", "values", "map", "exists", "get", "set", "unset", NULL, }; /* Tcl_RegisterObjType(&hash_type); */ if (objc < 2) { Tcl_WrongNumArgs(ip, 1, objv, "var ?option ...?"); return TCL_ERROR; } obj = Tcl_ObjGetVar2(ip, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (obj == NULL || obj->typePtr != &hash_type && hash_from_any(ip, obj) != TCL_OK) return TCL_ERROR; hi = (HashInfo*) obj->internalRep.otherValuePtr; /* hash var -> even-odd list */ if (objc < 3) { Tcl_SetObjResult(ip, hi->data); return TCL_OK; } if (Tcl_ListObjLength(ip, hi->data, &len) != TCL_OK || Tcl_GetIndexFromObj(ip, objv[2], cmds, "option", 0, &index) != TCL_OK) return TCL_ERROR; /* check number or args (3 for cmds 0..3, 4 for cmds 4..5) */ if (index <= 3 && objc != 3) { Tcl_WrongNumArgs(ip, 3, objv, ""); return TCL_ERROR; } else if (4 <= index && index <= 5 && objc != 4) { Tcl_WrongNumArgs(ip, 3, objv, "key"); return TCL_ERROR; } /* subcommands 6..7 modify the data and require an unshared object */ if (index >= 5 && Tcl_IsShared(obj)) { obj = Tcl_DuplicateObj(obj); Tcl_ObjSetVar2(ip, objv[1], NULL, obj, TCL_LEAVE_ERR_MSG); hi = (HashInfo*) obj->internalRep.otherValuePtr; /* also need exclusive handle to data (this is usually already so) */ if (Tcl_IsShared(hi->data)) { Tcl_Obj *tmp = Tcl_DuplicateObj(hi->data); Tcl_IncrRefCount(tmp); Tcl_DecrRefCount(hi->data); hi->data = tmp; } } switch (index) { case 0: /* hash var length -> n */ Tcl_SetObjResult(ip, Tcl_NewIntObj(len/2)); break; case 1: /* hash var keys -> list */ case 2: /* hash var values -> list */ obj = Tcl_GetObjResult(ip); if (Tcl_ListObjGetElements(ip, hi->data, &oc, &ov) != TCL_OK) return TCL_ERROR; /* can't happen */ for (i = index - 1; i < oc; i += 2) if (Tcl_ListObjAppendElement(ip, obj, ov[i]) != TCL_OK) return TCL_ERROR; /* can't happen */ break; case 3: /* hash var map -> list */ obj = Tcl_GetObjResult(ip); for (i = 0; i < hi->size; ++i) if (Tcl_ListObjAppendElement(ip, obj, Tcl_NewIntObj(hi->hvec[i])) != TCL_OK || Tcl_ListObjAppendElement(ip, obj, Tcl_NewIntObj(hi->hvec[i+hi->size])) != TCL_OK) return TCL_ERROR; /* can't happen */ break; case 4: /* hash var exists key -> 0/1 */ Tcl_SetObjResult(ip, Tcl_NewIntObj(hash_lookup(hi, objv[3]) >= 0)); break; case 5: /* hash var get key -> value */ pos = hash_lookup(hi, objv[3]); if (pos >= 0) { if (Tcl_ListObjIndex(ip, hi->data, pos + 1, &obj) != TCL_OK) return TCL_ERROR; Tcl_SetObjResult(ip, obj); } break; case 6: /* hash var set key value ... */ if (objc < 5 || objc % 2 != 1) { Tcl_WrongNumArgs(ip, 3, objv, "key value ..."); return TCL_ERROR; } /* assume all keys are new, will adjust further on next set/unset */ /*TODO this test does not add enough hysterisis, improve it later */ if (hash_dictresize(hi, (len + objc - 3) / 2) != TCL_OK) return TCL_ERROR; for (i = 3; i < objc; i += 2) { pos = hash_lookup(hi, objv[i]); if (pos >= 0) { if (Tcl_ListObjReplace(ip, hi->data, pos+1, 1, 1, objv+i+1) != TCL_OK) return TCL_ERROR; } else { if (Tcl_ListObjAppendElement(ip, hi->data, objv[i]) != TCL_OK || Tcl_ListObjAppendElement(ip, hi->data, objv[i+1]) != TCL_OK || hash_insertdict(hi, len) != TCL_OK) return TCL_ERROR; /* can't happen */ len += 2; } } break; case 7: /* hash var unset key ... */ if (objc < 4) { Tcl_WrongNumArgs(ip, 3, objv, "key ..."); return TCL_ERROR; } for (i = 3; i < objc; ++i) { pos = hash_lookup(hi, objv[i]); if (pos >= 0) hash_deleteswap(hi, pos); } /*TODO reduce hash map size again when it gets too sparse */ } return TCL_OK; } if {[info exists pkgtest] && $pkgtest} { proc ihash_try {} { set a {1 one 2 two 3 three} puts "new length = [ihash a length]" puts "new data = [ihash a]" puts "new keys = [ihash a keys]" puts "new values = [ihash a values]" puts "new map = [ihash a map]" puts "new get 1 = [ihash a get 1]" puts "new get 2 = [ihash a get 2]" puts "new get 3 = [ihash a get 3]" puts "new get 4 = [ihash a get 4]" ihash a set 2 deux 4 quattre puts "set length = [ihash a length]" puts "set data = [ihash a]" puts "set map = [ihash a map]" puts "set get 1 = [ihash a get 1]" puts "set get 2 = [ihash a get 2]" puts "set get 3 = [ihash a get 3]" puts "set get 4 = [ihash a get 4]" ihash a unset 0 2 puts "unset length = [ihash a length]" puts "unset data = [ihash a]" puts "unset map = [ihash a map]" puts "unset get 1 = [ihash a get 1]" puts "unset get 2 = [ihash a get 2]" puts "unset get 3 = [ihash a get 3]" puts "unset get 4 = [ihash a get 4]" foreach x {1 10 100 1000 10000} { set v {} for {set y 0} {$y < $x} {incr y} { lappend v $y [expr {$y+$y}] } set n [expr {100000/$x}] if {$n > 10} { set n 10 } set r [lindex [time {set a $v; ihash a; set v [ihash a]} $n] 0] set s [lindex [time {array unset b; array set b $v} $n] 0] puts [format "create %6d = %6d ihash, vs. %d array" $x $r $s] } foreach x {0 1000 abc} { catch {ihash a get $x} e1 catch {set b($x)} e2 puts "get $x: $e1 <-> $e2" } set x 1 puts "10x h = [time { ihash a get $x; ihash a get $x; ihash a get $x; ihash a get $x; ihash a get $x; ihash a get $x; ihash a get $x; ihash a get $x; ihash a get $x; ihash a get $x} 10000]" puts "10x a = [time { set b($x); set b($x); set b($x); set b($x); set b($x); set b($x); set b($x); set b($x); set b($x); set b($x)} 10000]" puts "h all = [time {foreach x [ihash a keys] { ihash a get $x }}]" puts "a all = [time {foreach x [array names b] { set b($x) }}]" puts "same = [expr {[lsort [ihash a]] == [lsort [array get b]]}]" puts "h list = [time {foreach {x y} [ihash a] { }}]" puts "a list = [time {foreach {x y} [array get b] { }}]" } ihash_try } critlib/index.html0000644000076500001200000001372510573223375014412 0ustar jcwadmin00000000000000C Runtime In Tcl Library
CritLib is a set of mostly independent packages for use in Tcl.

It is self-contained and includes CriTcl, the "C Runtime In Tcl" extension which automatically wraps and compiles C code. Details about this concept can be found on the Tcl'ers Wiki, see the CriTcl page there. A list of what could or should be done is being tracked on the ideas page.

CritBind is a utility script to quickly create merged shared libraries, as well as custom executables. See the read me file for details. With CritBind you can deploy the C code which CriTcl compiled for you.

Requirements differ from one package to the next. Most packages listed below use C code and rely on CriTcl, which requires gcc and Tcl 8.1 or later for stubs support. Some of the packages below might use features from a more recent version of Tcl (development takes place under Tcl 8.4).

Installation consists of unpacking the distribution and moving the "critlib/" directory to a spot where Tcl's package loader will find it. The "pkgtest.tcl" script exercises each package a bit (see the test output). Most packages have only been used on Linux and Windows NT4 (MinGW) so far.

No license applies unless noted otherwise in the source files. CriTcl and the scripts below were written by Jean-Claude Wippler. Hold the author harmless and any lawful use is permitted.


Contents of critlib.tar.gz (153 Kb):
ascenc0.12  Simple ASCII <-> binary encodings (base64 for now)  Mar 6, 2007
blowfish0.11  Wrapper for Eric Young's implementation of Blowfish encryption  Feb 26, 2003
cblas0.11  Interface to the 140+ CBLAS standard math routines  Nov 22, 2001
critcl0.33  C Runtime In Tcl - compile C code on the fly  Apr 10, 2003
dyncall0.11  Call routines in shared libraries (DLLs)  Nov 21, 2001
hexdump0.10  Quick hex dump in C, from Matt Newman's "pwb" for TclKit  Nov 20, 2001
ihash0.11  Hashed data access based on interleaved (even-odd) lists  Nov 20, 2001
lzrw10.10  Wrapper for Ross N. Williams' "lzrw1" compression algorithm  Nov 20, 2001
mathf0.11  An adaptation of Donal K. Fellows' math functions in Tcl  Dec 14, 2001
md5c0.11  Wrapper for RSA's Message Digest in C  Nov 20, 2001
mvec0.12  Memory based vectors, this is part of the VKIT vector engine  Nov 22, 2001
noop0.10  Trivial C extension, used to test CriTcl and as baseline for timing  Nov 18, 2001
rechan1.0  Reflecting channel interface  Oct 7, 2002
rhtml0.10  Wrapper for Richard Hipp's Tkhtml widget (called "html")  Dec 21, 2001
scratch0.10  Self-Contained Runtime pArser for Tcl as Critcl Hack  Dec 23, 2001
typcl0.12  Embedding Tcl in Python  Nov 20, 2001
vfs0.12  Wrapper for Vince Darley's Virtual File System core  Nov 20, 2001
xre0.10  Build Tcl's regex + regsub as loadable extension  Nov 21, 2001
zipper0.11  ZIP file constructor  Jun 6, 2002
zlib0.10  Interface to the "zlib" compression library  Nov 20, 2001
Last updated on 2007/03/06
Acknowledgements
Scott Beasley - dyncall on Windows
Vince Darley - Tcl 8.4's Virtual File System
Paul Duffin and Jan Nijtmans - stubs architecture
Donal K. Fellows - math functions, now in "mathf"
Jeff Hobbs and the TCT - continued work on Tcl
Steve Landers - critcl mods for use as separate tool
Don Libes - pure-Tcl implementation of MD5
Matt Newman - original VFS, Tcl wizard par excellence
John Ousterhout - founding father of Tcl
critlib/lzrw1.README0000644000076500001200000000071607375744052014355 0ustar jcwadmin00000000000000Wrapper for the LZRW1 compression algorithm =========================================== Rev 0.10: Initial release This package defines a "lzrw1" command, which has two operation modes: set cdata [lzrw1 compress data] set data [lzrw1 decompress cdata] This code is based on public domain software of 1991 by Ross N. Williams. Data is treated as binary, meaning that all input and output is going to be converted and treated as byte arrays in Tcl. critlib/lzrw1.tcl0000644000076500001200000001704407376413541014201 0ustar jcwadmin00000000000000# Wrapper for Ross N. Williams' "lzrw1" compression algorithm package provide lzrw1 0.10 package require critcl critcl::ccode { /******************************************************************************/ /* Start of LZRW1.C */ /******************************************************************************* THE LZRW1 ALGORITHM =================== Author : Ross N. Williams. Date : 31-Mar-1991. 1. I typed the following code in from my paper "An Extremely Fast Data Compression Algorithm", Data Compression Conference, Utah, 7-11 April, 1991. The fact that this code works indicates that the code in the paper is OK. 2. This file has been copied into a test harness and works. 3. Some users running old C compilers may wish to insert blanks around the "=" symbols of assignments so as to avoid expressions such as "a=*b;" being interpreted as "a=a*b;" 4. This code is public domain. 5. Warning: This code is non-deterministic insofar as it may yield different compressed representations of the same file on different runs. (However, it will always decompress correctly to the original). 6. If you use this code in anger (e.g. in a product) drop me a note at ross@spam.ua.oz.au and I will put you on a mailing list which will be invoked if anyone finds a bug in this code. 7. The internet newsgroup comp.compression might also carry information on this algorithm from time to time. *******************************************************************************/ #define UBYTE unsigned char /* Unsigned byte (1 byte ) */ #define UWORD unsigned int /* Unsigned word (2 bytes) */ #define ULONG unsigned long /* Unsigned longword (4 bytes) */ #define FLAG_BYTES 4 /* Number of bytes used by copy flag. */ #define FLAG_COMPRESS 0 /* Signals that compression occurred. */ #define FLAG_COPY 1 /* Signals that a copyover occurred. */ void fast_copy(p_src,p_dst,len) /* Fast copy routine. */ UBYTE *p_src,*p_dst; {while (len--) *p_dst++=*p_src++;} /******************************************************************************/ void lzrw1_compress(p_src_first,src_len,p_dst_first,p_dst_len) /* Input : Specify input block using p_src_first and src_len. */ /* Input : Point p_dst_first to the start of the output zone (OZ). */ /* Input : Point p_dst_len to a ULONG to receive the output length. */ /* Input : Input block and output zone must not overlap. */ /* Output : Length of output block written to *p_dst_len. */ /* Output : Output block in Mem[p_dst_first..p_dst_first+*p_dst_len-1]. */ /* Output : May write in OZ=Mem[p_dst_first..p_dst_first+src_len+256-1].*/ /* Output : Upon completion guaranteed *p_dst_len<=src_len+FLAG_BYTES. */ UBYTE *p_src_first,*p_dst_first; ULONG src_len,*p_dst_len; #define PS *p++!=*s++ /* Body of inner unrolled matching loop. */ #define ITEMMAX 16 /* Maximum number of bytes in an expanded item. */ {UBYTE *p_src=p_src_first,*p_dst=p_dst_first; UBYTE *p_src_post=p_src_first+src_len,*p_dst_post=p_dst_first+src_len; UBYTE *p_src_max1=p_src_post-ITEMMAX,*p_src_max16=p_src_post-16*ITEMMAX; UBYTE *hash[4096],*p_control; UWORD control=0,control_bits=0; *p_dst=FLAG_COMPRESS; p_dst+=FLAG_BYTES; p_control=p_dst; p_dst+=2; while (1) {UBYTE *p,*s; UWORD unroll=16,len,index; ULONG offset; if (p_dst>p_dst_post) goto overrun; if (p_src>p_src_max16) {unroll=1; if (p_src>p_src_max1) {if (p_src==p_src_post) break; goto literal;}} begin_unrolled_loop: index=((40543*((((p_src[0]<<4)^p_src[1])<<4)^p_src[2]))>>4) & 0xFFF; p=hash[index]; hash[index]=s=p_src; offset=s-p; if (offset>4095 || p>=1; control_bits++;} else {PS || PS || PS || PS || PS || PS || PS || PS || PS || PS || PS || PS || PS || s++; len=s-p_src-1; *p_dst++=((offset&0xF00)>>4)+(len-1); *p_dst++=offset&0xFF; p_src+=len; control=(control>>1)|0x8000; control_bits++;} end_unrolled_loop: if (--unroll) goto begin_unrolled_loop; if (control_bits==16) {*p_control=control&0xFF; *(p_control+1)=control>>8; p_control=p_dst; p_dst+=2; control=control_bits=0;} } control>>=16-control_bits; *p_control++=control&0xFF; *p_control++=control>>8; if (p_control==p_dst) p_dst-=2; *p_dst_len=p_dst-p_dst_first; return; overrun: fast_copy(p_src_first,p_dst_first+FLAG_BYTES,src_len); *p_dst_first=FLAG_COPY; *p_dst_len=src_len+FLAG_BYTES; } /******************************************************************************/ void lzrw1_decompress(p_src_first,src_len,p_dst_first,p_dst_len) /* Input : Specify input block using p_src_first and src_len. */ /* Input : Point p_dst_first to the start of the output zone. */ /* Input : Point p_dst_len to a ULONG to receive the output length. */ /* Input : Input block and output zone must not overlap. User knows */ /* Input : upperbound on output block length from earlier compression. */ /* Input : In any case, maximum expansion possible is eight times. */ /* Output : Length of output block written to *p_dst_len. */ /* Output : Output block in Mem[p_dst_first..p_dst_first+*p_dst_len-1]. */ /* Output : Writes only in Mem[p_dst_first..p_dst_first+*p_dst_len-1]. */ UBYTE *p_src_first, *p_dst_first; ULONG src_len, *p_dst_len; {UWORD controlbits=0, control; UBYTE *p_src=p_src_first+FLAG_BYTES, *p_dst=p_dst_first, *p_src_post=p_src_first+src_len; if (*p_src_first==FLAG_COPY) {fast_copy(p_src_first+FLAG_BYTES,p_dst_first,src_len-FLAG_BYTES); *p_dst_len=src_len-FLAG_BYTES; return;} while (p_src!=p_src_post) {if (controlbits==0) {control=*p_src++; control|=(*p_src++)<<8; controlbits=16;} if (control&1) {UWORD offset,len; UBYTE *p; offset=(*p_src&0xF0)<<4; len=1+(*p_src++&0xF); offset+=*p_src++&0xFF; p=p_dst-offset; while (len--) *p_dst++=*p++;} else *p_dst++=*p_src++; control>>=1; controlbits--; } *p_dst_len=p_dst-p_dst_first; } /******************************************************************************/ /* End of LZRW1.C */ /******************************************************************************/ } critcl::ccommand lzrw1 {dummy ip objc objv} { int e = TCL_OK, index, dlen; ULONG olen; UBYTE *data, *odata; Tcl_Obj *obj = Tcl_GetObjResult(ip); static char* cmds[] = { "compress", "decompress", NULL, }; if (objc != 3) { Tcl_WrongNumArgs(ip, 1, objv, "mode data"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(ip, objv[1], cmds, "mode", 0, &index) != TCL_OK) return TCL_ERROR; data = Tcl_GetByteArrayFromObj(objv[2], &dlen); switch (index) { case 0: /* compress data -> data */ odata = Tcl_SetByteArrayLength(obj, dlen + 256); lzrw1_compress(data, (ULONG) dlen, odata, &olen); break; case 1: /* decompress data -> data */ odata = Tcl_SetByteArrayLength(obj, 8 * dlen); lzrw1_decompress(data, (ULONG) dlen, odata, &olen); } Tcl_SetByteArrayLength(obj, (int) olen); return TCL_OK; } if {[info exists pkgtest] && $pkgtest} { set text "Hello world, world, world, world, world!" set small [lzrw1 compress $text] binary scan $small H* hex puts "compress = $hex" puts "restored = [lzrw1 decompress $small]" } critlib/mathf.README0000644000076500001200000000175607406356726014404 0ustar jcwadmin00000000000000Math functions in expr can be coded in Tcl ========================================== Rev 0.11: No longer need to specify arg count Rev 0.10: Initial release This is an adaption of the "intfun" and "doublefun" extension, written by Donal K. Fellows to define arbitrary math functions for use in expr: http://www.cs.man.ac.uk/~fellows/tcl/funcproc.c This code uses a single "mathf" command, with the return type specified as one of the arguments, and it allows passing a "curried" proc. But most importantly, this now uses the Tcl_Obj* API which is much faster. Here is an example: proc multiple {a b} { return [expr {$a * $b}] } mathf inch2cm double multiple 2.54 puts "1 foot = [expr {inch2cm(12)}] cm" There is one catch: the call to custom math functions cannot be used at global level, because the bytecode compiler will compile expr before the mathf command has actually created the function definition. But if placed inside a proc, everything should be fine. critlib/mathf.tcl0000644000076500001200000001051407406356242014212 0ustar jcwadmin00000000000000# An adaptation of Donal K. Fellows' math functions in Tcl # Original at http://www.cs.man.ac.uk/~fellows/tcl/funcproc.c package provide mathf 0.11 package require critcl critcl::ccode { /** ClientData implementation for mapping funcs to procs. */ struct fpinfo { char *funcname; int numargs; Tcl_Obj *procname; Tcl_ValueType type; }; /** Mathfunc handler. Uses a proc for the hard work. */ static int funcproc_handler(ClientData clientData, Tcl_Interp *ip, Tcl_Value *args, Tcl_Value *resultPtr) { struct fpinfo *info = (struct fpinfo *)clientData; Tcl_Obj *cmd; int e = TCL_OK, i; cmd = Tcl_DuplicateObj(info->procname); Tcl_IncrRefCount(cmd); for (i=0 ; e == TCL_OK && inumargs ; i++) { switch (args[i].type) { case TCL_INT: e = Tcl_ListObjAppendElement(ip, cmd, Tcl_NewLongObj(args[i].intValue)); break; case TCL_DOUBLE: e = Tcl_ListObjAppendElement(ip, cmd, Tcl_NewDoubleObj(args[i].doubleValue)); break; default: Tcl_AppendResult(ip, "unknown type of argument to ", info->funcname, NULL); e = TCL_ERROR; } } if (e == TCL_OK && Tcl_EvalObjEx(ip, cmd, TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL) != TCL_OK) { Tcl_AddErrorInfo(ip, "\n (while evaluating function "); Tcl_AddErrorInfo(ip, info->funcname); Tcl_AddErrorInfo(ip, ")"); e = TCL_ERROR; } Tcl_DecrRefCount(cmd); if (e != TCL_OK) return TCL_ERROR; resultPtr->type = info->type; switch (info->type) { case TCL_INT: e = Tcl_GetLongFromObj(ip, Tcl_GetObjResult(ip), &resultPtr->intValue); break; case TCL_DOUBLE: e =Tcl_GetDoubleFromObj(ip, Tcl_GetObjResult(ip), &resultPtr->doubleValue); break; default: /* I don't expect to reach this... */ Tcl_AppendResult(ip, "BAD RETURN TYPE", NULL); e = TCL_ERROR; } if (e != TCL_OK) { Tcl_AddErrorInfo(ip, "\n (while returning from function "); Tcl_AddErrorInfo(ip, info->funcname); Tcl_AddErrorInfo(ip, ")"); return TCL_ERROR; } return TCL_OK; } } # Install a new mathfunc handler. The clientdata argument specifies # what the return type is going to be. # @see Tcl_CreateMathFunc() critcl::ccommand _mathf {dummy interp objc objv} { struct fpinfo *info; Tcl_ValueType *tvec; int numargs, i, type; char *funcname; static char* types[] = { "int", "double", NULL }; if (objc < 5) { /* JCW: return type is an arg, proc can have extra args ("currying") */ Tcl_WrongNumArgs(interp, 1, objv, "funcname numparams rettype proc ?...?"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[2], &numargs) != TCL_OK || Tcl_GetIndexFromObj(interp, objv[3], types, "type", 0, &type) != TCL_OK) return TCL_ERROR; if (numargs<0) { Tcl_SetResult(interp, "number of function parameters must not be negative", TCL_STATIC); return TCL_ERROR; } funcname = Tcl_GetString(objv[1]); info = (struct fpinfo *)ckalloc(sizeof(struct fpinfo)); info->funcname = strcpy((char *)ckalloc(strlen(funcname)+1), funcname); info->numargs = numargs; info->procname = Tcl_NewListObj(objc - 4, objv + 4); info->type = type; Tcl_IncrRefCount(info->procname); /* never released */ /* Could use alloca() for the next line... */ /* Note the +1 so that a zero-sized alloc never happens... */ tvec = (Tcl_ValueType*)ckalloc(sizeof(Tcl_ValueType)*(numargs+1)); for (i=0 ; i */ /* Not needed if was alloca()ed... */ ckfree((void*)tvec); return TCL_OK; } # helper to deduce arg count (as suggested by Arjen Markus) proc mathf {fname rtype pname args} { set n [expr {[llength [info args $pname]] - [llength $args]}] eval [list _mathf $fname $n $rtype $pname] $args } if {[info exists pkgtest] && $pkgtest} { proc multiple {a b} { return [expr {$a * $b}] } mathf inch2cm double multiple 2.54 # note that immediate use is impossible: the bytecode compiler will barf # puts "1 foot = [expr {inch2cm(12)}] cm" proc doit {} { puts "1 foot = [expr {inch2cm(12)}] cm" puts "timing = [time {expr {inch2cm(12)}} 10000]" } doit } critlib/md5c.README0000644000076500001200000000213507375744065014127 0ustar jcwadmin00000000000000Yet another wrapper for RSA's MD5 message digest in C ===================================================== Rev 0.11: Fix filename typo Rev 0.10: Initial release This package defines a "md5c" command, which calculates the MD5 message digest. Its API is a bit unconventional in that it returns an object which can be treated as a 16-byte "string", but which can also be passed to the md5c command again as 2nd arg to progressively calculate an MD5. The simplest use is as follows: binary scan [md5c data] H* result puts "the result is: $result" To calculate md5c on a bunch of strings, say in a loop, you can do: set ctx [md5c ""] foreach x {aaa bbb ccc} { set ctx [md5c $x $ctx] } binary scan $ctx H* result puts "the result is: $result" Note that $ctx holds an object which is an intermediate MD5 "context", which can be used for further MD5 accumulation in successive calls. When a string representation is required, it is automatically finalized. Data is treated as binary, meaning that all input and output is going to be converted and treated as byte arrays in Tcl. critlib/md5c.tcl0000644000076500001200000000665507376413553013763 0ustar jcwadmin00000000000000# Wrapper for RSA's Message Digest in C package provide md5c 0.11 package require critcl critcl::cheaders md5c_c/md5.h critcl::csources md5c_c/md5.c critcl::ccode { #include "md5.h" #include #include #include static Tcl_ObjType md5_type; /* fast internal access representation */ static void md5_free_rep(Tcl_Obj* obj) { MD5_CTX* mp = (MD5_CTX*) obj->internalRep.otherValuePtr; free(mp); } static void md5_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup) { MD5_CTX* mp = (MD5_CTX*) obj->internalRep.otherValuePtr; dup->internalRep.otherValuePtr = malloc(sizeof *mp); memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp); dup->typePtr = &md5_type; } static void md5_string_rep(Tcl_Obj* obj) { unsigned char buf[16]; Tcl_Obj* temp; char* str; MD5_CTX dup = *(MD5_CTX*) obj->internalRep.otherValuePtr; MD5Final(buf, &dup); /* convert via a byte array to properly handle null bytes */ temp = Tcl_NewByteArrayObj(buf, sizeof buf); Tcl_IncrRefCount(temp); str = Tcl_GetStringFromObj(temp, &obj->length); obj->bytes = Tcl_Alloc(obj->length + 1); memcpy(obj->bytes, str, obj->length + 1); Tcl_DecrRefCount(temp); } static int md5_from_any(Tcl_Interp* ip, Tcl_Obj* obj) { assert(0); return TCL_ERROR; } static Tcl_ObjType md5_type = { "md5c", md5_free_rep, md5_dup_rep, md5_string_rep, md5_from_any }; } critcl::ccommand md5c {dummy ip objc objv} { MD5_CTX* mp; unsigned char* data; int size; Tcl_Obj* obj; //Tcl_RegisterObjType(&md5_type); if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(ip, 1, objv, "data ?context?"); return TCL_ERROR; } if (objc == 3) { if (objv[2]->typePtr != &md5_type && md5_from_any(ip, objv[2]) != TCL_OK) return TCL_ERROR; obj = objv[2]; if (Tcl_IsShared(obj)) obj = Tcl_DuplicateObj(obj); } else { obj = Tcl_NewObj(); mp = (MD5_CTX*) malloc(sizeof *mp); MD5Init(mp); if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) obj->typePtr->freeIntRepProc(obj); obj->internalRep.otherValuePtr = mp; obj->typePtr = &md5_type; } Tcl_SetObjResult(ip, obj); Tcl_IncrRefCount(obj); //!! huh? Tcl_InvalidateStringRep(obj); mp = (MD5_CTX*) obj->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[1], &size); MD5Update(mp, data, size); return TCL_OK; } if {[info exists pkgtest] && $pkgtest} { proc md5c_try {} { foreach {msg expected} { "" "d41d8cd98f00b204e9800998ecf8427e" "a" "0cc175b9c0f1b6a831c399e269772661" "abc" "900150983cd24fb0d6963f7d28e17f72" "message digest" "f96b697d7cb7938d525a2f31aaf161d0" "abcdefghijklmnopqrstuvwxyz" "c3fcd3d76192e4007dfb496cca67e13b" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" "d174ab98d277d9f5a5611c2c9f419d9f" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" "57edf4a22be3c955ac49da2e2107b67a" } { puts "testing: md5 \"$msg\"" binary scan [md5c $msg] H* computed puts "computed: $computed" if {0 != [string compare $computed $expected]} { puts "expected: $expected" puts "FAILED" } } foreach len {10 50 100 500 1000 5000 10000} { set blanks [format %$len.0s ""] puts "input length $len: [time {md5c $blanks} 1000]" } } md5c_try } critlib/md5c_c/0000755000076500001200000000000007250221507013530 5ustar jcwadmin00000000000000critlib/md5c_c/md5.c0000644000076500001200000002610507250221507014365 0ustar jcwadmin00000000000000/* *********************************************************************** ** md5.c -- the source code for MD5 routines ** ** RSA Data Security, Inc. MD5 Message-Digest Algorithm ** ** Created: 2/17/90 RLR ** ** Revised: 1/91 SRD,AJ,BSK,JT Reference C Version ** *********************************************************************** */ /* * Edited 7 May 93 by CP to change the interface to match that * of the MD5 routines in RSAREF. Due to this alteration, this * code is "derived from the RSA Data Security, Inc. MD5 Message- * Digest Algorithm". (See below.) */ /* *********************************************************************** ** Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. ** ** ** ** License to copy and use this software is granted provided that ** ** it is identified as the "RSA Data Security, Inc. MD5 Message- ** ** Digest Algorithm" in all material mentioning or referencing this ** ** software or this function. ** ** ** ** License is also granted to make and use derivative works ** ** provided that such works are identified as "derived from the RSA ** ** Data Security, Inc. MD5 Message-Digest Algorithm" in all ** ** material mentioning or referencing the derived work. ** ** ** ** RSA Data Security, Inc. makes no representations concerning ** ** either the merchantability of this software or the suitability ** ** of this software for any particular purpose. It is provided "as ** ** is" without express or implied warranty of any kind. ** ** ** ** These notices must be retained in any copies of any part of this ** ** documentation and/or software. ** *********************************************************************** */ #include "md5.h" /* *********************************************************************** ** Message-digest routines: ** ** To form the message digest for a message M ** ** (1) Initialize a context buffer mdContext using MD5Init ** ** (2) Call MD5Update on mdContext and M ** ** (3) Call MD5Final on mdContext ** ** The message digest is now in the bugffer passed to MD5Final ** *********************************************************************** */ static unsigned char PADDING[64] = { 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 }; /* F, G, H and I are basic MD5 functions */ #define F(x, y, z) (((x) & (y)) | ((~x) & (z))) #define G(x, y, z) (((x) & (z)) | ((y) & (~z))) #define H(x, y, z) ((x) ^ (y) ^ (z)) #define I(x, y, z) ((y) ^ ((x) | (~z))) /* ROTATE_LEFT rotates x left n bits */ #define ROTATE_LEFT(x, n) (((x) << (n)) | ((x) >> (32-(n)))) /* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4 */ /* Rotation is separate from addition to prevent recomputation */ #define FF(a, b, c, d, x, s, ac) \ {(a) += F ((b), (c), (d)) + (x) + (UINT4)(ac); \ (a) = ROTATE_LEFT ((a), (s)); \ (a) += (b); \ } #define GG(a, b, c, d, x, s, ac) \ {(a) += G ((b), (c), (d)) + (x) + (UINT4)(ac); \ (a) = ROTATE_LEFT ((a), (s)); \ (a) += (b); \ } #define HH(a, b, c, d, x, s, ac) \ {(a) += H ((b), (c), (d)) + (x) + (UINT4)(ac); \ (a) = ROTATE_LEFT ((a), (s)); \ (a) += (b); \ } #define II(a, b, c, d, x, s, ac) \ {(a) += I ((b), (c), (d)) + (x) + (UINT4)(ac); \ (a) = ROTATE_LEFT ((a), (s)); \ (a) += (b); \ } /* The routine MD5Init initializes the message-digest context mdContext. All fields are set to zero. */ void MD5Init (mdContext) MD5_CTX *mdContext; { mdContext->i[0] = mdContext->i[1] = (UINT4)0; /* Load magic initialization constants. */ mdContext->buf[0] = (UINT4)0x67452301L; mdContext->buf[1] = (UINT4)0xefcdab89L; mdContext->buf[2] = (UINT4)0x98badcfeL; mdContext->buf[3] = (UINT4)0x10325476L; } /* The routine MD5Update updates the message-digest context to account for the presence of each of the characters inBuf[0..inLen-1] in the message whose digest is being computed. */ void MD5Update (mdContext, inBuf, inLen) register MD5_CTX *mdContext; unsigned char *inBuf; unsigned int inLen; { register int i, ii; int mdi; UINT4 in[16]; /* compute number of bytes mod 64 */ mdi = (int)((mdContext->i[0] >> 3) & 0x3F); /* update number of bits */ if ((mdContext->i[0] + ((UINT4)inLen << 3)) < mdContext->i[0]) mdContext->i[1]++; mdContext->i[0] += ((UINT4)inLen << 3); mdContext->i[1] += ((UINT4)inLen >> 29); while (inLen--) { /* add new character to buffer, increment mdi */ mdContext->in[mdi++] = *inBuf++; /* transform if necessary */ if (mdi == 0x40) { for (i = 0, ii = 0; i < 16; i++, ii += 4) in[i] = (((UINT4)mdContext->in[ii+3]) << 24) | (((UINT4)mdContext->in[ii+2]) << 16) | (((UINT4)mdContext->in[ii+1]) << 8) | ((UINT4)mdContext->in[ii]); Transform (mdContext->buf, in); mdi = 0; } } } /* The routine MD5Final terminates the message-digest computation and ends with the desired message digest in mdContext->digest[0...15]. */ void MD5Final (digest, mdContext) unsigned char digest[16]; MD5_CTX *mdContext; { UINT4 in[16]; int mdi; unsigned int i, ii; unsigned int padLen; /* save number of bits */ in[14] = mdContext->i[0]; in[15] = mdContext->i[1]; /* compute number of bytes mod 64 */ mdi = (int)((mdContext->i[0] >> 3) & 0x3F); /* pad out to 56 mod 64 */ padLen = (mdi < 56) ? (56 - mdi) : (120 - mdi); MD5Update (mdContext, PADDING, padLen); /* append length in bits and transform */ for (i = 0, ii = 0; i < 14; i++, ii += 4) in[i] = (((UINT4)mdContext->in[ii+3]) << 24) | (((UINT4)mdContext->in[ii+2]) << 16) | (((UINT4)mdContext->in[ii+1]) << 8) | ((UINT4)mdContext->in[ii]); Transform (mdContext->buf, in); /* store buffer in digest */ for (i = 0, ii = 0; i < 4; i++, ii += 4) { digest[ii] = (unsigned char) (mdContext->buf[i] & 0xFF); digest[ii+1] = (unsigned char)((mdContext->buf[i] >> 8) & 0xFF); digest[ii+2] = (unsigned char)((mdContext->buf[i] >> 16) & 0xFF); digest[ii+3] = (unsigned char)((mdContext->buf[i] >> 24) & 0xFF); } } /* Basic MD5 step. Transforms buf based on in. Note that if the Mysterious Constants are arranged backwards in little-endian order and decrypted with the DES they produce OCCULT MESSAGES! */ void Transform(buf, in) register UINT4 *buf; register UINT4 *in; { register UINT4 a = buf[0], b = buf[1], c = buf[2], d = buf[3]; /* Round 1 */ #define S11 7 #define S12 12 #define S13 17 #define S14 22 FF ( a, b, c, d, in[ 0], S11, 0xD76AA478L); /* 1 */ FF ( d, a, b, c, in[ 1], S12, 0xE8C7B756L); /* 2 */ FF ( c, d, a, b, in[ 2], S13, 0x242070DBL); /* 3 */ FF ( b, c, d, a, in[ 3], S14, 0xC1BDCEEEL); /* 4 */ FF ( a, b, c, d, in[ 4], S11, 0xF57C0FAFL); /* 5 */ FF ( d, a, b, c, in[ 5], S12, 0x4787C62AL); /* 6 */ FF ( c, d, a, b, in[ 6], S13, 0xA8304613L); /* 7 */ FF ( b, c, d, a, in[ 7], S14, 0xFD469501L); /* 8 */ FF ( a, b, c, d, in[ 8], S11, 0x698098D8L); /* 9 */ FF ( d, a, b, c, in[ 9], S12, 0x8B44F7AFL); /* 10 */ FF ( c, d, a, b, in[10], S13, 0xFFFF5BB1L); /* 11 */ FF ( b, c, d, a, in[11], S14, 0x895CD7BEL); /* 12 */ FF ( a, b, c, d, in[12], S11, 0x6B901122L); /* 13 */ FF ( d, a, b, c, in[13], S12, 0xFD987193L); /* 14 */ FF ( c, d, a, b, in[14], S13, 0xA679438EL); /* 15 */ FF ( b, c, d, a, in[15], S14, 0x49B40821L); /* 16 */ /* Round 2 */ #define S21 5 #define S22 9 #define S23 14 #define S24 20 GG ( a, b, c, d, in[ 1], S21, 0xF61E2562L); /* 17 */ GG ( d, a, b, c, in[ 6], S22, 0xC040B340L); /* 18 */ GG ( c, d, a, b, in[11], S23, 0x265E5A51L); /* 19 */ GG ( b, c, d, a, in[ 0], S24, 0xE9B6C7AAL); /* 20 */ GG ( a, b, c, d, in[ 5], S21, 0xD62F105DL); /* 21 */ GG ( d, a, b, c, in[10], S22, 0x02441453L); /* 22 */ GG ( c, d, a, b, in[15], S23, 0xD8A1E681L); /* 23 */ GG ( b, c, d, a, in[ 4], S24, 0xE7D3FBC8L); /* 24 */ GG ( a, b, c, d, in[ 9], S21, 0x21E1CDE6L); /* 25 */ GG ( d, a, b, c, in[14], S22, 0xC33707D6L); /* 26 */ GG ( c, d, a, b, in[ 3], S23, 0xF4D50D87L); /* 27 */ GG ( b, c, d, a, in[ 8], S24, 0x455A14EDL); /* 28 */ GG ( a, b, c, d, in[13], S21, 0xA9E3E905L); /* 29 */ GG ( d, a, b, c, in[ 2], S22, 0xFCEFA3F8L); /* 30 */ GG ( c, d, a, b, in[ 7], S23, 0x676F02D9L); /* 31 */ GG ( b, c, d, a, in[12], S24, 0x8D2A4C8AL); /* 32 */ /* Round 3 */ #define S31 4 #define S32 11 #define S33 16 #define S34 23 HH ( a, b, c, d, in[ 5], S31, 0xFFFA3942L); /* 33 */ HH ( d, a, b, c, in[ 8], S32, 0x8771F681L); /* 34 */ HH ( c, d, a, b, in[11], S33, 0x6D9D6122L); /* 35 */ HH ( b, c, d, a, in[14], S34, 0xFDE5380CL); /* 36 */ HH ( a, b, c, d, in[ 1], S31, 0xA4BEEA44L); /* 37 */ HH ( d, a, b, c, in[ 4], S32, 0x4BDECFA9L); /* 38 */ HH ( c, d, a, b, in[ 7], S33, 0xF6BB4B60L); /* 39 */ HH ( b, c, d, a, in[10], S34, 0xBEBFBC70L); /* 40 */ HH ( a, b, c, d, in[13], S31, 0x289B7EC6L); /* 41 */ HH ( d, a, b, c, in[ 0], S32, 0xEAA127FAL); /* 42 */ HH ( c, d, a, b, in[ 3], S33, 0xD4EF3085L); /* 43 */ HH ( b, c, d, a, in[ 6], S34, 0x04881D05L); /* 44 */ HH ( a, b, c, d, in[ 9], S31, 0xD9D4D039L); /* 45 */ HH ( d, a, b, c, in[12], S32, 0xE6DB99E5L); /* 46 */ HH ( c, d, a, b, in[15], S33, 0x1FA27CF8L); /* 47 */ HH ( b, c, d, a, in[ 2], S34, 0xC4AC5665L); /* 48 */ /* Round 4 */ #define S41 6 #define S42 10 #define S43 15 #define S44 21 II ( a, b, c, d, in[ 0], S41, 0xF4292244L); /* 49 */ II ( d, a, b, c, in[ 7], S42, 0x432AFF97L); /* 50 */ II ( c, d, a, b, in[14], S43, 0xAB9423A7L); /* 51 */ II ( b, c, d, a, in[ 5], S44, 0xFC93A039L); /* 52 */ II ( a, b, c, d, in[12], S41, 0x655B59C3L); /* 53 */ II ( d, a, b, c, in[ 3], S42, 0x8F0CCC92L); /* 54 */ II ( c, d, a, b, in[10], S43, 0xFFEFF47DL); /* 55 */ II ( b, c, d, a, in[ 1], S44, 0x85845DD1L); /* 56 */ II ( a, b, c, d, in[ 8], S41, 0x6FA87E4FL); /* 57 */ II ( d, a, b, c, in[15], S42, 0xFE2CE6E0L); /* 58 */ II ( c, d, a, b, in[ 6], S43, 0xA3014314L); /* 59 */ II ( b, c, d, a, in[13], S44, 0x4E0811A1L); /* 60 */ II ( a, b, c, d, in[ 4], S41, 0xF7537E82L); /* 61 */ II ( d, a, b, c, in[11], S42, 0xBD3AF235L); /* 62 */ II ( c, d, a, b, in[ 2], S43, 0x2AD7D2BBL); /* 63 */ II ( b, c, d, a, in[ 9], S44, 0xEB86D391L); /* 64 */ buf[0] += a; buf[1] += b; buf[2] += c; buf[3] += d; } critlib/md5c_c/md5.h0000644000076500001200000000647007250221507014375 0ustar jcwadmin00000000000000#ifndef MD5_H #define MD5_H /* *********************************************************************** ** md5.h -- header file for implementation of MD5 ** ** RSA Data Security, Inc. MD5 Message-Digest Algorithm ** ** Created: 2/17/90 RLR ** ** Revised: 12/27/90 SRD,AJ,BSK,JT Reference C version ** ** Revised (for MD5): RLR 4/27/91 ** ** -- G modified to have y&~z instead of y&z ** ** -- FF, GG, HH modified to add in last register done ** ** -- Access pattern: round 2 works mod 5, round 3 works mod 3 ** ** -- distinct additive constant for each step ** ** -- round 4 added, working mod 7 ** *********************************************************************** */ /* * Edited 7 May 93 by CP to change the interface to match that * of the MD5 routines in RSAREF. Due to this alteration, this * code is "derived from the RSA Data Security, Inc. MD5 Message- * Digest Algorithm". (See below.) Also added argument names * to the prototypes. */ /* *********************************************************************** ** Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. ** ** ** ** License to copy and use this software is granted provided that ** ** it is identified as the "RSA Data Security, Inc. MD5 Message- ** ** Digest Algorithm" in all material mentioning or referencing this ** ** software or this function. ** ** ** ** License is also granted to make and use derivative works ** ** provided that such works are identified as "derived from the RSA ** ** Data Security, Inc. MD5 Message-Digest Algorithm" in all ** ** material mentioning or referencing the derived work. ** ** ** ** RSA Data Security, Inc. makes no representations concerning ** ** either the merchantability of this software or the suitability ** ** of this software for any particular purpose. It is provided "as ** ** is" without express or implied warranty of any kind. ** ** ** ** These notices must be retained in any copies of any part of this ** ** documentation and/or software. ** *********************************************************************** */ /* typedef a 32-bit type */ #ifdef __alpha typedef unsigned int UINT4; #else typedef unsigned long int UINT4; #endif /* Data structure for MD5 (Message-Digest) computation */ typedef struct { UINT4 buf[4]; /* scratch buffer */ UINT4 i[2]; /* number of _bits_ handled mod 2^64 */ unsigned char in[64]; /* input buffer */ } MD5_CTX; void MD5Init (MD5_CTX *mdContext); void MD5Update (MD5_CTX *mdContext, unsigned char *buf, unsigned int len); void MD5Final (unsigned char digest[16], MD5_CTX *mdContext); void Transform (UINT4 *buf, UINT4 *in); #endif critlib/md5pure.tcl0000644000076500001200000003166607375334073014512 0ustar jcwadmin00000000000000################################################## # # md5.tcl - MD5 in Tcl # Author: Don Libes , July 1999 # Version 1.2.0 # # MD5 defined by RFC 1321, "The MD5 Message-Digest Algorithm" # HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication" # # Most of the comments below come right out of RFC 1321; That's why # they have such peculiar numbers. In addition, I have retained # original syntax, bugs in documentation (yes, really), etc. from the # RFC. All remaining bugs are mine. # # HMAC implementation by D. J. Hagberg and # is based on C code in RFC 2104. # # For more info, see: http://expect.nist.gov/md5pure # # - Don ################################################## namespace eval md5pure { variable i variable t variable T set i 0 foreach t { 0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee 0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501 0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be 0x6b901122 0xfd987193 0xa679438e 0x49b40821 0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa 0xd62f105d 0x2441453 0xd8a1e681 0xe7d3fbc8 0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed 0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a 0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c 0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70 0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05 0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665 0xf4292244 0x432aff97 0xab9423a7 0xfc93a039 0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1 0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1 0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391 } { incr i set T($i) [expr $t] } } # test md5pure # # This proc is not necessary during runtime and may be omitted if you # are simply inserting this file into a production program. # proc md5pure::test {} { foreach {msg expected} { "" "d41d8cd98f00b204e9800998ecf8427e" "a" "0cc175b9c0f1b6a831c399e269772661" "abc" "900150983cd24fb0d6963f7d28e17f72" "message digest" "f96b697d7cb7938d525a2f31aaf161d0" "abcdefghijklmnopqrstuvwxyz" "c3fcd3d76192e4007dfb496cca67e13b" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" "d174ab98d277d9f5a5611c2c9f419d9f" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" "57edf4a22be3c955ac49da2e2107b67a" } { puts "testing: md5 \"$msg\"" set computed [md5 $msg] puts "expected: $expected" puts "computed: $computed" if {0 != [string compare $computed $expected]} { puts "FAILED" } else { puts "SUCCEEDED" } } } # time md5pure # # This proc is not necessary during runtime and may be omitted if you # are simply inserting this file into a production program. # proc md5pure::time {} { foreach len {10 50 100 500 1000 5000 10000} { set time [::time {md5 [format %$len.0s ""]} 10] regexp "\[0-9]*" $time msec puts "input length $len: [expr {$msec/1000}] milliseconds per interation" } } proc md5pure::md5 {msg} { variable T # # 3.1 Step 1. Append Padding Bits # set msgLen [string length $msg] set padLen [expr {56 - $msgLen%64}] if {$msgLen % 64 > 56} { incr padLen 64 } # pad even if no padding required if {$padLen == 0} { incr padLen 64 } # append single 1b followed by 0b's append msg [binary format "a$padLen" \200] # # 3.2 Step 2. Append Length # # RFC doesn't say whether to use little- or big-endian # code demonstrates little-endian # This step limits our input to size 2^32b or 2^24B append msg [binary format "i1i1" [expr {8*$msgLen}] 0] # # 3.3 Step 3. Initialize MD Buffer # set A [expr 0x67452301] set B [expr 0xefcdab89] set C [expr 0x98badcfe] set D [expr 0x10325476] # # 3.4 Step 4. Process Message in 16-Word Blocks # # process each 16-word block # RFC doesn't say whether to use little- or big-endian # code says little-endian binary scan $msg i* blocks set i 0 foreach b $blocks { set M($i) $b incr i } set blockLen [array size M] for {set i 0} {$i < $blockLen/16} {incr i} { # copy block i into X for {set j 0} {$j<16} {incr j} { set X($j) $M([expr $i*16+$j]) } # Save A as AA, B as BB, C as CC, and D as DD. set AA $A set BB $B set CC $C set DD $D # Round 1. # Let [abcd k s i] denote the operation # a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s). # [ABCD 0 7 1] [DABC 1 12 2] [CDAB 2 17 3] [BCDA 3 22 4] set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(0) + $T(1) }] 7]}] set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(1) + $T(2) }] 12]}] set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(2) + $T(3) }] 17]}] set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(3) + $T(4) }] 22]}] # [ABCD 4 7 5] [DABC 5 12 6] [CDAB 6 17 7] [BCDA 7 22 8] set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(4) + $T(5) }] 7]}] set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(5) + $T(6) }] 12]}] set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(6) + $T(7) }] 17]}] set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(7) + $T(8) }] 22]}] # [ABCD 8 7 9] [DABC 9 12 10] [CDAB 10 17 11] [BCDA 11 22 12] set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(8) + $T(9) }] 7]}] set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(9) + $T(10)}] 12]}] set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(10) + $T(11)}] 17]}] set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(11) + $T(12)}] 22]}] # [ABCD 12 7 13] [DABC 13 12 14] [CDAB 14 17 15] [BCDA 15 22 16] set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(12) + $T(13)}] 7]}] set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(13) + $T(14)}] 12]}] set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(14) + $T(15)}] 17]}] set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(15) + $T(16)}] 22]}] # Round 2. # Let [abcd k s i] denote the operation # a = b + ((a + G(b,c,d) + X[k] + T[i]) <<< s). # Do the following 16 operations. # [ABCD 1 5 17] [DABC 6 9 18] [CDAB 11 14 19] [BCDA 0 20 20] set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(1) + $T(17)}] 5]}] set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(6) + $T(18)}] 9]}] set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(11) + $T(19)}] 14]}] set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(0) + $T(20)}] 20]}] # [ABCD 5 5 21] [DABC 10 9 22] [CDAB 15 14 23] [BCDA 4 20 24] set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(5) + $T(21)}] 5]}] set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(10) + $T(22)}] 9]}] set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(15) + $T(23)}] 14]}] set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(4) + $T(24)}] 20]}] # [ABCD 9 5 25] [DABC 14 9 26] [CDAB 3 14 27] [BCDA 8 20 28] set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(9) + $T(25)}] 5]}] set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(14) + $T(26)}] 9]}] set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(3) + $T(27)}] 14]}] set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(8) + $T(28)}] 20]}] # [ABCD 13 5 29] [DABC 2 9 30] [CDAB 7 14 31] [BCDA 12 20 32] set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(13) + $T(29)}] 5]}] set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(2) + $T(30)}] 9]}] set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(7) + $T(31)}] 14]}] set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(12) + $T(32)}] 20]}] # Round 3. # Let [abcd k s t] [sic] denote the operation # a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s). # Do the following 16 operations. # [ABCD 5 4 33] [DABC 8 11 34] [CDAB 11 16 35] [BCDA 14 23 36] set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(5) + $T(33)}] 4]}] set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(8) + $T(34)}] 11]}] set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(11) + $T(35)}] 16]}] set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(14) + $T(36)}] 23]}] # [ABCD 1 4 37] [DABC 4 11 38] [CDAB 7 16 39] [BCDA 10 23 40] set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(1) + $T(37)}] 4]}] set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(4) + $T(38)}] 11]}] set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(7) + $T(39)}] 16]}] set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(10) + $T(40)}] 23]}] # [ABCD 13 4 41] [DABC 0 11 42] [CDAB 3 16 43] [BCDA 6 23 44] set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(13) + $T(41)}] 4]}] set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(0) + $T(42)}] 11]}] set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(3) + $T(43)}] 16]}] set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(6) + $T(44)}] 23]}] # [ABCD 9 4 45] [DABC 12 11 46] [CDAB 15 16 47] [BCDA 2 23 48] set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(9) + $T(45)}] 4]}] set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(12) + $T(46)}] 11]}] set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(15) + $T(47)}] 16]}] set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(2) + $T(48)}] 23]}] # Round 4. # Let [abcd k s t] [sic] denote the operation # a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s). # Do the following 16 operations. # [ABCD 0 6 49] [DABC 7 10 50] [CDAB 14 15 51] [BCDA 5 21 52] set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(0) + $T(49)}] 6]}] set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(7) + $T(50)}] 10]}] set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(14) + $T(51)}] 15]}] set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(5) + $T(52)}] 21]}] # [ABCD 12 6 53] [DABC 3 10 54] [CDAB 10 15 55] [BCDA 1 21 56] set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(12) + $T(53)}] 6]}] set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(3) + $T(54)}] 10]}] set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(10) + $T(55)}] 15]}] set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(1) + $T(56)}] 21]}] # [ABCD 8 6 57] [DABC 15 10 58] [CDAB 6 15 59] [BCDA 13 21 60] set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(8) + $T(57)}] 6]}] set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(15) + $T(58)}] 10]}] set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(6) + $T(59)}] 15]}] set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(13) + $T(60)}] 21]}] # [ABCD 4 6 61] [DABC 11 10 62] [CDAB 2 15 63] [BCDA 9 21 64] set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(4) + $T(61)}] 6]}] set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(11) + $T(62)}] 10]}] set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(2) + $T(63)}] 15]}] set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(9) + $T(64)}] 21]}] # Then perform the following additions. (That is increment each # of the four registers by the value it had before this block # was started.) incr A $AA incr B $BB incr C $CC incr D $DD } # 3.5 Step 5. Output # ... begin with the low-order byte of A, and end with the high-order byte # of D. return [bytes $A][bytes $B][bytes $C][bytes $D] } # bitwise left-rotate proc md5pure::<<< {x i} { # This works by bitwise-ORing together right piece and left # piece so that the (original) right piece becomes the left # piece and vice versa. # # The (original) right piece is a simple left shift. # The (original) left piece should be a simple right shift # but Tcl does sign extension on right shifts so we # shift it 1 bit, mask off the sign, and finally shift # it the rest of the way. expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))} } proc md5pure::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}} proc md5pure::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}} proc md5pure::H {x y z} {expr {$x ^ $y ^ $z}} proc md5pure::I {x y z} {expr {$y ^ ($x | (~$z))}} proc md5pure::byte0 {i} {expr {0xff & $i}} proc md5pure::byte1 {i} {expr {(0xff00 & $i) >> 8}} proc md5pure::byte2 {i} {expr {(0xff0000 & $i) >> 16}} proc md5pure::byte3 {i} {expr {((0xff000000 & $i) >> 24) & 0xff}} proc md5pure::bytes {i} { format %0.2x%0.2x%0.2x%0.2x [byte0 $i] [byte1 $i] [byte2 $i] [byte3 $i] } # hmac: hash for message authentication proc md5pure::hmac {key text} { # if key is longer than 64 bytes, reset it to MD5(key). If shorter, # pad it out with null (\x00) chars. set keyLen [string length $key] if {$keyLen > 64} { set key [binary format H32 [md5 $key]] set keyLen [string length $key] } # ensure the key is padded out to 64 chars with nulls. set padLen [expr {64 - $keyLen}] append key [binary format "a$padLen" {}] # Split apart the key into a list of 16 little-endian words binary scan $key i16 blocks # XOR key with ipad and opad values set k_ipad {} set k_opad {} foreach i $blocks { append k_ipad [binary format i [expr {$i ^ 0x36363636}]] append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]] } # Perform inner md5, appending its results to the outer key append k_ipad $text append k_opad [binary format H* [md5 $k_ipad]] # Perform outer md5 md5 $k_opad } package provide md5pure 1.2 critlib/mvec.README0000644000076500001200000000117407377006662014227 0ustar jcwadmin00000000000000Core primitives for use by the Vkit vector engine ================================================= Rev 0.12: Also allow variable name instead of channel for mmap Rev 0.11: Folded into the Vkit project Rev 0.10: Initial release This package defines "mmap" for support of read-only memory-mapped files, and an "mvec" command which encapsulates indexed access to a variety of vector formats (such as 1/2/4/8/16/32/64-bit ints, 32/64-bit floats, as well as the reverse-endian encoding of these). For details about this package (which is work-in-progress), see: http://mini.net/tcl/2487.html http://mini.net/tcl/2489.html critlib/mvec.tcl0000644000076500001200000003212707377040565014056 0ustar jcwadmin00000000000000# Memory based vectors, this is part of the VKIT vector engine # $Id: mvec.tcl,v 1.5 2001/11/22 00:06:13 jcw Exp $ package provide mvec 0.12 package require critcl critcl::ccode { #include #include #include #include #include } critcl::ccode { static Tcl_ObjType mmap_type; /* convert channel name to mmap'ed representation */ static void mmap_free_rep(Tcl_Obj* obj) { long n = (long) obj->internalRep.twoPtrValue.ptr1; if (n >= 0) { int e = munmap(obj->internalRep.twoPtrValue.ptr2, (size_t) n); assert(e == 0); } else { Tcl_DecrRefCount((Tcl_Obj*) obj->internalRep.twoPtrValue.ptr2); } } static void mmap_dup_rep(Tcl_Obj *obj, Tcl_Obj* dup) { /* never need to duplicate, since mvec objects are immutable */ assert(0); } static void mmap_string_rep(Tcl_Obj* a) { /* never loses the string representation, so this can't happen */ assert(0); } static int mmap_from_any(Tcl_Interp* ip, Tcl_Obj* obj) { struct stat sb; Tcl_Channel cp; ClientData fd; void *p; Tcl_Obj *value; if (ip == NULL) return TCL_ERROR; value = Tcl_ObjGetVar2(ip, obj, NULL, TCL_GLOBAL_ONLY); if (value != NULL) { Tcl_IncrRefCount(value); obj->internalRep.twoPtrValue.ptr1 = (void*) -1; obj->internalRep.twoPtrValue.ptr2 = value; obj->typePtr = &mmap_type; return TCL_OK; } cp = Tcl_GetChannel(ip, Tcl_GetStringFromObj(obj, NULL), NULL); if (cp == NULL || Tcl_GetChannelHandle(cp, TCL_READABLE, &fd) != TCL_OK) { Tcl_SetResult(ip, "bad channel", TCL_STATIC); return TCL_ERROR; } if (fstat((int) fd, &sb) == 0) { p = mmap(NULL, sb.st_size, PROT_READ, MAP_PRIVATE, (int) fd, 0); if (p != MAP_FAILED) { if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) obj->typePtr->freeIntRepProc(obj); obj->internalRep.twoPtrValue.ptr1 = (void*) sb.st_size; obj->internalRep.twoPtrValue.ptr2 = p; obj->typePtr = &mmap_type; return TCL_OK; } } Tcl_SetResult(ip, Tcl_PosixError(ip), TCL_STATIC); return TCL_ERROR; } static Tcl_ObjType mmap_type = { "mmap", mmap_free_rep, mmap_dup_rep, mmap_string_rep, mmap_from_any }; } critcl::ccommand mmap {dummy ip objc objv} { long size; char* data; /* Tcl_RegisterObjType(&mmap_type); */ if (objc != 2 && objc != 4) { Tcl_WrongNumArgs(ip, 1, objv, "channel ?offset length?"); return TCL_ERROR; } if (objv[1]->typePtr != &mmap_type && mmap_from_any(ip, objv[1]) != TCL_OK) return TCL_ERROR; data = objv[1]->internalRep.twoPtrValue.ptr2; size = (long) objv[1]->internalRep.twoPtrValue.ptr1; if (size < 0) { int n; data = Tcl_GetByteArrayFromObj((Tcl_Obj*) data, &n); size = n; } if (objc < 4) { Tcl_SetLongObj(Tcl_GetObjResult(ip), size); } else { long offset, length; if (Tcl_GetLongFromObj(ip, objv[2], &offset) != TCL_OK || Tcl_GetLongFromObj(ip, objv[3], &length) != TCL_OK) return TCL_ERROR; if (offset < 0) offset = 0; if (offset + length > size) length = size - offset; if (length < 0) length = 0; Tcl_SetByteArrayObj(Tcl_GetObjResult(ip), data + offset, length); } return TCL_OK; } critcl::ccode { /* keep a cache of small ints, instead of reallocating them */ #define LO_SMALL -128 #define HI_SMALL 128 #define SmallIntObj(i) smallvec[i] static Tcl_Obj **smallvec = NULL; static Tcl_Obj *mvec_get_minus(char* data, int index) { return Tcl_NewIntObj(index); } static Tcl_Obj *mvec_get_zero(char* data, int index) { return (Tcl_Obj*) data; } static Tcl_Obj *mvec_get_1(char* data, int index) { return SmallIntObj((data[index>>3] >> (index&7)) & 1); } static Tcl_Obj *mvec_get_2(char* data, int index) { return SmallIntObj((data[index>>2] >> ((index&3) << 1)) & 3); } static Tcl_Obj *mvec_get_4(char* data, int index) { return SmallIntObj((data[index>>1] >> ((index&1) << 2)) & 15); } static Tcl_Obj *mvec_get_8(char* data, int index) { return SmallIntObj(data[index]); } static Tcl_Obj *mvec_get_16(char* data, int index) { return Tcl_NewIntObj(((short*) data)[index]); } static Tcl_Obj *mvec_get_32(char* data, int index) { return Tcl_NewLongObj(((long*) data)[index]); } static Tcl_Obj *mvec_get_64(char* data, int index) { return Tcl_NewByteArrayObj(data + 8 * index, 8); } static Tcl_Obj *mvec_get_32f(char* data, int index) { return Tcl_NewDoubleObj(((float*) data)[index]); } static Tcl_Obj *mvec_get_64f(char* data, int index) { return Tcl_NewDoubleObj(((double*) data)[index]); } static Tcl_Obj * mvec_get_16r(char* data, int index) { char buf[2]; data += index * sizeof buf; buf[1] = data[0]; buf[0] = data[1]; return Tcl_NewIntObj(*(short*) buf); } static Tcl_Obj * mvec_get_32r(char* data, int index) { char buf[4]; data += index * sizeof buf; buf[3] = data[0]; buf[2] = data[1]; buf[1] = data[2]; buf[0] = data[3]; return Tcl_NewIntObj(*(long*) buf); } static Tcl_Obj * mvec_get_32fr(char* data, int index) { char buf[4]; data += index * sizeof buf; buf[3] = data[0]; buf[2] = data[1]; buf[1] = data[2]; buf[0] = data[3]; return Tcl_NewDoubleObj(*(float*) buf); } static Tcl_Obj * mvec_get_64r(char* data, int index) { char buf[8]; int i = sizeof buf; data += index * sizeof buf; while (--i >= 0) buf[i] = *data++; return Tcl_NewByteArrayObj(buf, sizeof buf); } static Tcl_Obj * mvec_get_64fr(char* data, int index) { char buf[8]; int i = sizeof buf; data += index * sizeof buf; while (--i >= 0) buf[i] = *data++; return Tcl_NewDoubleObj(*(double*) buf); } /* the entries of the following three static arrays must be consistent */ static char *modes[] = { "-", "0", "1", "2", "4", "8", "16", "16r", "32", "32r", "32f", "32fr", "64", "64r", "64f", "64fr", NULL, }; static Tcl_Obj *(*funtab[])(char*,int) = { mvec_get_minus, mvec_get_zero, mvec_get_1, mvec_get_2, mvec_get_4, mvec_get_8, mvec_get_16, mvec_get_16r, mvec_get_32, mvec_get_32r, mvec_get_32f, mvec_get_32fr, mvec_get_64, mvec_get_64r, mvec_get_64f, mvec_get_64fr, }; static char shifts[] = { -1, -1, 0, 1, 2, 3, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, }; typedef struct { Tcl_Obj* dobj; long offset; int count; int mode; } MemVecInfo; static Tcl_ObjType mvec_type; /* fast internal access representation */ static void mvec_free_rep(Tcl_Obj *obj) { MemVecInfo* vi = (MemVecInfo*) obj->internalRep.otherValuePtr; Tcl_DecrRefCount(vi->dobj); free(vi); } static void mvec_dup_rep(Tcl_Obj *obj, Tcl_Obj* dup) { /* never need to duplicate, since mvec objects are immutable */ assert(0); } static void mvec_string_rep(Tcl_Obj *obj) { /* never loses the string representation, so this can't happen */ assert(0); } static int mvec_from_any(Tcl_Interp *ip, Tcl_Obj *obj) { int oc; Tcl_Obj **ov; MemVecInfo vi; vi.mode = vi.offset = vi.count = -1; if (ip == NULL || Tcl_ListObjGetElements(ip, obj, &oc, &ov) != TCL_OK) return TCL_ERROR; if (oc < 2) { Tcl_WrongNumArgs(ip, 0, ov, "(mvec) mode ..."); return TCL_ERROR; } if (Tcl_GetIndexFromObj(ip, ov[0], modes, "mode", 0, &vi.mode) != TCL_OK) { if (Tcl_GetIntFromObj(ip, ov[oc-1], &vi.count) != TCL_OK) return TCL_ERROR; Tcl_ResetResult(ip); vi.dobj = Tcl_DuplicateObj(obj); } else { long size; int length = 0; vi.dobj = ov[1]; if (oc < 4) { if (vi.mode > 1) (void) Tcl_GetByteArrayFromObj(ov[1], &length); if (oc == 3 && Tcl_GetIntFromObj(ip, ov[2], &vi.count) != TCL_OK) return TCL_ERROR; } else if (oc == 4 && vi.mode > 1) { if (ov[1]->typePtr != &mmap_type && mmap_from_any(ip, ov[1]) != TCL_OK || Tcl_GetLongFromObj(ip, ov[2], &vi.offset) != TCL_OK || Tcl_GetIntFromObj(ip, ov[3], &vi.count) != TCL_OK) return TCL_ERROR; size = (long) ov[1]->internalRep.twoPtrValue.ptr1; if (size < 0) { int i; Tcl_Obj* value = (Tcl_Obj*) ov[1]->internalRep.twoPtrValue.ptr2; Tcl_GetByteArrayFromObj(value, &i); size = i; } length = size - vi.offset; } else { Tcl_WrongNumArgs(ip, 0, ov, "(mvec) mode ?data ?cnt?? ?chan off cnt?"); return TCL_ERROR; } /* refine this code so count is always within the available data */ if (vi.count < 0) vi.count = vi.mode > 1 ? ((long) length << 3) >> shifts[vi.mode] : 0; } Tcl_IncrRefCount(vi.dobj); Tcl_GetStringFromObj(obj, NULL); assert(obj->bytes); if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) obj->typePtr->freeIntRepProc(obj); obj->internalRep.otherValuePtr = memcpy(malloc(sizeof vi), &vi, sizeof vi); obj->typePtr = &mvec_type; return TCL_OK; } static Tcl_ObjType mvec_type = { "mvec", mvec_free_rep, mvec_dup_rep, mvec_string_rep, mvec_from_any }; } critcl::ccommand mvec {dummy ip objc objv} { Tcl_Obj *obj; MemVecInfo *vi; int e = TCL_OK; /* set up the cached small ints once, this will never be released */ if (smallvec == NULL) { int i, n = HI_SMALL - LO_SMALL; smallvec = ((Tcl_Obj**) Tcl_Alloc(n * sizeof (Tcl_Obj*))) - LO_SMALL; for (i = LO_SMALL; i < HI_SMALL; ++i) Tcl_IncrRefCount(smallvec[i] = Tcl_NewIntObj(i)); } /* Tcl_RegisterObjType(&mvec_type); */ if (objc < 2 || objc > 6) { Tcl_WrongNumArgs(ip, 1, objv, "vec ?index? ?count? ?pred? ?cond?"); return TCL_ERROR; } obj = objv[1]; if (obj->typePtr != &mvec_type && mvec_from_any(ip, obj) != TCL_OK) return TCL_ERROR; vi = (MemVecInfo*) obj->internalRep.otherValuePtr; if (objc == 2) { Tcl_Obj *elems[3]; elems[0] = Tcl_NewIntObj(vi->count); if (vi->mode >= 0) { elems[1] = Tcl_NewStringObj(modes[vi->mode], -1); elems[2] = smallvec[shifts[vi->mode]]; } else { elems[1] = Tcl_NewObj(); elems[2] = obj; } Tcl_SetObjResult(ip, Tcl_NewListObj(3, elems)); } else { int pos, defn; char *data; Tcl_Obj *defv = vi->dobj; if (vi->mode < 0) { if (Tcl_IsShared(defv)) { defv = Tcl_DuplicateObj(defv); Tcl_IncrRefCount(defv); Tcl_DecrRefCount(vi->dobj); vi->dobj = defv; } e = Tcl_ListObjLength(ip, defv, &defn); assert(e == TCL_OK); if (objc == 3) { e = Tcl_ListObjReplace(ip, defv, defn-1, 1, 1, objv + 2); assert(e == TCL_OK); return Tcl_EvalObjEx(ip, defv, TCL_EVAL_DIRECT); } } if (Tcl_GetIntFromObj(ip, objv[2], &pos) != TCL_OK) return TCL_ERROR; if (pos < 0 || (pos >= vi->count && vi->mode > 1)) { Tcl_SetResult(ip, "index is out of range", TCL_STATIC); return TCL_ERROR; } if (vi->offset >= 0) { data = (char*) defv->internalRep.twoPtrValue.ptr2 + vi->offset; if ((long) defv->internalRep.twoPtrValue.ptr1 < 0) data = Tcl_GetByteArrayFromObj((Tcl_Obj*) data, NULL); } else if (vi->mode > 1) data = Tcl_GetByteArrayFromObj(defv, NULL); else data = (char*) defv; if (objc == 3) { assert(vi->mode >= 0); Tcl_SetObjResult(ip, funtab[vi->mode](data, pos)); } else { int i, count; Tcl_Obj *(*getter)(char*,int) = vi->mode >= 0 ? funtab[vi->mode] : NULL; Tcl_Obj *r = Tcl_NewObj(); Tcl_IncrRefCount(r); if (Tcl_GetIntFromObj(ip, objv[3], &count) != TCL_OK) return TCL_ERROR; if (count < 0) count = vi->count; if (count > vi->count - pos && (vi->mode < 0 || vi->mode > 1)) count = vi->count - pos; assert(count >= 0); if (vi->mode >= 0 && objc == 4) { /* use fast mode if real vector and no predicate or condition */ Tcl_Obj **ov = (Tcl_Obj**) Tcl_Alloc(count * sizeof (Tcl_Obj*)); for (i = 0; i < count; ++i) ov[i] = getter(data, i + pos); Tcl_SetListObj(r, count, ov); Tcl_Free((char*) ov); } else { int f = 1; Tcl_Obj *var = objc > 4 ? objv[4] : NULL; Tcl_Obj *expr = objc > 5 ? objv[5] : NULL; Tcl_Obj *s, *t; count += pos; for (i = pos; e == TCL_OK && i < count; ++i) { s = i < HI_SMALL ? smallvec[i] : Tcl_NewIntObj(i); e = Tcl_ListObjReplace(ip, defv, defn-1, 1, 1, &s); assert(e == TCL_OK); if (getter != NULL) t = getter(data, i); else { e = Tcl_EvalObjEx(ip, defv, TCL_EVAL_DIRECT); if (e != TCL_OK) break; t = Tcl_GetObjResult(ip); } Tcl_IncrRefCount(t); if (expr != NULL) if (Tcl_ObjSetVar2(ip, var, NULL, t, TCL_LEAVE_ERR_MSG) == NULL) e = TCL_ERROR; else e = Tcl_ExprBooleanObj(ip, expr, &f); else if (var != NULL) { Tcl_Obj *pred[4]; pred[0] = var; pred[1] = obj; pred[2] = s; pred[3] = t; e = Tcl_EvalObjv(ip, 4, pred, 0); if (e == TCL_OK) e = Tcl_GetIntFromObj(ip, Tcl_GetObjResult(ip), &f); } if (f) Tcl_ListObjAppendElement(ip, r, t); Tcl_DecrRefCount(t); } assert(i == count || e == TCL_ERROR); } if (e == TCL_OK) Tcl_SetObjResult(ip, r); Tcl_DecrRefCount(r); } } return e; } if {[info exists pkgtest] && $pkgtest} { puts "compile: [time {catch mvec}]" } critlib/noop.README0000644000076500001200000000076207375744353014256 0ustar jcwadmin00000000000000Do nothing, but do it very quickly! =================================== Rev 0.10: Initial release This package defines a "noop" command, which does... nothing at all. Here's the essence of the source code in this package: package require critcl critcl::cproc noop {} void {;} Noop can come in handy to verify proper operation of CriTcl, but also to determine the base speed of your system, because timing tests will give you an indication of the time spent in the C extension interface. critlib/noop.tcl0000644000076500001200000000043507375742503014073 0ustar jcwadmin00000000000000# Trivial C extension, used to test CriTcl and as baseline for timing package provide noop 0.10 package require critcl critcl::cproc noop {} void {;} if {[info exists pkgtest] && $pkgtest} { puts "compile: [time noop]" puts "run 100: [time [string repeat {noop;} 100] 1000]" } critlib/pkgIndex.tcl0000644000076500001200000000371410573223167014666 0ustar jcwadmin00000000000000# Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. package ifneeded ascenc 0.12 [list source [file join $dir ascenc.tcl]] package ifneeded blowfish 0.11 [list source [file join $dir blowfish.tcl]] package ifneeded cblas 0.11 [list source [file join $dir cblas.tcl]] package ifneeded critcl 0.33 [list source [file join $dir critcl.tcl]] package ifneeded dyncall 0.11 [list source [file join $dir dyncall.tcl]] package ifneeded hexdump 0.10 [list source [file join $dir hexdump.tcl]] package ifneeded ihash 0.11 [list source [file join $dir ihash.tcl]] package ifneeded lzrw1 0.10 [list source [file join $dir lzrw1.tcl]] package ifneeded mathf 0.11 [list source [file join $dir mathf.tcl]] package ifneeded md5c 0.11 [list source [file join $dir md5c.tcl]] package ifneeded md5pure 1.2 [list source [file join $dir md5pure.tcl]] package ifneeded mvec 0.12 [list source [file join $dir mvec.tcl]] package ifneeded noop 0.10 [list source [file join $dir noop.tcl]] package ifneeded rchan 0.10 [list source [file join $dir rchan.tcl]] package ifneeded rechan 1.0 [list source [file join $dir rechan.tcl]] package ifneeded rhtml 0.10 [list source [file join $dir rhtml.tcl]] package ifneeded scratch 0.10 [list source [file join $dir scratch.tcl]] package ifneeded typcl 0.12 [list source [file join $dir typcl.tcl]] package ifneeded vfs 0.12 [list source [file join $dir vfs.tcl]] package ifneeded xre 0.10 [list source [file join $dir xre.tcl]] package ifneeded zipper 0.11 [list source [file join $dir zipper.tcl]] package ifneeded zlib 0.10 [list source [file join $dir zlib.tcl]] critlib/pkgtest0000755000076500001200000000206707375744524014033 0ustar jcwadmin00000000000000#!/usr/bin/env tclsh # Test all packages, by loading them with the special "pkgtest" flag set # If an argument is given, it is used as dir to leave compiled libs in. set dir . source pkgIndex.tcl set pkgtest 1 # test the CriTcl package separately set h "CritLib test (critcl [package versions critcl])" puts "" puts " $h" puts " [string repeat = [string length $h]]" puts "" source critcl.tcl puts "" puts [string repeat "_" 79] critcl::config outdir [lindex $argv 0] set errors 0 foreach name [lsort [package names]] { if {$name == "critcl"} continue set f $name.tcl if {![file exists $f]} continue # sort according to versions, and use the highest one set v [lindex [lsort -command {package vcomp} [package versions $name]] end] set x "$name $v" puts "" puts " [string toupper $x]" puts " [string repeat = [string length $x]]" puts "" if {[catch { source $f; package require -exact $name $v }]} { puts "\nERROR IN PACKAGE $x:\n$::errorInfo" incr errors } puts "" puts [string repeat "_" 79] } puts "$errors errors" exit $errors critlib/preamble.html0000644000076500001200000000424507477753352015103 0ustar jcwadmin00000000000000C Runtime In Tcl Library
CritLib is a set of mostly independent packages for use in Tcl.

It is self-contained and includes CriTcl, the "C Runtime In Tcl" extension which automatically wraps and compiles C code. Details about this concept can be found on the Tcl'ers Wiki, see the CriTcl page there. A list of what could or should be done is being tracked on the ideas page.

CritBind is a utility script to quickly create merged shared libraries, as well as custom executables. See the read me file for details. With CritBind you can deploy the C code which CriTcl compiled for you.

Requirements differ from one package to the next. Most packages listed below use C code and rely on CriTcl, which requires gcc and Tcl 8.1 or later for stubs support. Some of the packages below might use features from a more recent version of Tcl (development takes place under Tcl 8.4).

Installation consists of unpacking the distribution and moving the "critlib/" directory to a spot where Tcl's package loader will find it. The "pkgtest.tcl" script exercises each package a bit (see the test output). Most packages have only been used on Linux and Windows NT4 (MinGW) so far.

No license applies unless noted otherwise in the source files. CriTcl and the scripts below were written by Jean-Claude Wippler <jcw@equi4.com>. Hold the author harmless and any lawful use is permitted.


%
Acknowledgements
Scott Beasley - dyncall on Windows
Vince Darley - Tcl 8.4's Virtual File System
Paul Duffin and Jan Nijtmans - stubs architecture
Donal K. Fellows - math functions, now in "mathf"
Jeff Hobbs and the TCT - continued work on Tcl
Steve Landers - critcl mods for use as separate tool
Don Libes - pure-Tcl implementation of MD5
Matt Newman - original VFS, Tcl wizard par excellence
John Ousterhout - founding father of Tcl
critlib/rchan.tcl0000644000076500001200000002013307376413570014210 0ustar jcwadmin00000000000000# Reflecting channel interface package provide rchan 0.10 package require critcl critcl::ccode { #include #ifndef EINVAL #define EINVAL 9 #endif typedef struct { Tcl_Channel _chan; int _validMask; int _watchMask; Tcl_Interp* _interp; Tcl_Obj* _context; Tcl_Obj* _seek; Tcl_Obj* _read; Tcl_Obj* _write; Tcl_Obj* _name; } ReflectingChannel; static void CreateReflectingChannel (ReflectingChannel *cp, Tcl_Interp* ip_, Tcl_Obj* context_, int mode_, const char* name_) { cp->_validMask = mode_; cp->_watchMask = 0; cp->_chan = 0; cp->_context = context_; cp->_interp = ip_; cp->_name = Tcl_NewStringObj(name_, -1); /* support Tcl_GetIndexFromObj by keeping these objectified */ cp->_seek = Tcl_NewStringObj("seek", -1); cp->_read = Tcl_NewStringObj("read", -1); cp->_write = Tcl_NewStringObj("write", -1); Tcl_IncrRefCount(cp->_context); Tcl_IncrRefCount(cp->_seek); Tcl_IncrRefCount(cp->_read); Tcl_IncrRefCount(cp->_write); Tcl_IncrRefCount(cp->_name); } static void DeleteReflectingChannel (ReflectingChannel *cp) { /* printf("destroying reflchannel %s\n", Tcl_GetString(_name)); */ Tcl_DecrRefCount(cp->_context); Tcl_DecrRefCount(cp->_seek); Tcl_DecrRefCount(cp->_read); Tcl_DecrRefCount(cp->_write); Tcl_DecrRefCount(cp->_name); } typedef struct { Tcl_Event _header; ReflectingChannel* chan; } RcEvent; static int rcEventProc(Tcl_Event *evPtr, int flags) { RcEvent *me = (RcEvent*) evPtr; if (!(flags & TCL_FILE_EVENTS)) return 0; Tcl_NotifyChannel(me->chan->_chan, me->chan->_watchMask); return 1; } static void rcCheckProc(ClientData cd_, int flags) { RcEvent *evPtr; ReflectingChannel* chan = (ReflectingChannel*) cd_; if (!(flags & TCL_FILE_EVENTS)) return; evPtr = (RcEvent*) Tcl_Alloc(sizeof (RcEvent)); evPtr->_header.proc = rcEventProc; evPtr->chan = chan; Tcl_QueueEvent( (Tcl_Event*)evPtr, TCL_QUEUE_TAIL); } static void rcSetupProc(ClientData cd_, int flags) { ReflectingChannel* chan = (ReflectingChannel*) cd_; Tcl_Time blockTime = { 0, 0}; if (!(flags & TCL_FILE_EVENTS)) return; if (chan->_watchMask) Tcl_SetMaxBlockTime(&blockTime); } static int rcEventFilter( Tcl_Event *evPtr, ClientData cd_) { RcEvent* me = (RcEvent*) evPtr; ReflectingChannel* chan = (ReflectingChannel*) cd_; return evPtr->proc == rcEventProc && me->chan == chan; } static int rcClose (ClientData cd_, Tcl_Interp* interp) { ReflectingChannel* chan = (ReflectingChannel*) cd_; /* printf("closing refl-channel %s\n", Tcl_GetString(chan->_name)); */ /* Tcl_DeleteEventSource(rcSetupProc, rcCheckProc, chan); */ Tcl_DeleteEvents(rcEventFilter, chan); if (chan->_chan != 0) { Tcl_Channel tmp = chan->_chan; chan->_chan = 0; /* prevent recursion, JCW 9/9/2001 */ Tcl_UnregisterChannel(chan->_interp, tmp); DeleteReflectingChannel(chan); free(chan); } return TCL_OK; } static Tcl_Obj* rcBuildCmdList(ReflectingChannel* chan_, Tcl_Obj* cmd_) { Tcl_Obj* vec = Tcl_DuplicateObj(chan_->_context); Tcl_IncrRefCount(vec); if (Tcl_ListObjAppendElement(chan_->_interp, vec, cmd_) == TCL_ERROR || Tcl_ListObjAppendElement(chan_->_interp, vec, chan_->_name) == TCL_ERROR){ Tcl_DecrRefCount(vec); return 0; } return vec; /* with refcount 1 */ } static int rcInput (ClientData cd_, char* buf, int toRead, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; Tcl_Interp* ip = chan->_interp; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_read); if (cmd != 0) { int n = -1; int e = Tcl_ListObjAppendElement(ip, cmd, Tcl_NewIntObj(toRead)); if (e == TCL_OK) { Tcl_SavedResult sr; Tcl_SaveResult(ip, &sr); e = Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (e == TCL_OK) { Tcl_Obj* r = Tcl_GetObjResult(ip); unsigned char* s = Tcl_GetByteArrayFromObj(r, &n); if (0 <= n && n <= toRead) memcpy(buf, s, n); else n = -1; } Tcl_RestoreResult(ip, &sr); } Tcl_DecrRefCount(cmd); if (n >= 0) return n; } *errorCodePtr = EINVAL; return -1; } static int rcOutput (ClientData cd_, char* buf, int toWrite, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; Tcl_Interp* ip = chan->_interp; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_write); if (cmd != 0) { int e = Tcl_ListObjAppendElement(ip, cmd, Tcl_NewByteArrayObj((unsigned char*) buf, toWrite)); if (e == TCL_OK) { Tcl_SavedResult sr; Tcl_SaveResult(ip, &sr); e = Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (e == TCL_OK) { Tcl_Obj* r = Tcl_GetObjResult(ip); int n; e = Tcl_GetIntFromObj(ip, r, &n); if (e == TCL_OK && 0 <= n && n <= toWrite) { Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); return n; } } Tcl_RestoreResult(ip, &sr); } Tcl_DecrRefCount(cmd); } *errorCodePtr = EINVAL; return -1; } static int rcSeek (ClientData cd_, long offset, int seekMode, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; Tcl_Interp* ip = chan->_interp; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_seek); if (cmd != 0) { int e = Tcl_ListObjAppendElement(ip, cmd, Tcl_NewLongObj(offset)); if (e == TCL_OK) { int e = Tcl_ListObjAppendElement(ip, cmd, Tcl_NewIntObj(seekMode)); if (e == TCL_OK) { Tcl_SavedResult sr; Tcl_SaveResult(ip, &sr); e = Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (e == TCL_OK) { Tcl_Obj* r = Tcl_GetObjResult(ip); int n; e = Tcl_GetIntFromObj(ip, r, &n); if (e == TCL_OK) { Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); return n; } } Tcl_RestoreResult(ip, &sr); } } Tcl_DecrRefCount(cmd); } *errorCodePtr = EINVAL; return -1; } static void rcWatchChannel (ClientData cd_, int mask) { ReflectingChannel* chan = (ReflectingChannel*) cd_; Tcl_Time blockTime = { 0, 0 }; /* * Since the file is always ready for events, we set the block time * to zero so we will poll. */ chan->_watchMask = mask & chan->_validMask; if (chan->_watchMask) { Tcl_SetMaxBlockTime(&blockTime); } } static int rcGetFile (ClientData cd_, int direction, ClientData* handlePtr) { return TCL_ERROR; } static Tcl_ChannelType rChannelType = { "rchan", /* Type name. */ 0, /* Set blocking/nonblocking behaviour. NULL'able */ rcClose, /* Close channel, clean instance data */ rcInput, /* Handle read request */ rcOutput, /* Handle write request */ rcSeek, /* Move location of access point. NULL'able */ 0, /* Set options. NULL'able */ 0, /* Get options. NULL'able */ rcWatchChannel, /* Initialize notifier */ rcGetFile /* Get OS handle from the channel. */ }; } critcl::ccommand rchan {cd_ ip_ objc_ objv_} { ReflectingChannel *rc; int mode; static int mkChanSeq = 0; char buffer [20]; if (objc_ != 3) { Tcl_WrongNumArgs(ip_, 1, objv_, "command mode"); return TCL_ERROR; } if (Tcl_GetIntFromObj(ip_, objv_[2], &mode) == TCL_ERROR) return TCL_ERROR; sprintf(buffer, "rchan%d", ++mkChanSeq); rc = malloc (sizeof *rc); CreateReflectingChannel (rc, ip_, objv_[1], mode, buffer); rc->_chan = Tcl_CreateChannel(&rChannelType, buffer, rc, mode); /* Tcl_CreateEventSource(rcSetupProc, rcCheckProc, rc); */ Tcl_RegisterChannel(ip_, rc->_chan); Tcl_SetResult(ip_, buffer, TCL_VOLATILE); return TCL_OK; } if {[info exists pkgtest] && $pkgtest} { proc blah {args} { puts "blah: $args" } puts "compile: [time {rchan blah 6}]" } critlib/README0000644000076500001200000000060307375744731013276 0ustar jcwadmin00000000000000See "index.html" for details about CritLib. - this is a Tcl package, just drop it in a dir listed on auto_path and go - most scripts can be used separately (assuming CriTcl is available) - "adjust" (re-) generates pkgIndex.tcl and index.html, and runs pkgtest - "pkgtest" runs a few small tests, as stored in each package - the sample test output can be found in the file "testout.txt" critlib/rechan.README0000644000076500001200000000312207550665366014535 0ustar jcwadmin00000000000000Reflecting channels back into Tcl ================================= Rev 1.0: Renamed (used to be called rchan), fixed fileevent timer bugs Rev 0.10: Initial release The http://mini.net/tcl/2514.html page is a good spot to comment on this. This package defines a "rechan" command, which lets you create Tcl-style channels that are completely handled by Tcl scripts, instead of C code. Rechan must be called with two arguments to create a new channel: rechan cmd mode Where: cmd = the name of the "callback" that will process requests mode = the open mode (6 is R/W, the normal case) The callback cmd can be one or more words (i.e. a list). Depending on the operation, a request name and some args will be tacked on before invoking it. The following requests are implemented: $cmd seek $chan ?? called when a "seek $chan ??" is done $cmd read $chan called when a "read $chan " request is made $cmd write $chan called when a "write $chan " request is made $cmd close $chan called when the channel is closed Other operations are not supported. Rechan is not all that capable, though it works with fileevents now. It has been invaluable in TclKit to implement its database-backed VFS design. Without some sort of "reflection", the Virtual File System (whether the original one by Matt Newman or the C-based on in the core by Vince Darley) could not have been implemented. It is hoped that one day, some sort of channel reflection becomes part of standard Tcl, and included in the core. critlib/rechan.tcl0000644000076500001200000001642007550323725014355 0ustar jcwadmin00000000000000# Reflecting channel interface package provide rechan 1.0 package require critcl critcl::ccode { #include /* Uncomment for Solaris (and comment above) for memcpy declaration */ /* #include */ #ifndef EINVAL #define EINVAL 9 #endif typedef struct { Tcl_Channel _chan; int _validMask; int _watchMask; Tcl_Interp* _interp; Tcl_Obj* _context; Tcl_Obj* _seek; Tcl_Obj* _read; Tcl_Obj* _write; Tcl_Obj* _name; Tcl_TimerToken _timer; } ReflectingChannel; static ReflectingChannel* rcCreate (Tcl_Interp* ip_, Tcl_Obj* context_, int mode_, const char* name_) { ReflectingChannel* cp = (ReflectingChannel*) Tcl_Alloc (sizeof *cp); cp->_validMask = mode_; cp->_watchMask = 0; cp->_chan = 0; cp->_context = context_; cp->_interp = ip_; cp->_name = Tcl_NewStringObj(name_, -1); cp->_timer = NULL; /* support Tcl_GetIndexFromObj by keeping these objectified */ cp->_seek = Tcl_NewStringObj("seek", -1); cp->_read = Tcl_NewStringObj("read", -1); cp->_write = Tcl_NewStringObj("write", -1); Tcl_IncrRefCount(cp->_context); Tcl_IncrRefCount(cp->_seek); Tcl_IncrRefCount(cp->_read); Tcl_IncrRefCount(cp->_write); Tcl_IncrRefCount(cp->_name); return cp; } static Tcl_Obj* rcBuildCmdList(ReflectingChannel* chan_, Tcl_Obj* cmd_) { Tcl_Obj* vec = Tcl_DuplicateObj(chan_->_context); Tcl_IncrRefCount(vec); Tcl_ListObjAppendElement(chan_->_interp, vec, cmd_); Tcl_ListObjAppendElement(chan_->_interp, vec, chan_->_name); return vec; /* with refcount 1 */ } static int rcClose (ClientData cd_, Tcl_Interp* interp) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, Tcl_NewStringObj("close", -1)); Tcl_Interp* ip = chan->_interp; Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK) Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n); Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); if (chan->_timer != NULL) { Tcl_DeleteTimerHandler(chan->_timer); chan->_timer = NULL; } Tcl_DecrRefCount(chan->_context); Tcl_DecrRefCount(chan->_seek); Tcl_DecrRefCount(chan->_read); Tcl_DecrRefCount(chan->_write); Tcl_DecrRefCount(chan->_name); Tcl_Free((char*) chan); return TCL_OK; } static int rcInput (ClientData cd_, char* buf, int toRead, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; if (chan->_validMask & TCL_READABLE) { Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_read); Tcl_Interp* ip = chan->_interp; Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(toRead)); Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK) { void* s = Tcl_GetByteArrayFromObj(Tcl_GetObjResult(ip), &n); if (0 <= n && n <= toRead) if (n > 0) memcpy(buf, s, n); else chan->_watchMask &= ~TCL_READABLE; else n = -1; } Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); } if (n < 0) *errorCodePtr = EINVAL; return n; } static int rcOutput (ClientData cd_, const char* buf, int toWrite, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; if (chan->_validMask & TCL_WRITABLE) { Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_write); Tcl_Interp* ip = chan->_interp; Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewByteArrayObj((unsigned char*) buf, toWrite)); Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK && Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n) == TCL_OK) if (0 <= n && n <= toWrite) chan->_watchMask = chan->_validMask; else n = -1; Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); } if (n < 0) *errorCodePtr = EINVAL; return n; } static int rcSeek (ClientData cd_, long offset, int seekMode, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_seek); Tcl_Interp* ip = chan->_interp; Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewLongObj(offset)); Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(seekMode)); Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK && Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n) == TCL_OK) chan->_watchMask = chan->_validMask; Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); if (n < 0) *errorCodePtr = EINVAL; return n; } static void rcTimerProc (ClientData cd_) { ReflectingChannel* chan = (ReflectingChannel*) cd_; if (chan->_timer != NULL) Tcl_DeleteTimerHandler(chan->_timer); chan->_timer = NULL; Tcl_NotifyChannel(chan->_chan, chan->_watchMask); } static void rcWatchChannel (ClientData cd_, int mask) { ReflectingChannel* chan = (ReflectingChannel*) cd_; /* Dec 2001: adopting logic used in Andreas Kupries' memchan, i.e. timers */ if (mask) { chan->_watchMask = mask & chan->_validMask; if (chan->_watchMask && chan->_timer == NULL) chan->_timer = Tcl_CreateTimerHandler(5, rcTimerProc, cd_); } else if (chan->_timer != NULL) { Tcl_DeleteTimerHandler(chan->_timer); chan->_timer = NULL; } } static int rcGetFile (ClientData cd_, int direction, ClientData* handlePtr) { return TCL_ERROR; } static Tcl_ChannelType reChannelType = { "rechan", /* Type name. */ 0, /* Set blocking/nonblocking behaviour. NULL'able */ rcClose, /* Close channel, clean instance data */ rcInput, /* Handle read request */ rcOutput, /* Handle write request */ rcSeek, /* Move location of access point. NULL'able */ 0, /* Set options. NULL'able */ 0, /* Get options. NULL'able */ rcWatchChannel, /* Initialize notifier */ rcGetFile /* Get OS handle from the channel. */ }; } critcl::ccommand rechan {cd_ ip_ objc_ objv_} { ReflectingChannel *rc; int mode; static int mkChanSeq = 0; char buffer [20]; if (objc_ != 3) { Tcl_WrongNumArgs(ip_, 1, objv_, "command mode"); return TCL_ERROR; } if (Tcl_ListObjLength(ip_, objv_[1], &mode) == TCL_ERROR || Tcl_GetIntFromObj(ip_, objv_[2], &mode) == TCL_ERROR) return TCL_ERROR; sprintf(buffer, "rechan%d", ++mkChanSeq); rc = rcCreate (ip_, objv_[1], mode, buffer); rc->_chan = Tcl_CreateChannel(&reChannelType, buffer, (ClientData) rc, mode); Tcl_RegisterChannel(ip_, rc->_chan); Tcl_SetChannelOption(ip_, rc->_chan, "-buffering", "none"); Tcl_SetChannelOption(ip_, rc->_chan, "-blocking", "0"); Tcl_SetResult(ip_, buffer, TCL_VOLATILE); return TCL_OK; } if {[info exists pkgtest] && $pkgtest} { proc blah {args} { puts "blah: $args" } puts "compile: [time {rechan blah 6}]" } critlib/rhtml.README0000644000076500001200000000415307410512667014416 0ustar jcwadmin00000000000000Wrapper for Richard Hipp's Tkhtml widget ======================================== Rev 0.10: Initial release This is a very thin wrapper around the Tkhtml widget by Richard hipp. Its sole purpose is to bring the build process into the CriTcl system. Building this extension takes a little bit of preparation: - get the Tkhtml distribution and unpack it as ./tkhtml/ - you need to create separately buildable C headers and sources: mkdir tkhtml.bld cd tkhtml.bld ../tkhtml/configure (this may fail, e.g. if Tcl/Tk headers are not found) make srcdir - the result is a directory with all necessary sources copied over (note that we do not use the provided build, we just get sources) - now go to the critlib area, and do a "cd rhtml_c" - this area contains symbolic links which you need to adjust, e.g.: ln -sf the_above_dir_path/tkhtml.bld/srcdir/* . - this resets the symlinks, but you need one more adjustment: mv -f htmlwidget.c rhtmlwidget.c - now, fix the symlinks to the tk*.h headers: ln -sf my_tk_source_tree/generic/tk.h ln -sf my_tk_source_tree/generic/tkDecls.h ln -sf my_tk_source_tree/generic/tkIntXlibDecls.h - one last change is to adjust the location of the X11 libs, if they are not in /usr/X11R6/lib/libX11.* - see the code in rhtml.tcl: critcl::clibraries -L/usr/X11R6/lib -lX11 Phew, that's it. CriTcl should now be able to build the Tkhtml widget. The command gets inited and defined slightly differently, but there is no difference once the package loads. The way to use this package is: package require rhtml html ?args ...? The source code of the Tkhtml extension is available from DRH's site: http://www.hwaci.com/ There's also a modified version in the BrowseX app by Peter MacDonald: http://www.browsex.com/ That version has not yet been tried (it has some changes/dependencies). One of the things this CriTcl extension demonstrates, is how to set up the Tk stubs table without changes to the (Tk-unaware) CriTcl code, in a way which also does not require the "libtkstub8.4.a" binary code. The trick used to do this is documented in the code, see "rhtml.tcl". critlib/rhtml.tcl0000644000076500001200000000543107410505127014234 0ustar jcwadmin00000000000000# Wrapper for Richard Hipp's Tkhtml widget (called "html") package provide rhtml 0.10 package require critcl namespace eval rhtml { namespace export init html # "htmlwidget.c" was renamed to "rhtmlwidget.c" for easy globbing critcl::cheaders -DUSE_TK_STUBS critcl::cheaders rhtml_c/*.h rhtml_c/rhtmlwidget.c critcl::csources rhtml_c/html*.c # adjust the line below as needed if X11 is not being found critcl::clibraries -L/usr/X11R6/lib -lX11 critcl::ccode { #include /* these get inited by calling the "rhtml::init" cproc defined below */ TkStubs *tkStubsPtr; struct TkPlatStubs *tkPlatStubsPtr; struct TkIntStubs *tkIntStubsPtr; struct TkIntPlatStubs *tkIntPlatStubsPtr; struct TkIntXlibStubs *tkIntXlibStubsPtr; /* stubs support is built into critcl, so disable this call */ #undef Tcl_InitStubs #define Tcl_InitStubs(a,b,c) b #undef Tk_InitStubs #define Tk_InitStubs(a,b,c) b /* disable (rename) the init code, since it is generated by critcl */ #define Tkhtml_Init DummyTkhtml_Init #include "rhtmlwidget.c" #undef Tcl_InitStubs #undef Tkhtml_Init } critcl::ccommand html HtmlCommand # This performs Tk stub setup, as normally provided by "libtkstub8.4.a". # # But instead of setting up Tk stubs from C code at extension init time, # we define an "init" command which is called from Tcl before the html # command is used. This effectively turns the logic of stub table inits # around to being done *in* the extension, but *initiated* from a script. # # There are (small) advantages to this approach: # - it fits in better with the structure of critcl # - it's slightly simpler (less C code) # - Tk is not "package require'd" at extension load time # # Note that the "init" proc is generic code, but it *must* be defined in # each extension using Tk, so the stub vector of that extension gets set. # This mechanism can be extended to other stub vectors as needed. critcl::cproc init {Tcl_Interp* ip} ok { if (Tcl_PkgRequireEx(ip, "Tk", "8.1", 0, (ClientData*) &tkStubsPtr) == NULL) return TCL_ERROR; if (tkStubsPtr == NULL || tkStubsPtr->hooks == NULL) { Tcl_SetResult(ip, "This code requires Tk stubs-support.", TCL_STATIC); return TCL_ERROR; } tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs; tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs; tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs; tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs; return TCL_OK; } } # emulate the old behavior and set things up as a "html" command again rhtml::init interp alias {} html {} rhtml::html if {1 || [info exists pkgtest] && $pkgtest} { # make a harmless call which fails, to prove that it ran catch {html -?} err puts $err } critlib/rhtml_c/0000755000076500001200000000000007457512660014042 5ustar jcwadmin00000000000000critlib/rhtml_c/html.h0000755000076500001200000000000010573223446022641 2/home/builds/tkhtml.src/html.hustar jcwadmin00000000000000critlib/rhtml_c/htmlcmd.c0000755000076500001200000000000010573223446023777 2/home/builds/tkhtml.src/htmlcmd.custar jcwadmin00000000000000critlib/rhtml_c/htmlcmd.h0000755000076500001200000000000010573223446024011 2/home/builds/tkhtml.src/htmlcmd.hustar jcwadmin00000000000000critlib/rhtml_c/htmldraw.c0000755000076500001200000000000010573223446024363 2/home/builds/tkhtml.src/htmldraw.custar jcwadmin00000000000000critlib/rhtml_c/htmldraw.h0000755000076500001200000000000010573223446024375 2/home/builds/tkhtml.src/htmldraw.hustar jcwadmin00000000000000critlib/rhtml_c/htmlform.c0000755000076500001200000000000010573223446024377 2/home/builds/tkhtml.src/htmlform.custar jcwadmin00000000000000critlib/rhtml_c/htmlform.h0000755000076500001200000000000010573223446024411 2/home/builds/tkhtml.src/htmlform.hustar jcwadmin00000000000000critlib/rhtml_c/htmlimage.c0000755000076500001200000000000010573223446024635 2/home/builds/tkhtml.src/htmlimage.custar jcwadmin00000000000000critlib/rhtml_c/htmlimage.h0000755000076500001200000000000010573223446024647 2/home/builds/tkhtml.src/htmlimage.hustar jcwadmin00000000000000critlib/rhtml_c/htmlindex.c0000755000076500001200000000000010573223446024707 2/home/builds/tkhtml.src/htmlindex.custar jcwadmin00000000000000critlib/rhtml_c/htmlindex.h0000755000076500001200000000000010573223446024721 2/home/builds/tkhtml.src/htmlindex.hustar jcwadmin00000000000000critlib/rhtml_c/htmllayout.c0000755000076500001200000000000010573223446025323 2/home/builds/tkhtml.src/htmllayout.custar jcwadmin00000000000000critlib/rhtml_c/htmllayout.h0000755000076500001200000000000010573223446025335 2/home/builds/tkhtml.src/htmllayout.hustar jcwadmin00000000000000critlib/rhtml_c/htmlparse.c0000755000076500001200000000000010573223446024715 2/home/builds/tkhtml.src/htmlparse.custar jcwadmin00000000000000critlib/rhtml_c/htmlparse.h0000755000076500001200000000000010573223446024727 2/home/builds/tkhtml.src/htmlparse.hustar jcwadmin00000000000000critlib/rhtml_c/htmlsizer.c0000755000076500001200000000000010573223446024761 2/home/builds/tkhtml.src/htmlsizer.custar jcwadmin00000000000000critlib/rhtml_c/htmlsizer.h0000755000076500001200000000000010573223446024773 2/home/builds/tkhtml.src/htmlsizer.hustar jcwadmin00000000000000critlib/rhtml_c/htmltable.c0000755000076500001200000000000010573223446024647 2/home/builds/tkhtml.src/htmltable.custar jcwadmin00000000000000critlib/rhtml_c/htmltable.h0000755000076500001200000000000010573223446024661 2/home/builds/tkhtml.src/htmltable.hustar jcwadmin00000000000000critlib/rhtml_c/htmltest.c0000755000076500001200000000000010573223446024427 2/home/builds/tkhtml.src/htmltest.custar jcwadmin00000000000000critlib/rhtml_c/htmltest.h0000755000076500001200000000000010573223446024441 2/home/builds/tkhtml.src/htmltest.hustar jcwadmin00000000000000critlib/rhtml_c/htmltokens.c0000755000076500001200000000000010573223446025277 2/home/builds/tkhtml.src/htmltokens.custar jcwadmin00000000000000critlib/rhtml_c/htmltokens.h0000755000076500001200000000000010573223446025311 2/home/builds/tkhtml.src/htmltokens.hustar jcwadmin00000000000000critlib/rhtml_c/htmlurl.c0000755000076500001200000000000010573223446024075 2/home/builds/tkhtml.src/htmlurl.custar jcwadmin00000000000000critlib/rhtml_c/htmlurl.h0000755000076500001200000000000010573223446024107 2/home/builds/tkhtml.src/htmlurl.hustar jcwadmin00000000000000critlib/rhtml_c/htmlwidget.h0000755000076500001200000000000010573223446025251 2/home/builds/tkhtml.src/htmlwidget.hustar jcwadmin00000000000000critlib/rhtml_c/rhtmlwidget.c0000755000076500001200000000000010573223446025421 2/home/builds/tkhtml.src/htmlwidget.custar jcwadmin00000000000000critlib/rhtml_c/tk.h0000755000076500001200000000000010573223446021226 2/home/tcl/tk/generic/tk.hustar jcwadmin00000000000000critlib/rhtml_c/tkDecls.h0000755000076500001200000000000010573223446023154 2/home/tcl/tk/generic/tkDecls.hustar jcwadmin00000000000000critlib/rhtml_c/tkIntXlibDecls.h0000755000076500001200000000000010573223446025740 2/home/tcl/tk/generic/tkIntXlibDecls.hustar jcwadmin00000000000000critlib/scratch.c0000644000076500001200000004711107411407401014173 0ustar jcwadmin00000000000000/* Self-Contained Runtime pArser for Tcl, as Critcl Hack */ #ifndef _TCL #include #endif #include #include /* strtol */ static int ListLength(Tcl_Obj* o) { int n; if (Tcl_ListObjLength(NULL, o, &n) == TCL_ERROR) n = -1; return n; } /* Character classes */ enum { eNormal = 0x00, eSpace = 0x01, eNewLine = 0x02, eSemiColon = 0x04, eSubstitute = 0x08, eDoubleQuote = 0x10, eCloseParen = 0x20, eCloseBracket = 0x40, eBrace = 0x80 }; enum { efrLiteral, efrEscaped, efrExtraAfterBrace, efrMissingBrace, efrExtraAfterQuote, efrMissingQuote, efrEof = -1 }; typedef struct { Tcl_Obj* stack; const char* start; } TclEngine; typedef struct { const char* from; const char* to; } TclScanner; typedef struct { TclScanner ts; TclEngine* engine; const char* error; } TclTokenizer; typedef struct { TclTokenizer tt; char token; int valid; Tcl_Obj* value; } TclExprScanner; void te_AppendStack(TclEngine* te, Tcl_Obj* obj); Tcl_Obj* te_LitResult(TclEngine*, char, const char*, const char*); void te_TclEngine (TclEngine* te, const char* start); Tcl_Obj* te_TclScan(TclEngine* te, const char* from, const char* to); Tcl_Obj* te_TclExpr(TclEngine* te, const char* from, const char* to); void te_LitChar(TclEngine* te, char ch); void te_Literal(TclEngine* te, const char* from, const char* to); int te_Frame(TclEngine* te); void te_Command(TclEngine* te, int base); int te_Merge(TclEngine* te, int wbase); Tcl_Obj* te_Pop(TclEngine* te); void te_Scalar(TclEngine* te, const char* from, const char* to); void te_Array(TclEngine* te, const char* from, const char* to); void te_Quote(TclEngine* te, int unbalanced); Tcl_Obj* tes_Descend(TclExprScanner* tes, int level); Tcl_Obj* tes_Term(TclExprScanner* tes); void tes_BinOp(TclExprScanner*, Tcl_Obj**, char, Tcl_Obj*); /* Look ahead to the next character */ char ts_PeekChar(const TclScanner* ts) { return ts->from != ts->to ? *ts->from : 0; } /* Determine the character class */ int ts_CharClass(char c) { return c == ' ' || c == '\t' ? eSpace : c == '\n' ? eNewLine : c == ';' || c == 0 ? eSemiColon : c == '\\' || c == '$' || c == '[' ? eSubstitute : c == '"' ? /*"*/ eDoubleQuote : c == ')' ? eCloseParen : c == ']' ? eCloseBracket : c == '{' || c == '}' ? eBrace : eNormal; } /* Return next character, or a null byte if at end */ int ts_PeekClass(const TclScanner* ts) { return ts_CharClass(ts_PeekChar(ts)); } /* Return non-zero if next character is white space or newline */ int ts_AtWhiteOrEol(const TclScanner* ts) { return ts_PeekClass(ts) & (eSpace | eNewLine); } /* Returns number of chars which can be replace by a space, or zero */ int ts_EscapedNewLine(const TclScanner* ts) { int i = 2; if (ts->from + 1 >= ts->to || ts->from[0] != '\\' || ts->from[1] != '\n') return 0; while (ts->from + i < ts->to && ts_CharClass(ts->from[i]) == eSpace) ++i; return i; } /* Skip over whitespace and escaped newlines */ void ts_SkipWhiteSpace(TclScanner* ts) { int i; for (;;) { while (ts_PeekClass(ts) & eSpace) ++ts->from; i = ts_EscapedNewLine(ts); if (i == 0) return; ts->from += i; } } /* Define a new scanner over a specified string */ ts_TclScanner (TclScanner* ts, const char* from, const char* to) { ts->from = from; ts->to = to; } char ts_ConvertBackslash(TclScanner* ts); int ts_FindListElement(TclScanner* ts, const char** begin, const char** end); int ts_ConvertListElement(TclScanner* ts, const char* begin, const char* end, char* buffer); char ts_ConvertBackslash(TclScanner* ts) { const char* start; char ch; if (ts->from == ts->to) return '\\'; start = ts->from++; if (*start == 'x' && isxdigit(ts_PeekChar(ts))) { char ch = 0; while (isxdigit(ts_PeekChar(ts))) { ch = (char) (16 * ch + (*ts->from & 0x1F)); if (*ts->from++ > '9') ch += 9; } return ch; } if (isdigit(*start)) { char ch = 0; while (isdigit(ts_PeekChar(ts))) ch = (char) (8 * ch + *ts->from++ - '0'); return ch; } if (*start == '\n') { ts->from = start - 1; ts->from += ts_EscapedNewLine(ts); return ' '; } ch = *start; switch (ch) { case 'a': ch = 0x07; break; case 'b': ch = 0x08; break; case 'f': ch = 0x0C; break; case 'n': ch = 0x0A; break; case 'r': ch = 0x0D; break; case 't': ch = 0x09; break; case 'v': ch = 0x0B; break; } return ch; } /* Find the boundaries of the next list element */ int ts_FindListElement(TclScanner* ts, const char** begin, const char** end) { int level = 0; int escaped = efrLiteral; while (ts_AtWhiteOrEol(ts)) ++ts->from; if (ts->from == ts->to) return efrEof; switch (ts_PeekChar(ts)) { case '{': *begin = ++ts->from; while (ts->from != ts->to) { switch (*ts->from++) { case '{': ++level; break; case '}': if (--level >= 0) break; *end = ts->from - 1; return ts_AtWhiteOrEol(ts) || ts->from == ts->to ? escaped : efrExtraAfterBrace; /* extra characters after close-brace */ case '\\': if (ts->from != ts->to) ++ts->from; escaped = efrEscaped; } } return efrMissingBrace; /* missing closing brace in list element */ case '"': *begin = ++ts->from; while (ts->from != ts->to) { switch (*ts->from++) { case '"': *end = ts->from - 1; return ts_AtWhiteOrEol(ts) || ts->from == ts->to ? escaped : efrExtraAfterQuote; /* extra characters after close-quote */ case '\\': if (ts->from != ts->to) ++ts->from; escaped = efrEscaped; } } return efrMissingQuote; /* missing quote in list element */ default: *begin = ts->from; do { if (*ts->from == '\\') { if (++ts->from == ts->to) break; escaped = efrEscaped; } } while (!ts_AtWhiteOrEol(ts) && ++ts->from != ts->to); *end = ts->from; return escaped; } } int ts_ConvertListElement(TclScanner* ts, const char* begin, const char* end, char* buffer) { char* p = buffer; const char* save = ts->from; ts->from = begin; while (ts->from != end) { char c = *ts->from++; if (c == '\\' && ts->from != end) c = ts_ConvertBackslash(ts); *p++ = c; } ts->from = save; return p - buffer; } void tt_Fail(TclTokenizer* tt, const char* error) { tt->error = error; } /* Fail and throw an error if next char is incorrect, else skip it */ void tt_Require(TclTokenizer* tt, char ch, const char* error) { if (ts_PeekChar(&tt->ts) != ch) tt_Fail(tt, error); else ++tt->ts.from; } /* Define a new tokenizer over a specified string */ void tt_TclTokenizer (TclTokenizer* tt, const char* from, const char* to, TclEngine* engine) { ts_TclScanner(&tt->ts, from, to); tt->engine = engine; tt->error = NULL; } /* The number of unparsed characters remaining */ size_t tt_Remaining(const TclTokenizer* tt) { return tt->ts.to - tt->ts.from; } void tt_TokenizeScript(TclTokenizer* tt); void tt_TokenizeCommand(TclTokenizer* tt, int nested); int tt_TokenizeUntil(TclTokenizer* tt, int mask); int tt_TokenizeVariable(TclTokenizer* tt); /* Tokenize all the commands */ void tt_TokenizeScript(TclTokenizer* tt) { while (tt->ts.from != tt->ts.to) { tt_TokenizeCommand(tt, 0); } } /* Tokenize the next command, end at close bracket is nested */ void tt_TokenizeCommand(TclTokenizer* tt, int nested) { int base, wbase, mask; const char *first, *end, *init = tt->ts.from; for (;;) { ts_SkipWhiteSpace(&tt->ts); if (ts_PeekClass(&tt->ts) & (eNewLine | eSemiColon)) { if (tt->ts.from == tt->ts.to) return; ++tt->ts.from; continue; } if (ts_PeekChar(&tt->ts) != '#') break; while (++tt->ts.from != tt->ts.to) { /* this is non-conformant: no escaped backslashes */ if (*tt->ts.from == '\n' && tt->ts.from[-1] != '\\') break; } } if (tt->ts.from == tt->ts.to) return; base = te_Frame(tt->engine); wbase = base; mask = eNewLine | eSemiColon; if (nested) mask |= eCloseBracket; first = tt->ts.from; while (tt->ts.from != tt->ts.to) { const char* start = tt->ts.from++; if (*start == '"') { tt_TokenizeUntil(tt, eDoubleQuote); tt_Require(tt, '"', "missing close-quote"); /* if (tt->ts.from != tt->ts.to && !ts_AtWhiteOrEol(&tt->ts) && nested && *tt->ts.from != ']') */ /* tt_Fail(tt, "extra characters after close-quote"); */ } else if (*start == '{') { const char* token = tt->ts.from; int level = 0; for (;;) { while (ts_PeekClass(&tt->ts) == eNormal) ++tt->ts.from; if (tt->ts.from == tt->ts.to) break; if (*tt->ts.from == '\\' && tt->ts.from + 1 != tt->ts.to) { if (tt->ts.from[1] == '\n') { if (tt->ts.from > token) te_Literal(tt->engine, token, tt->ts.from); tt->ts.from += ts_EscapedNewLine(&tt->ts); te_LitChar(tt->engine, ' '); token = tt->ts.from; } else ++tt->ts.from; } else if (*tt->ts.from == '{') ++level; else if (*tt->ts.from == '}' && --level < 0) break; ++tt->ts.from; } if (tt->ts.from > token) te_Literal(tt->engine, token, tt->ts.from); tt_Require(tt, '}', "missing close-brace"); /* if (tt->ts.from != tt->ts.to && !ts_AtWhiteOrEol(&tt->ts) && nested && *tt->ts.from != ']') */ /* tt_Fail(tt, "extra characters after close-brace"); */ } else { --tt->ts.from; tt_TokenizeUntil(tt, mask | eSpace); } end = tt->ts.from; ts_SkipWhiteSpace(&tt->ts); if (ts_PeekClass(&tt->ts) & mask) break; wbase = te_Merge(tt->engine, wbase); } te_Merge(tt->engine, wbase); te_Command(tt->engine, base); } /* Tokenize a number of tokens until specific characters are reached */ int tt_TokenizeUntil(TclTokenizer* tt, int mask) { while (tt->ts.from != tt->ts.to) { const char* start = tt->ts.from; if (ts_CharClass(*tt->ts.from) & mask) return 1; switch (*tt->ts.from++) { case '$': if (!tt_TokenizeVariable(tt)) te_Literal(tt->engine, start, tt->ts.from); break; case '[': while (tt->ts.from != tt->ts.to && *tt->ts.from != ']') tt_TokenizeCommand(tt, 1); tt_Require(tt, ']', "missing close-bracket"); break; case '\\': --tt->ts.from; tt_Require(tt, '\\', "missing \\"); te_LitChar(tt->engine, ts_ConvertBackslash(&tt->ts)); if (start[1] == '\n' && (mask & eSpace)) return 0; break; default: while (tt->ts.from != tt->ts.to && (ts_CharClass(*tt->ts.from) & (mask | eSubstitute)) == 0) ++tt->ts.from; te_Literal(tt->engine, start, tt->ts.from); } } return 1; } /* Tokenize veriable names, in all their variations */ int tt_TokenizeVariable(TclTokenizer* tt) { if (ts_PeekChar(&tt->ts) == '{') { const char* start = ++tt->ts.from; while (tt->ts.from != tt->ts.to && *tt->ts.from++ != '}') ; --tt->ts.from; tt_Require(tt, '}', "missing close-brace for variable name"); te_Scalar(tt->engine, start, tt->ts.from - 1); } else { const char* start = tt->ts.from; while (tt->ts.from != tt->ts.to) { if (!isalnum(*tt->ts.from) && *tt->ts.from != '_') break; ++tt->ts.from; } if (ts_PeekChar(&tt->ts) != '(') { if (start == tt->ts.from) return 0; /* not a variable after all */ te_Scalar(tt->engine, start, tt->ts.from); } else { const char* end = tt->ts.from; ++tt->ts.from; tt_TokenizeUntil(tt, eCloseParen); tt_Require(tt, ')', "missing )"); te_Array(tt->engine, start, end); } } return 1; } /* moved out of inline code, because some compilers don't like it */ static const char* precedences[] = { "o", "a", "|", "^", "&", "en", "<>lg", "ud", "+-", "*/%", 0 }; void tes_LookAhead(TclExprScanner* tes, const char* chars) { while (*chars) if (ts_PeekChar(&tes->tt.ts) == *chars++) { tes->token = *chars; ++tes->tt.ts.from; break; } else ++chars; } char tes_Peek(TclExprScanner* tes) { if (!tes->valid) { while (ts_AtWhiteOrEol(&tes->tt.ts)) ++tes->tt.ts.from; if (tes->value != NULL) { /* funny way to clean up if refcount is zero */ Tcl_IncrRefCount(tes->value); Tcl_DecrRefCount(tes->value); tes->value = NULL; } tes->valid = 1; if (tes->tt.ts.from == tes->tt.ts.to) { tes->token = 0; } else { tes->token = *tes->tt.ts.from++; switch (tes->token) { case '&': tes_LookAhead(tes, "&a"); break; case '|': tes_LookAhead(tes, "|o"); break; case '<': tes_LookAhead(tes, "': tes_LookAhead(tes, ">d=g"); break; case '=': tes_LookAhead(tes, "=e"); break; case '!': tes_LookAhead(tes, "=n"); break; case '$': if (tt_TokenizeVariable(&tes->tt)) { tes->token = 'V'; tes->value = te_Pop(tes->tt.engine); } break; case '[': while (tes->tt.ts.from != tes->tt.ts.to && *tes->tt.ts.from != ']') tt_TokenizeCommand(&tes->tt, 1); tt_Require(&tes->tt, ']', "missing close-bracket"); tes->token = 'V'; tes->value = te_Pop(tes->tt.engine); break; case '"': tt_TokenizeUntil(&tes->tt, eDoubleQuote); tt_Require(&tes->tt, '"', "missing \""); tes->token = 'V'; tes->value = te_Pop(tes->tt.engine); break; default: if (isdigit(tes->token)) { const char* start = --tes->tt.ts.from; /*! hm, strtol needs a terminating character */ strtol(tes->tt.ts.from, (char**) &tes->tt.ts.from, 0); te_Literal(tes->tt.engine, start, tes->tt.ts.from); tes->token = 'V'; tes->value = te_Pop(tes->tt.engine); } } } } if (tes->value == NULL) tes->value = Tcl_NewObj(); return tes->token; } char tes_Consume(TclExprScanner* tes) { char token = tes_Peek(tes); tes->valid = 0; return token; } Tcl_Obj* tes_TopLevel(TclExprScanner* tes) { Tcl_Obj *result = tes_Descend(tes, 0); if (tes_Peek(tes) == '?') { Tcl_Obj *r = Tcl_NewStringObj("Q", 1); Tcl_ListObjAppendElement(NULL, r, result); tes_Consume(tes); Tcl_ListObjAppendElement(NULL, r, tes_TopLevel(tes)); tt_Require(&tes->tt, ':', "missing colon in conditional expression"); tes_Consume(tes); Tcl_ListObjAppendElement(NULL, r, tes_TopLevel(tes)); result = r; } return result; } Tcl_Obj* tes_Descend(TclExprScanner* tes, int level) { Tcl_Obj* result; const char* ops = precedences[level]; if (ops == 0) result = tes_Term(tes); else { result = tes_Descend(tes, level + 1); /*printf("Descend level %d value %ld\n", level, result.GetInt()); */ while (*ops) { if (tes_Peek(tes) == *ops) { char op = tes_Consume(tes); tes_BinOp(tes, &result, op, tes_Descend(tes, level + 1)); ops = precedences[level]; /* restart */ } else ++ops; } } return result; } Tcl_Obj* tes_Term(TclExprScanner* tes) { Tcl_Obj* r = NULL; char token = tes_Consume(tes); switch (token) { case '(': r = tes_TopLevel(tes); if (tes_Consume(tes) != ')') tt_Fail(&tes->tt, "left parenthesis missing"); break; case 'V': r = tes->value; tes->value = NULL; break; case '+': case '-': case '~': case '!': r = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, r, Tcl_NewStringObj("U", 1)); Tcl_ListObjAppendElement(NULL, r, Tcl_NewStringObj(&token, 1)); Tcl_ListObjAppendElement(NULL, r, tes_Term(tes)); break; default: tt_Fail(&tes->tt, "malformed expression"); r = Tcl_NewObj(); } return r != NULL ? r : Tcl_NewObj(); } void tes_BinOp(TclExprScanner* tes, Tcl_Obj** left, char op, Tcl_Obj* right) { Tcl_Obj* r = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, r, Tcl_NewStringObj("B", 1)); Tcl_ListObjAppendElement(NULL, r, Tcl_NewStringObj(&op, 1)); Tcl_ListObjAppendElement(NULL, r, *left); Tcl_ListObjAppendElement(NULL, r, right); *left = r; } void tes_TclExprScanner (TclExprScanner* tes, const char* from, const char* to, TclEngine* engine) { tt_TclTokenizer (&tes->tt, from, to, engine); tes->valid = 0; tes->value = NULL; } Tcl_Obj* tes_Evaluate(TclExprScanner* tes) { Tcl_Obj* result = tes_TopLevel(tes); if (tes_Peek(tes) != 0) tt_Fail(&tes->tt, "spurious characters after expression"); return result; } void te_TclEngine (TclEngine* te, const char* start) { te->start = start; te->stack = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(te->stack); } void te_OwnStack(TclEngine* te) { if (Tcl_IsShared(te->stack)) { Tcl_Obj* o = Tcl_DuplicateObj(te->stack); Tcl_IncrRefCount(o); Tcl_DecrRefCount(te->stack); te->stack = o; } } void te_AppendStack(TclEngine* te, Tcl_Obj* obj) { te_OwnStack(te); Tcl_ListObjAppendElement(NULL, te->stack, obj); } Tcl_Obj* te_LitResult(TclEngine* te, char type, const char* from, const char* to) { Tcl_Obj* o = Tcl_NewStringObj(&type, 1); Tcl_Obj* r = Tcl_NewListObj(1, &o); if (te->start != 0) { Tcl_ListObjAppendElement(NULL, r, Tcl_NewIntObj(from - te->start)); Tcl_ListObjAppendElement(NULL, r, Tcl_NewIntObj(to - from)); } else Tcl_ListObjAppendElement(NULL, r, Tcl_NewStringObj(from, to - from)); return r; } void te_LitChar(TclEngine* te, char ch) { Tcl_Obj* o = Tcl_NewStringObj("C", 1); Tcl_Obj* r = Tcl_NewListObj(1, &o); Tcl_ListObjAppendElement(NULL, r, Tcl_NewIntObj(ch)); te_AppendStack(te, r); } void te_Literal(TclEngine* te, const char* from, const char* to) { if (from + 1 == to && *from <= ' ' || *from > '~') te_LitChar(te, *from); else te_AppendStack(te, te_LitResult(te, 'L', from, to)); } int te_Frame(TclEngine* te) { return ListLength(te->stack); } void te_Command(TclEngine* te, int base) { int n = ListLength(te->stack); Tcl_Obj *r, **v, *o = Tcl_NewStringObj("X", 1); Tcl_ListObjGetElements(NULL, te->stack, &n, &v); r = Tcl_NewListObj(n - base, v + base); Tcl_ListObjReplace(NULL, r, 0, 0, 1, &o); te_OwnStack(te); Tcl_ListObjReplace(NULL, te->stack, base, n - base, 0, NULL); te_AppendStack(te, r); } int te_Merge(TclEngine* te, int wbase) { int n = ListLength(te->stack); if (n - wbase != 1) { Tcl_Obj *r, **v, *o = Tcl_NewStringObj("M", 1); Tcl_ListObjGetElements(NULL, te->stack, &n, &v); r = Tcl_NewListObj(n - wbase, v + wbase); Tcl_ListObjReplace(NULL, r, 0, 0, 1, &o); te_OwnStack(te); Tcl_ListObjReplace(NULL, te->stack, wbase, n - wbase, 0, NULL); te_AppendStack(te, r); } return ListLength(te->stack); } Tcl_Obj* te_Pop(TclEngine* te) { Tcl_Obj* r; int n = ListLength(te->stack); if (n > 0) { te_OwnStack(te); Tcl_ListObjIndex(NULL, te->stack, --n, &r); ++r->refCount; Tcl_ListObjReplace(NULL, te->stack, n, 1, 0, NULL); --r->refCount; } else r = Tcl_NewObj(); return r; } void te_Quote(TclEngine* te, int unbalanced) { Tcl_Obj* o = Tcl_NewStringObj(unbalanced ? "U" : "B", 1); Tcl_Obj* r = Tcl_NewListObj(1, &o); Tcl_ListObjAppendElement(NULL, r, te_Pop(te)); te_AppendStack(te, r); } void te_Scalar(TclEngine* te, const char* from, const char* to) { te_AppendStack(te, te_LitResult(te, 'S', from, to)); } void te_Array(TclEngine* te, const char* from, const char* to) { Tcl_Obj* r = te_LitResult(te, 'A', from, to); Tcl_ListObjAppendElement(NULL, r, te_Pop(te)); te_AppendStack(te, r); } Tcl_Obj* te_TclScan(TclEngine* te, const char* from, const char* to) { TclTokenizer tokenizer; te_AppendStack(te, Tcl_NewStringObj("T", 1)); tt_TclTokenizer(&tokenizer, from, to, te); tt_TokenizeScript(&tokenizer); return te->stack; } Tcl_Obj* te_TclExpr(TclEngine* te, const char* from, const char* to) { TclExprScanner scanner; tes_TclExprScanner(&scanner, from, to, te); return tes_Evaluate(&scanner); } critlib/scratch.README0000644000076500001200000000240007411421327014701 0ustar jcwadmin00000000000000A parser for Tcl scripts and expressions ======================================== Rev 0.10: Initial release The acronym for this extensions is admittedly a bit strained, but the code for this was indeed written some time ago to scratch an itch: "Self-Contained Runtime pArser for Tcl, as Critcl Hack" This extension is as close as one gets to "parsing" Tcl, even though this language has no real syntax (at least not in the BNF sense). There are two commands, both best illustrated with an example: % puts [scratch::parse {set a [c $d(1)]} 0] T {X {L set} {L a} {X {L c} {A d {L 1}}}} % puts [scratch::expr {1 + 2 * $a + [b $c]} 0] B + {B + {L 1} {B * {L 2} {S a}}} {X {L b} {S c}} % In the above, the first example generates a parse tree for a script, whereas the second works on algebraic expressions. The result is a tree of nodes, each a list with a type and arguments. There is also an alternative way to encode the resulting tree, which does not return tokens as strings but as two integers: offset + size: % puts [scratch::parse {set a [c $d(1)]} 1] T {X {L 0 3} {L 4 1} {X {L 7 1} {A 10 1 {L 12 1}}}} % puts [scratch::expr {1 + 2 * $a + [b $c]} 1] B + {B + {L 0 1} {B * {L 4 1} {S 9 1}}} {X {L 14 1} {S 17 1}} % critlib/scratch.tcl0000644000076500001200000000215007411421327014530 0ustar jcwadmin00000000000000# Self-Contained Runtime pArser for Tcl as Critcl Hack # Converted from earlier C++ version in "Pink", and from TinyTcl before that package provide scratch 0.10 package require critcl namespace eval scratch { namespace export parse expr critcl::ccode { #include "scratch.c" } critcl::cproc parse {char* txt int copy} Tcl_Obj* { Tcl_Obj *r; TclEngine engine; te_TclEngine(&engine, copy != 0 ? txt : 0); r = te_TclScan(&engine, txt, txt + strlen(txt)); Tcl_IncrRefCount(r); return r; } critcl::cproc expr {char* txt int copy} Tcl_Obj* { Tcl_Obj *r; TclEngine engine; te_TclEngine(&engine, copy != 0 ? txt : 0); r = te_TclExpr(&engine, txt, txt + strlen(txt)); Tcl_IncrRefCount(r); return r; } } if {[info exists pkgtest] && $pkgtest} { puts [scratch::parse {set a [c $d(1)]} 0] puts [scratch::parse {set a [c $d(1)]} 1] puts [scratch::parse {set a "b $c $d(e) [set f [$g h $i($j)]]"} 0] puts [scratch::parse {set a "b $c $d(e) [set f [$g h $i($j)]]"} 1] puts [scratch::expr {1 + 2 * $a + [b $c]} 0] puts [scratch::expr {1 + 2 * $a + [b $c]} 1] } critlib/testout.txt0000644000076500001200000002026707411421433014654 0ustar jcwadmin00000000000000 CritLib test (critcl 0.30) ========================== iadd 123 456 : 579 iadd 1 : wrong # args: should be "iadd x y" iadd 1 2 3 : wrong # args: should be "iadd x y" iadd 0 zero : expected integer but got "zero" Tcl nop: 0.01 microseconds per iteration C nop: 0.74 microseconds per iteration Tcl expr: 0.35 microseconds per iteration Tcl vars: 1.74 microseconds per iteration Tcl esum: 2.95 microseconds per iteration C iadd: 1.09 microseconds per iteration C vars: 2.64 microseconds per iteration Tcl expr: 0.6 microseconds per iteration Tcl vars: 2.71 microseconds per iteration Tcl pow3: 3.19 microseconds per iteration C cube: 0.98 microseconds per iteration C vars: 1.79 microseconds per iteration Hello world! _______________________________________________________________________________ ASCENC 0.11 =========== 123456789 = MTIzNDU2Nzg5 = 123456789 -> -> 1 -> MQ== -> 1 12 -> MTI= -> 12 123 -> MTIz -> 123 1234 -> MTIzNA== -> 1234 12345 -> MTIzNDU= -> 12345 0 -> MA== -> 0 00 -> MDA= -> 00 000 -> MDAw -> 000 0000 -> MDAwMA== -> 0000 00000 -> MDAwMDA= -> 00000 this is a test! -> dGhpcyBpcyBhIHRlc3Qh -> this is a test! MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0 NTY3ODkwMTIzNDU2Nzg5 012345678901234567890123456789012345678901234567890123456789 _______________________________________________________________________________ BLOWFISH 0.10 ============= plain = Hello world! coded = 258d3a52bf61df2467bade73 clear = Hello world! _______________________________________________________________________________ CBLAS 0.11 ========== 11.0 14.0 17.0 20.0 _______________________________________________________________________________ DYNCALL 0.11 ============ wrong # args: should be "dyncall symptr args" _______________________________________________________________________________ HEXDUMP 0.10 ============ 00000000 23205175 69636b20 68657820 64756d70 *# Quick hex dump* 00000010 20696e20 432c2066 726f6d20 4d617474 * in C, from Matt* 00000020 204e6577 6d616e27 73202270 77622220 * Newman's "pwb" * 00000030 666f7220 54636c4b 69740a0a 7061636b *for TclKit..pack* 00000040 61676520 70726f76 69646520 68657864 *age provide hexd* 00000050 756d7020 302e3130 0a706163 6b616765 *ump 0.10.package* 00000060 20726571 75697265 20637269 74636c0a * require critcl.* 00000070 0a637269 74636c3a 3a63636f 6d6d616e *.critcl::ccomman* 00000080 64206865 7864756d 70207b64 756d6d79 *d hexdump {dummy* 00000090 20696e74 65727020 6f626a63 206f626a * interp objc obj* 000000a0 767d207b 0a202073 74617469 63206368 *v} {. static ch* 000000b0 61722068 65785b5d 203d2022 30313233 *ar hex[] = "0123* 000000c0 34353637 38396162 63646566 223b0a20 *456789abcdef";. * 000000d0 2054636c 5f4f626a 202a6f62 6a507472 * Tcl_Obj *objPtr* 000000e0 3b0a2020 756e7369 676e6564 20636861 *;. unsigned cha* 000000f0 72202a73 63702c20 2a646370 3b0a2020 *r *scp, *dcp;. * 00000100 756e7369 676e6564 20636861 72206331 *unsigned char c1* 00000110 203d2027 5c30273b 0a202063 68617220 * = '\0';. char * 00000120 2a707265 66697820 3d204e55 4c4c3b0a **prefix = NULL;.* 00000130 2020696e 74207363 6c656e2c 2064636c * int sclen, dcl* 00000140 656e2c20 706c656e 203d2030 2c20692c *en, plen = 0, i,* 00000150 20696478 2c20636f 75 * idx, cou * _______________________________________________________________________________ IHASH 0.11 ========== new length = 3 new data = 1 one 2 two 3 three new keys = 1 2 3 new values = one two three new map = 0 -1 0 -1 0 -1 0 -1 2105051955 2 -2061914958 4 0 -1 1977051568 0 new get 1 = one new get 2 = two new get 3 = three new get 4 = set length = 4 set data = 1 one 2 deux 3 three 4 quattre set map = 0 -1 0 -1 -1933914571 6 0 -1 2105051955 2 -2061914958 4 0 -1 1977051568 0 set get 1 = one set get 2 = deux set get 3 = three set get 4 = quattre unset length = 3 unset data = 1 one 4 quattre 3 three unset map = 0 -1 0 -1 -1933914571 2 0 -1 -1 -1 -2061914958 4 0 -1 1977051568 0 unset get 1 = one unset get 2 = unset get 3 = three unset get 4 = quattre create 1 = 20 ihash, vs. 20 array create 10 = 18 ihash, vs. 44 array create 100 = -224 ihash, vs. 328 array create 1000 = 386 ihash, vs. 2619 array create 10000 = 13644 ihash, vs. 37195 array get 0: 0 <-> 0 get 1000: 2000 <-> 2000 get abc: <-> can't read "b(abc)": no such element in array 10x h = 34 microseconds per iteration 10x a = 18 microseconds per iteration h all = 57201 microseconds per iteration a all = 54075 microseconds per iteration same = 1 h list = 20984 microseconds per iteration a list = 59270 microseconds per iteration _______________________________________________________________________________ LZRW1 0.10 ========== compress = 00000000001048656c6c6f20776f726c642c0f076f726c0000642c20776f726c6421 restored = Hello world, world, world, world, world! _______________________________________________________________________________ MATHF 0.10 ========== 1 foot = 30.48 cm timing = 8 microseconds per iteration _______________________________________________________________________________ MD5C 0.11 ========= testing: md5 "" computed: d41d8cd98f00b204e9800998ecf8427e testing: md5 "a" computed: 0cc175b9c0f1b6a831c399e269772661 testing: md5 "abc" computed: 900150983cd24fb0d6963f7d28e17f72 testing: md5 "message digest" computed: f96b697d7cb7938d525a2f31aaf161d0 testing: md5 "abcdefghijklmnopqrstuvwxyz" computed: c3fcd3d76192e4007dfb496cca67e13b testing: md5 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" computed: d174ab98d277d9f5a5611c2c9f419d9f testing: md5 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" computed: 57edf4a22be3c955ac49da2e2107b67a input length 10: 1 microseconds per iteration input length 50: 5 microseconds per iteration input length 100: 5 microseconds per iteration input length 500: 17 microseconds per iteration input length 1000: 34 microseconds per iteration input length 5000: 153 microseconds per iteration input length 10000: 305 microseconds per iteration _______________________________________________________________________________ MD5PURE 1.2 =========== _______________________________________________________________________________ MVEC 0.12 ========= compile: 761685 microseconds per iteration _______________________________________________________________________________ NOOP 0.10 ========= compile: 238128 microseconds per iteration run 100: 74 microseconds per iteration _______________________________________________________________________________ RCHAN 0.10 ========== compile: 1152125 microseconds per iteration _______________________________________________________________________________ SCRATCH 0.10 ============ T {X {L set} {L a} {X {L c} {A d {L 1}}}} T {X {L 0 3} {L 4 1} {X {L 7 1} {A 10 1 {L 12 1}}}} T {X {L set} {L a} {M {L {b }} {S c} {C 32} {A d {L e}} {C 32} {X {L set} {L f} {X {S g} {L h} {A i {S j}}}}}} T {X {L 0 3} {L 4 1} {M {L 7 2} {S 10 1} {C 32} {A 13 1 {L 15 1}} {C 32} {X {L 19 3} {L 23 1} {X {S 27 1} {L 29 1} {A 32 1 {S 35 1}}}}}} B + {B + {L 1} {B * {L 2} {S a}}} {X {L b} {S c}} B + {B + {L 0 1} {B * {L 4 1} {S 9 1}}} {X {L 14 1} {S 17 1}} _______________________________________________________________________________ TYPCL 0.12 ========== no test code _______________________________________________________________________________ VFS 0.12 ======== ERROR IN PACKAGE vfs 0.12: conflicting versions provided for package "vfs": 1.0, then 0.12 while executing "package provide vfs 0.12" (file "vfs.tcl" line 3) invoked from within "source $f" _______________________________________________________________________________ XRE 0.10 ======== ok! xre _______________________________________________________________________________ ZIPPER 0.10 =========== no test code _______________________________________________________________________________ ZLIB 0.10 ========= adler = 26f00e2e crc32 = 5e4c0b61 compress = 789cf348cdc9c95728cf2fca49d1c14329020026f00e2e restored = Hello world, world, world, world, world! deflated = f348cdc9c95728cf2fca49d1c143290200 restored = Hello world, world, world, world, world! _______________________________________________________________________________ 1 errors critlib/typcl.py0000644000076500001200000000107607376430250014115 0ustar jcwadmin00000000000000import typcl typcl.config('/usr/lib/libtcl8.3.so') tcl = typcl.interp() print tcl print tcl.eval('info patchlevel') tcl.init() # initialize Tcl runtime so Tk initialization works tcl.eval('load /usr/lib/libtk8.3.so') print tcl.eval('package require Tk') print map(str, tcl.call('info', 'vars').v) def fetch(key): return globals()[key.s] tcl.link('pyfetch', fetch) tcl.eval('puts "called from: [pyfetch __name__]"') tcl.eval(""" pack [button .b1 -text "Hit me!" -command {puts "ouch, that hurts"}] pack [button .b2 -text "Exit" -command exit] vwait forever """) critlib/typcl.README0000644000076500001200000000617407376431000014420 0ustar jcwadmin00000000000000Using CriTcl to build a Python extension ======================================== Rev 0.12: Moved Tcl lib path to Python, no longer hard-wired Rev 0.11: Added logic to transfer data and do calls both ways Rev 0.10: Initial release Typcl is a bit weird... It's a an extension to use Tcl *from* Python. It doesn't really require CriTcl and could have been done in standard C. Nevertheless, CriTcl makes it relatively easy to build the Typcl module, because there isn't any need to have Tcl headers or libraries around to build it. Then again, to run this you will need libtcl8.*.so - and also normally all runtime files plus Tk, etc. This code demonstrates using Tcl as shared library, and hooking into it at run time (Tcl's stubs architecture makes this delightfully simple). Furthermore, Typcl avoids string conversions where possible (both ways). Building Typcl requires a few things: - tclsh (probably needs 8.3 or later), to run the typcl.tcl script - the CriTcl package, in a place where tclsh will find it - a working setup of gcc (which CriTcl will launch) - Python headers (hardwired as /home/builds/Python-2.1.1 for now) Running Typcl requires some more things: - a Python interpreter (doh!) - Tcl as shared lib (e.g. /usr/lib/libtcl8.3.so) - if you want full Tcl: the Tcl runtime scripts, notably "init.tcl" - if you want Tk as well: the Tk library as loadable extension To build: - edit the "typcl.tcl" script to set the Python include paths right - create the beast, by doing "tclsh typcl.tcl" - the result is "typcl.so", this is a Python loadable module To try it out, do "python typcl.py" (note: it too has hardwired paths). As you will see, there is enough machinery here to run Tk scripts. The Typcl module implements a number of Python methods: typcl.config('path/to/libtcl8.?.so') this must be called first to make linkage work tcl = typcl.interp() returns a fresh Tcl interpreter object tcl.init() initialize the Tcl runtime, i.e. call Tcl_Init() print tcl.eval('info patchlevel') evaluate a script, and return the result print tcl.call('info', 'patchlevel') perform a call, passing arguments individually What the above does not show, is that the result is an object (which has a __str__, hence "print" does the right thing). Supported conversions: tcl.eval('expr {123+456}').s converts to a string (same as str()) tcl.eval('expr {123+456}').i converts to an int tcl.eval('expr {1.23+456}').f converts to a float tcl.eval('list 123 456').v converts to a vector, i.e. a Python list tcl.eval('list 123 456').v[0].i this shows that vector conversion is nested Lastly, there is a "link" method which lets Tcl call back into Python. It creates a command in the Tcl context which can call a Python object. The following example shows how to fetch Python info from Tcl: def fetch(key): return globals()[key.s] tcl.link('pyfetch', fetch) tcl.eval('puts "called from: [pyfetch __name__]"') Typcl is still young. Issues such as properly dealing with events and releasing the Python lock, as well as Unicode, have not been tackled. critlib/typcl.so0000755000076500001200000002321407411411204014073 0ustar jcwadmin00000000000000ELFà 4Ì"4 (    , ,Ôü„„/„/ÀÀ%A2)0->@5=?,8(<36;:!19%"#'&+*7.4/$ ”4D°4 d Ä d Œ  à  À à , €/„/D0L0T0ô0ô0S‘„/ñÿ´ÜÃb"± P ¤€Ç/d  1Jº"18*(_ ŸxuDô0ñÿéâö5À ;†"Ñ=ô0ñÿö1 T0ñÿP1ñÿ…1»bŽÖ _DYNAMIC_GLOBAL_OFFSET_TABLE___gmon_start___init_fini__cxa_finalize__deregister_frame_info__register_frame_infodlopendlsymtclStubsPtrPyExc_RuntimeErrorPyErr_SetString_Py_NoneStructPyString_TypePyInt_TypePyFloat_TypePyTuple_TypePyTuple_SizePyList_TypePyObject_Str_PyObject_New_PyObject_DelPyString_FromStringAndSizePyInt_FromLongPyFloat_FromDoublePyList_NewPy_FindMethodPyArg_ParseTuplePy_GetProgramNameinittypclPyType_TypePy_InitModule4PyTuple_NewPyObject_CallObjecttclPlatStubsPtrtclIntStubsPtrtclIntPlatStubsPtrTypcl_Initlibc.so.6_edata__bss_start_endGLIBC_2.1.3GLIBC_2.03si Uii a ,$,l,x,€,¤,à-ä-ì-ð-ô-ü-.. ....L.X.`.,/0/8/¬0?U‰åƒìSè[Ãä$èdè?èÚ[ÉÃÿ³ÿ£ÿ£ héàÿÿÿÿ£héÐÿÿÿÿ£héÀÿÿÿÿ£hé°ÿÿÿÿ£h é ÿÿÿÿ£ h(éÿÿÿÿ£$h0é€ÿÿÿÿ£(h8épÿÿÿÿ£,h@é`ÿÿÿÿ£0hHéPÿÿÿÿ£4hPé@ÿÿÿÿ£8hXé0ÿÿÿÿ£<h`é ÿÿÿÿ£@hhéÿÿÿÿ£Dhpéÿÿÿÿ£Hhxéðþÿÿÿ£Lh€éàþÿÿÿ£PhˆéÐþÿÿÿ£ThéÀþÿÿÿ£Xh˜é°þÿÿU‰åƒìSè[Ãh#‹ƒœ…ÀtÿÐ[ÉÉöU‰åƒìSè[Ã8#ƒ»Ôûÿÿudƒ»„t.‹ƒpƒÄô‹PèVÿÿÿƒÄët&‹ƒÐûÿÿP‰“Ðûÿÿ‹ÿЋƒÐûÿÿƒ8u⃻xtƒÄôƒ,ÿÿÿPèvþÿÿǃÔûÿÿ‹]è‰ì]Éö¼'U‰åƒìSè[è"[‰ì]ô&U‰åƒìSè[È"ƒ»ltƒÄøƒ Pƒ,ÿÿÿPèºýÿÿ‹]è‰ì]ô&U‰åƒìSè[ÃH"[‰ì]ô&U‰åƒìVSè[Ã'"‹EƒÄøhPè÷ýÿÿ‰ÂƒÄ…ÒtIƒÄøƒŒêÿÿPRèþýÿÿƒÄ…Àt2ÿЉƅöt*ƒÄôVèÊ ƒÄ…Àt‹ƒ”ƒÄô‹V‹€ÀÿÐÿƒìûÿÿeè[^‰ì]ÃU‰åƒìSè[è!‹UƒÄø‹ƒ”ƒÄô‹R‹€ÀÿÐP‹ƒ\‹Pèàüÿÿ1À‹]è‰ì]Ãt&¼'U‰åƒìWVSè[ÃV!‹}…ÿ„ð;»`„ä‹Wƒ üÿÿ9Âu‹G éß;“hu'‹ƒ”ƒÄø‹‹GPGP‹‚èÿÐé·´&;“ˆu‹ƒ”ƒÄô‹‹GP‹‚àÿÐéŒ;“du$ƒÄø‹ƒ”ƒìÝG‹Ý$‹€ÔÿÐécv;“€uzƒÄôWèËüÿÿ‰Eü‹ƒ”ƒÄô‹‹EüÁàP‹BÿЉEø1öƒÄ ;uü}#ƒÇ t&ƒÄô‹·Pèôþÿÿ‹Uø‰²ƒÄF;uü|åƒÄø‹³”‹Uø‹R‹UüR‹€ÜÿЉǃÄô‹‹Uøëu;“Œuw‹G‰Eô‹ƒ”ƒÄô‹‹EôÁàP‹BÿЉEð1öƒÄ;uô}‹G ƒÄô‹°Pè}þÿÿ‹Uð‰²ƒÄF;uô|âƒÄø‹³”‹Uð‹R‹UôR‹€ÜÿЉǃÄô‹‹UðR‹@ÿЉøë_ƒÄôWè²ûÿÿ‰ÇƒÄ…ÿt=‹ƒ”ƒÄø‹‹GPGP‹‚èÿЉÆÿƒÄƒ?u ƒÄô‹GW‹@ÿЉð붋ƒ”‹‹€äÿÐeØ[^_‰ì]öU‰åƒì WVSè[Ã&‹}‹u ƒÄôƒ üÿÿPè¢úÿÿ‰x‰p ÿeè[^_‰ì]Ãt&U‰åƒìVSè[Ãç‹u‹F ÿƒ8‹ƒ”ƒÄô‹‹F P‹‚€ÿЃÄƒÄôVèxúÿÿeè[^‰ì]ÃvU‰åƒìSè[Ø‹M‹ƒ”ƒÄø‹EüP‹A P‹‚¬ÿЉƒÄø‹EüPRèúÿÿ‹]è‰ì]Éö¼'U‰åƒì,WVSè[ÃF‹E €8„ƒ€x…y¾ƒèfƒø‡Y‰Ú+”ƒüáÿÿÿât&¼'qÁÁ¯ÁÁÁÁÁÁÁÁÁÀÁÁ.ƒÄô‹MQèÿÿÿ鋃”ƒÄü‹EüP‹M‹A P‹AP‹‚¤ÿЃÄ…À…ÁƒÄô‹EüPè¾øÿÿéÕ‹ƒ”ƒÄü‹EðP‹M‹A P‹AP‹‚”ÿЃÄ…À…ƒƒÄøƒìÝEðÝ$è‹ùÿÿé’‹ƒ”‹EìPEèP‹M‹A P‹AP‹‚¼ÿЃÄ…ÀuCƒÄô‹EèPèðøÿÿ‰Ç1öƒÄ;uè}'‹EìƒÄø‹°P‹U‹BPè¢ýÿÿ‰Â‹G ‰°ƒÄF;uè|Ù‰øë%‹MƒÄô‹APèþúÿÿëƒÄüP‹EPƒðûÿÿPèøÿÿeÈ[^_‰ì]ô&¼'U‰åƒìVSè[Ãw‹u‹ƒ”ƒÄô‹‹FP‹‚ØÿЃÄ…Àu ‹ƒ`ÿë ƒÄô‹FPè„úÿÿeè[^‰ì]Ãt&¼'U‰åƒì WVSè[ËE ƒÄôPèŸúÿÿ‰ÆƒÄü‹»”ÿ‹hV‹M‹AP‹‚œÿЉEüÿƒÄ ƒ>ƒÄô‹V‹€€ÿЃÄƒ}üu'ƒÄøƒÄô‹M‹‹AP‹‚ ÿÐP‹U‹BPècüÿÿë)ƒÄøƒÄô‹M‹‹AP‹‚ÀÿÐP‹ƒ\‹PèÖöÿÿ1Àeè[^_‰ì]ô&¼'U‰åƒìSè[ÃH‹E ƒÄüUüR“¦êÿÿRPè’÷ÿÿƒÄ…ÀtƒÄø‹EüP‹EPèïþÿÿë1À‹]è‰ì]Ãt&U‰åƒìSè[Ãø‹U…Òtÿ u ƒÄô‹BR‹@ÿЋ]è‰ì]Ãë U‰åƒìSè[ø‹U EüPEøPƒ­êÿÿPRè÷ÿÿƒÄ…Àt?‹Eüÿ‹ƒ”ƒÄô‹ƒüäÿÿP‹EüPƒœçÿÿP‹EøP‹E‹@P‹‚ˆÿЋƒ`ÿë1À‹]è‰ì]öU‰åƒìVSè[Ã7‹u‹ƒ”ƒÄô‹‹FP‹‚ÀÿЃÄôVèÕõÿÿeè[^‰ì]ÃU‰åƒìSè[Ãø‹U‹E ƒÄüPRƒŒýÿÿPèRõÿÿ‹]è‰ì]Ãë U‰åƒìVSè[÷‹E ƒÄüUüR“ÕêÿÿRPèöÿÿƒÄ…ÀtVƒÄô‹EüPèR÷ÿÿƒÄƒ»ìûÿÿt&‹ƒ”ƒÄô‹0èBõÿÿP‹†HÿЋƒ`ÿëvƒÄøƒÞêÿÿP‹ƒ\‹Pè¤ôÿÿ1Àeè[^‰ì]ö¼'U‰åƒìVSè[ûìûÿÿt(ƒÄôƒìýÿÿPèôÿÿ‰Æ‹ƒ”‹‹€€ÿЉF‰ðëƒÄøƒ ëÿÿP‹ƒ\‹Pè/ôÿÿ1Àeè[^‰ì]ô&U‰åƒìSè[苃˜‰ƒüÿÿ‰ƒðýÿÿƒÄôhòjƒÿÿÿPƒØþÿÿPƒ=ëÿÿPèóóÿÿ‹]è‰ì]ÃU‰åƒì WVSè[ÃVƒ}u‹ƒ”ƒÄü‹jƒLëÿÿ鲃}'‹ƒ”‹ƒlëÿÿP‹EPj‹E P‹‚(é“vƒÄô‹EHPèoôÿÿ‰Eü¿ƒÄ;}}&‰ÆƒÆ ‹UƒÄø‹ºP‹E Pè›øÿÿ‰ƒÄƒÆG;}|߃Äø‹UüR‹EPèÙóÿÿ‰Ç‹UüƒÄÿ uƒÄô‹BR‹@ÿЃÄ…ÿu.‹ƒ”ƒÄü‹jƒyëÿÿP‹E P‹‚¨ÿиë@´&ƒÄø‹ƒ”ƒÄô‹0WèìõÿÿP‹U R‹†´ÿÐÿƒÄ ƒ?u ƒÄô‹GW‹@ÿÐ1Àeè[^_‰ì]ö¼'U‰åƒìVSè[ËM‹Q …Òt:Ϻ£ütƒŒëÿÿ‰ÇA1Àëo´&‹³”‰jƒ³ëÿÿPƒ·ëÿÿPQ‹‚PÿÐ…Àu Ç1Àë9‹‹@…Àt*‹“‹‰‹‹@‹“|‹@‰‹‹@‹“t‹@‰¸eè[^‰ì]Ãë U‰åƒìVSè[ÃG‹uƒÄôVè ÿÿÿƒÄ…Àt*‹ƒ”ƒÄô‹jjƒœçÿÿPƒ»ëÿÿPV‹‚ˆÿÐ1Àë¸eè[^‰ì]ÃU‰åƒìVSè[Ãç³ðÿÿÿƒ»ðÿÿÿÿt ‹ÿЃÆüƒ>ÿuô[^‰ì]Ãt&¼'U‰åƒìSè[è[‰ì]ô&U‰åƒìSè[Èè7òÿÿ[ÉÃTcl_CreateInterpTypclObjO:evalsO:linklinkevalcallinitTypclInterps:configTcl initialization failednot initialized, call config firstinterpconfigtypclpython has not been initializedoption ?...?python exceptionThis extension requires stubs-support.8.1Tclpython ,P0ñ`°init() -- initialize the Tcl runtimecall(cmd,...) -- process call in Tcl and return resulteval(script) -- evaluate script in Tcl and return resultlink(name, obj) -- create a Tcl command to call a Python objectÐà,0 -`-  - Pconfig() -- configure Typcl to find the Tcl runtimeinterp() -- create a new Tcl interpreterŠÀ.ƒ0/Interface to Tcl3 d À”D4 U T0 Ä d `þÿÿo4 ÿÿÿoðÿÿo°úÿÿoÿÿÿÿÿÿÿÿ„/¢ ² Â Ò â ò   " 2 B R b r ‚ ’ ¢ ² Â Ò ,GCC: (GNU) 2.95.3 20010315 (SuSE)GCC: (GNU) 2.95.3 20010315 (SuSE)GCC: (GNU) 2.95.3 20010315 (SuSE)GCC: (GNU) 2.95.3 20010315 (SuSE)GCC: (GNU) 2.95.3 20010315 (SuSE)01.0101.0101.0101.0101.01.symtab.strtab.shstrtab.hash.dynsym.dynstr.gnu.version.gnu.version_r.rel.dyn.rel.plt.init.plt.text.fini.rodata.data.eh_frame.dynamic.ctors.dtors.got.sbss.bss.comment.note”” ! 44)DDk1ÿÿÿo°°‚>þÿÿo4 4 0M d d `V Ä Ä   _d d %eŒ Œ Pjà à à pÀÀvàà@ ~ , ` „€/€Ž„/„À—D0D žL0L ¥T0T  ªô0ô °ô0ô (µô ¯¾£!d"Äcritlib/typcl.tcl0000644000076500001200000002120207376417540014247 0ustar jcwadmin00000000000000# Embedding Tcl in Python package provide typcl 0.12 package require critcl critcl::cheaders -I/home/builds/Python-2.1.1/Include critcl::cheaders -I/home/builds/Python-2.1.1 # support for connecting to Tcl in a specific shared library using stubs critcl::ccode { #include static int MyInitStubs(Tcl_Interp*); /* defined by critcl later on */ static int inited = 0; static void BindTclStubs(char* lib) { void *h = dlopen(lib, RTLD_NOW | RTLD_GLOBAL); if (h != NULL) { Tcl_Interp *(*f)() = (Tcl_Interp *(*)()) dlsym(h, "Tcl_CreateInterp"); if (f != NULL) { Tcl_Interp *ip = (*f)(); if (ip != NULL && MyInitStubs(ip)) { Tcl_DeleteInterp(ip); ++inited; } } } } } critcl::ccode { #include typedef struct { PyObject_HEAD; Tcl_Interp *ip; } typclinterp; typedef struct { PyObject_HEAD; Tcl_Interp *ip; Tcl_Obj *obj; } typclobj; staticforward PyTypeObject typclinterp_type; staticforward PyTypeObject typclobj_type; static PyObject* PassFailure(Tcl_Interp *ip) { PyErr_SetString(PyExc_RuntimeError, Tcl_GetStringResult(ip)); return NULL; } static Tcl_Obj* PyAsTclObj(PyObject *o) { if (o != NULL && o != Py_None) { if (o->ob_type == &typclobj_type) { typclobj *to = (typclobj*) o; return to->obj; } if (PyString_Check(o)) return Tcl_NewStringObj(PyString_AS_STRING(o), PyString_GET_SIZE(o)); if (PyInt_Check(o)) return Tcl_NewLongObj(PyInt_AS_LONG(o)); if (PyFloat_Check(o)) return Tcl_NewDoubleObj(PyFloat_AS_DOUBLE(o)); if (PyTuple_Check(o)) { int i, oc = PyTuple_Size(o); Tcl_Obj *obj, **ov = (Tcl_Obj**) ckalloc(oc * sizeof (Tcl_Obj*)); for (i = 0; i < oc; ++i) ov[i] = PyAsTclObj(PyTuple_GET_ITEM(o, i)); obj = Tcl_NewListObj(oc, ov); ckfree((void*) ov); return obj; } if (PyList_Check(o)) { int i, oc = PyList_GET_SIZE(o); Tcl_Obj *obj, **ov = (Tcl_Obj**) ckalloc(oc * sizeof (Tcl_Obj*)); for (i = 0; i < oc; ++i) ov[i] = PyAsTclObj(PyList_GET_ITEM(o, i)); obj = Tcl_NewListObj(oc, ov); ckfree((void*) ov); return obj; } o = PyObject_Str(o); if (o != NULL) { Tcl_Obj *obj = Tcl_NewStringObj(PyString_AS_STRING(o), PyString_GET_SIZE(o)); Py_DECREF(o); return obj; } } return Tcl_NewObj(); } static PyObject* TclAsPyObj(Tcl_Interp *ip, Tcl_Obj *obj) { typclobj *to = PyObject_New(typclobj, &typclobj_type); to->ip = ip; to->obj = obj; Tcl_IncrRefCount(obj); return (PyObject*) to; } static PyMethodDef typclobj_meth[] = { {0} }; static void typclobj_dealloc(typclobj *to) { Tcl_DecrRefCount(to->obj); PyObject_Del(to); } static PyObject *typclobj_str(typclobj *to) { int n; char *p = Tcl_GetStringFromObj(to->obj, &n); return PyString_FromStringAndSize(p, n); } static PyObject *typclobj_getattr(typclobj *to, char *nm) { if (nm[0] != 0 && nm[1] == 0) { switch (*nm) { case 's': { /* string */ return typclobj_str(to); } case 'i': { /* int */ long v; if (Tcl_GetLongFromObj(to->ip, to->obj, &v) != TCL_OK) break; return PyInt_FromLong(v); } case 'f': { /* float */ double v; if (Tcl_GetDoubleFromObj(to->ip, to->obj, &v) != TCL_OK) break; return PyFloat_FromDouble(v); } case 'v': { /* vector */ PyObject *o; Tcl_Obj **ov; int i, oc; if (Tcl_ListObjGetElements(to->ip, to->obj, &oc, &ov) != TCL_OK) break; o = PyList_New(oc); for (i = 0; i < oc; ++i) PyList_SET_ITEM(o, i, TclAsPyObj(to->ip, ov[i])); return o; } } return PassFailure(to->ip); } return Py_FindMethod(typclobj_meth, (PyObject*) to, nm); } statichere PyTypeObject typclobj_type = { PyObject_HEAD_INIT(0) 0, "TypclObj", sizeof (typclobj), 0, (destructor) typclobj_dealloc, 0, (getattrfunc) typclobj_getattr, 0, 0, 0, 0, 0, 0, 0, 0, (reprfunc) typclobj_str, }; static char doc_init[] = "init() -- initialize the Tcl runtime"; static PyObject* meth_init(typclinterp *ti, PyObject *args) { if (Tcl_Init(ti->ip) != TCL_OK) return PassFailure(ti->ip); Py_INCREF(Py_None); return Py_None; } static char doc_call[] = "call(cmd,...) -- process call in Tcl and return result"; static PyObject* meth_call(typclinterp *ti, PyObject *args) { int e; Tcl_Obj *obj = PyAsTclObj(args); Tcl_IncrRefCount(obj); e = Tcl_EvalObjEx(ti->ip, obj, TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); Tcl_DecrRefCount(obj); if (e != TCL_OK) { PyErr_SetString(PyExc_RuntimeError, Tcl_GetStringResult(ti->ip)); return NULL; } return TclAsPyObj(ti->ip, Tcl_GetObjResult(ti->ip)); } static char doc_eval[] = "eval(script) -- evaluate script in Tcl and return result"; static PyObject* meth_eval(typclinterp *ti, PyObject *args) { PyObject *o; if (!PyArg_ParseTuple(args, "O:eval", &o)) return NULL; return meth_call(ti, o); } /* forward declaration */ static int tcl_python(ClientData cd, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]); static void MyDelProc(ClientData cd) { Py_XDECREF((PyObject*) cd); } static char doc_link[] = "link(name, obj) -- create a Tcl command to call a Python object"; static PyObject* meth_link(typclinterp *ti, PyObject *args) { char *s; PyObject *o; if (!PyArg_ParseTuple(args, "sO:link", &s, &o)) return NULL; Py_INCREF(o); Tcl_CreateObjCommand(ti->ip, s, tcl_python, o, MyDelProc); Py_INCREF(Py_None); return Py_None; } statichere PyMethodDef typclinterp_meth[] = { {"init", (PyCFunction) meth_init, METH_VARARGS, doc_init}, {"call", (PyCFunction) meth_call, METH_VARARGS, doc_call}, {"eval", (PyCFunction) meth_eval, METH_VARARGS, doc_eval}, {"link", (PyCFunction) meth_link, METH_VARARGS, doc_link}, {0} }; static void typclinterp_dealloc(typclinterp *ti) { Tcl_DeleteInterp(ti->ip); PyObject_Del(ti); } static PyObject *typclinterp_getattr(typclinterp *ti, char *nm) { return Py_FindMethod(typclinterp_meth, (PyObject*) ti, nm); } static PyTypeObject typclinterp_type = { PyObject_HEAD_INIT(0) 0, "TypclInterp", sizeof (typclinterp), 0, (destructor) typclinterp_dealloc, 0, (getattrfunc) typclinterp_getattr, }; static char doc_config[] = "config() -- configure Typcl to find the Tcl runtime"; static PyObject* meth_config(PyObject *o, PyObject *args) { char *s; if (!PyArg_ParseTuple(args, "s:config", &s)) return NULL; BindTclStubs(s); if (!inited) { PyErr_SetString(PyExc_RuntimeError, "Tcl initialization failed"); return NULL; } Tcl_FindExecutable(Py_GetProgramName()); Py_INCREF(Py_None); return Py_None; } static char doc_interp[] = "interp() -- create a new Tcl interpreter"; static PyObject* meth_interp(PyObject *o, PyObject *args) { typclinterp *ti; if (!inited) { PyErr_SetString(PyExc_RuntimeError, "not initialized, call config first"); return NULL; } ti = PyObject_New(typclinterp, &typclinterp_type); ti->ip = Tcl_CreateInterp(); return (PyObject*) ti; } static PyMethodDef module_methods[] = { {"config", meth_config, METH_VARARGS, doc_config}, {"interp", meth_interp, METH_VARARGS, doc_interp}, {0} }; static char doc_typcl[] = "Interface to Tcl"; DL_EXPORT(void) inittypcl() { typclobj_type.ob_type = &PyType_Type; typclinterp_type.ob_type = &PyType_Type; Py_InitModule4("typcl", module_methods, doc_typcl, 0, PYTHON_API_VERSION); } } # the name of this command is not necessarily the one used later on critcl::ccommand python {cd ip objc objv} { int i; PyObject *r, *t, *o = (PyObject*) cd; if (o == NULL) { Tcl_SetResult(ip, "python has not been initialized", TCL_STATIC); return TCL_ERROR; } if (objc < 2) { Tcl_WrongNumArgs(ip, 1, objv, "option ?...?"); return TCL_ERROR; } t = PyTuple_New(objc - 1); for (i = 1; i < objc; ++i) PyTuple_SET_ITEM(t, i - 1, TclAsPyObj(ip, objv[i])); r = PyObject_CallObject(o, t); Py_DECREF(t); if (r == NULL) { Tcl_SetResult(ip, "python exception", TCL_STATIC); return TCL_ERROR; } Tcl_SetObjResult(ip, PyAsTclObj(r)); Py_DECREF(r); return TCL_OK; } # always generate code, this "Tcl script" is not really used from Tcl foreach {libfile ininame} [critcl::cbuild "" 0] break # copy to a "typcl.so" file which can be loaded and used from Python if {[info exists libfile]} { set dest typcl[file extension $libfile] file delete $dest file copy $libfile $dest } if {[info exists pkgtest] && $pkgtest} { puts "no test code" } critlib/vfs.README0000644000076500001200000000175407376214250014070 0ustar jcwadmin00000000000000Wrapper for Tcl 8.4's new Virtual File System layer by Vince Darley =================================================================== Rev 0.12: Remove hard-coded include path, disable librarypath for now Rev 0.11: Switched back to vfs::filesystem Rev 0.10: Initial release This is a thin wrapper around "vfs.c", from the TclVFS project, see: http://sourceforge.net/projects/tclvfs VFS can only be used as of Tcl 8.4 (now in alpha). Usage: vfs::filesystem info ?path? without arg: list all mount point, with arg: list mount cmd vfs::filesystem mount ?-volume? path cmd mount the specified path, using "cmd" as driver for this area vfs::filesystem unmount path unmount the specified path Historical note: the Virtual File System (VFS) is an idea by Matt Newman, who initally coded a nearly 100% pure Tcl version it for use in TclKit. The current implementation is now part of the Tcl core, and provides a high degree of compatibility with the Tcl test suite. critlib/vfs.tcl0000644000076500001200000000265307376413600013714 0ustar jcwadmin00000000000000# Wrapper for Vince Darley's Virtual File System core package provide vfs 0.12 package require critcl namespace eval vfs { namespace export filesystem # HACK ALERT: provide a fake header which defines "struct stat", etc. critcl::cheaders vfs_c/tclPort.h # make sure the vfs.c file is found set dir [file join [file dirname [info script]] vfs_c] critcl::cheaders -I$dir critcl::cinit { if (Tcl_PkgRequire(ip, "Tcl", "8.4", 0) == NULL) return TCL_ERROR; Vfs_RegisterWithInterp(ip); } critcl::ccode { /* stubs support is built into critcl, so disable this call */ #undef Tcl_InitStubs #define Tcl_InitStubs(a,b,c) b /* disable (rename) the init code, since it is generated by critcl */ #define Vfs_Init DummyVfs_Init #include #undef Tcl_InitStubs #undef Vfs_Init } critcl::ccommand filesystem VfsFilesystemObjCmd } if 0 { # Support for encodings, from Vince Darley # This also depends on the extra include path, see tclInt.h critcl::ccommand librarypath {dummy interp objc objv} { if (objc == 1) { Tcl_SetObjResult(interp, TclGetLibraryPath()); } else { TclSetLibraryPath(objv[1]); TclpSetInitialEncodings(); } return TCL_OK; } } if {[info exists pkgtest] && $pkgtest} { # make a harmless call which fails, to prove that it ran catch vfs::filesystem err puts $err #puts [librarypath] } critlib/vfs_c/0000755000076500001200000000000007376213555013513 5ustar jcwadmin00000000000000critlib/vfs_c/tclPort.h0000644000076500001200000000023707376213555015315 0ustar jcwadmin00000000000000/* this is *NOT* the real , just a fake one for use in vfs.c */ #include #include #include #include critlib/vfs_c/vfs.c0000644000076500001200000013400107373770070014451 0ustar jcwadmin00000000000000/* * vfs.c -- * * This file contains the implementation of the Vfs extension * to Tcl. It provides a script level interface to Tcl's * virtual file system support, and therefore allows * vfs's to be implemented in Tcl. * * The code is thread-safe. Although under normal use only * one interpreter will be used to add/remove mounts and volumes, * it does cope with multiple interpreters in multiple threads. * * Copyright (c) 2001 Vince Darley. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include /* Required to access the 'stat' structure fields */ #include "tclPort.h" /* * Windows needs to know which symbols to export. Unix does not. * BUILD_Vfs should be undefined for Unix. */ #ifdef BUILD_Vfs #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT #endif /* BUILD_Vfs */ /* * Only the _Init function is exported. */ EXTERN int Vfs_Init _ANSI_ARGS_((Tcl_Interp*)); /* * Functions to add and remove a volume from the list of volumes. * These aren't currently exported, but could be in the future. */ static void Vfs_AddVolume _ANSI_ARGS_((Tcl_Obj*)); static int Vfs_RemoveVolume _ANSI_ARGS_((Tcl_Obj*)); /* * Stores the list of volumes registered with the vfs (and therefore * also registered with Tcl). It is maintained as a valid Tcl list at * all times, or NULL if there are none (we don't keep it as an empty * list just as a slight optimisation to improve Tcl's efficiency in * determining whether paths are absolute or relative). * * We keep a refCount on this object whenever it is non-NULL. */ static Tcl_Obj *vfsVolumes = NULL; /* * Declare a mutex for thread-safety of modification of the * list of vfs volumes. */ TCL_DECLARE_MUTEX(vfsVolumesMutex) /* * struct Vfs_InterpCmd -- * * Any vfs action which is exposed to Tcl requires both an interpreter * and a command prefix for evaluation. To carry out any filesystem * action inside a vfs, this extension will lappend various additional * parameters to the command string, evaluate it in the interpreter and * then extract the result (the way the result is handled is documented * in each individual vfs callback below). * * We retain a refCount on the 'mountCmd' object, but there is no need * for us to register our interpreter reference, since we will be * made invalid when the interpreter disappears. Also, Tcl_Objs of * "path" type which use one of these structures as part of their * internal representation also do not need to add to any refCounts, * because if this object disappears, all internal representations will * be made invalid. */ typedef struct Vfs_InterpCmd { Tcl_Obj *mountCmd; /* The Tcl command prefix which will be used * to perform all filesystem actions on this * file. */ Tcl_Interp *interp; /* The Tcl interpreter in which the above * command will be evaluated. */ } Vfs_InterpCmd; /* * struct VfsNativeRep -- * * Structure used for the native representation of a path in a Tcl vfs. * To fully specify a file, the string representation is also required. * * When a Tcl interpreter is deleted, all mounts whose callbacks * are in it are removed and freed. This also means that the * global filesystem epoch that Tcl retains is modified, and all * path internal representations are therefore discarded. Therefore we * don't have to worry about vfs files containing stale VfsNativeRep * structures (but it also means we mustn't touch the fsCmd field * of one of these structures if the interpreter has gone). This * means when we free one of these structures, we just free the * memory allocated, and ignore the fsCmd pointer (which may or may * not point to valid memory). */ typedef struct VfsNativeRep { int splitPosition; /* The index into the string representation * of the file which indicates where the * vfs filesystem is mounted. */ Vfs_InterpCmd* fsCmd; /* The Tcl interpreter and command pair * which will be used to perform all filesystem * actions on this file. */ } VfsNativeRep; /* * struct VfsChannelCleanupInfo -- * * Structure we use to retain sufficient information about * a channel that we can properly clean up all resources * when the channel is closed. This is required when using * 'open' on things inside the vfs. * * When the channel in question is begin closed, we will * temporarily register the channel with the given interpreter, * evaluate the closeCallBack, and then detach the channel * from the interpreter and return (allowing Tcl to continue * closing the channel as normal). * * Nothing in the callback can prevent the channel from * being closed. */ typedef struct VfsChannelCleanupInfo { Tcl_Channel channel; /* The channel which needs cleaning up */ Tcl_Obj* closeCallback; /* The Tcl command string to evaluate * when the channel is closing, which will * carry out any cleanup that is necessary. */ Tcl_Interp* interp; /* The interpreter in which to evaluate the * cleanup operation. */ } VfsChannelCleanupInfo; /* * Forward declarations for procedures defined later in this file: */ static int VfsFilesystemObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); /* * Now we define the virtual filesystem callbacks */ static Tcl_FSStatProc VfsStat; static Tcl_FSAccessProc VfsAccess; static Tcl_FSOpenFileChannelProc VfsOpenFileChannel; static Tcl_FSMatchInDirectoryProc VfsMatchInDirectory; static Tcl_FSDeleteFileProc VfsDeleteFile; static Tcl_FSCreateDirectoryProc VfsCreateDirectory; static Tcl_FSRemoveDirectoryProc VfsRemoveDirectory; static Tcl_FSFileAttrStringsProc VfsFileAttrStrings; static Tcl_FSFileAttrsGetProc VfsFileAttrsGet; static Tcl_FSFileAttrsSetProc VfsFileAttrsSet; static Tcl_FSUtimeProc VfsUtime; static Tcl_FSPathInFilesystemProc VfsInFilesystem; static Tcl_FSFilesystemPathTypeProc VfsFilesystemPathType; static Tcl_FSFilesystemSeparatorProc VfsFilesystemSeparator; static Tcl_FSFreeInternalRepProc VfsFreeInternalRep; static Tcl_FSDupInternalRepProc VfsDupInternalRep; static Tcl_FSListVolumesProc VfsListVolumes; static Tcl_Filesystem vfsFilesystem = { "tclvfs", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, &VfsInFilesystem, &VfsDupInternalRep, &VfsFreeInternalRep, /* No native to normalized */ NULL, /* No create native rep function */ NULL, /* normalize path isn't needed */ NULL, &VfsFilesystemPathType, &VfsFilesystemSeparator, &VfsStat, &VfsAccess, &VfsOpenFileChannel, &VfsMatchInDirectory, &VfsUtime, /* link is not important */ NULL, &VfsListVolumes, &VfsFileAttrStrings, &VfsFileAttrsGet, &VfsFileAttrsSet, &VfsCreateDirectory, &VfsRemoveDirectory, &VfsDeleteFile, /* Use stat for lstat */ NULL, /* No copy file */ NULL, /* No rename file */ NULL, /* No copy directory */ NULL, /* No load */ NULL, /* We don't need a getcwd or chdir */ NULL, NULL }; /* * struct VfsMount -- * * Each filesystem mount point which is registered will result in * the allocation of one of these structures. They are stored * in a linked list whose head is 'listOfMounts'. */ typedef struct VfsMount { CONST char* mountPoint; int mountLen; int isVolume; Vfs_InterpCmd interpCmd; struct VfsMount* nextMount; } VfsMount; static VfsMount* listOfMounts = NULL; /* * Declare a mutex for thread-safety of modification of the * list of vfs mounts. */ TCL_DECLARE_MUTEX(vfsMountsMutex) /* We might wish to consider exporting these in the future */ static int Vfs_AddMount(Tcl_Obj* mountPoint, int isVolume, Tcl_Interp *interp, Tcl_Obj* mountCmd); static int Vfs_RemoveMount(Tcl_Obj* mountPoint, Tcl_Interp* interp); static Vfs_InterpCmd* Vfs_FindMount(CONST char* mountPoint); static Tcl_Obj* Vfs_ListMounts(void); static void Vfs_UnregisterWithInterp _ANSI_ARGS_((ClientData, Tcl_Interp*)); static void Vfs_RegisterWithInterp _ANSI_ARGS_((Tcl_Interp*)); /* Some private helper procedures */ static VfsNativeRep* VfsGetNativePath(Tcl_Obj* pathObjPtr); static Tcl_CloseProc VfsCloseProc; static void VfsExitProc(ClientData clientData); static Tcl_Obj* VfsCommand(Tcl_Interp **iRef, CONST char* cmd, Tcl_Obj * pathPtr); /* * Hard-code platform dependencies. We do not need to worry * about backslash-separators on windows, because a normalized * path will never contain them. */ #ifdef MAC_TCL #define VFS_SEPARATOR ':' #else #define VFS_SEPARATOR '/' #endif /* *---------------------------------------------------------------------- * * Vfs_Init -- * * This procedure is the main initialisation point of the Vfs * extension. * * Results: * Returns a standard Tcl completion code, and leaves an error * message in the interp's result if an error occurs. * * Side effects: * Adds a command to the Tcl interpreter. * *---------------------------------------------------------------------- */ int Vfs_Init(interp) Tcl_Interp *interp; /* Interpreter for application. */ { if (Tcl_InitStubs(interp, "8.4", 0) == NULL) { return TCL_ERROR; } if (Tcl_PkgRequire(interp, "Tcl", "8.4", 0) == NULL) { return TCL_ERROR; } /* * Safe interpreters are not allowed to modify the filesystem! * (Since those modifications will affect other interpreters). */ if (Tcl_IsSafe(interp)) { return TCL_ERROR; } if (Tcl_PkgProvide(interp, "vfs", "1.0") == TCL_ERROR) { return TCL_ERROR; } /* * Create 'vfs::filesystem' command, and interpreter-specific * initialisation. */ Tcl_CreateObjCommand(interp, "vfs::filesystem", VfsFilesystemObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Vfs_RegisterWithInterp(interp); return TCL_OK; } /* *---------------------------------------------------------------------- * * Vfs_RegisterWithInterp -- * * Allow the given interpreter to be used to handle vfs callbacks. * * Results: * None. * * Side effects: * May register the entire vfs code (if not previously registered). * Registers some cleanup action for when this interpreter is * deleted. * *---------------------------------------------------------------------- */ static void Vfs_RegisterWithInterp(interp) Tcl_Interp *interp; { ClientData vfsAlreadyRegistered; /* * We need to know if the interpreter is deleted, so we can * remove all interp-specific mounts. */ Tcl_SetAssocData(interp, "vfs::inUse", (Tcl_InterpDeleteProc*) Vfs_UnregisterWithInterp, (ClientData) 1); /* * Perform one-off registering of our filesystem if that * has not happened before. */ vfsAlreadyRegistered = Tcl_FSData(&vfsFilesystem); if (vfsAlreadyRegistered == NULL) { Tcl_FSRegister((ClientData)1, &vfsFilesystem); Tcl_CreateExitHandler(VfsExitProc, (ClientData)NULL); } } /* *---------------------------------------------------------------------- * * Vfs_UnregisterWithInterp -- * * Remove all of the mount points that this interpreter handles. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void Vfs_UnregisterWithInterp(dummy, interp) ClientData dummy; Tcl_Interp *interp; { int res = TCL_OK; /* Remove all of this interpreters mount points */ while (res == TCL_OK) { res = Vfs_RemoveMount(NULL, interp); } /* Make sure our assoc data has been deleted */ Tcl_DeleteAssocData(interp, "vfs::inUse"); } /* *---------------------------------------------------------------------- * * Vfs_AddMount -- * * Adds a new vfs mount point. After this call all filesystem * access within that mount point will be redirected to the * interpreter/mountCmd pair. * * This command must not be called unless 'interp' has already * been registered with 'Vfs_RegisterWithInterp' above. This * usually happens automatically with a 'package require vfs'. * * Results: * TCL_OK unless the inputs are bad or a memory allocation * error occurred, or the interpreter is not vfs-registered. * * Side effects: * A new volume may be added to the list of available volumes. * Future filesystem access inside the mountPoint will be * redirected. Tcl is informed that a new mount has been added * and this will make all cached path representations invalid. * *---------------------------------------------------------------------- */ static int Vfs_AddMount(mountPoint, isVolume, interp, mountCmd) Tcl_Obj* mountPoint; int isVolume; Tcl_Interp* interp; Tcl_Obj* mountCmd; { char *strRep; int len; VfsMount *newMount; if (mountPoint == NULL || interp == NULL || mountCmd == NULL) { return TCL_ERROR; } /* * Check whether this intepreter can properly clean up * mounts on exit. If not, throw an error. */ if (Tcl_GetAssocData(interp, "vfs::inUse", NULL) == NULL) { return TCL_ERROR; } newMount = (VfsMount*) ckalloc(sizeof(VfsMount)); if (newMount == NULL) { return TCL_ERROR; } strRep = Tcl_GetStringFromObj(mountPoint, &len); newMount->mountPoint = (char*) ckalloc(1+len); newMount->mountLen = len; if (newMount->mountPoint == NULL) { ckfree((char*)newMount); return TCL_ERROR; } strcpy((char*)newMount->mountPoint, strRep); newMount->interpCmd.mountCmd = mountCmd; newMount->interpCmd.interp = interp; newMount->isVolume = isVolume; Tcl_IncrRefCount(mountCmd); Tcl_MutexLock(&vfsMountsMutex); newMount->nextMount = listOfMounts; listOfMounts = newMount; Tcl_MutexUnlock(&vfsMountsMutex); if (isVolume) { Vfs_AddVolume(mountPoint); } Tcl_FSMountsChanged(&vfsFilesystem); return TCL_OK; } /* *---------------------------------------------------------------------- * * Vfs_RemoveMount -- * * This procedure searches for a matching mount point and removes * it if one is found. If 'mountPoint' is given, then both it and * the interpreter must match for a mount point to be removed. * * If 'mountPoint' is NULL, then the first mount point for the * given interpreter is removed (if any). * * Results: * TCL_OK if a mount was removed, TCL_ERROR otherwise. * * Side effects: * A volume may be removed from the current list of volumes * (as returned by 'file volumes'). A vfs may be removed from * the filesystem. If successful, Tcl will be informed that * the list of current mounts has changed, and all cached file * representations will be made invalid. * *---------------------------------------------------------------------- */ static int Vfs_RemoveMount(mountPoint, interp) Tcl_Obj* mountPoint; Tcl_Interp *interp; { /* These two are only used if mountPoint is non-NULL */ char *strRep = NULL; int len = 0; VfsMount *mountIter; /* Set to NULL just to avoid warnings */ VfsMount *lastMount = NULL; if (mountPoint != NULL) { strRep = Tcl_GetStringFromObj(mountPoint, &len); } Tcl_MutexLock(&vfsMountsMutex); mountIter = listOfMounts; while (mountIter != NULL) { if ((interp == mountIter->interpCmd.interp) && ((mountPoint == NULL) || (mountIter->mountLen == len && !strcmp(mountIter->mountPoint, strRep)))) { /* We've found the mount. */ if (mountIter == listOfMounts) { listOfMounts = mountIter->nextMount; } else { lastMount->nextMount = mountIter->nextMount; } /* Free the allocated memory */ if (mountIter->isVolume) { if (mountPoint == NULL) { Tcl_Obj *volObj = Tcl_NewStringObj(mountIter->mountPoint, mountIter->mountLen); Tcl_IncrRefCount(volObj); Vfs_RemoveVolume(volObj); Tcl_DecrRefCount(volObj); } else { Vfs_RemoveVolume(mountPoint); } } ckfree((char*)mountIter->mountPoint); Tcl_DecrRefCount(mountIter->interpCmd.mountCmd); ckfree((char*)mountIter); Tcl_FSMountsChanged(&vfsFilesystem); Tcl_MutexUnlock(&vfsMountsMutex); return TCL_OK; } lastMount = mountIter; mountIter = mountIter->nextMount; } Tcl_MutexUnlock(&vfsMountsMutex); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Vfs_FindMount -- * * This procedure is searches all currently mounted paths for * one which matches the given path. The given path should * be the absolute, normalized, unique string for the given * path. * * Results: * Returns the interpreter, command-prefix pair for the given * mount point, if one is found, otherwise NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Vfs_InterpCmd* Vfs_FindMount(mountPoint) CONST char* mountPoint; { VfsMount *mountIter; int len; if (mountPoint == NULL) { return NULL; } len = strlen(mountPoint); Tcl_MutexLock(&vfsMountsMutex); mountIter = listOfMounts; while (mountIter != NULL) { if (mountIter->mountLen == len && !strcmp(mountIter->mountPoint, mountPoint)) { Vfs_InterpCmd *ret = &mountIter->interpCmd; Tcl_MutexUnlock(&vfsMountsMutex); return ret; } mountIter = mountIter->nextMount; } Tcl_MutexUnlock(&vfsMountsMutex); return NULL; } /* *---------------------------------------------------------------------- * * Vfs_ListMounts -- * * Returns a valid Tcl list, with refCount of zero, containing * all currently mounted paths. * *---------------------------------------------------------------------- */ static Tcl_Obj* Vfs_ListMounts(void) { VfsMount *mountIter; Tcl_Obj *res = Tcl_NewObj(); Tcl_MutexLock(&vfsMountsMutex); /* Build list of mounts */ mountIter = listOfMounts; while (mountIter != NULL) { Tcl_Obj* mount = Tcl_NewStringObj(mountIter->mountPoint, mountIter->mountLen); Tcl_ListObjAppendElement(NULL, res, mount); mountIter = mountIter->nextMount; } Tcl_MutexUnlock(&vfsMountsMutex); return res; } /* *---------------------------------------------------------------------- * * VfsFilesystemObjCmd -- * * This procedure implements the "vfs::filesystem" command. It is * used to mount/unmount particular interfaces to new filesystems, * or to query for what is mounted where. * * Results: * A standard Tcl result. * * Side effects: * Inserts or removes a filesystem from Tcl's stack. * *---------------------------------------------------------------------- */ static int VfsFilesystemObjCmd(dummy, interp, objc, objv) ClientData dummy; Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; { int index; static char *optionStrings[] = { "info", "mount", "unmount", NULL }; enum options { VFS_INFO, VFS_MOUNT, VFS_UNMOUNT, }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case VFS_MOUNT: { int i; if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "mount ?-volume? path cmd"); return TCL_ERROR; } if (objc == 5) { char *option = Tcl_GetString(objv[2]); if (strcmp("-volume", option)) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", option, "\": must be -volume", (char *) NULL); return TCL_ERROR; } i = 3; return Vfs_AddMount(objv[i], 1, interp, objv[i+1]); } else { Tcl_Obj *path; i = 2; path = Tcl_FSGetNormalizedPath(interp, objv[i]); return Vfs_AddMount(path, 0, interp, objv[i+1]); } break; } case VFS_INFO: { if (objc > 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } if (objc == 2) { Tcl_SetObjResult(interp, Vfs_ListMounts()); } else { Vfs_InterpCmd *val; val = Vfs_FindMount(Tcl_GetString(objv[2])); if (val == NULL) { Tcl_Obj *path = Tcl_FSGetNormalizedPath(interp, objv[2]); val = Vfs_FindMount(Tcl_GetString(path)); if (val == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "no such mount \"", Tcl_GetString(objv[2]), "\"", (char *) NULL); return TCL_ERROR; } } Tcl_SetObjResult(interp, val->mountCmd); } break; } case VFS_UNMOUNT: { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } if (Vfs_RemoveMount(objv[2], interp) == TCL_ERROR) { Tcl_Obj * path; path = Tcl_FSGetNormalizedPath(interp, objv[2]); if (Vfs_RemoveMount(path, interp) == TCL_ERROR) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "no such mount \"", Tcl_GetString(objv[2]), "\"", (char *) NULL); return TCL_ERROR; } } return TCL_OK; } } return TCL_OK; } static int VfsInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) { Tcl_Obj *normedObj; int len, splitPosition; /* Just set this to avoid a warning */ char remember = '\0'; char *normed; VfsNativeRep *nativeRep; Vfs_InterpCmd *interpCmd = NULL; if (TclInExit()) { /* * Even Tcl_FSGetNormalizedPath may fail due to lack of system * encodings, so we just say we can't handle anything if we are * in the middle of the exit sequence. We could perhaps be * more subtle than this! */ return -1; } normedObj = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normedObj == NULL) { return -1; } normed = Tcl_GetStringFromObj(normedObj, &len); splitPosition = len; /* * Find the most specific mount point for this path. * Mount points are specified by unique strings, so * we have to use a unique normalised path for the * checks here. */ while (interpCmd == NULL) { interpCmd = Vfs_FindMount(normed); if (interpCmd != NULL) break; if (splitPosition != len) { normed[splitPosition] = VFS_SEPARATOR; } while ((splitPosition > 0) && (normed[--splitPosition] != VFS_SEPARATOR)) { /* Do nothing */ } /* * We now know that normed[splitPosition] is a separator. * However, we might have mounted a root filesystem with a * strange name (for example 'ftp://') */ if ((splitPosition > 0) && (splitPosition != len)) { remember = normed[splitPosition + 1]; normed[splitPosition+1] = '\0'; interpCmd = Vfs_FindMount(normed); if (interpCmd != NULL) { splitPosition++; break; } normed[splitPosition+1] = remember; } /* Otherwise continue as before */ /* Terminate the string there */ if (splitPosition == 0) { break; } remember = VFS_SEPARATOR; normed[splitPosition] = 0; } /* * Now either splitPosition is zero, or we found a mount point. * Test for both possibilities, just to be sure. */ if ((splitPosition == 0) || (interpCmd == NULL)) { return -1; } if (splitPosition != len) { normed[splitPosition] = remember; } nativeRep = (VfsNativeRep*) ckalloc(sizeof(VfsNativeRep)); nativeRep->splitPosition = splitPosition; nativeRep->fsCmd = interpCmd; *clientDataPtr = (ClientData)nativeRep; return TCL_OK; } /* * Simple helper function to extract the native vfs representation of a * path object, or NULL if no such representation exists. */ static VfsNativeRep* VfsGetNativePath(Tcl_Obj* pathObjPtr) { return (VfsNativeRep*) Tcl_FSGetInternalRep(pathObjPtr, &vfsFilesystem); } static void VfsFreeInternalRep(ClientData clientData) { VfsNativeRep *nativeRep = (VfsNativeRep*)clientData; if (nativeRep != NULL) { /* Free the native memory allocation */ ckfree((char*)nativeRep); } } static ClientData VfsDupInternalRep(ClientData clientData) { VfsNativeRep *original = (VfsNativeRep*)clientData; VfsNativeRep *nativeRep = (VfsNativeRep*) ckalloc(sizeof(VfsNativeRep)); nativeRep->splitPosition = original->splitPosition; nativeRep->fsCmd = original->fsCmd; return (ClientData)nativeRep; } static Tcl_Obj* VfsFilesystemPathType(Tcl_Obj *pathPtr) { VfsNativeRep* nativeRep = VfsGetNativePath(pathPtr); if (nativeRep == NULL) { return NULL; } else { return nativeRep->fsCmd->mountCmd; } } static Tcl_Obj* VfsFilesystemSeparator(Tcl_Obj* pathObjPtr) { return Tcl_NewStringObj("/",1); } static int VfsStat(pathPtr, bufPtr) Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */ struct stat *bufPtr; /* Filled with results of stat call. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; mountCmd = VfsCommand(&interp, "stat", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal == TCL_OK) { int statListLength; Tcl_Obj* resPtr = Tcl_GetObjResult(interp); if (Tcl_ListObjLength(interp, resPtr, &statListLength) == TCL_ERROR) { returnVal = TCL_ERROR; } else if (statListLength & 1) { /* It is odd! */ returnVal = TCL_ERROR; } else { /* * The st_mode field is set part by the 'mode' * and part by the 'type' stat fields. */ bufPtr->st_mode = 0; while (statListLength > 0) { Tcl_Obj *field, *val; char *fieldName; statListLength -= 2; Tcl_ListObjIndex(interp, resPtr, statListLength, &field); Tcl_ListObjIndex(interp, resPtr, statListLength+1, &val); fieldName = Tcl_GetString(field); if (!strcmp(fieldName,"dev")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_dev = v; } else if (!strcmp(fieldName,"ino")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_ino = (unsigned short)v; } else if (!strcmp(fieldName,"mode")) { int v; if (Tcl_GetIntFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_mode |= v; } else if (!strcmp(fieldName,"nlink")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_nlink = (short)v; } else if (!strcmp(fieldName,"uid")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_uid = (short)v; } else if (!strcmp(fieldName,"gid")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_gid = (short)v; } else if (!strcmp(fieldName,"size")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_size = v; } else if (!strcmp(fieldName,"atime")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_atime = v; } else if (!strcmp(fieldName,"mtime")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_mtime = v; } else if (!strcmp(fieldName,"ctime")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_ctime = v; } else if (!strcmp(fieldName,"type")) { char *str; str = Tcl_GetString(val); if (!strcmp(str,"directory")) { bufPtr->st_mode |= S_IFDIR; } else if (!strcmp(str,"file")) { bufPtr->st_mode |= S_IFREG; } else { /* * Do nothing. This means we do not currently * support anything except files and directories */ } } else { /* Ignore additional stat arguments */ } } } } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (returnVal != 0) { Tcl_SetErrno(ENOENT); return -1; } else { return returnVal; } } int VfsAccess(pathPtr, mode) Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */ int mode; /* Permission setting. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; mountCmd = VfsCommand(&interp, "access", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(mode)); /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (returnVal != 0) { Tcl_SetErrno(ENOENT); return -1; } else { return returnVal; } } Tcl_Channel VfsOpenFileChannel(cmdInterp, pathPtr, modeString, permissions) Tcl_Interp *cmdInterp; /* Interpreter for error reporting; * can be NULL. */ Tcl_Obj *pathPtr; /* Name of file to open. */ char *modeString; /* A list of POSIX open modes or * a string such as "rw". */ int permissions; /* If the open involves creating a * file, with what modes to create * it? */ { Tcl_Channel chan = NULL; Tcl_Obj *mountCmd = NULL; Tcl_Obj *closeCallback = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; mountCmd = VfsCommand(&interp, "open", pathPtr); if (mountCmd == NULL) { return NULL; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewStringObj(modeString,-1)); Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(permissions)); Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal == TCL_OK) { int reslen; Tcl_Obj *resultObj; /* * There may be file channel leaks on these two * error conditions, if the open command actually * created a channel, but then passed us a bogus list. */ resultObj = Tcl_GetObjResult(interp); if ((Tcl_ListObjLength(interp, resultObj, &reslen) == TCL_ERROR) || (reslen > 2) || (reslen == 0)) { returnVal = TCL_ERROR; } else { Tcl_Obj *element; Tcl_ListObjIndex(interp, resultObj, 0, &element); chan = Tcl_GetChannel(interp, Tcl_GetString(element), 0); if (chan == NULL) { returnVal = TCL_ERROR; } else { if (reslen == 2) { Tcl_ListObjIndex(interp, resultObj, 1, &element); closeCallback = element; Tcl_IncrRefCount(closeCallback); } } } Tcl_RestoreResult(interp, &savedResult); } else { /* Leave an error message if the cmdInterp is non NULL */ if (cmdInterp != NULL) { int posixError = -1; Tcl_Obj* error = Tcl_GetObjResult(interp); if (Tcl_GetIntFromObj(NULL, error, &posixError) == TCL_OK) { Tcl_SetErrno(posixError); Tcl_ResetResult(cmdInterp); Tcl_AppendResult(cmdInterp, "couldn't open \"", Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), (char *) NULL); } else { /* * Copy over the error message to cmdInterp, * duplicating it in case of threading issues. */ Tcl_SetObjResult(cmdInterp, Tcl_DuplicateObj(error)); } } if (interp == cmdInterp) { /* * We want our error message to propagate up, * so we want to forget this result */ Tcl_DiscardResult(&savedResult); } else { Tcl_RestoreResult(interp, &savedResult); } } Tcl_DecrRefCount(mountCmd); if (chan != NULL) { /* * We got the Channel from some Tcl code. This means it was * registered with the interpreter. But we want a pristine * channel which hasn't been registered with anyone. We use * Tcl_DetachChannel to do this for us. We must use the * correct interpreter. */ Tcl_DetachChannel(interp, chan); if (closeCallback != NULL) { VfsChannelCleanupInfo *channelRet = NULL; channelRet = (VfsChannelCleanupInfo*) ckalloc(sizeof(VfsChannelCleanupInfo)); channelRet->channel = chan; channelRet->interp = interp; channelRet->closeCallback = closeCallback; /* The channelRet structure will be freed in the callback */ Tcl_CreateCloseHandler(chan, &VfsCloseProc, (ClientData)channelRet); } } return chan; } /* * IMPORTANT: This procedure must *not* modify the interpreter's result * this leads to the objResultPtr being corrupted (somehow), and curious * crashes in the future (which are very hard to debug ;-). * * This is particularly important since we are evaluating arbitrary * Tcl code in the callback. * * Also note we are relying on the close-callback to occur just before * the channel is about to be properly closed, but after all output * has been flushed. That way we can, in the callback, read in the * entire contents of the channel and, say, compress it for storage * into a tclkit or zip archive. */ void VfsCloseProc(ClientData clientData) { VfsChannelCleanupInfo * channelRet = (VfsChannelCleanupInfo*) clientData; Tcl_SavedResult savedResult; Tcl_Channel chan = channelRet->channel; Tcl_Interp * interp = channelRet->interp; Tcl_SaveResult(interp, &savedResult); /* * The interpreter needs to know about the channel, else the Tcl * callback will fail, so we register the channel (this allows * the Tcl code to use the channel's string-name). */ Tcl_RegisterChannel(interp, chan); Tcl_EvalObjEx(interp, channelRet->closeCallback, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_DecrRefCount(channelRet->closeCallback); /* * More complications; we can't just unregister the channel, * because it is in the middle of being cleaned up, and the cleanup * code doesn't like a channel to be closed again while it is * already being closed. So, we do the same trick as above to * unregister it without cleanup. */ Tcl_DetachChannel(interp, chan); Tcl_RestoreResult(interp, &savedResult); ckfree((char*)channelRet); } int VfsMatchInDirectory( Tcl_Interp *cmdInterp, /* Interpreter to receive results. */ Tcl_Obj *returnPtr, /* Interpreter to receive results. */ Tcl_Obj *dirPtr, /* Contains path to directory to search. */ char *pattern, /* Pattern to match against. */ Tcl_GlobTypeData *types) /* Object containing list of acceptable types. * May be NULL. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; int type = 0; Tcl_Obj *vfsResultPtr = NULL; mountCmd = VfsCommand(&interp, "matchindirectory", dirPtr); if (mountCmd == NULL) { return -1; } if (types != NULL) { type = types->type; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewStringObj(pattern,-1)); Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(type)); Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal != -1) { vfsResultPtr = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (vfsResultPtr != NULL) { if (returnVal == TCL_OK) { Tcl_IncrRefCount(vfsResultPtr); Tcl_ListObjAppendList(cmdInterp, returnPtr, vfsResultPtr); Tcl_DecrRefCount(vfsResultPtr); } else { Tcl_SetObjResult(cmdInterp, vfsResultPtr); } } return returnVal; } int VfsDeleteFile( Tcl_Obj *pathPtr) /* Pathname of file to be removed (UTF-8). */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; mountCmd = VfsCommand(&interp, "deletefile", pathPtr); if (mountCmd == NULL) { return -1; } /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); return returnVal; } int VfsCreateDirectory( Tcl_Obj *pathPtr) /* Pathname of directory to create (UTF-8). */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; mountCmd = VfsCommand(&interp, "createdirectory", pathPtr); if (mountCmd == NULL) { return -1; } /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); return returnVal; } int VfsRemoveDirectory( Tcl_Obj *pathPtr, /* Pathname of directory to be removed * (UTF-8). */ int recursive, /* If non-zero, removes directories that * are nonempty. Otherwise, will only remove * empty directories. */ Tcl_Obj **errorPtr) /* Location to store name of file * causing error. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; mountCmd = VfsCommand(&interp, "removedirectory", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(recursive)); /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (returnVal == TCL_ERROR) { /* Assume there was a problem with the directory being non-empty */ if (errorPtr != NULL) { *errorPtr = pathPtr; Tcl_IncrRefCount(*errorPtr); } Tcl_SetErrno(EEXIST); } return returnVal; } char** VfsFileAttrStrings(pathPtr, objPtrRef) Tcl_Obj* pathPtr; Tcl_Obj** objPtrRef; { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; mountCmd = VfsCommand(&interp, "fileattributes", pathPtr); if (mountCmd == NULL) { *objPtrRef = NULL; return NULL; } Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal == TCL_OK) { *objPtrRef = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } else { *objPtrRef = NULL; } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); return NULL; } int VfsFileAttrsGet(cmdInterp, index, pathPtr, objPtrRef) Tcl_Interp *cmdInterp; /* The interpreter for error reporting. */ int index; /* index of the attribute command. */ Tcl_Obj *pathPtr; /* filename we are operating on. */ Tcl_Obj **objPtrRef; /* for output. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; mountCmd = VfsCommand(&interp, "fileattributes", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(index)); Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal != -1) { *objPtrRef = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (returnVal != -1) { if (returnVal == TCL_OK) { /* * Our caller expects a ref count of zero in * the returned object pointer. */ } else { /* Leave error message in correct interp */ Tcl_SetObjResult(cmdInterp, *objPtrRef); *objPtrRef = NULL; } } return returnVal; } int VfsFileAttrsSet(cmdInterp, index, pathPtr, objPtr) Tcl_Interp *cmdInterp; /* The interpreter for error reporting. */ int index; /* index of the attribute command. */ Tcl_Obj *pathPtr; /* filename we are operating on. */ Tcl_Obj *objPtr; /* for input. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; Tcl_Obj *errorPtr = NULL; mountCmd = VfsCommand(&interp, "fileattributes", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(index)); Tcl_ListObjAppendElement(interp, mountCmd, objPtr); Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal != -1 && returnVal != TCL_OK) { errorPtr = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (errorPtr != NULL) { /* * Leave error message in correct interp, errorPtr was * duplicated above, in case of threading issues. */ Tcl_SetObjResult(cmdInterp, errorPtr); } return returnVal; } int VfsUtime(pathPtr, tval) Tcl_Obj* pathPtr; struct utimbuf *tval; { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; mountCmd = VfsCommand(&interp, "utime", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewLongObj(tval->actime)); Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewLongObj(tval->modtime)); /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); return returnVal; } Tcl_Obj* VfsListVolumes(void) { Tcl_Obj *retVal; Tcl_MutexLock(&vfsVolumesMutex); if (vfsVolumes != NULL) { Tcl_IncrRefCount(vfsVolumes); retVal = vfsVolumes; } else { retVal = NULL; } Tcl_MutexUnlock(&vfsVolumesMutex); return retVal; } void Vfs_AddVolume(volume) Tcl_Obj *volume; { Tcl_MutexLock(&vfsVolumesMutex); if (vfsVolumes == NULL) { vfsVolumes = Tcl_NewObj(); Tcl_IncrRefCount(vfsVolumes); } else { if (Tcl_IsShared(vfsVolumes)) { /* * Another thread is using this object, so we duplicate the * object and reduce the refCount on the shared one. */ Tcl_Obj *oldVols = vfsVolumes; vfsVolumes = Tcl_DuplicateObj(oldVols); Tcl_IncrRefCount(vfsVolumes); Tcl_DecrRefCount(oldVols); } } Tcl_ListObjAppendElement(NULL, vfsVolumes, volume); Tcl_MutexUnlock(&vfsVolumesMutex); } int Vfs_RemoveVolume(volume) Tcl_Obj *volume; { int i, len; Tcl_MutexLock(&vfsVolumesMutex); Tcl_ListObjLength(NULL, vfsVolumes, &len); for (i = 0;i < len; i++) { Tcl_Obj *vol; Tcl_ListObjIndex(NULL, vfsVolumes, i, &vol); if (!strcmp(Tcl_GetString(vol),Tcl_GetString(volume))) { /* It's in the list, at index i */ if (len == 1) { /* An optimization here */ Tcl_DecrRefCount(vfsVolumes); vfsVolumes = NULL; } else { /* Make ourselves the unique owner */ if (Tcl_IsShared(vfsVolumes)) { Tcl_Obj *oldVols = vfsVolumes; vfsVolumes = Tcl_DuplicateObj(oldVols); Tcl_IncrRefCount(vfsVolumes); Tcl_DecrRefCount(oldVols); } /* Remove the element */ Tcl_ListObjReplace(NULL, vfsVolumes, i, 1, 0, NULL); Tcl_MutexUnlock(&vfsVolumesMutex); return TCL_OK; } } } Tcl_MutexUnlock(&vfsVolumesMutex); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * VfsCommand -- * * Build a portion of a command to be evaluated in Tcl. * * Results: * Returns a list containing the command, or NULL if an * error occurred. * * Side effects: * None except memory allocation. * *---------------------------------------------------------------------- */ static Tcl_Obj* VfsCommand(Tcl_Interp **iRef, CONST char* cmd, Tcl_Obj *pathPtr) { Tcl_Obj *normed; Tcl_Obj *mountCmd; int len; int splitPosition; int dummyLen; VfsNativeRep *nativeRep; Tcl_Interp *interp; char *normedString; nativeRep = VfsGetNativePath(pathPtr); if (nativeRep == NULL) { return NULL; } interp = nativeRep->fsCmd->interp; if (Tcl_InterpDeleted(interp)) { return NULL; } splitPosition = nativeRep->splitPosition; normed = Tcl_FSGetNormalizedPath(NULL, pathPtr); normedString = Tcl_GetStringFromObj(normed, &len); mountCmd = Tcl_DuplicateObj(nativeRep->fsCmd->mountCmd); Tcl_IncrRefCount(mountCmd); if (Tcl_ListObjLength(NULL, mountCmd, &dummyLen) == TCL_ERROR) { Tcl_DecrRefCount(mountCmd); return NULL; } Tcl_ListObjAppendElement(NULL, mountCmd, Tcl_NewStringObj(cmd,-1)); if (splitPosition == len) { Tcl_ListObjAppendElement(NULL, mountCmd, normed); Tcl_ListObjAppendElement(NULL, mountCmd, Tcl_NewStringObj("",0)); } else { Tcl_ListObjAppendElement(NULL, mountCmd, Tcl_NewStringObj(normedString,splitPosition)); if (normedString[splitPosition] != VFS_SEPARATOR) { /* This will occur if we mount 'ftp://' */ splitPosition--; } Tcl_ListObjAppendElement(NULL, mountCmd, Tcl_NewStringObj(normedString+splitPosition+1, len-splitPosition-1)); } Tcl_ListObjAppendElement(NULL, mountCmd, pathPtr); if (iRef != NULL) { *iRef = interp; } return mountCmd; } static void VfsExitProc(ClientData clientData) { Tcl_FSUnregister(&vfsFilesystem); /* * This is probably no longer needed, because each individual * interp's cleanup will trigger removal of all volumes which * belong to it. */ if (vfsVolumes != NULL) { Tcl_DecrRefCount(vfsVolumes); vfsVolumes = NULL; } } critlib/xre.README0000644000076500001200000000216707376460267014102 0ustar jcwadmin00000000000000Turning regex and regsub into a loadable extension ================================================== Rev 0.10: Initial release This package defines xregex and xregsub, which are equivalent to Tcl's regex and regsub, respectively. The reason for doing this, is to show how one could start to modularize Tcl... gradually. The changes needed to modularize regex/regsub were absolutely minimal: - copy all key source files from Tcl's generic/ to xre_c/ - extract xre.c from the tclCmdMZ.c source code - add lots of define's to make the code independent of the original - define dummy "tclInt.h" and "tclPort.h" headers (with minimal defs) Note that *NO* changes were made to the source code. The source files were symlinked here to avoid adding them to the CritLib distribution, you will need to either adjust them in xre_c, or make your own copies. Regex and regsub were picked as example, because they were relatively easy to extract (all the main code is by Henry Spencer, and written independently of the Tcl core). But this is just to give an idea of what *could* be done. Regex/regsub are about 1/8th of the Tcl binary. critlib/xre.tcl0000644000076500001200000000256107376671261013723 0ustar jcwadmin00000000000000# Build Tcl's regex + regsub as loadable extension package provide xre 0.10 package require critcl critcl::cheaders xre_c/*.h xre_c/regc_*.c xre_c/tclRegexp.c xre_c/xre.c critcl::csources xre_c/regcomp.c critcl::csources xre_c/regerror.c critcl::csources xre_c/regexec.c critcl::csources xre_c/regfree.c critcl::ccode { #undef Tcl_GetRegExpFromObj #undef Tcl_RegExpCompile #undef Tcl_RegExpExec #undef Tcl_RegExpExecObj #undef Tcl_RegExpGetInfo #undef Tcl_RegExpMatch #undef Tcl_RegExpMatchObj #undef Tcl_RegExpRange #undef TclRegAbout #undef TclRegError #undef TclRegExpRangeUniChar #define Tcl_GetRegExpFromObj xGetRegExpFromObj #define Tcl_RegExpCompile xRegExpCompile #define Tcl_RegExpExec xRegExpExec #define Tcl_RegExpExecObj xRegExpExecObj #define Tcl_RegExpGetInfo xRegExpGetInfo #define Tcl_RegExpMatch xRegExpMatch #define Tcl_RegExpMatchObj xRegExpMatchObj #define Tcl_RegExpRange xRegExpRange #define TclRegAbout xRegAbout #define TclRegError xRegError #define TclRegExpRangeUniChar xRegExpRangeUniChar #define Tcl_RegexpObjCmd xRegexpObjCmd #define Tcl_RegsubObjCmd xRegsubObjCmd #include #include } critcl::ccommand xregex Tcl_RegexpObjCmd critcl::ccommand xregsub Tcl_RegsubObjCmd if {[info exists pkgtest] && $pkgtest} { xregex {(.*) (.*)} {xre ok!} - a b puts "$b $a" } critlib/xre_c/0000755000076500001200000000000007431255306013503 5ustar jcwadmin00000000000000critlib/xre_c/regc_color.c0000755000076500001200000000000010573223446024230 2/home/tcl/tcl/generic/regc_color.custar jcwadmin00000000000000critlib/xre_c/regc_cvec.c0000755000076500001200000000000010573223446023634 2/home/tcl/tcl/generic/regc_cvec.custar jcwadmin00000000000000critlib/xre_c/regc_lex.c0000755000076500001200000000000010573223446023354 2/home/tcl/tcl/generic/regc_lex.custar jcwadmin00000000000000critlib/xre_c/regc_locale.c0000755000076500001200000000000010573223446024472 2/home/tcl/tcl/generic/regc_locale.custar jcwadmin00000000000000critlib/xre_c/regc_nfa.c0000755000076500001200000000000010573223446023304 2/home/tcl/tcl/generic/regc_nfa.custar jcwadmin00000000000000critlib/xre_c/regcomp.c0000755000076500001200000000000010573223446023064 2/home/tcl/tcl/generic/regcomp.custar jcwadmin00000000000000critlib/xre_c/regcustom.h0000755000076500001200000000000010573223446024026 2/home/tcl/tcl/generic/regcustom.hustar jcwadmin00000000000000critlib/xre_c/rege_dfa.c0000755000076500001200000000000010573223446023264 2/home/tcl/tcl/generic/rege_dfa.custar jcwadmin00000000000000critlib/xre_c/regerror.c0000755000076500001200000000000010573223446023452 2/home/tcl/tcl/generic/regerror.custar jcwadmin00000000000000critlib/xre_c/regerrs.h0000755000076500001200000000000010573223446023130 2/home/tcl/tcl/generic/regerrs.hustar jcwadmin00000000000000critlib/xre_c/regex.h0000755000076500001200000000000010573223446022232 2/home/tcl/tcl/generic/regex.hustar jcwadmin00000000000000critlib/xre_c/regexec.c0000755000076500001200000000000010573223446023040 2/home/tcl/tcl/generic/regexec.custar jcwadmin00000000000000critlib/xre_c/regfree.c0000755000076500001200000000000010573223446023032 2/home/tcl/tcl/generic/regfree.custar jcwadmin00000000000000critlib/xre_c/regfronts.c0000755000076500001200000000000010573223446024016 2/home/tcl/tcl/generic/regfronts.custar jcwadmin00000000000000critlib/xre_c/regguts.h0000755000076500001200000000000010573223446023146 2/home/tcl/tcl/generic/regguts.hustar jcwadmin00000000000000critlib/xre_c/tclInt.h0000644000076500001200000000027107376455304015121 0ustar jcwadmin00000000000000/* dummy file */ #include #define UCHAR(c) ((unsigned char) (c)) #define TCL_TSD_INIT(keyPtr) (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData)) critlib/xre_c/tclPort.h0000644000076500001200000000005107376454602015307 0ustar jcwadmin00000000000000/* dummy file */ #include critlib/xre_c/tclRegexp.c0000755000076500001200000000000010573223446023666 2/home/tcl/tcl/generic/tclRegexp.custar jcwadmin00000000000000critlib/xre_c/tclRegexp.h0000755000076500001200000000000010573223446023700 2/home/tcl/tcl/generic/tclRegexp.hustar jcwadmin00000000000000critlib/xre_c/xre.c0000644000076500001200000003623407376454110014457 0ustar jcwadmin00000000000000/* * This source code was extracted from the tclCmdMZ.c command in Tcl. * It contains just the definitions for regexp and regsub. * November 2001, Jean-Claude Wippler */ /* * tclCmdMZ.c -- * * This file contains the top-level command routines for most of * the Tcl built-in commands whose names begin with the letters * M to Z. It contains only commands in the generic core (i.e. * those that don't depend much upon UNIX facilities). * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCmdMZ.c,v 1.49 2001/11/19 14:35:54 dkf Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclRegexp.h" /* *---------------------------------------------------------------------- * * Tcl_RegexpObjCmd -- * * This procedure is invoked to process the "regexp" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_RegexpObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int i, indices, match, about, offset, all, doinline, numMatchesSaved; int cflags, eflags, stringLength; Tcl_RegExp regExpr; Tcl_Obj *objPtr, *resultPtr; Tcl_RegExpInfo info; static char *options[] = { "-all", "-about", "-indices", "-inline", "-expanded", "-line", "-linestop", "-lineanchor", "-nocase", "-start", "--", (char *) NULL }; enum options { REGEXP_ALL, REGEXP_ABOUT, REGEXP_INDICES, REGEXP_INLINE, REGEXP_EXPANDED,REGEXP_LINE, REGEXP_LINESTOP,REGEXP_LINEANCHOR, REGEXP_NOCASE, REGEXP_START, REGEXP_LAST }; indices = 0; about = 0; cflags = TCL_REG_ADVANCED; eflags = 0; offset = 0; all = 0; doinline = 0; for (i = 1; i < objc; i++) { char *name; int index; name = Tcl_GetString(objv[i]); if (name[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case REGEXP_ALL: { all = 1; break; } case REGEXP_INDICES: { indices = 1; break; } case REGEXP_INLINE: { doinline = 1; break; } case REGEXP_NOCASE: { cflags |= TCL_REG_NOCASE; break; } case REGEXP_ABOUT: { about = 1; break; } case REGEXP_EXPANDED: { cflags |= TCL_REG_EXPANDED; break; } case REGEXP_LINE: { cflags |= TCL_REG_NEWLINE; break; } case REGEXP_LINESTOP: { cflags |= TCL_REG_NLSTOP; break; } case REGEXP_LINEANCHOR: { cflags |= TCL_REG_NLANCH; break; } case REGEXP_START: { if (++i >= objc) { goto endOfForLoop; } if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) { return TCL_ERROR; } if (offset < 0) { offset = 0; } break; } case REGEXP_LAST: { i++; goto endOfForLoop; } } } endOfForLoop: if ((objc - i) < (2 - about)) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"); return TCL_ERROR; } objc -= i; objv += i; if (doinline && ((objc - 2) != 0)) { /* * User requested -inline, but specified match variables - a no-no. */ Tcl_AppendResult(interp, "regexp match variables not allowed", " when using -inline", (char *) NULL); return TCL_ERROR; } /* * Get the length of the string that we are matching against so * we can do the termination test for -all matches. Do this before * getting the regexp to avoid shimmering problems. */ objPtr = objv[1]; stringLength = Tcl_GetCharLength(objPtr); regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; } if (about) { if (TclRegAbout(interp, regExpr) < 0) { return TCL_ERROR; } return TCL_OK; } if (offset > 0) { /* * Add flag if using offset (string is part of a larger string), * so that "^" won't match. */ eflags |= TCL_REG_NOTBOL; } objc -= 2; objv += 2; resultPtr = Tcl_GetObjResult(interp); if (doinline) { /* * Save all the subexpressions, as we will return them as a list */ numMatchesSaved = -1; } else { /* * Save only enough subexpressions for matches we want to keep, * expect in the case of -all, where we need to keep at least * one to know where to move the offset. */ numMatchesSaved = (objc == 0) ? all : objc; } /* * The following loop is to handle multiple matches within the * same source string; each iteration handles one match. If "-all" * hasn't been specified then the loop body only gets executed once. * We terminate the loop when the starting offset is past the end of the * string. */ while (1) { match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset /* offset */, numMatchesSaved, eflags); if (match < 0) { return TCL_ERROR; } if (match == 0) { /* * We want to set the value of the intepreter result only when * this is the first time through the loop. */ if (all <= 1) { /* * If inlining, set the interpreter's object result to an * empty list, otherwise set it to an integer object w/ * value 0. */ if (doinline) { Tcl_SetListObj(resultPtr, 0, NULL); } else { Tcl_SetIntObj(resultPtr, 0); } return TCL_OK; } break; } /* * If additional variable names have been specified, return * index information in those variables. */ Tcl_RegExpGetInfo(regExpr, &info); if (doinline) { /* * It's the number of substitutions, plus one for the matchVar * at index 0 */ objc = info.nsubs + 1; } for (i = 0; i < objc; i++) { Tcl_Obj *newPtr; if (indices) { int start, end; Tcl_Obj *objs[2]; /* * Only adjust the match area if there was a match for * that area. (Scriptics Bug 4391/SF Bug #219232) */ if (i <= info.nsubs && info.matches[i].start >= 0) { start = offset + info.matches[i].start; end = offset + info.matches[i].end; /* * Adjust index so it refers to the last character in the * match instead of the first character after the match. */ if (end >= offset) { end--; } } else { start = -1; end = -1; } objs[0] = Tcl_NewLongObj(start); objs[1] = Tcl_NewLongObj(end); newPtr = Tcl_NewListObj(2, objs); } else { if (i <= info.nsubs) { newPtr = Tcl_GetRange(objPtr, offset + info.matches[i].start, offset + info.matches[i].end - 1); } else { newPtr = Tcl_NewObj(); } } if (doinline) { if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr) != TCL_OK) { Tcl_DecrRefCount(newPtr); return TCL_ERROR; } } else { Tcl_Obj *valuePtr; valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0); if (valuePtr == NULL) { Tcl_DecrRefCount(newPtr); Tcl_AppendResult(interp, "couldn't set variable \"", Tcl_GetString(objv[i]), "\"", (char *) NULL); return TCL_ERROR; } } } if (all == 0) { break; } /* * Adjust the offset to the character just after the last one * in the matchVar and increment all to count how many times * we are making a match. We always increment the offset by at least * one to prevent endless looping (as in the case: * regexp -all {a*} a). Otherwise, when we match the NULL string at * the end of the input string, we will loop indefinately (because the * length of the match is 0, so offset never changes). */ if (info.matches[0].end == 0) { offset++; } offset += info.matches[0].end; all++; eflags |= TCL_REG_NOTBOL; if (offset >= stringLength) { break; } } /* * Set the interpreter's object result to an integer object * with value 1 if -all wasn't specified, otherwise it's all-1 * (the number of times through the while - 1). */ if (!doinline) { Tcl_SetIntObj(resultPtr, (all ? all-1 : 1)); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_RegsubObjCmd -- * * This procedure is invoked to process the "regsub" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_RegsubObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int idx, result, cflags, all, wlen, wsublen, numMatches, offset; int start, end, subStart, subEnd, match; Tcl_RegExp regExpr; Tcl_RegExpInfo info; Tcl_Obj *resultPtr, *subPtr, *objPtr; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend; static char *options[] = { "-all", "-nocase", "-expanded", "-line", "-linestop", "-lineanchor", "-start", "--", NULL }; enum options { REGSUB_ALL, REGSUB_NOCASE, REGSUB_EXPANDED, REGSUB_LINE, REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_START, REGSUB_LAST }; cflags = TCL_REG_ADVANCED; all = 0; offset = 0; for (idx = 1; idx < objc; idx++) { char *name; int index; name = Tcl_GetString(objv[idx]); if (name[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case REGSUB_ALL: { all = 1; break; } case REGSUB_NOCASE: { cflags |= TCL_REG_NOCASE; break; } case REGSUB_EXPANDED: { cflags |= TCL_REG_EXPANDED; break; } case REGSUB_LINE: { cflags |= TCL_REG_NEWLINE; break; } case REGSUB_LINESTOP: { cflags |= TCL_REG_NLSTOP; break; } case REGSUB_LINEANCHOR: { cflags |= TCL_REG_NLANCH; break; } case REGSUB_START: { if (++idx >= objc) { goto endOfForLoop; } if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) { return TCL_ERROR; } if (offset < 0) { offset = 0; } break; } case REGSUB_LAST: { idx++; goto endOfForLoop; } } } endOfForLoop: if (objc - idx != 4) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string subSpec varName"); return TCL_ERROR; } objv += idx; regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; } /* * Make sure to avoid problems where the objects are shared. This * can cause RegExpObj <> UnicodeObj shimmering that causes data * corruption. [Bug #461322] */ if (objv[1] == objv[0]) { objPtr = Tcl_DuplicateObj(objv[1]); } else { objPtr = objv[1]; } wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); if (objv[2] == objv[0]) { subPtr = Tcl_DuplicateObj(objv[2]); } else { subPtr = objv[2]; } wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); result = TCL_OK; resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); /* * The following loop is to handle multiple matches within the * same source string; each iteration handles one match and its * corresponding substitution. If "-all" hasn't been specified * then the loop body only gets executed once. */ numMatches = 0; for ( ; offset < wlen; ) { /* * The flags argument is set if string is part of a larger string, * so that "^" won't match. */ match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset, 10 /* matches */, ((offset > 0) ? TCL_REG_NOTBOL : 0)); if (match < 0) { result = TCL_ERROR; goto done; } if (match == 0) { break; } if ((numMatches == 0) && (offset > 0)) { /* * Copy the initial portion of the string in if an offset * was specified. */ Tcl_AppendUnicodeToObj(resultPtr, wstring, offset); } numMatches++; /* * Copy the portion of the source string before the match to the * result variable. */ Tcl_RegExpGetInfo(regExpr, &info); start = info.matches[0].start; end = info.matches[0].end; Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start); /* * Append the subSpec argument to the variable, making appropriate * substitutions. This code is a bit hairy because of the backslash * conventions and because the code saves up ranges of characters in * subSpec to reduce the number of calls to Tcl_SetVar. */ wsrc = wfirstChar = wsubspec; wend = wsubspec + wsublen; for (ch = *wsrc; wsrc != wend; wsrc++, ch = *wsrc) { if (ch == '&') { idx = 0; } else if (ch == '\\') { ch = wsrc[1]; if ((ch >= '0') && (ch <= '9')) { idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar + 1); *wsrc = '\\'; wfirstChar = wsrc + 2; wsrc++; continue; } else { continue; } } else { continue; } if (wfirstChar != wsrc) { Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; if ((subStart >= 0) && (subEnd >= 0)) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } } if (*wsrc == '\\') { wsrc++; } wfirstChar = wsrc + 1; } if (wfirstChar != wsrc) { Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (end == 0) { /* * Always consume at least one character of the input string * in order to prevent infinite loops. */ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); offset++; } else { offset += end; } if (!all) { break; } } /* * Copy the portion of the source string after the last match to the * result variable. */ if (numMatches == 0) { /* * On zero matches, just ignore the offset, since it shouldn't * matter to us in this case, and the user may have skewed it. */ Tcl_AppendUnicodeToObj(resultPtr, wstring, wlen); } else if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); } if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", Tcl_GetString(objv[3]), "\"", (char *) NULL); result = TCL_ERROR; } else { /* * Set the interpreter's object result to an integer object * holding the number of matches. */ Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches); } done: if (objv[1] == objv[0]) { Tcl_DecrRefCount(objPtr); } if (objv[2] == objv[0]) { Tcl_DecrRefCount(subPtr); } Tcl_DecrRefCount(resultPtr); return result; } critlib/zipper.README0000644000076500001200000000155407477752504014614 0ustar jcwadmin00000000000000Creating ZIP archives in Tcl ============================ Rev 0.11: Added ?force? arg to bypass re-compression Rev 0.10: Initial release Zipper is a package to create ZIP archives with a few simple commands: zipper::initialize $fd initialize things to start writing zip file entries zipper::addentry name contents ?date? ?force? add one entry, modification date defaults to [clock seconds] zipper::finalize write trailing table of contents, returns file descriptor Example: package require zipper zipper::initialize [open try.zip w] zipper::addentry dir/file.txt "some data to store" close [zipper::finalize] If the "zlib" package is available, it will be used to to compress the data when possible and to calculate proper CRC-32 checksums. Otherwise, the output file will contain uncompressed data and zero checksums. critlib/zipper.tcl0000644000076500001200000000555407477532203014435 0ustar jcwadmin00000000000000# ZIP file constructor package provide zipper 0.11 namespace eval zipper { namespace export initialize addentry finalize namespace eval v { variable fd variable base variable toc } proc initialize {fd} { set v::fd $fd set v::base [tell $fd] set v::toc {} fconfigure $fd -translation binary -encoding binary } proc emit {s} { puts -nonewline $v::fd $s } proc dostime {sec} { set f [clock format $sec -format {%Y %m %d %H %M %S} -gmt 1] regsub -all { 0(\d)} $f { \1} f foreach {Y M D h m s} $f break set date [expr {(($Y-1980)<<9) | ($M<<5) | $D}] set time [expr {($h<<11) | ($m<<5) | ($s>>1)}] return [list $date $time] } proc addentry {name contents {date ""} {force 0}} { if {$date == ""} { set date [clock seconds] } foreach {date time} [dostime $date] break set flag 0 set type 0 ;# stored set fsize [string length $contents] set csize $fsize set fnlen [string length $name] if {$force > 0 && $force != [string length $contents]} { set csize $fsize set fsize $force set type 8 ;# if we're passing in compressed data, it's deflated } if {[catch { zlib crc32 $contents } crc]} { set crc 0 } elseif {$type == 0} { set cdata [zlib deflate $contents] if {[string length $cdata] < [string length $contents]} { set contents $cdata set csize [string length $cdata] set type 8 ;# deflate } } lappend v::toc "[binary format a2c6ssssiiiss4ii PK {1 2 20 0 20 0} \ $flag $type $time $date $crc $csize $fsize $fnlen \ {0 0 0 0} 128 [tell $v::fd]]$name" emit [binary format a2c4ssssiiiss PK {3 4 20 0} \ $flag $type $time $date $crc $csize $fsize $fnlen 0] emit $name emit $contents } proc finalize {} { set pos [tell $v::fd] set ntoc [llength $v::toc] foreach x $v::toc { emit $x } set v::toc {} set len [expr {[tell $v::fd] - $pos}] incr pos -$v::base emit [binary format a2c2ssssiis PK {5 6} 0 0 $ntoc $ntoc $len $pos 0] return $v::fd } } if {[info exists pkgtest] && $pkgtest} { puts "no test code" } # test code below runs when this is launched as the main script if {[info exists argv0] && [string match zipper-* [file tail $argv0]]} { catch { package require zlib } zipper::initialize [open try.zip w] set dirs [list .] while {[llength $dirs] > 0} { set d [lindex $dirs 0] set dirs [lrange $dirs 1 end] foreach f [lsort [glob -nocomplain [file join $d *]]] { if {[file isfile $f]} { regsub {^\./} $f {} f set fd [open $f] fconfigure $fd -translation binary -encoding binary zipper::addentry $f [read $fd] [file mtime $f] close $fd } elseif {[file isdir $f]} { lappend dirs $f } } } close [zipper::finalize] puts "size = [file size try.zip]" puts [exec unzip -v try.zip] file delete try.zip } critlib/zlib.README0000644000076500001200000000223607375744436014243 0ustar jcwadmin00000000000000Yet another zlib wrapper ======================== Rev 0.10: Initial release This package defines a "zlib" command, which has a number of options, they are described below in the form of a sample call: set checksum [zlib adler32 data ?startvalue?] # adler32 calculates a quick "Adler-32" checksum set checksum [zlib crc32 data ?startvalue?] # crc32 calculates the standard "CRC-32" checksum set cdata [zlib compress data ?level?] # zlib-compress data with optional compression level set ddata [zlib deflate data ?level?] # headerless compression with optional compression level set data [zlib decompress cdata ?bufsize?] # zlib-decompress data with optional buffer size set data [zlib inflate ddata ?level?] # headerless decompression with optional buffer size Compress/decompress and deflate/inflate must be used in the proper pairs. When the bufsize is not specified, decompression starts with a 16 Kb buf, which gets resized by doubling until the output data fits in the buffer. Data is treated as binary, meaning that all input and output is going to be converted and treated as byte arrays in Tcl. critlib/zlib.tcl0000644000076500001200000000676207376413605014070 0ustar jcwadmin00000000000000# Interface to the "zlib" compression library package provide zlib 0.10 package require critcl critcl::clibraries -lz critcl::ccode { #include } critcl::ccommand zlib {dummy ip objc objv} { int e = TCL_OK, index, dlen, wbits = -MAX_WBITS; long flag; Byte *data; z_stream stream; Tcl_Obj *obj = Tcl_GetObjResult(ip); static char* cmds[] = { "adler32", "crc32", "compress", "deflate", "decompress", "inflate", NULL, }; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(ip, 1, objv, "option data ?...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(ip, objv[1], cmds, "option", 0, &index) != TCL_OK || objc > 3 && Tcl_GetLongFromObj(ip, objv[3], &flag) != TCL_OK) return TCL_ERROR; data = Tcl_GetByteArrayFromObj(objv[2], &dlen); switch (index) { case 0: /* adler32 str ?start? -> checksum */ if (objc < 4) flag = (long) adler32(0, 0, 0); Tcl_SetLongObj(obj, (long) adler32((uLong) flag, data, dlen)); return TCL_OK; case 1: /* crc32 str ?start? -> checksum */ if (objc < 4) flag = (long) crc32(0, 0, 0); Tcl_SetLongObj(obj, (long) crc32((uLong) flag, data, dlen)); return TCL_OK; case 2: /* compress data ?level? -> data */ wbits = MAX_WBITS; case 3: /* deflate data ?level? -> data */ if (objc < 4) flag = Z_DEFAULT_COMPRESSION; stream.avail_in = (uInt) dlen; stream.next_in = data; stream.avail_out = (uInt) dlen + dlen / 1000 + 12; Tcl_SetByteArrayLength(obj, stream.avail_out); stream.next_out = Tcl_GetByteArrayFromObj(obj, NULL); stream.zalloc = 0; stream.zfree = 0; stream.opaque = 0; e = deflateInit2(&stream, (int) flag, Z_DEFLATED, wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY); if (e != Z_OK) break; e = deflate(&stream, Z_FINISH); if (e != Z_STREAM_END) { deflateEnd(&stream); if (e == Z_OK) e = Z_BUF_ERROR; } else e = deflateEnd(&stream); break; case 4: /* decompress data ?bufsize? -> data */ wbits = MAX_WBITS; case 5: /* inflate data ?bufsize? -> data */ { if (objc < 4) flag = 16 * 1024; for (;;) { stream.zalloc = 0; stream.zfree = 0; /* +1 because ZLIB can "over-request" input (but ignore it) */ stream.avail_in = (uInt) dlen + 1; stream.next_in = data; stream.avail_out = (uInt) flag; Tcl_SetByteArrayLength(obj, stream.avail_out); stream.next_out = Tcl_GetByteArrayFromObj(obj, NULL); /* Negative value suppresses ZLIB header */ e = inflateInit2(&stream, wbits); if (e == Z_OK) { e = inflate(&stream, Z_FINISH); if (e != Z_STREAM_END) { inflateEnd(&stream); if (e == Z_OK) e = Z_BUF_ERROR; } else e = inflateEnd(&stream); } if (e == Z_OK || e != Z_BUF_ERROR) break; Tcl_SetByteArrayLength(obj, 0); flag *= 2; } break; } } if (e != Z_OK) { Tcl_SetResult(ip, (char*) zError(e), TCL_STATIC); return TCL_ERROR; } Tcl_SetByteArrayLength(obj, stream.total_out); return TCL_OK; } if {[info exists pkgtest] && $pkgtest} { proc zlib_try {} { set text "Hello world, world, world, world, world!" puts "adler = [format %08x [zlib adler32 $text]]" puts "crc32 = [format %08x [zlib crc32 $text]]" set small [zlib compress $text] binary scan $small H* hex puts "compress = $hex" puts "restored = [zlib decompress $small]" set small [zlib deflate $text] binary scan $small H* hex puts "deflated = $hex" puts "restored = [zlib inflate $small]" } zlib_try }