Check-in [7a110bb514]
Not logged in

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

Overview
Comment:cleanup missing pieces in tbcload and tclcompiler
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7a110bb514ff59282bdc94aaca96e50142bc8da1
User & Date: chw 2019-07-07 08:21:58
Context
2019-07-08
05:03
attempt to fix ticket [e3c6fbfa6f], now generating <Leave> on <<FingerUp>> check-in: bff8537e1b user: chw tags: trunk
2019-07-07
08:26
merge with trunk check-in: fea67f041d user: chw tags: wtf-8-experiment
08:21
cleanup missing pieces in tbcload and tclcompiler check-in: 7a110bb514 user: chw tags: trunk
05:18
improve fix from [d74c9c42c0] check-in: ab2836e6c1 user: chw tags: trunk
Changes

Changes to jni/tbcload/cmpInt.h.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
32
33
34
35
36
37
38








39
40
41
42
43
44
45
...
277
278
279
280
281
282
283






284
285
286
287
288
289
290
 *  Internal header file for the Compiler/Loader package.
 *  This header defines a number of macros that are used by both the writer
 *  and reader package to initialize some static variables. We use macros
 *  because the writer and the reader are two separate packages, and we don't
 *  want to share code between the two.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 2002      ActiveState SRL
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: cmpInt.h,v 1.6 2002/12/02 17:42:02 andreas_kupries Exp $
 */

................................................................................
 * Activate features specific to 8.5 and higher.
 * JumpTableInfo AuxData (for compiled 'switch').
 */

#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5))
#define TCL_85_PLUS
#endif









/*
 * USE_CATCH_WRAPPER controls whether the emitted code has a catch around
 * the call to loader::bceval and code to strip off the additional back trace
 * from the error info
 */
# define USE_CATCH_WRAPPER 0
................................................................................
/*
 * The one-letter codes for the AuxData types range types
 */
# define CMP_FOREACH_INFO		'F'
#ifdef TCL_85_PLUS
# define CMP_JUMPTABLE_INFO		'J'
#endif







/*
 * the following set of procedures needs to be wrapped around a DLLEXPORT
 * macro setup, because they are exported by the Tbcload DLL
 */

# ifdef BUILD_tbcload







|







 







>
>
>
>
>
>
>
>







 







>
>
>
>
>
>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
...
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
 *  Internal header file for the Compiler/Loader package.
 *  This header defines a number of macros that are used by both the writer
 *  and reader package to initialize some static variables. We use macros
 *  because the writer and the reader are two separate packages, and we don't
 *  want to share code between the two.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 2002-2014, 2017 ActiveState Software Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: cmpInt.h,v 1.6 2002/12/02 17:42:02 andreas_kupries Exp $
 */

................................................................................
 * Activate features specific to 8.5 and higher.
 * JumpTableInfo AuxData (for compiled 'switch').
 */

#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5))
#define TCL_85_PLUS
#endif

#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
#define TCL_86_PLUS
#endif

#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION > 6)) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION == 6) && (TCL_RELEASE_SERIAL >= 2))
#define TCL_862_PLUS
#endif

/*
 * USE_CATCH_WRAPPER controls whether the emitted code has a catch around
 * the call to loader::bceval and code to strip off the additional back trace
 * from the error info
 */
# define USE_CATCH_WRAPPER 0
................................................................................
/*
 * The one-letter codes for the AuxData types range types
 */
# define CMP_FOREACH_INFO		'F'
#ifdef TCL_85_PLUS
# define CMP_JUMPTABLE_INFO		'J'
#endif
#ifdef TCL_86_PLUS
# define CMP_DICTUPDATE_INFO		'D'
#endif
#ifdef TCL_862_PLUS
# define CMP_FOREACH_INFO_2		'f'
#endif

/*
 * the following set of procedures needs to be wrapped around a DLLEXPORT
 * macro setup, because they are exported by the Tbcload DLL
 */

# ifdef BUILD_tbcload

Changes to jni/tbcload/cmpRead.c.

2
3
4
5
6
7
8

9
10
11
12
13
14
15
...
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344






345
346
347
348
349
350
351
...
428
429
430
431
432
433
434








435
436
437
438
439
440
441
...
808
809
810
811
812
813
814

815
816
817
818



