Check-in [84713bcd79]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:add tcl upstream changes
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 84713bcd7963d381f5225764332e0ce26dc8a6ae
User & Date: chw 2019-06-09 13:40:19
Context
2019-06-10
17:53
add a few nanosvg upstream changes to tksvg check-in: 530070899f user: chw tags: trunk
2019-06-09
14:01
merge with trunk check-in: 88028e3b04 user: chw tags: wtf-8-experiment
13:40
add tcl upstream changes check-in: 84713bcd79 user: chw tags: trunk
13:39
add tk upstream changes check-in: 367ac8ead5 user: chw tags: trunk
Changes

Changes to jni/tcl/generic/tclBinary.c.

314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
...
660
661
662
663
664
665
666

667


668
669
670
671

672


673
674
675
676
677
678
679
680

681


682
683
684
685
686
687
688
...
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
...
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
....
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
....
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
....
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
....
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
....
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
....
2116
2117
2118
2119
2120
2121
2122

2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
....
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
....
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
....
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
....
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
....
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609

2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
....
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
....
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
....
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
....
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
....
2914
2915
2916
2917
2918
2919
2920

2921
2922


2923
2924
2925
2926
2927
2928
2929
....
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955

2956
2957


2958
2959


2960
2961
2962
2963
2964
2965
2966
....
2999
3000
3001
3002
3003
3004
3005
3006
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new
				   value. May be NULL even if length > 0. */
    int length)			/* Length of the array of bytes, which must
				   be >= 0. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
................................................................................
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	int attempt;

	if (needed <= INT_MAX/2) {

	    /* Try to allocate double the total space that is needed. */


	    attempt = 2 * needed;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {

	    /* Try to allocate double the increment that is needed (plus). */


	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = len + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {

	    /* Last chance: Try to allocate exactly what is needed. */


	    attempt = needed;
	    ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
................................................................................
    int arg;			/* Index of next argument to consume. */
    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. */
    int flags;			/* Format field flags */
    const char *format;	/* Pointer to current position in format
				 * string. */
    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.*/
    const char *errorString;
................................................................................
     */

    resultPtr = Tcl_NewObj();
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(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.
     */

    arg = 2;
    format = TclGetString(objv[1]);
    cursor = buffer;
    maxPos = cursor;
    while (*format != 0) {
................................................................................
		TclListObjGetElements(interp, objv[arg], &listc, &listv);
		if (count == BINARY_ALL) {
		    count = listc;
		}
	    }
	    arg++;
	    for (i = 0; i < count; i++) {
		if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	}
	case 'x':
................................................................................
    int arg;			/* Index of next argument to consume. */
    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. */
    int flags;			/* Format field flags */
    const char *format;	/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    const char *errorString;
    const char *str;
    int offset, size, length;

................................................................................

	    /*
	     * Trim trailing nulls and spaces, if necessary.
	     */

	    if (cmd == 'A') {
		while (size > 0) {
		    if (src[size-1] != '\0' && src[size-1] != ' ') {
			break;
		    }
		    size--;
		}
	    }

	    /*
................................................................................

	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * valid range for float.
	 */

	if (fabs(dvalue) > (double)FLT_MAX) {
	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;
................................................................................

static Tcl_Obj *
ScanNumber(
    unsigned char *buffer,	/* Buffer to scan number from. */
    int type,			/* Format character from "binary scan" */
    int flags,			/* Format field flags */
    Tcl_HashTable **numberCachePtrPtr)
				/* Place to look for cache of scanned
				 * value objects, or NULL if too many
				 * different numbers have been scanned. */
{
    long value;
    float fvalue;
    double dvalue;
    Tcl_WideUInt uwvalue;

    /*
................................................................................
		    + (buffer[1] << 16)
		    + (((long) buffer[0]) << 24));
	}

	/*
	 * Check to see if the value was sign extended properly on systems
	 * where an int is more than 32-bits.

	 * We avoid caching unsigned integers as we cannot distinguish between
	 * 32bit signed and unsigned in the hash (short and char are ok).
	 */

	if (flags & BINARY_UNSIGNED) {
	    return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
	}
	if ((value & (((unsigned) 1)<<31)) && (value > 0)) {
	    value -= (((unsigned) 1)<<31);
	    value -= (((unsigned) 1)<<31);
	}

    returnNumericObject:
	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewLongObj(value);
	} else {
	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
................................................................................
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    data = Tcl_GetByteArrayFromObj(objv[1], &count);
    cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
    for (offset = 0; offset < count; ++offset) {
	*cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)];
	*cursor++ = HexDigits[(data[offset] & 0x0f)];
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
	for (i=0 ; i<2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit((int) c)) {
................................................................................
	    c -= '0';
	    if (c > 9) {
		c += ('0' - 'A') + 10;
	    }
	    if (c > 16) {
		c += ('A' - 'a');
	    }
	    value |= (c & 0xf);
	}
	if (i < 2) {
	    cut++;
	}
	*cursor++ = UCHAR(value);
	value = 0;
    }
................................................................................
{
    Tcl_Obj *resultObj;
    unsigned char *data, *cursor, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    int wrapcharlen = 1;
    int offset, i, index, size, outindex = 0, count = 0;
    enum {OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc%2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
	    if (wrapcharlen == 0) {
		maxlen = 0;
	    }
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
    if (count > 0) {
	size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */
	if (maxlen > 0 && size > maxlen) {
	    int adjusted = size + (wrapcharlen * (size / maxlen));

	    if (size % maxlen == 0) {
		adjusted -= wrapcharlen;
	    }
	    size = adjusted;
	}
	cursor = Tcl_SetByteArrayLength(resultObj, size);
	limit = cursor + size;
	for (offset = 0; offset < count; offset+=3) {
	    unsigned char d[3] = {0, 0, 0};

	    for (i = 0; i < 3 && offset+i < count; ++i) {
		d[i] = data[offset + i];
	    }
	    OUTPUT(B64Digits[d[0] >> 2]);
	    OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
	    if (offset+1 < count) {
		OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
	    } else {
		OUTPUT(B64Digits[64]);
	    }
	    if (offset+2 < count) {
		OUTPUT(B64Digits[d[2] & 0x3f]);
	    } else {
................................................................................
    int lineLength = 61;
    const unsigned char SingleNewline[] = { (unsigned char) '\n' };
    const unsigned char *wrapchar = SingleNewline;
    int wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc%2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) {

		return TCL_ERROR;
	    }
	    if (lineLength < 3 || lineLength > 85) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen);
	    break;
	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    resultObj = Tcl_NewObj();
    offset = 0;
    data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 0;

    /*
................................................................................
    while (offset < count) {
	int lineLen = count - offset;

	if (lineLen > rawLength) {
	    lineLen = rawLength;
	}
	*cursor++ = UueDigits[lineLen];
	for (i=0 ; i<lineLen ; i++) {
	    n <<= 8;
	    n |= data[offset++];
	    for (bits += 8; bits > 6 ; bits -= 6) {
		*cursor++ = UueDigits[(n >> (bits-6)) & 0x3f];
	    }
	}
	if (bits > 0) {
	    n <<= 8;
	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
	    bits = 0;
	}
	for (j=0 ; j<wrapcharlen ; ++j) {
	    *cursor++ = wrapchar[j];
	}
    }

    /*
     * Fix the length of the output bytearray.
     */

    Tcl_SetByteArrayLength(resultObj, cursor-start);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, size, count = 0, strict = 0, lineLen;
    unsigned char c;
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;

    /*
     * The decoding loop. First, we get the length of line (strictly, the
................................................................................
	    lineLen = (c - 32) & 0x3f;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i=0 ; i<4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!TclIsSpaceProc(c)) {
			    goto badUu;
			} else if (c == '\n') {
................................................................................
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;

	/*
................................................................................

	    if (data < dataend) {
		c = *data++;
	    } else if (i > 1) {
		c = '=';
	    } else {
		if (strict && i <= 1) {

		    /* single resp. unfulfilled char (each 4th next single char)
		     * is rather bad64 error case in strict mode */


		    goto bad64;
		}
		cut += 3;
		break;
	    }

	    /*
................................................................................
	     * because they're only valid as the last character or two of the
	     * final block of input. Unless strict mode is enabled, skip any
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		     value <<= 6;
		     cut++;
		} else if (!strict && TclIsSpaceProc(c)) {
		     i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=' && (

		!strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */
	    ) {


		value <<= 6;
		if (i) cut++;


	    } else if (strict || !TclIsSpaceProc(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
................................................................................
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */








|
|

|







 







>
|
>
>




>
|
>
>








>
|
>
>







 







|







 







|
|
|







 







|







 







|







 







|







 







|







 







|
|
|







 







>







|
|
|







 







|
|







 







|













|





|







 







|







 







|


|




|






|











|








|

|










|


|




|







 







|




|






|
>











|











|







 







|



|







|








|







 







|






|













|







 







|







 







|













|







 







>
|
|
>
>







 







|
|

|













|
>
|
<
>
>

|
>
>







 







<
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
...
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
...
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
...
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
....
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
....
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
....
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
....
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
....
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
....
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
....
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
....
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
....
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
....
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
....
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
....
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
....
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
....
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
....
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
....
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
....
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971

2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
....
3017
3018
3019
3020
3021
3022
3023

 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new value.
				 * May be NULL even if length > 0. */
    int length)			/* Length of the array of bytes, which must
				 * be >= 0. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
................................................................................
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	int attempt;

	if (needed <= INT_MAX/2) {
	    /*
	     * Try to allocate double the total space that is needed.
	     */

	    attempt = 2 * needed;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Try to allocate double the increment that is needed (plus).
	     */

	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = len + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Last chance: Try to allocate exactly what is needed.
	     */

	    attempt = needed;
	    ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
................................................................................
    int arg;			/* Index of next argument to consume. */
    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. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    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.*/
    const char *errorString;
................................................................................
     */

    resultPtr = Tcl_NewObj();
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(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.
     */

    arg = 2;
    format = TclGetString(objv[1]);
    cursor = buffer;
    maxPos = cursor;
    while (*format != 0) {
................................................................................
		TclListObjGetElements(interp, objv[arg], &listc, &listv);
		if (count == BINARY_ALL) {
		    count = listc;
		}
	    }
	    arg++;
	    for (i = 0; i < count; i++) {
		if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	}
	case 'x':
................................................................................
    int arg;			/* Index of next argument to consume. */
    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. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    const char *errorString;
    const char *str;
    int offset, size, length;

................................................................................

	    /*
	     * Trim trailing nulls and spaces, if necessary.
	     */

	    if (cmd == 'A') {
		while (size > 0) {
		    if (src[size - 1] != '\0' && src[size - 1] != ' ') {
			break;
		    }
		    size--;
		}
	    }

	    /*
................................................................................

	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * valid range for float.
	 */

	if (fabs(dvalue) > (double) FLT_MAX) {
	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;
................................................................................

static Tcl_Obj *
ScanNumber(
    unsigned char *buffer,	/* Buffer to scan number from. */
    int type,			/* Format character from "binary scan" */
    int flags,			/* Format field flags */
    Tcl_HashTable **numberCachePtrPtr)
				/* Place to look for cache of scanned value
				 * objects, or NULL if too many different
				 * numbers have been scanned. */
{
    long value;
    float fvalue;
    double dvalue;
    Tcl_WideUInt uwvalue;

    /*
................................................................................
		    + (buffer[1] << 16)
		    + (((long) buffer[0]) << 24));
	}

	/*
	 * Check to see if the value was sign extended properly on systems
	 * where an int is more than 32-bits.
	 *
	 * We avoid caching unsigned integers as we cannot distinguish between
	 * 32bit signed and unsigned in the hash (short and char are ok).
	 */

	if (flags & BINARY_UNSIGNED) {
	    return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
	}
	if ((value & (((unsigned) 1) << 31)) && (value > 0)) {
	    value -= (((unsigned) 1) << 31);
	    value -= (((unsigned) 1) << 31);
	}

    returnNumericObject:
	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewLongObj(value);
	} else {
	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
................................................................................
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    data = Tcl_GetByteArrayFromObj(objv[1], &count);
    cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
    for (offset = 0; offset < count; ++offset) {
	*cursor++ = HexDigits[(data[offset] >> 4) & 0x0f];
	*cursor++ = HexDigits[data[offset] & 0x0f];
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc - 1], &count);
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
	for (i = 0 ; i < 2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit((int) c)) {
................................................................................
	    c -= '0';
	    if (c > 9) {
		c += ('0' - 'A') + 10;
	    }
	    if (c > 16) {
		c += ('A' - 'a');
	    }
	    value |= c & 0xf;
	}
	if (i < 2) {
	    cut++;
	}
	*cursor++ = UCHAR(value);
	value = 0;
    }
................................................................................
{
    Tcl_Obj *resultObj;
    unsigned char *data, *cursor, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    int wrapcharlen = 1;
    int offset, i, index, size, outindex = 0, count = 0;
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen);
	    if (wrapcharlen == 0) {
		maxlen = 0;
	    }
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count);
    if (count > 0) {
	size = (((count * 4) / 3) + 3) & ~3;	/* ensure 4 byte chunks */
	if (maxlen > 0 && size > maxlen) {
	    int adjusted = size + (wrapcharlen * (size / maxlen));

	    if (size % maxlen == 0) {
		adjusted -= wrapcharlen;
	    }
	    size = adjusted;
	}
	cursor = Tcl_SetByteArrayLength(resultObj, size);
	limit = cursor + size;
	for (offset = 0; offset < count; offset += 3) {
	    unsigned char d[3] = {0, 0, 0};

	    for (i = 0; i < 3 && offset + i < count; ++i) {
		d[i] = data[offset + i];
	    }
	    OUTPUT(B64Digits[d[0] >> 2]);
	    OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
	    if (offset + 1 < count) {
		OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
	    } else {
		OUTPUT(B64Digits[64]);
	    }
	    if (offset+2 < count) {
		OUTPUT(B64Digits[d[2] & 0x3f]);
	    } else {
................................................................................
    int lineLength = 61;
    const unsigned char SingleNewline[] = { (unsigned char) '\n' };
    const unsigned char *wrapchar = SingleNewline;
    int wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1],
		    &lineLength) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (lineLength < 3 || lineLength > 85) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = Tcl_GetByteArrayFromObj(objv[i + 1], &wrapcharlen);
	    break;
	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    resultObj = Tcl_NewObj();
    offset = 0;
    data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count);
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 0;

    /*
................................................................................
    while (offset < count) {
	int lineLen = count - offset;

	if (lineLen > rawLength) {
	    lineLen = rawLength;
	}
	*cursor++ = UueDigits[lineLen];
	for (i = 0 ; i < lineLen ; i++) {
	    n <<= 8;
	    n |= data[offset++];
	    for (bits += 8; bits > 6 ; bits -= 6) {
		*cursor++ = UueDigits[(n >> (bits - 6)) & 0x3f];
	    }
	}
	if (bits > 0) {
	    n <<= 8;
	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
	    bits = 0;
	}
	for (j = 0 ; j < wrapcharlen ; ++j) {
	    *cursor++ = wrapchar[j];
	}
    }

    /*
     * Fix the length of the output bytearray.
     */

    Tcl_SetByteArrayLength(resultObj, cursor - start);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, size, count = 0, strict = 0, lineLen;
    unsigned char c;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc - 1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;

    /*
     * The decoding loop. First, we get the length of line (strictly, the
................................................................................
	    lineLen = (c - 32) & 0x3f;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i = 0 ; i < 4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!TclIsSpaceProc(c)) {
			    goto badUu;
			} else if (c == '\n') {
................................................................................
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc - 1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;

	/*
................................................................................

	    if (data < dataend) {
		c = *data++;
	    } else if (i > 1) {
		c = '=';
	    } else {
		if (strict && i <= 1) {
		    /*
		     * Single resp. unfulfilled char (each 4th next single
		     * char) is rather bad64 error case in strict mode.
		     */

		    goto bad64;
		}
		cut += 3;
		break;
	    }

	    /*
................................................................................
	     * because they're only valid as the last character or two of the
	     * final block of input. Unless strict mode is enabled, skip any
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		    value <<= 6;
		    cut++;
		} else if (!strict && TclIsSpaceProc(c)) {
		    i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=' && (!strict || i > 1)) {
		/*
		 * "=" and "a=" is rather bad64 error case in strict mode.

		 */

		value <<= 6;
		if (i) {
		    cut++;
		}
	    } else if (strict || !TclIsSpaceProc(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
................................................................................
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

jni/tcl/library/msgs/ja.msg became a regular file.