Diff
Not logged in

Differences From Artifact [c298fef8b4]:

To Artifact [232ae02f46]:


1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20












-
+







/* 
 * tclBinary.c --
 *
 *	This file contains the implementation of the "binary" Tcl built-in
 *	command and the Tcl binary data object.
 *
 * Copyright (c) 1997 by 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: tclBinary.c,v 1.13.4.4 2004/09/30 00:51:32 dgp Exp $
 * RCS: @(#) $Id: tclBinary.c,v 1.13.4.5 2004/10/28 18:46:19 dgp Exp $
 */

#include "tclInt.h"

#ifdef TCL_NO_MATH
#define fabs(x) (x<0 ? -x : x)
#else
571
572
573
574
575
576
577
578

579
580
581
582
583
584
585
571
572
573
574
575
576
577

578
579
580
581
582
583
584
585







-
+







    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    int count;			/* Count associated with current format
				 * character. */
    char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr;		/* Object holding result buffer. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    char *errorString, *errorValue, *str;
    int offset, size, length, index;
    static CONST char *options[] = { 
770
771
772
773
774
775
776
777

778
779
780
781
782
783
784
770
771
772
773
774
775
776

777
778
779
780
781
782
783
784







-
+







	    }

	    /*
	     * Prepare the result object by preallocating the caclulated
	     * number of bytes and filling with nulls.
	     */

	    resultPtr = Tcl_GetObjResult(interp);
	    resultPtr = Tcl_NewObj();
	    buffer = Tcl_SetByteArrayLength(resultPtr, length);
	    memset((VOID *) buffer, 0, (size_t) length);

	    /*
	     * Pack the data into the result object.  Note that we can skip
	     * the error checking during this pass, since we have already
	     * parsed the string once.
1029
1030
1031
1032
1033
1034
1035

1036
1037
1038
1039
1040
1041
1042
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043







+







			} else {
			    cursor = buffer + count;
			}
			break;
		    }
		}
	    }
	    Tcl_SetObjResult(interp, resultPtr);
	    break;
	}
	case BINARY_SCAN: {
	    int i;
	    Tcl_Obj *valuePtr, *elementPtr;
	    Tcl_HashTable numberCacheHash;
	    Tcl_HashTable *numberCachePtr;
1338
1339
1340
1341
1342
1343
1344
1345
1346

1347
1348
1349
1350
1351
1352
1353
1354
1355

1356
1357
1358
1359
1360
1361
1362
1339
1340
1341
1342
1343
1344
1345


1346
1347
1348
1349
1350
1351
1352
1353
1354

1355
1356
1357
1358
1359
1360
1361
1362







-
-
+








-
+







	    }

	    /*
	     * Set the result to the last position of the cursor.
	     */

	    done:
	    Tcl_ResetResult(interp);
	    Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
	    Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 4));
	    DeleteScanNumberCache(numberCachePtr);
	    break;
	}
    }
    return TCL_OK;

    badValue:
    Tcl_ResetResult(interp);
    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "expected ", errorString,
    Tcl_AppendResult(interp, "expected ", errorString,
	    " string but got \"", errorValue, "\" instead", NULL);
    return TCL_ERROR;

    badCount:
    errorString = "missing count for \"@\" field specifier";
    goto error;