819
820
821
822
823



824
825
826
827
828



829
830
831
832
833
834
835
....
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
....
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
....
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
....
1850
1851
1852
1853
1854
1855
1856














1857
1858
1859
1860
1861
1862
1863
....
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
....
2204
2205
2206
2207
2208
2209
2210












2211
2212
2213
2214
2215
2216
2217
....
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
....
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
....
2535
2536
2537
2538
2539
2540
2541



















































































































































































2542
2543
2544
2545
2546
2547
2548
....
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
 * cmpRead.c --
 *
 *  This file contains the code used by the compiled file script loader to
 *  load a compiled script. The script loader is registered in the Init
 *  procedure of the "Loader" package.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: cmpRead.c,v 1.11 2002/11/28 16:53:10 andreas_kupries Exp $
 */

................................................................................
/*
 * These Tcl_ObjType pointers are initialized the first time that the package
 * is loaded; we do it this way because the actual object types are not
 * exported by the TCL DLL, and therefore if we use the address of the
 * standard types we get an undefined symbol at link time.
 */

static CONST Tcl_ObjType *cmpTclProProcBodyType = 0;
static CONST Tcl_ObjType *cmpByteCodeType = 0;
static CONST Tcl_ObjType *cmpDoubleType = 0;
static CONST Tcl_ObjType *cmpIntType = 0;

/*
 * Same thing for AuxDataTypes.
 */

static CONST AuxDataType *cmpForeachInfoType = 0;
#ifdef TCL_85_PLUS
static CONST AuxDataType *cmpJumptableInfoType = 0;






#endif

static int didLoadTypes = 0;

/*
 * error message to generate when we run into the end of the buffer and we
 * are expecting more stuff
................................................................................
			ExceptionRange *excArray, int excArraySize));
static int	ExtractForeachInfo _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr, AuxData *auxDataPtr));
#ifdef TCL_85_PLUS
static int	ExtractJumptableInfo _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr, AuxData *auxDataPtr));
#endif








static int	ExtractInteger _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr, int *valuePtr));
static int	ExtractObjArray _ANSI_ARGS_((Tcl_Interp *interp,
			int numLitObjects, ExtractionEnv* envPtr,
			Tcl_Obj **objArray, int objArraySize));
static Tcl_Obj *ExtractObject _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr));
................................................................................
    /*
     * The assignements to p must be kept consistent with the ones in
     * TclInitByteCodeObj, so that the arrays are aligned as expected.
     */

    p += sizeof(ByteCode);
    byteCodePtr->codeStart = p;


    p += TCL_ALIGN(numCodeBytes);
    if (numLitObjects > 0) {
	byteCodePtr->objArrayPtr = (Tcl_Obj **) p;



    }

    p += TCL_ALIGN(objArrayBytes);
    if (numExceptRanges > 0) {
	byteCodePtr->exceptArrayPtr = (ExceptionRange *) p;



    }

    p += TCL_ALIGN(exceptArrayBytes);
    if (numAuxDataItems > 0) {
	byteCodePtr->auxDataArrayPtr = (AuxData *) p;



    }

    p += auxDataArrayBytes;
    byteCodePtr->codeDeltaStart = p;
    p += locMapPtr->codeDeltaSize;
    byteCodePtr->codeLengthStart = p;
    p += locMapPtr->codeLengthSize;
................................................................................
{
    Tcl_Obj *objPtr = NULL;
    char *imagePtr;
    char *imageEnd;
    char *objString;
    char typeCode;
    int objStringLength;
    CONST Tcl_ObjType *objTypePtr = NULL;

    imagePtr = envPtr->curImagePtr;
    imageEnd = envPtr->imageEnd;

    /*
     * skip whitespace, get the typecode
     */
................................................................................
	     * The side effects of this need to be investigated further.
	     */

	    objPtr = Tcl_NewStringObj(noSourceCode, -1);
	    Tcl_IncrRefCount(objPtr);

	    objPtr->internalRep.otherValuePtr = (VOID *) localExEnv.codePtr;
	    objPtr->typePtr = cmpByteCodeType;

	    localExEnv.codePtr->refCount++;

	    /*
	     * skip over the ByteCode representation we just read in
	     */

................................................................................
	    Tcl_AppendResult(interp, "unknown object type \"",
		    errBuf, "\"", (char *) NULL);
	    AppendErrorLocation(interp, envPtr);
	    return NULL;
	}

	if (objTypePtr
		&& (Tcl_ConvertToType(interp, objPtr, objTypePtr) != TCL_OK)) {
	    Tcl_DecrRefCount(objPtr);
	    return NULL;
	}
    }

    return objPtr;
}
................................................................................
	    }
