/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclbinary.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclbinary.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (hide annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (7 years, 7 months ago) by dashley
File MIME type: text/plain
File size: 41241 byte(s)
Rename for reorganization.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclbinary.c,v 1.1.1.1 2001/06/13 04:33:55 dtashley Exp $ */
2    
3     /*
4     * tclBinary.c --
5     *
6     * This file contains the implementation of the "binary" Tcl built-in
7     * command and the Tcl binary data object.
8     *
9     * Copyright (c) 1997 by Sun Microsystems, Inc.
10     * Copyright (c) 1998-1999 by Scriptics Corporation.
11     *
12     * See the file "license.terms" for information on usage and redistribution
13     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14     *
15     * RCS: @(#) $Id: tclbinary.c,v 1.1.1.1 2001/06/13 04:33:55 dtashley Exp $
16     */
17    
18     #include <math.h>
19     #include "tclInt.h"
20     #include "tclPort.h"
21    
22     /*
23     * The following constants are used by GetFormatSpec to indicate various
24     * special conditions in the parsing of a format specifier.
25     */
26    
27     #define BINARY_ALL -1 /* Use all elements in the argument. */
28     #define BINARY_NOCOUNT -2 /* No count was specified in format. */
29    
30     /*
31     * Prototypes for local procedures defined in this file:
32     */
33    
34     static void DupByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
35     Tcl_Obj *copyPtr));
36     static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
37     Tcl_Obj *src, unsigned char **cursorPtr));
38     static void FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
39     static int GetFormatSpec _ANSI_ARGS_((char **formatPtr,
40     char *cmdPtr, int *countPtr));
41     static Tcl_Obj * ScanNumber _ANSI_ARGS_((unsigned char *buffer, int type));
42     static int SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp,
43     Tcl_Obj *objPtr));
44     static void UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr));
45    
46    
47     /*
48     * The following object type represents an array of bytes. An array of
49     * bytes is not equivalent to an internationalized string. Conceptually, a
50     * string is an array of 16-bit quantities organized as a sequence of properly
51     * formed UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
52     * Accessor functions are provided to convert a ByteArray to a String or a
53     * String to a ByteArray. Two or more consecutive bytes in an array of bytes
54     * may look like a single UTF-8 character if the array is casually treated as
55     * a string. But obtaining the String from a ByteArray is guaranteed to
56     * produced properly formed UTF-8 sequences so that there is a one-to-one
57     * map between bytes and characters.
58     *
59     * Converting a ByteArray to a String proceeds by casting each byte in the
60     * array to a 16-bit quantity, treating that number as a Unicode character,
61     * and storing the UTF-8 version of that Unicode character in the String.
62     * For ByteArrays consisting entirely of values 1..127, the corresponding
63     * String representation is the same as the ByteArray representation.
64     *
65     * Converting a String to a ByteArray proceeds by getting the Unicode
66     * representation of each character in the String, casting it to a
67     * byte by truncating the upper 8 bits, and then storing the byte in the
68     * ByteArray. Converting from ByteArray to String and back to ByteArray
69     * is not lossy, but converting an arbitrary String to a ByteArray may be.
70     */
71    
72     Tcl_ObjType tclByteArrayType = {
73     "bytearray",
74     FreeByteArrayInternalRep,
75     DupByteArrayInternalRep,
76     UpdateStringOfByteArray,
77     SetByteArrayFromAny
78     };
79    
80     /*
81     * The following structure is the internal rep for a ByteArray object.
82     * Keeps track of how much memory has been used and how much has been
83     * allocated for the byte array to enable growing and shrinking of the
84     * ByteArray object with fewer mallocs.
85     */
86    
87     typedef struct ByteArray {
88     int used; /* The number of bytes used in the byte
89     * array. */
90     int allocated; /* The amount of space actually allocated
91     * minus 1 byte. */
92     unsigned char bytes[4]; /* The array of bytes. The actual size of
93     * this field depends on the 'allocated' field
94     * above. */
95     } ByteArray;
96    
97     #define BYTEARRAY_SIZE(len) \
98     ((unsigned) (sizeof(ByteArray) - 4 + (len)))
99     #define GET_BYTEARRAY(objPtr) \
100     ((ByteArray *) (objPtr)->internalRep.otherValuePtr)
101     #define SET_BYTEARRAY(objPtr, baPtr) \
102     (objPtr)->internalRep.otherValuePtr = (VOID *) (baPtr)
103    
104    
105     /*
106     *---------------------------------------------------------------------------
107     *
108     * Tcl_NewByteArrayObj --
109     *
110     * This procedure is creates a new ByteArray object and initializes
111     * it from the given array of bytes.
112     *
113     * Results:
114     * The newly create object is returned. This object will have no
115     * initial string representation. The returned object has a ref count
116     * of 0.
117     *
118     * Side effects:
119     * Memory allocated for new object and copy of byte array argument.
120     *
121     *---------------------------------------------------------------------------
122     */
123    
124     #ifdef TCL_MEM_DEBUG
125     #undef Tcl_NewByteArrayObj
126    
127    
128     Tcl_Obj *
129     Tcl_NewByteArrayObj(bytes, length)
130     unsigned char *bytes; /* The array of bytes used to initialize
131     * the new object. */
132     int length; /* Length of the array of bytes, which must
133     * be >= 0. */
134     {
135     return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
136     }
137    
138     #else /* if not TCL_MEM_DEBUG */
139    
140     Tcl_Obj *
141     Tcl_NewByteArrayObj(bytes, length)
142     unsigned char *bytes; /* The array of bytes used to initialize
143     * the new object. */
144     int length; /* Length of the array of bytes, which must
145     * be >= 0. */
146     {
147     Tcl_Obj *objPtr;
148    
149     TclNewObj(objPtr);
150     Tcl_SetByteArrayObj(objPtr, bytes, length);
151     return objPtr;
152     }
153     #endif /* TCL_MEM_DEBUG */
154    
155     /*
156     *---------------------------------------------------------------------------
157     *
158     * Tcl_DbNewByteArrayObj --
159     *
160     * This procedure is normally called when debugging: i.e., when
161     * TCL_MEM_DEBUG is defined. It is the same as the Tcl_NewByteArrayObj
162     * above except that it calls Tcl_DbCkalloc directly with the file name
163     * and line number from its caller. This simplifies debugging since then
164     * the checkmem command will report the correct file name and line number
165     * when reporting objects that haven't been freed.
166     *
167     * When TCL_MEM_DEBUG is not defined, this procedure just returns the
168     * result of calling Tcl_NewByteArrayObj.
169     *
170     * Results:
171     * The newly create object is returned. This object will have no
172     * initial string representation. The returned object has a ref count
173     * of 0.
174     *
175     * Side effects:
176     * Memory allocated for new object and copy of byte array argument.
177     *
178     *---------------------------------------------------------------------------
179     */
180    
181     #ifdef TCL_MEM_DEBUG
182    
183     Tcl_Obj *
184     Tcl_DbNewByteArrayObj(bytes, length, file, line)
185     unsigned char *bytes; /* The array of bytes used to initialize
186     * the new object. */
187     int length; /* Length of the array of bytes, which must
188     * be >= 0. */
189     char *file; /* The name of the source file calling this
190     * procedure; used for debugging. */
191     int line; /* Line number in the source file; used
192     * for debugging. */
193     {
194     Tcl_Obj *objPtr;
195    
196     TclDbNewObj(objPtr, file, line);
197     Tcl_SetByteArrayObj(objPtr, bytes, length);
198     return objPtr;
199     }
200    
201     #else /* if not TCL_MEM_DEBUG */
202    
203     Tcl_Obj *
204     Tcl_DbNewByteArrayObj(bytes, length, file, line)
205     unsigned char *bytes; /* The array of bytes used to initialize
206     * the new object. */
207     int length; /* Length of the array of bytes, which must
208     * be >= 0. */
209     char *file; /* The name of the source file calling this
210     * procedure; used for debugging. */
211     int line; /* Line number in the source file; used
212     * for debugging. */
213     {
214     return Tcl_NewByteArrayObj(bytes, length);
215     }
216     #endif /* TCL_MEM_DEBUG */
217    
218     /*
219     *---------------------------------------------------------------------------
220     *
221     * Tcl_SetByteArrayObj --
222     *
223     * Modify an object to be a ByteArray object and to have the specified
224     * array of bytes as its value.
225     *
226     * Results:
227     * None.
228     *
229     * Side effects:
230     * The object's old string rep and internal rep is freed.
231     * Memory allocated for copy of byte array argument.
232     *
233     *----------------------------------------------------------------------
234     */
235    
236     void
237     Tcl_SetByteArrayObj(objPtr, bytes, length)
238     Tcl_Obj *objPtr; /* Object to initialize as a ByteArray. */
239     unsigned char *bytes; /* The array of bytes to use as the new
240     * value. */
241     int length; /* Length of the array of bytes, which must
242     * be >= 0. */
243     {
244     Tcl_ObjType *typePtr;
245     ByteArray *byteArrayPtr;
246    
247     if (Tcl_IsShared(objPtr)) {
248     panic("Tcl_SetByteArrayObj called with shared object");
249     }
250     typePtr = objPtr->typePtr;
251     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
252     (*typePtr->freeIntRepProc)(objPtr);
253     }
254     Tcl_InvalidateStringRep(objPtr);
255    
256     byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
257     byteArrayPtr->used = length;
258     byteArrayPtr->allocated = length;
259     memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length);
260    
261     objPtr->typePtr = &tclByteArrayType;
262     SET_BYTEARRAY(objPtr, byteArrayPtr);
263     }
264    
265     /*
266     *----------------------------------------------------------------------
267     *
268     * Tcl_GetByteArrayFromObj --
269     *
270     * Attempt to get the array of bytes from the Tcl object. If the
271     * object is not already a ByteArray object, an attempt will be
272     * made to convert it to one.
273     *
274     * Results:
275     * Pointer to array of bytes representing the ByteArray object.
276     *
277     * Side effects:
278     * Frees old internal rep. Allocates memory for new internal rep.
279     *
280     *----------------------------------------------------------------------
281     */
282    
283     unsigned char *
284     Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
285     Tcl_Obj *objPtr; /* The ByteArray object. */
286     int *lengthPtr; /* If non-NULL, filled with length of the
287     * array of bytes in the ByteArray object. */
288     {
289     ByteArray *baPtr;
290    
291     SetByteArrayFromAny(NULL, objPtr);
292     baPtr = GET_BYTEARRAY(objPtr);
293    
294     if (lengthPtr != NULL) {
295     *lengthPtr = baPtr->used;
296     }
297     return (unsigned char *) baPtr->bytes;
298     }
299    
300     /*
301     *----------------------------------------------------------------------
302     *
303     * Tcl_SetByteArrayLength --
304     *
305     * This procedure changes the length of the byte array for this
306     * object. Once the caller has set the length of the array, it
307     * is acceptable to directly modify the bytes in the array up until
308     * Tcl_GetStringFromObj() has been called on this object.
309     *
310     * Results:
311     * The new byte array of the specified length.
312     *
313     * Side effects:
314     * Allocates enough memory for an array of bytes of the requested
315     * size. When growing the array, the old array is copied to the
316     * new array; new bytes are undefined. When shrinking, the
317     * old array is truncated to the specified length.
318     *
319     *---------------------------------------------------------------------------
320     */
321    
322     unsigned char *
323     Tcl_SetByteArrayLength(objPtr, length)
324     Tcl_Obj *objPtr; /* The ByteArray object. */
325     int length; /* New length for internal byte array. */
326     {
327     ByteArray *byteArrayPtr, *newByteArrayPtr;
328    
329     if (Tcl_IsShared(objPtr)) {
330     panic("Tcl_SetObjLength called with shared object");
331     }
332     if (objPtr->typePtr != &tclByteArrayType) {
333     SetByteArrayFromAny(NULL, objPtr);
334     }
335    
336     byteArrayPtr = GET_BYTEARRAY(objPtr);
337     if (length > byteArrayPtr->allocated) {
338     newByteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
339     newByteArrayPtr->used = length;
340     newByteArrayPtr->allocated = length;
341     memcpy((VOID *) newByteArrayPtr->bytes,
342     (VOID *) byteArrayPtr->bytes, (size_t) byteArrayPtr->used);
343     ckfree((char *) byteArrayPtr);
344     byteArrayPtr = newByteArrayPtr;
345     SET_BYTEARRAY(objPtr, byteArrayPtr);
346     }
347     Tcl_InvalidateStringRep(objPtr);
348     byteArrayPtr->used = length;
349     return byteArrayPtr->bytes;
350     }
351    
352     /*
353     *---------------------------------------------------------------------------
354     *
355     * SetByteArrayFromAny --
356     *
357     * Generate the ByteArray internal rep from the string rep.
358     *
359     * Results:
360     * The return value is always TCL_OK.
361     *
362     * Side effects:
363     * A ByteArray object is stored as the internal rep of objPtr.
364     *
365     *---------------------------------------------------------------------------
366     */
367    
368     static int
369     SetByteArrayFromAny(interp, objPtr)
370     Tcl_Interp *interp; /* Not used. */
371     Tcl_Obj *objPtr; /* The object to convert to type ByteArray. */
372     {
373     Tcl_ObjType *typePtr;
374     int length;
375     char *src, *srcEnd;
376     unsigned char *dst;
377     ByteArray *byteArrayPtr;
378     Tcl_UniChar ch;
379    
380     typePtr = objPtr->typePtr;
381     if (typePtr != &tclByteArrayType) {
382     src = Tcl_GetStringFromObj(objPtr, &length);
383     srcEnd = src + length;
384    
385     byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
386     for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
387     src += Tcl_UtfToUniChar(src, &ch);
388     *dst++ = (unsigned char) ch;
389     }
390    
391     byteArrayPtr->used = dst - byteArrayPtr->bytes;
392     byteArrayPtr->allocated = length;
393    
394     if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
395     (*typePtr->freeIntRepProc)(objPtr);
396     }
397     objPtr->typePtr = &tclByteArrayType;
398     SET_BYTEARRAY(objPtr, byteArrayPtr);
399     }
400     return TCL_OK;
401     }
402    
403     /*
404     *----------------------------------------------------------------------
405     *
406     * FreeByteArrayInternalRep --
407     *
408     * Deallocate the storage associated with a ByteArray data object's
409     * internal representation.
410     *
411     * Results:
412     * None.
413     *
414     * Side effects:
415     * Frees memory.
416     *
417     *----------------------------------------------------------------------
418     */
419    
420     static void
421     FreeByteArrayInternalRep(objPtr)
422     Tcl_Obj *objPtr; /* Object with internal rep to free. */
423     {
424     ckfree((char *) GET_BYTEARRAY(objPtr));
425     }
426    
427     /*
428     *---------------------------------------------------------------------------
429     *
430     * DupByteArrayInternalRep --
431     *
432     * Initialize the internal representation of a ByteArray Tcl_Obj
433     * to a copy of the internal representation of an existing ByteArray
434     * object.
435     *
436     * Results:
437     * None.
438     *
439     * Side effects:
440     * Allocates memory.
441     *
442     *---------------------------------------------------------------------------
443     */
444    
445     static void
446     DupByteArrayInternalRep(srcPtr, copyPtr)
447     Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
448     Tcl_Obj *copyPtr; /* Object with internal rep to set. */
449     {
450     int length;
451     ByteArray *srcArrayPtr, *copyArrayPtr;
452    
453     srcArrayPtr = GET_BYTEARRAY(srcPtr);
454     length = srcArrayPtr->used;
455    
456     copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
457     copyArrayPtr->used = length;
458     copyArrayPtr->allocated = length;
459     memcpy((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes,
460     (size_t) length);
461     SET_BYTEARRAY(copyPtr, copyArrayPtr);
462    
463     copyPtr->typePtr = &tclByteArrayType;
464     }
465    
466     /*
467     *---------------------------------------------------------------------------
468     *
469     * UpdateStringOfByteArray --
470     *
471     * Update the string representation for a ByteArray data object.
472     * Note: This procedure does not invalidate an existing old string rep
473     * so storage will be lost if this has not already been done.
474     *
475     * Results:
476     * None.
477     *
478     * Side effects:
479     * The object's string is set to a valid string that results from
480     * the ByteArray-to-string conversion.
481     *
482     * The object becomes a string object -- the internal rep is
483     * discarded and the typePtr becomes NULL.
484     *
485     *---------------------------------------------------------------------------
486     */
487    
488     static void
489     UpdateStringOfByteArray(objPtr)
490     Tcl_Obj *objPtr; /* ByteArray object whose string rep to
491     * update. */
492     {
493     int i, length, size;
494     unsigned char *src;
495     char *dst;
496     ByteArray *byteArrayPtr;
497    
498     byteArrayPtr = GET_BYTEARRAY(objPtr);
499     src = byteArrayPtr->bytes;
500     length = byteArrayPtr->used;
501    
502     /*
503     * How much space will string rep need?
504     */
505    
506     size = length;
507     for (i = 0; i < length; i++) {
508     if ((src[i] == 0) || (src[i] > 127)) {
509     size++;
510     }
511     }
512    
513     dst = (char *) ckalloc((unsigned) (size + 1));
514     objPtr->bytes = dst;
515     objPtr->length = size;
516    
517     if (size == length) {
518     memcpy((VOID *) dst, (VOID *) src, (size_t) size);
519     dst[size] = '\0';
520     } else {
521     for (i = 0; i < length; i++) {
522     dst += Tcl_UniCharToUtf(src[i], dst);
523     }
524     *dst = '\0';
525     }
526     }
527    
528     /*
529     *----------------------------------------------------------------------
530     *
531     * Tcl_BinaryObjCmd --
532     *
533     * This procedure implements the "binary" Tcl command.
534     *
535     * Results:
536     * A standard Tcl result.
537     *
538     * Side effects:
539     * See the user documentation.
540     *
541     *----------------------------------------------------------------------
542     */
543    
544     int
545     Tcl_BinaryObjCmd(dummy, interp, objc, objv)
546     ClientData dummy; /* Not used. */
547     Tcl_Interp *interp; /* Current interpreter. */
548     int objc; /* Number of arguments. */
549     Tcl_Obj *CONST objv[]; /* Argument objects. */
550     {
551     int arg; /* Index of next argument to consume. */
552     int value = 0; /* Current integer value to be packed.
553     * Initialized to avoid compiler warning. */
554     char cmd; /* Current format character. */
555     int count; /* Count associated with current format
556     * character. */
557     char *format; /* Pointer to current position in format
558     * string. */
559     Tcl_Obj *resultPtr; /* Object holding result buffer. */
560     unsigned char *buffer; /* Start of result buffer. */
561     unsigned char *cursor; /* Current position within result buffer. */
562     unsigned char *maxPos; /* Greatest position within result buffer that
563     * cursor has visited.*/
564     char *errorString, *errorValue, *str;
565     int offset, size, length, index;
566     static char *options[] = {
567     "format", "scan", NULL
568     };
569     enum options {
570     BINARY_FORMAT, BINARY_SCAN
571     };
572    
573     if (objc < 2) {
574     Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
575     return TCL_ERROR;
576     }
577    
578     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
579     &index) != TCL_OK) {
580     return TCL_ERROR;
581     }
582    
583     switch ((enum options) index) {
584     case BINARY_FORMAT: {
585     if (objc < 3) {
586     Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
587     return TCL_ERROR;
588     }
589    
590     /*
591     * To avoid copying the data, we format the string in two passes.
592     * The first pass computes the size of the output buffer. The
593     * second pass places the formatted data into the buffer.
594     */
595    
596     format = Tcl_GetString(objv[2]);
597     arg = 3;
598     offset = 0;
599     length = 0;
600     while (*format != '\0') {
601     str = format;
602     if (!GetFormatSpec(&format, &cmd, &count)) {
603     break;
604     }
605     switch (cmd) {
606     case 'a':
607     case 'A':
608     case 'b':
609     case 'B':
610     case 'h':
611     case 'H': {
612     /*
613     * For string-type specifiers, the count corresponds
614     * to the number of bytes in a single argument.
615     */
616    
617     if (arg >= objc) {
618     goto badIndex;
619     }
620     if (count == BINARY_ALL) {
621     Tcl_GetByteArrayFromObj(objv[arg], &count);
622     } else if (count == BINARY_NOCOUNT) {
623     count = 1;
624     }
625     arg++;
626     if (cmd == 'a' || cmd == 'A') {
627     offset += count;
628     } else if (cmd == 'b' || cmd == 'B') {
629     offset += (count + 7) / 8;
630     } else {
631     offset += (count + 1) / 2;
632     }
633     break;
634     }
635     case 'c': {
636     size = 1;
637     goto doNumbers;
638     }
639     case 's':
640     case 'S': {
641     size = 2;
642     goto doNumbers;
643     }
644     case 'i':
645     case 'I': {
646     size = 4;
647     goto doNumbers;
648     }
649     case 'f': {
650     size = sizeof(float);
651     goto doNumbers;
652     }
653     case 'd': {
654     size = sizeof(double);
655    
656     doNumbers:
657     if (arg >= objc) {
658     goto badIndex;
659     }
660    
661     /*
662     * For number-type specifiers, the count corresponds
663     * to the number of elements in the list stored in
664     * a single argument. If no count is specified, then
665     * the argument is taken as a single non-list value.
666     */
667    
668     if (count == BINARY_NOCOUNT) {
669     arg++;
670     count = 1;
671     } else {
672     int listc;
673     Tcl_Obj **listv;
674     if (Tcl_ListObjGetElements(interp, objv[arg++],
675     &listc, &listv) != TCL_OK) {
676     return TCL_ERROR;
677     }
678     if (count == BINARY_ALL) {
679     count = listc;
680     } else if (count > listc) {
681     Tcl_AppendResult(interp,
682     "number of elements in list does not match count",
683     (char *) NULL);
684     return TCL_ERROR;
685     }
686     }
687     offset += count*size;
688     break;
689     }
690     case 'x': {
691     if (count == BINARY_ALL) {
692     Tcl_AppendResult(interp,
693     "cannot use \"*\" in format string with \"x\"",
694     (char *) NULL);
695     return TCL_ERROR;
696     } else if (count == BINARY_NOCOUNT) {
697     count = 1;
698     }
699     offset += count;
700     break;
701     }
702     case 'X': {
703     if (count == BINARY_NOCOUNT) {
704     count = 1;
705     }
706     if ((count > offset) || (count == BINARY_ALL)) {
707     count = offset;
708     }
709     if (offset > length) {
710     length = offset;
711     }
712     offset -= count;
713     break;
714     }
715     case '@': {
716     if (offset > length) {
717     length = offset;
718     }
719     if (count == BINARY_ALL) {
720     offset = length;
721     } else if (count == BINARY_NOCOUNT) {
722     goto badCount;
723     } else {
724     offset = count;
725     }
726     break;
727     }
728     default: {
729     errorString = str;
730     goto badfield;
731     }
732     }
733     }
734     if (offset > length) {
735     length = offset;
736     }
737     if (length == 0) {
738     return TCL_OK;
739     }
740    
741     /*
742     * Prepare the result object by preallocating the caclulated
743     * number of bytes and filling with nulls.
744     */
745    
746     resultPtr = Tcl_GetObjResult(interp);
747     buffer = Tcl_SetByteArrayLength(resultPtr, length);
748     memset((VOID *) buffer, 0, (size_t) length);
749    
750     /*
751     * Pack the data into the result object. Note that we can skip
752     * the error checking during this pass, since we have already
753     * parsed the string once.
754     */
755    
756     arg = 3;
757     format = Tcl_GetString(objv[2]);
758     cursor = buffer;
759     maxPos = cursor;
760     while (*format != 0) {
761     if (!GetFormatSpec(&format, &cmd, &count)) {
762     break;
763     }
764     if ((count == 0) && (cmd != '@')) {
765     arg++;
766     continue;
767     }
768     switch (cmd) {
769     case 'a':
770     case 'A': {
771     char pad = (char) (cmd == 'a' ? '\0' : ' ');
772     unsigned char *bytes;
773    
774     bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
775    
776     if (count == BINARY_ALL) {
777     count = length;
778     } else if (count == BINARY_NOCOUNT) {
779     count = 1;
780     }
781     if (length >= count) {
782     memcpy((VOID *) cursor, (VOID *) bytes,
783     (size_t) count);
784     } else {
785     memcpy((VOID *) cursor, (VOID *) bytes,
786     (size_t) length);
787     memset((VOID *) (cursor + length), pad,
788     (size_t) (count - length));
789     }
790     cursor += count;
791     break;
792     }
793     case 'b':
794     case 'B': {
795     unsigned char *last;
796    
797     str = Tcl_GetStringFromObj(objv[arg++], &length);
798     if (count == BINARY_ALL) {
799     count = length;
800     } else if (count == BINARY_NOCOUNT) {
801     count = 1;
802     }
803     last = cursor + ((count + 7) / 8);
804     if (count > length) {
805     count = length;
806     }
807     value = 0;
808     errorString = "binary";
809     if (cmd == 'B') {
810     for (offset = 0; offset < count; offset++) {
811     value <<= 1;
812     if (str[offset] == '1') {
813     value |= 1;
814     } else if (str[offset] != '0') {
815     errorValue = str;
816     goto badValue;
817     }
818     if (((offset + 1) % 8) == 0) {
819     *cursor++ = (unsigned char) value;
820     value = 0;
821     }
822     }
823     } else {
824     for (offset = 0; offset < count; offset++) {
825     value >>= 1;
826     if (str[offset] == '1') {
827     value |= 128;
828     } else if (str[offset] != '0') {
829     errorValue = str;
830     goto badValue;
831     }
832     if (!((offset + 1) % 8)) {
833     *cursor++ = (unsigned char) value;
834     value = 0;
835     }
836     }
837     }
838     if ((offset % 8) != 0) {
839     if (cmd == 'B') {
840     value <<= 8 - (offset % 8);
841     } else {
842     value >>= 8 - (offset % 8);
843     }
844     *cursor++ = (unsigned char) value;
845     }
846     while (cursor < last) {
847     *cursor++ = '\0';
848     }
849     break;
850     }
851     case 'h':
852     case 'H': {
853     unsigned char *last;
854     int c;
855    
856     str = Tcl_GetStringFromObj(objv[arg++], &length);
857     if (count == BINARY_ALL) {
858     count = length;
859     } else if (count == BINARY_NOCOUNT) {
860     count = 1;
861     }
862     last = cursor + ((count + 1) / 2);
863     if (count > length) {
864     count = length;
865     }
866     value = 0;
867     errorString = "hexadecimal";
868     if (cmd == 'H') {
869     for (offset = 0; offset < count; offset++) {
870     value <<= 4;
871     if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
872     errorValue = str;
873     goto badValue;
874     }
875     c = str[offset] - '0';
876     if (c > 9) {
877     c += ('0' - 'A') + 10;
878     }
879     if (c > 16) {
880     c += ('A' - 'a');
881     }
882     value |= (c & 0xf);
883     if (offset % 2) {
884     *cursor++ = (char) value;
885     value = 0;
886     }
887     }
888     } else {
889     for (offset = 0; offset < count; offset++) {
890     value >>= 4;
891    
892     if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
893     errorValue = str;
894     goto badValue;
895     }
896     c = str[offset] - '0';
897     if (c > 9) {
898     c += ('0' - 'A') + 10;
899     }
900     if (c > 16) {
901     c += ('A' - 'a');
902     }
903     value |= ((c << 4) & 0xf0);
904     if (offset % 2) {
905     *cursor++ = (unsigned char)(value & 0xff);
906     value = 0;
907     }
908     }
909     }
910     if (offset % 2) {
911     if (cmd == 'H') {
912     value <<= 4;
913     } else {
914     value >>= 4;
915     }
916     *cursor++ = (unsigned char) value;
917     }
918    
919     while (cursor < last) {
920     *cursor++ = '\0';
921     }
922     break;
923     }
924     case 'c':
925     case 's':
926     case 'S':
927     case 'i':
928     case 'I':
929     case 'd':
930     case 'f': {
931     int listc, i;
932     Tcl_Obj **listv;
933    
934     if (count == BINARY_NOCOUNT) {
935     /*
936     * Note that we are casting away the const-ness of
937     * objv, but this is safe since we aren't going to
938     * modify the array.
939     */
940    
941     listv = (Tcl_Obj**)(objv + arg);
942     listc = 1;
943     count = 1;
944     } else {
945     Tcl_ListObjGetElements(interp, objv[arg],
946     &listc, &listv);
947     if (count == BINARY_ALL) {
948     count = listc;
949     }
950     }
951     arg++;
952     for (i = 0; i < count; i++) {
953     if (FormatNumber(interp, cmd, listv[i], &cursor)
954     != TCL_OK) {
955     return TCL_ERROR;
956     }
957     }
958     break;
959     }
960     case 'x': {
961     if (count == BINARY_NOCOUNT) {
962     count = 1;
963     }
964     memset(cursor, 0, (size_t) count);
965     cursor += count;
966     break;
967     }
968     case 'X': {
969     if (cursor > maxPos) {
970     maxPos = cursor;
971     }
972     if (count == BINARY_NOCOUNT) {
973     count = 1;
974     }
975     if ((count == BINARY_ALL)
976     || (count > (cursor - buffer))) {
977     cursor = buffer;
978     } else {
979     cursor -= count;
980     }
981     break;
982     }
983     case '@': {
984     if (cursor > maxPos) {
985     maxPos = cursor;
986     }
987     if (count == BINARY_ALL) {
988     cursor = maxPos;
989     } else {
990     cursor = buffer + count;
991     }
992     break;
993     }
994     }
995     }
996     break;
997     }
998     case BINARY_SCAN: {
999     int i;
1000     Tcl_Obj *valuePtr, *elementPtr;
1001    
1002     if (objc < 4) {
1003     Tcl_WrongNumArgs(interp, 2, objv,
1004     "value formatString ?varName varName ...?");
1005     return TCL_ERROR;
1006     }
1007     buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
1008     format = Tcl_GetString(objv[3]);
1009     cursor = buffer;
1010     arg = 4;
1011     offset = 0;
1012     while (*format != '\0') {
1013     str = format;
1014     if (!GetFormatSpec(&format, &cmd, &count)) {
1015     goto done;
1016     }
1017     switch (cmd) {
1018     case 'a':
1019     case 'A': {
1020     unsigned char *src;
1021    
1022     if (arg >= objc) {
1023     goto badIndex;
1024     }
1025     if (count == BINARY_ALL) {
1026     count = length - offset;
1027     } else {
1028     if (count == BINARY_NOCOUNT) {
1029     count = 1;
1030     }
1031     if (count > (length - offset)) {
1032     goto done;
1033     }
1034     }
1035    
1036     src = buffer + offset;
1037     size = count;
1038    
1039     /*
1040     * Trim trailing nulls and spaces, if necessary.
1041     */
1042    
1043     if (cmd == 'A') {
1044     while (size > 0) {
1045     if (src[size-1] != '\0' && src[size-1] != ' ') {
1046     break;
1047     }
1048     size--;
1049     }
1050     }
1051     valuePtr = Tcl_NewByteArrayObj(src, size);
1052     resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
1053     NULL, valuePtr, TCL_LEAVE_ERR_MSG);
1054     arg++;
1055     if (resultPtr == NULL) {
1056     Tcl_DecrRefCount(valuePtr); /* unneeded */
1057     return TCL_ERROR;
1058     }
1059     offset += count;
1060     break;
1061     }
1062     case 'b':
1063     case 'B': {
1064     unsigned char *src;
1065     char *dest;
1066    
1067     if (arg >= objc) {
1068     goto badIndex;
1069     }
1070     if (count == BINARY_ALL) {
1071     count = (length - offset) * 8;
1072     } else {
1073     if (count == BINARY_NOCOUNT) {
1074     count = 1;
1075     }
1076     if (count > (length - offset) * 8) {
1077     goto done;
1078     }
1079     }
1080     src = buffer + offset;
1081     valuePtr = Tcl_NewObj();
1082     Tcl_SetObjLength(valuePtr, count);
1083     dest = Tcl_GetString(valuePtr);
1084    
1085     if (cmd == 'b') {
1086     for (i = 0; i < count; i++) {
1087     if (i % 8) {
1088     value >>= 1;
1089     } else {
1090     value = *src++;
1091     }
1092     *dest++ = (char) ((value & 1) ? '1' : '0');
1093     }
1094     } else {
1095     for (i = 0; i < count; i++) {
1096     if (i % 8) {
1097     value <<= 1;
1098     } else {
1099     value = *src++;
1100     }
1101     *dest++ = (char) ((value & 0x80) ? '1' : '0');
1102     }
1103     }
1104    
1105     resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
1106     NULL, valuePtr, TCL_LEAVE_ERR_MSG);
1107     arg++;
1108     if (resultPtr == NULL) {
1109     Tcl_DecrRefCount(valuePtr); /* unneeded */
1110     return TCL_ERROR;
1111     }
1112     offset += (count + 7 ) / 8;
1113     break;
1114     }
1115     case 'h':
1116     case 'H': {
1117     char *dest;
1118     unsigned char *src;
1119     int i;
1120     static char hexdigit[] = "0123456789abcdef";
1121    
1122     if (arg >= objc) {
1123     goto badIndex;
1124     }
1125     if (count == BINARY_ALL) {
1126     count = (length - offset)*2;
1127     } else {
1128     if (count == BINARY_NOCOUNT) {
1129     count = 1;
1130     }
1131     if (count > (length - offset)*2) {
1132     goto done;
1133     }
1134     }
1135     src = buffer + offset;
1136     valuePtr = Tcl_NewObj();
1137     Tcl_SetObjLength(valuePtr, count);
1138     dest = Tcl_GetString(valuePtr);
1139    
1140     if (cmd == 'h') {
1141     for (i = 0; i < count; i++) {
1142     if (i % 2) {
1143     value >>= 4;
1144     } else {
1145     value = *src++;
1146     }
1147     *dest++ = hexdigit[value & 0xf];
1148     }
1149     } else {
1150     for (i = 0; i < count; i++) {
1151     if (i % 2) {
1152     value <<= 4;
1153     } else {
1154     value = *src++;
1155     }
1156     *dest++ = hexdigit[(value >> 4) & 0xf];
1157     }
1158     }
1159    
1160     resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
1161     NULL, valuePtr, TCL_LEAVE_ERR_MSG);
1162     arg++;
1163     if (resultPtr == NULL) {
1164     Tcl_DecrRefCount(valuePtr); /* unneeded */
1165     return TCL_ERROR;
1166     }
1167     offset += (count + 1) / 2;
1168     break;
1169     }
1170     case 'c': {
1171     size = 1;
1172     goto scanNumber;
1173     }
1174     case 's':
1175     case 'S': {
1176     size = 2;
1177     goto scanNumber;
1178     }
1179     case 'i':
1180     case 'I': {
1181     size = 4;
1182     goto scanNumber;
1183     }
1184     case 'f': {
1185     size = sizeof(float);
1186     goto scanNumber;
1187     }
1188     case 'd': {
1189     unsigned char *src;
1190    
1191     size = sizeof(double);
1192     /* fall through */
1193    
1194     scanNumber:
1195     if (arg >= objc) {
1196     goto badIndex;
1197     }
1198     if (count == BINARY_NOCOUNT) {
1199     if ((length - offset) < size) {
1200     goto done;
1201     }
1202     valuePtr = ScanNumber(buffer+offset, cmd);
1203     offset += size;
1204     } else {
1205     if (count == BINARY_ALL) {
1206     count = (length - offset) / size;
1207     }
1208     if ((length - offset) < (count * size)) {
1209     goto done;
1210     }
1211     valuePtr = Tcl_NewObj();
1212     src = buffer+offset;
1213     for (i = 0; i < count; i++) {
1214     elementPtr = ScanNumber(src, cmd);
1215     src += size;
1216     Tcl_ListObjAppendElement(NULL, valuePtr,
1217     elementPtr);
1218     }
1219     offset += count*size;
1220     }
1221    
1222     resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
1223     NULL, valuePtr, TCL_LEAVE_ERR_MSG);
1224     arg++;
1225     if (resultPtr == NULL) {
1226     Tcl_DecrRefCount(valuePtr); /* unneeded */
1227     return TCL_ERROR;
1228     }
1229     break;
1230     }
1231     case 'x': {
1232     if (count == BINARY_NOCOUNT) {
1233     count = 1;
1234     }
1235     if ((count == BINARY_ALL)
1236     || (count > (length - offset))) {
1237     offset = length;
1238     } else {
1239     offset += count;
1240     }
1241     break;
1242     }
1243     case 'X': {
1244     if (count == BINARY_NOCOUNT) {
1245     count = 1;
1246     }
1247     if ((count == BINARY_ALL) || (count > offset)) {
1248     offset = 0;
1249     } else {
1250     offset -= count;
1251     }
1252     break;
1253     }
1254     case '@': {
1255     if (count == BINARY_NOCOUNT) {
1256     goto badCount;
1257     }
1258     if ((count == BINARY_ALL) || (count > length)) {
1259     offset = length;
1260     } else {
1261     offset = count;
1262     }
1263     break;
1264     }
1265     default: {
1266     errorString = str;
1267     goto badfield;
1268     }
1269     }
1270     }
1271    
1272     /*
1273     * Set the result to the last position of the cursor.
1274     */
1275    
1276     done:
1277     Tcl_ResetResult(interp);
1278     Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
1279     break;
1280     }
1281     }
1282     return TCL_OK;
1283    
1284     badValue:
1285     Tcl_ResetResult(interp);
1286     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "expected ", errorString,
1287     " string but got \"", errorValue, "\" instead", NULL);
1288     return TCL_ERROR;
1289    
1290     badCount:
1291     errorString = "missing count for \"@\" field specifier";
1292     goto error;
1293    
1294     badIndex:
1295     errorString = "not enough arguments for all format specifiers";
1296     goto error;
1297    
1298     badfield: {
1299     Tcl_UniChar ch;
1300     char buf[TCL_UTF_MAX + 1];
1301    
1302     Tcl_UtfToUniChar(errorString, &ch);
1303     buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
1304     Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
1305     return TCL_ERROR;
1306     }
1307    
1308     error:
1309     Tcl_AppendResult(interp, errorString, NULL);
1310     return TCL_ERROR;
1311     }
1312    
1313     /*
1314     *----------------------------------------------------------------------
1315     *
1316     * GetFormatSpec --
1317     *
1318     * This function parses the format strings used in the binary
1319     * format and scan commands.
1320     *
1321     * Results:
1322     * Moves the formatPtr to the start of the next command. Returns
1323     * the current command character and count in cmdPtr and countPtr.
1324     * The count is set to BINARY_ALL if the count character was '*'
1325     * or BINARY_NOCOUNT if no count was specified. Returns 1 on
1326     * success, or 0 if the string did not have a format specifier.
1327     *
1328     * Side effects:
1329     * None.
1330     *
1331     *----------------------------------------------------------------------
1332     */
1333    
1334     static int
1335     GetFormatSpec(formatPtr, cmdPtr, countPtr)
1336     char **formatPtr; /* Pointer to format string. */
1337     char *cmdPtr; /* Pointer to location of command char. */
1338     int *countPtr; /* Pointer to repeat count value. */
1339     {
1340     /*
1341     * Skip any leading blanks.
1342     */
1343    
1344     while (**formatPtr == ' ') {
1345     (*formatPtr)++;
1346     }
1347    
1348     /*
1349     * The string was empty, except for whitespace, so fail.
1350     */
1351    
1352     if (!(**formatPtr)) {
1353     return 0;
1354     }
1355    
1356     /*
1357     * Extract the command character and any trailing digits or '*'.
1358     */
1359    
1360     *cmdPtr = **formatPtr;
1361     (*formatPtr)++;
1362     if (**formatPtr == '*') {
1363     (*formatPtr)++;
1364     (*countPtr) = BINARY_ALL;
1365     } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
1366     (*countPtr) = strtoul(*formatPtr, formatPtr, 10);
1367     } else {
1368     (*countPtr) = BINARY_NOCOUNT;
1369     }
1370     return 1;
1371     }
1372    
1373     /*
1374     *----------------------------------------------------------------------
1375     *
1376     * FormatNumber --
1377     *
1378     * This routine is called by Tcl_BinaryObjCmd to format a number
1379     * into a location pointed at by cursor.
1380     *
1381     * Results:
1382     * A standard Tcl result.
1383     *
1384     * Side effects:
1385     * Moves the cursor to the next location to be written into.
1386     *
1387     *----------------------------------------------------------------------
1388     */
1389    
1390     static int
1391     FormatNumber(interp, type, src, cursorPtr)
1392     Tcl_Interp *interp; /* Current interpreter, used to report
1393     * errors. */
1394     int type; /* Type of number to format. */
1395     Tcl_Obj *src; /* Number to format. */
1396     unsigned char **cursorPtr; /* Pointer to index into destination buffer. */
1397     {
1398     int value;
1399     double dvalue;
1400    
1401     if ((type == 'd') || (type == 'f')) {
1402     /*
1403     * For floating point types, we need to copy the data using
1404     * memcpy to avoid alignment issues.
1405     */
1406    
1407     if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
1408     return TCL_ERROR;
1409     }
1410     if (type == 'd') {
1411     memcpy((VOID *) *cursorPtr, (VOID *) &dvalue, sizeof(double));
1412     *cursorPtr += sizeof(double);
1413     } else {
1414     float fvalue;
1415    
1416     /*
1417     * Because some compilers will generate floating point exceptions
1418     * on an overflow cast (e.g. Borland), we restrict the values
1419     * to the valid range for float.
1420     */
1421    
1422     if (fabs(dvalue) > (double)FLT_MAX) {
1423     fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
1424     } else {
1425     fvalue = (float) dvalue;
1426     }
1427     memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
1428     *cursorPtr += sizeof(float);
1429     }
1430     } else {
1431     if (Tcl_GetIntFromObj(interp, src, &value) != TCL_OK) {
1432     return TCL_ERROR;
1433     }
1434     if (type == 'c') {
1435     *(*cursorPtr)++ = (unsigned char) value;
1436     } else if (type == 's') {
1437     *(*cursorPtr)++ = (unsigned char) value;
1438     *(*cursorPtr)++ = (unsigned char) (value >> 8);
1439     } else if (type == 'S') {
1440     *(*cursorPtr)++ = (unsigned char) (value >> 8);
1441     *(*cursorPtr)++ = (unsigned char) value;
1442     } else if (type == 'i') {
1443     *(*cursorPtr)++ = (unsigned char) value;
1444     *(*cursorPtr)++ = (unsigned char) (value >> 8);
1445     *(*cursorPtr)++ = (unsigned char) (value >> 16);
1446     *(*cursorPtr)++ = (unsigned char) (value >> 24);
1447     } else if (type == 'I') {
1448     *(*cursorPtr)++ = (unsigned char) (value >> 24);
1449     *(*cursorPtr)++ = (unsigned char) (value >> 16);
1450     *(*cursorPtr)++ = (unsigned char) (value >> 8);
1451     *(*cursorPtr)++ = (unsigned char) value;
1452     }
1453     }
1454     return TCL_OK;
1455     }
1456    
1457     /*
1458     *----------------------------------------------------------------------
1459     *
1460     * ScanNumber --
1461     *
1462     * This routine is called by Tcl_BinaryObjCmd to scan a number
1463     * out of a buffer.
1464     *
1465     * Results:
1466     * Returns a newly created object containing the scanned number.
1467     * This object has a ref count of zero.
1468     *
1469     * Side effects:
1470     * None.
1471     *
1472     *----------------------------------------------------------------------
1473     */
1474    
1475     static Tcl_Obj *
1476     ScanNumber(buffer, type)
1477     unsigned char *buffer; /* Buffer to scan number from. */
1478     int type; /* Format character from "binary scan" */
1479     {
1480     long value;
1481    
1482     /*
1483     * We cannot rely on the compiler to properly sign extend integer values
1484     * when we cast from smaller values to larger values because we don't know
1485     * the exact size of the integer types. So, we have to handle sign
1486     * extension explicitly by checking the high bit and padding with 1's as
1487     * needed.
1488     */
1489    
1490     switch (type) {
1491     case 'c': {
1492     /*
1493     * Characters need special handling. We want to produce a
1494     * signed result, but on some platforms (such as AIX) chars
1495     * are unsigned. To deal with this, check for a value that
1496     * should be negative but isn't.
1497     */
1498    
1499     value = buffer[0];
1500     if (value & 0x80) {
1501     value |= -0x100;
1502     }
1503     return Tcl_NewLongObj((long)value);
1504     }
1505     case 's': {
1506     value = (long) (buffer[0] + (buffer[1] << 8));
1507     goto shortValue;
1508     }
1509     case 'S': {
1510     value = (long) (buffer[1] + (buffer[0] << 8));
1511     shortValue:
1512     if (value & 0x8000) {
1513     value |= -0x10000;
1514     }
1515     return Tcl_NewLongObj(value);
1516     }
1517     case 'i': {
1518     value = (long) (buffer[0]
1519     + (buffer[1] << 8)
1520     + (buffer[2] << 16)
1521     + (buffer[3] << 24));
1522     goto intValue;
1523     }
1524     case 'I': {
1525     value = (long) (buffer[3]
1526     + (buffer[2] << 8)
1527     + (buffer[1] << 16)
1528     + (buffer[0] << 24));
1529     intValue:
1530     /*
1531     * Check to see if the value was sign extended properly on
1532     * systems where an int is more than 32-bits.
1533     */
1534    
1535     if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
1536     value -= (((unsigned int)1)<<31);
1537     value -= (((unsigned int)1)<<31);
1538     }
1539     return Tcl_NewLongObj(value);
1540     }
1541     case 'f': {
1542     float fvalue;
1543     memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float));
1544     return Tcl_NewDoubleObj(fvalue);
1545     }
1546     case 'd': {
1547     double dvalue;
1548     memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double));
1549     return Tcl_NewDoubleObj(dvalue);
1550     }
1551     }
1552     return NULL;
1553     }
1554    
1555    
1556     /* $History: tclbinary.c $
1557     *
1558     * ***************** Version 1 *****************
1559     * User: Dtashley Date: 1/02/01 Time: 1:35a
1560     * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
1561     * Initial check-in.
1562     */
1563    
1564     /* End of TCLBINARY.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25