#ifdef TCL_85_PLUS
	} else if (typeCode == CMP_JUMPTABLE_INFO) {
	  int result = ExtractJumptableInfo(interp, envPtr, auxPtr);
	  if (result != TCL_OK) {
	    return result;
	  }














#endif
	} else {
	    char errBuf[2];
	    errBuf[0] = typeCode;
	    errBuf[1] = '\0';
	    Tcl_AppendResult(interp, "unknown aux data type: ",
		    errBuf, (char *) NULL);
................................................................................
     * See the comment above Tcl_NewStringObj in ExtractObjArray.
     */

    objPtr = Tcl_NewStringObj(noSourceCode, -1);
    Tcl_IncrRefCount(objPtr);

    objPtr->internalRep.otherValuePtr = (VOID *) exEnv.codePtr;
    objPtr->typePtr = cmpByteCodeType;
    exEnv.codePtr->refCount++;

    CleanupExtractEnv(&exEnv);

    return objPtr;
}
 
................................................................................
	    panic("InitTypes: failed to find the ForeachInfo AuxData type");
	}
#ifdef TCL_85_PLUS
	cmpJumptableInfoType = TclGetAuxDataType("JumptableInfo");
	if (!cmpJumptableInfoType) {
	    panic("InitTypes: failed to find the JumptableInfo AuxData type");
	}












#endif
	didLoadTypes += 1;
    }
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	}
    }

    /*
     * finally! Assign the ForeachInfo to the AuxData.
     */

    auxDataPtr->type = cmpForeachInfoType;
    auxDataPtr->clientData = (ClientData) infoPtr;

    return TCL_OK;

    errorReturn:

    if (infoPtr) {
................................................................................
    }


    /*
     * finally! Assign the JumptableInfo to the AuxData.
     */

    auxDataPtr->type = cmpJumptableInfoType;
    auxDataPtr->clientData = (ClientData) infoPtr;

    return TCL_OK;

    errorReturn:

    if (infoPtr) {
................................................................................
      }
      Tcl_DeleteHashTable(&infoPtr->hashTable);
      ckfree((char *) infoPtr);
    }

    return result;
}



















































































































































































#endif
 
/*
 *----------------------------------------------------------------------
 *
 * ExtractProcBody --
 *
................................................................................
     * We also bump the reference count on the ByteCode because the object
     * contains a reference to it.
     */

    bodyPtr = Tcl_NewStringObj(noSourceCode, -1);
    Tcl_IncrRefCount(bodyPtr);
    bodyPtr->internalRep.otherValuePtr = (VOID *) codePtr;
    bodyPtr->typePtr = cmpByteCodeType;
    codePtr->refCount++;

    /*
     * allocate the proc struct and start populating it.
     * We initialize the reference count on the Proc to 0 because
     * ProcBodyNewObj will bump it when it creates a TclProProcBody Tcl_Obj.
     */







>







 







|
|
|
|





|

|
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>







 







>




>
>
>





>
>
>





>
>
>







 







|







 







|







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
...
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
...
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
...
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
....
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
....
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
....
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
....
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
....
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
....
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
....
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
....
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
....
2586
2587
2588
2589
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
2641
2642
2643
2644
2645
2646
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
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
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
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
....
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
 * cmpRead.c --
 *
 *  This file contains the code used by the compiled file script loader to
 *  load a compiled script. The script loader is registered in the Init
 *  procedure of the "Loader" package.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 2000, 2017 ActiveState Software Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: cmpRead.c,v 1.11 2002/11/28 16:53:10 andreas_kupries Exp $
 */

................................................................................
/*
 * These Tcl_ObjType pointers are initialized the first time that the package
 * is loaded; we do it this way because the actual object types are not
 * exported by the TCL DLL, and therefore if we use the address of the
 * standard types we get an undefined symbol at link time.
 */

static const Tcl_ObjType *cmpTclProProcBodyType = 0;
static const Tcl_ObjType *cmpByteCodeType = 0;
static const Tcl_ObjType *cmpDoubleType = 0;
static const Tcl_ObjType *cmpIntType = 0;

/*
 * Same thing for AuxDataTypes.
 */

static const AuxDataType *cmpForeachInfoType = 0;
#ifdef TCL_85_PLUS
static const AuxDataType *cmpJumptableInfoType = 0;
#endif
#ifdef TCL_86_PLUS
static const AuxDataType *cmpDictUpdateInfoType = 0;
#endif
#ifdef TCL_862_PLUS
static const AuxDataType *cmpNewForeachInfoType = 0;
#endif

static int didLoadTypes = 0;

/*
 * error message to generate when we run into the end of the buffer and we
 * are expecting more stuff
................................................................................
			ExceptionRange *excArray, int excArraySize));
static int	ExtractForeachInfo _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr, AuxData *auxDataPtr));
#ifdef TCL_85_PLUS
static int	ExtractJumptableInfo _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr, AuxData *auxDataPtr));
#endif
#ifdef TCL_86_PLUS
static int	ExtractDictUpdateInfo _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr, AuxData *auxDataPtr));
#endif
#ifdef TCL_862_PLUS
static int	ExtractNewForeachInfo _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr, AuxData *auxDataPtr));
#endif
static int	ExtractInteger _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr, int *valuePtr));
static int	ExtractObjArray _ANSI_ARGS_((Tcl_Interp *interp,
			int numLitObjects, ExtractionEnv* envPtr,
			Tcl_Obj **objArray, int objArraySize));
static Tcl_Obj *ExtractObject _ANSI_ARGS_((Tcl_Interp *interp,
			ExtractionEnv *envPtr));
................................................................................
    /*
     * The assignements to p must be kept consistent with the ones in
     * TclInitByteCodeObj, so that the arrays are aligned as expected.
     */

    p += sizeof(ByteCode);
    byteCodePtr->codeStart = p;
    memset(p, 0, (size_t) numCodeBytes);

    p += TCL_ALIGN(numCodeBytes);
    if (numLitObjects > 0) {
	byteCodePtr->objArrayPtr = (Tcl_Obj **) p;
	memset(p, 0, (size_t) objArrayBytes);
    } else {
	byteCodePtr->objArrayPtr = (Tcl_Obj **) 0;
    }

    p += TCL_ALIGN(objArrayBytes);
    if (numExceptRanges > 0) {
	byteCodePtr->exceptArrayPtr = (ExceptionRange *) p;
	memset(p, 0, (size_t) exceptArrayBytes);
    } else {
	byteCodePtr->exceptArrayPtr = (ExceptionRange *) 0;
    }

    p += TCL_ALIGN(exceptArrayBytes);
    if (numAuxDataItems > 0) {
	byteCodePtr->auxDataArrayPtr = (AuxData *) p;
	memset(p, 0, (size_t) auxDataArrayBytes);
    } else {
	byteCodePtr->auxDataArrayPtr = (AuxData *) 0;
    }

    p += auxDataArrayBytes;
    byteCodePtr->codeDeltaStart = p;
    p += locMapPtr->codeDeltaSize;
    byteCodePtr->codeLengthStart = p;
    p += locMapPtr->codeLengthSize;
................................................................................
{
    Tcl_Obj *objPtr = NULL;
    char *imagePtr;
    char *imageEnd;
    char *objString;
    char typeCode;
    int objStringLength;
    const Tcl_ObjType *objTypePtr = NULL;

    imagePtr = envPtr->curImagePtr;
    imageEnd = envPtr->imageEnd;

    /*
     * skip whitespace, get the typecode
     */
................................................................................
	     * The side effects of this need to be investigated further.
	     */

	    objPtr = Tcl_NewStringObj(noSourceCode, -1);
	    Tcl_IncrRefCount(objPtr);

	    objPtr->internalRep.otherValuePtr = (VOID *) localExEnv.codePtr;
	    objPtr->typePtr = (Tcl_ObjType*) cmpByteCodeType;

	    localExEnv.codePtr->refCount++;

	    /*
	     * skip over the ByteCode representation we just read in
	     */

................................................................................
	    Tcl_AppendResult(interp, "unknown object type \"",
		    errBuf, "\"", (char *) NULL);
	    AppendErrorLocation(interp, envPtr);
	    return NULL;
	}

	if (objTypePtr
	    && (Tcl_ConvertToType(interp, objPtr, (Tcl_ObjType *) objTypePtr) != TCL_OK)) {
	    Tcl_DecrRefCount(objPtr);
	    return NULL;
	}
    }

    return objPtr;
}
................................................................................
	    }
#ifdef TCL_85_PLUS
	} else if (typeCode == CMP_JUMPTABLE_INFO) {
	  int result = ExtractJumptableInfo(interp, envPtr, auxPtr);
	  if (result != TCL_OK) {
	    return result;
	  }
#endif
#ifdef TCL_86_PLUS
	} else if (typeCode == CMP_DICTUPDATE_INFO) {
	  int result = ExtractDictUpdateInfo(interp, envPtr, auxPtr);
	  if (result != TCL_OK) {
	    return result;
	  }
#endif
#ifdef TCL_862_PLUS
	} else if (typeCode == CMP_FOREACH_INFO_2) {
	  int result = ExtractNewForeachInfo(interp, envPtr, auxPtr);
	  if (result != TCL_OK) {
	    return result;
	  }
#endif
	} else {
	    char errBuf[2];
	    errBuf[0] = typeCode;
	    errBuf[1] = '\0';
	    Tcl_AppendResult(interp, "unknown aux data type: ",
		    errBuf, (char *) NULL);
................................................................................
     * See the comment above Tcl_NewStringObj in ExtractObjArray.
     */

    objPtr = Tcl_NewStringObj(noSourceCode, -1);
    Tcl_IncrRefCount(objPtr);

    objPtr->internalRep.otherValuePtr = (VOID *) exEnv.codePtr;
    objPtr->typePtr = (Tcl_ObjType *) cmpByteCodeType;
    exEnv.codePtr->refCount++;

    CleanupExtractEnv(&exEnv);

    return objPtr;
}
 
................................................................................
	    panic("InitTypes: failed to find the ForeachInfo AuxData type");
	}
#ifdef TCL_85_PLUS
	cmpJumptableInfoType = TclGetAuxDataType("JumptableInfo");
	if (!cmpJumptableInfoType) {
	    panic("InitTypes: failed to find the JumptableInfo AuxData type");
	}
#endif
#ifdef TCL_86_PLUS
	cmpDictUpdateInfoType = TclGetAuxDataType("DictUpdateInfo");
	if (!cmpDictUpdateInfoType) {
	    panic("InitTypes: failed to find the DictUpdateInfo AuxData type");
	}
#endif
#ifdef TCL_862_PLUS
        cmpNewForeachInfoType = TclGetAuxDataType("NewForeachInfo");
        if (!cmpNewForeachInfoType) {
            panic("InitTypes: failed to find the NewForeachInfo AuxData type");
        }
#endif
	didLoadTypes += 1;
    }
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	}
    }

    /*
     * finally! Assign the ForeachInfo to the AuxData.
     */

    auxDataPtr->type = (AuxDataType *) cmpForeachInfoType;
    auxDataPtr->clientData = (ClientData) infoPtr;

    return TCL_OK;

    errorReturn:

    if (infoPtr) {
................................................................................
    }


    /*
     * finally! Assign the JumptableInfo to the AuxData.
     */

    auxDataPtr->type = (AuxDataType *) cmpJumptableInfoType;
    auxDataPtr->clientData = (ClientData) infoPtr;

    return TCL_OK;

    errorReturn:

    if (infoPtr) {
................................................................................
      }
      Tcl_DeleteHashTable(&infoPtr->hashTable);
      ckfree((char *) infoPtr);
    }

    return result;
}
#endif
 
#ifdef TCL_86_PLUS
/*
 *----------------------------------------------------------------------
 *
 * ExtractDictUpdateInfo --
 *
 *  Extract a DictUpdateInfo struct from the extraction environment..
 *
 * Results:
 *  Returns a TCL error code.
 *
 * Side effects:
 *  Creates a DictUpdateInfo AuxData at *auxPtr.
 *  Sets the TCL result on error.
 *
 *----------------------------------------------------------------------
 */

static int
ExtractDictUpdateInfo(interp, envPtr, auxDataPtr)
    Tcl_Interp *interp;		/* the current interpreter */
    ExtractionEnv *envPtr;	/* the extraction environment */
    AuxData *auxDataPtr;	/* pointer to the AuxData item to be filled
				 * with the DictUpdateInfo extracted from the
				 * image */
{
    int i, numVar, result, value;
    DictUpdateInfo *infoPtr = NULL;

    /*
     * read in the control variables, allocate and initialize the
     * DictUpdateInfo struct.
     */

    result = ExtractInteger(interp, envPtr, &numVar);
    if (result != TCL_OK) {
	return result;
    }

    infoPtr = (DictUpdateInfo *) ckalloc((unsigned)(sizeof(DictUpdateInfo)+numVar*sizeof(int)));
    infoPtr->length = numVar;

    for(i=0; i < numVar;i++) {
        result = ExtractInteger(interp, envPtr, &value);
	if (result != TCL_OK) {
	    goto errorReturn;
	}
	infoPtr->varIndices [i] = value;
    }

    /*
     * finally! Assign the DictUpdateInfo to the AuxData.
     */

    auxDataPtr->type = (AuxDataType *) cmpDictUpdateInfoType;
    auxDataPtr->clientData = (ClientData) infoPtr;

    return TCL_OK;

 errorReturn:

    if (infoPtr) {
	ckfree((char *) infoPtr);
    }

    return result;
}
#endif
 
#ifdef TCL_862_PLUS
/*
 *----------------------------------------------------------------------
 *
 * ExtractNewForeachInfo --
 *
 *  Extract a ForeachInfo struct from the extraction environment..
 *  For the new foreach bytecodes.
 *
 * Results:
 *  Returns a TCL error code.
 *
 * Side effects:
 *  Creates a ForeachInfo AuxData at *auxPtr.
 *  Sets the TCL result on error.
 *
 *----------------------------------------------------------------------
 */

static int
ExtractNewForeachInfo(interp, envPtr, auxDataPtr)
    Tcl_Interp *interp;		/* the current interpreter */
    ExtractionEnv *envPtr;	/* the extraction environment */
    AuxData *auxDataPtr;	/* pointer to the AuxData item to be filled
				 * with the ForeachInfo extracted from the
				 * image */
{
    int i, j, result;
    int numLists, loopCtTemp, numVars;
    ForeachInfo *infoPtr = NULL;
    ForeachVarList *varListPtr = NULL;
    int *varPtr;

    /*
     * read in the control variables, allocate and initialize the
     * ForeachInfo struct.
     */

    result = ExtractInteger(interp, envPtr, &numLists);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * The new bytecodes handling foreach do not use firstValueTemp.
     * Was dropped from saved bytecode. Fake a nice value, see %% below.
     */

    result = ExtractInteger(interp, envPtr, &loopCtTemp);
    if (result != TCL_OK) {
	return result;
    }

    infoPtr = (ForeachInfo *) ckalloc((unsigned)
	    (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
    infoPtr->numLists = numLists;
    infoPtr->firstValueTemp = 0; /* %% */
    infoPtr->loopCtTemp = loopCtTemp;
    for (i=0 ; i < numLists ; i++) {
	infoPtr->varLists[i] = (ForeachVarList *) NULL;
    }

    /*
     * now load the ForeachVarList structs
     */

    for (i=0 ; i < numLists ; i++) {
	result = ExtractInteger(interp, envPtr, &numVars);
	if (result != TCL_OK) {
	    goto errorReturn;
	}

	varListPtr = (ForeachVarList *) ckalloc((unsigned)
		sizeof(ForeachVarList) + numVars*sizeof(int));
	infoPtr->varLists[i] = varListPtr;
	varListPtr->numVars = numVars;

	varPtr = &varListPtr->varIndexes[0];
	for (j=0 ; j < numVars ; j++) {
	    result = ExtractInteger(interp, envPtr, varPtr);
	    if (result != TCL_OK) {
		goto errorReturn;
	    }
	    varPtr++;
	}
    }

    /*
     * finally! Assign the ForeachInfo to the AuxData.
     */

    auxDataPtr->type = (AuxDataType *) cmpForeachInfoType;
    auxDataPtr->clientData = (ClientData) infoPtr;

    return TCL_OK;

    errorReturn:

    if (infoPtr) {
	for (i=0 ; i < infoPtr->numLists ; i++) {
	    ckfree((char *) infoPtr->varLists[i]);
	}
	ckfree((char *) infoPtr);
    }

    return result;
}
 
#endif
 
/*
 *----------------------------------------------------------------------
 *
 * ExtractProcBody --
 *
................................................................................
     * We also bump the reference count on the ByteCode because the object
     * contains a reference to it.
     */

    bodyPtr = Tcl_NewStringObj(noSourceCode, -1);
    Tcl_IncrRefCount(bodyPtr);
    bodyPtr->internalRep.otherValuePtr = (VOID *) codePtr;
    bodyPtr->typePtr = (Tcl_ObjType *) cmpByteCodeType;
    codePtr->refCount++;

    /*
     * allocate the proc struct and start populating it.
     * We initialize the reference count on the Proc to 0 because
     * ProcBodyNewObj will bump it when it creates a TclProProcBody Tcl_Obj.
     */

Changes to undroid/tclcompiler/cmpInt.h.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
32
33
34
35
36
37
38








39
40
41
42
43
44
45
...
277
278
279
280
281
282
283






284
285
286
287
288
289
290
 *  Internal header file for the Compiler/Loader package.
 *  This header defines a number of macros that are used by both the writer
 *  and reader package to initialize some static variables. We use macros
 *  because the writer and the reader are two separate packages, and we don't
 *  want to share code between the two.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 2002      ActiveState SRL
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: cmpInt.h,v 1.6 2002/12/02 17:42:02 andreas_kupries Exp $
 */

................................................................................
 * Activate features specific to 8.5 and higher.
 * JumpTableInfo AuxData (for compiled 'switch').
 */

#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5))
#define TCL_85_PLUS
#endif









/*
 * USE_CATCH_WRAPPER controls whether the emitted code has a catch around
 * the call to loader::bceval and code to strip off the additional back trace
 * from the error info
 */
# define USE_CATCH_WRAPPER 0
................................................................................
/*
 * The one-letter codes for the AuxData types range types
 */
# define CMP_FOREACH_INFO		'F'
#ifdef TCL_85_PLUS
# define CMP_JUMPTABLE_INFO		'J'
#endif







/*
 * the following set of procedures needs to be wrapped around a DLLEXPORT
 * macro setup, because they are exported by the Tbcload DLL
 */

# ifdef BUILD_tbcload







|







 







>
>
>
>
>
>
>
>







 







>
>
>
>
>
>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
...
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
 *  Internal header file for the Compiler/Loader package.
 *  This header defines a number of macros that are used by both the writer
 *  and reader package to initialize some static variables. We use macros
 *  because the writer and the reader are two separate packages, and we don't
 *  want to share code between the two.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 2002-2014, 2017 ActiveState Software Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: cmpInt.h,v 1.6 2002/12/02 17:42:02 andreas_kupries Exp $
 */

................................................................................
 * Activate features specific to 8.5 and higher.
 * JumpTableInfo AuxData (for compiled 'switch').
 */

#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5))
#define TCL_85_PLUS
#endif

#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
#define TCL_86_PLUS
#endif

#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION > 6)) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION == 6) && (TCL_RELEASE_SERIAL >= 2))
#define TCL_862_PLUS
#endif

/*
 * USE_CATCH_WRAPPER controls whether the emitted code has a catch around
 * the call to loader::bceval and code to strip off the additional back trace
 * from the error info
 */
# define USE_CATCH_WRAPPER 0
................................................................................
/*
 * The one-letter codes for the AuxData types range types
 */
# define CMP_FOREACH_INFO		'F'
#ifdef TCL_85_PLUS
# define CMP_JUMPTABLE_INFO		'J'
#endif
#ifdef TCL_86_PLUS
# define CMP_DICTUPDATE_INFO		'D'
#endif
#ifdef TCL_862_PLUS
# define CMP_FOREACH_INFO_2		'f'
#endif

/*
 * the following set of procedures needs to be wrapped around a DLLEXPORT
 * macro setup, because they are exported by the Tbcload DLL
 */

# ifdef BUILD_tbcload