summaryrefslogtreecommitdiffstats
path: root/Python/bltinmodule.c
blob: a81af65658206a17c22a07ff98db37c4143d64b2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
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
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
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
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
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
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
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
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
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
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
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
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
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
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
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
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
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
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
/* Built-in functions */

#include "Python.h"
#include "Python-ast.h"

#include "node.h"
#include "code.h"

#include "asdl.h"
#include "ast.h"

#include <ctype.h>

#ifdef HAVE_LANGINFO_H
#include <langinfo.h>   /* CODESET */
#endif

/* The default encoding used by the platform file system APIs
   Can remain NULL for all platforms that don't have such a concept

   Don't forget to modify PyUnicode_DecodeFSDefault() if you touch any of the
   values for Py_FileSystemDefaultEncoding!
*/
#ifdef HAVE_MBCS
const char *Py_FileSystemDefaultEncoding = "mbcs";
int Py_HasFileSystemDefaultEncoding = 1;
#elif defined(__APPLE__)
const char *Py_FileSystemDefaultEncoding = "utf-8";
int Py_HasFileSystemDefaultEncoding = 1;
#else
const char *Py_FileSystemDefaultEncoding = NULL; /* set by initfsencoding() */
int Py_HasFileSystemDefaultEncoding = 0;
#endif

_Py_IDENTIFIER(__builtins__);
_Py_IDENTIFIER(__dict__);
_Py_IDENTIFIER(__prepare__);
_Py_IDENTIFIER(__round__);
_Py_IDENTIFIER(encoding);
_Py_IDENTIFIER(errors);
_Py_IDENTIFIER(fileno);
_Py_IDENTIFIER(flush);
_Py_IDENTIFIER(metaclass);
_Py_IDENTIFIER(sort);
_Py_IDENTIFIER(stdin);
_Py_IDENTIFIER(stdout);
_Py_IDENTIFIER(stderr);

static PyObject *
builtin___build_class__(PyObject *self, PyObject *args, PyObject *kwds)
{
    PyObject *func, *name, *bases, *mkw, *meta, *winner, *prep, *ns, *cell;
    PyObject *cls = NULL;
    Py_ssize_t nargs;
    int isclass;

    assert(args != NULL);
    if (!PyTuple_Check(args)) {
        PyErr_SetString(PyExc_TypeError,
                        "__build_class__: args is not a tuple");
        return NULL;
    }
    nargs = PyTuple_GET_SIZE(args);
    if (nargs < 2) {
        PyErr_SetString(PyExc_TypeError,
                        "__build_class__: not enough arguments");
        return NULL;
    }
    func = PyTuple_GET_ITEM(args, 0); /* Better be callable */
    if (!PyFunction_Check(func)) {
        PyErr_SetString(PyExc_TypeError,
                        "__build__class__: func must be a function");
        return NULL;
    }
    name = PyTuple_GET_ITEM(args, 1);
    if (!PyUnicode_Check(name)) {
        PyErr_SetString(PyExc_TypeError,
                        "__build_class__: name is not a string");
        return NULL;
    }
    bases = PyTuple_GetSlice(args, 2, nargs);
    if (bases == NULL)
        return NULL;

    if (kwds == NULL) {
        meta = NULL;
        mkw = NULL;
    }
    else {
        mkw = PyDict_Copy(kwds); /* Don't modify kwds passed in! */
        if (mkw == NULL) {
            Py_DECREF(bases);
            return NULL;
        }
        meta = _PyDict_GetItemId(mkw, &PyId_metaclass);
        if (meta != NULL) {
            Py_INCREF(meta);
            if (_PyDict_DelItemId(mkw, &PyId_metaclass) < 0) {
                Py_DECREF(meta);
                Py_DECREF(mkw);
                Py_DECREF(bases);
                return NULL;
            }
            /* metaclass is explicitly given, check if it's indeed a class */
            isclass = PyType_Check(meta);
        }
    }
    if (meta == NULL) {
        /* if there are no bases, use type: */
        if (PyTuple_GET_SIZE(bases) == 0) {
            meta = (PyObject *) (&PyType_Type);
        }
        /* else get the type of the first base */
        else {
            PyObject *base0 = PyTuple_GET_ITEM(bases, 0);
            meta = (PyObject *) (base0->ob_type);
        }
        Py_INCREF(meta);
        isclass = 1;  /* meta is really a class */
    }

    if (isclass) {
        /* meta is really a class, so check for a more derived
           metaclass, or possible metaclass conflicts: */
        winner = (PyObject *)_PyType_CalculateMetaclass((PyTypeObject *)meta,
                                                        bases);
        if (winner == NULL) {
            Py_DECREF(meta);
            Py_XDECREF(mkw);
            Py_DECREF(bases);
            return NULL;
        }
        if (winner != meta) {
            Py_DECREF(meta);
            meta = winner;
            Py_INCREF(meta);
        }
    }
    /* else: meta is not a class, so we cannot do the metaclass
       calculation, so we will use the explicitly given object as it is */
    prep = _PyObject_GetAttrId(meta, &PyId___prepare__);
    if (prep == NULL) {
        if (PyErr_ExceptionMatches(PyExc_AttributeError)) {
            PyErr_Clear();
            ns = PyDict_New();
        }
        else {
            Py_DECREF(meta);
            Py_XDECREF(mkw);
            Py_DECREF(bases);
            return NULL;
        }
    }
    else {
        PyObject *pargs = PyTuple_Pack(2, name, bases);
        if (pargs == NULL) {
            Py_DECREF(prep);
            Py_DECREF(meta);
            Py_XDECREF(mkw);
            Py_DECREF(bases);
            return NULL;
        }
        ns = PyEval_CallObjectWithKeywords(prep, pargs, mkw);
        Py_DECREF(pargs);
        Py_DECREF(prep);
    }
    if (ns == NULL) {
        Py_DECREF(meta);
        Py_XDECREF(mkw);
        Py_DECREF(bases);
        return NULL;
    }
    cell = PyEval_EvalCodeEx(PyFunction_GET_CODE(func), PyFunction_GET_GLOBALS(func), ns,
                             NULL, 0, NULL, 0, NULL, 0, NULL,
                             PyFunction_GET_CLOSURE(func));
    if (cell != NULL) {
        PyObject *margs;
        margs = PyTuple_Pack(3, name, bases, ns);
        if (margs != NULL) {
            cls = PyEval_CallObjectWithKeywords(meta, margs, mkw);
            Py_DECREF(margs);
        }
        if (cls != NULL && PyCell_Check(cell))
            PyCell_Set(cell, cls);
        Py_DECREF(cell);
    }
    Py_DECREF(ns);
    Py_DECREF(meta);
    Py_XDECREF(mkw);
    Py_DECREF(bases);
    return cls;
}

PyDoc_STRVAR(build_class_doc,
"__build_class__(func, name, *bases, metaclass=None, **kwds) -> class\n\
\n\
Internal helper function used by the class statement.");

static PyObject *
builtin___import__(PyObject *self, PyObject *args, PyObject *kwds)
{
    static char *kwlist[] = {"name", "globals", "locals", "fromlist",
                             "level", 0};
    PyObject *name, *globals = NULL, *locals = NULL, *fromlist = NULL;
    int level = 0;

    if (!PyArg_ParseTupleAndKeywords(args, kwds, "U|OOOi:__import__",
                    kwlist, &name, &globals, &locals, &fromlist, &level))
        return NULL;
    return PyImport_ImportModuleLevelObject(name, globals, locals,
                                            fromlist, level);
}

PyDoc_STRVAR(import_doc,
"__import__(name, globals=None, locals=None, fromlist=(), level=0) -> module\n\
\n\
Import a module. Because this function is meant for use by the Python\n\
interpreter and not for general use it is better to use\n\
importlib.import_module() to programmatically import a module.\n\
\n\
The globals argument is only used to determine the context;\n\
they are not modified.  The locals argument is unused.  The fromlist\n\
should be a list of names to emulate ``from name import ...'', or an\n\
empty list to emulate ``import name''.\n\
When importing a module from a package, note that __import__('A.B', ...)\n\
returns package A when fromlist is empty, but its submodule B when\n\
fromlist is not empty.  Level is used to determine whether to perform \n\
absolute or relative imports. 0 is absolute while a positive number\n\
is the number of parent directories to search relative to the current module.");


static PyObject *
builtin_abs(PyObject *self, PyObject *v)
{
    return PyNumber_Absolute(v);
}

PyDoc_STRVAR(abs_doc,
"abs(number) -> number\n\
\n\
Return the absolute value of the argument.");

static PyObject *
builtin_all(PyObject *self, PyObject *v)
{
    PyObject *it, *item;
    PyObject *(*iternext)(PyObject *);
    int cmp;

    it = PyObject_GetIter(v);
    if (it == NULL)
        return NULL;
    iternext = *Py_TYPE(it)->tp_iternext;

    for (;;) {
        item = iternext(it);
        if (item == NULL)
            break;
        cmp = PyObject_IsTrue(item);
        Py_DECREF(item);
        if (cmp < 0) {
            Py_DECREF(it);
            return NULL;
        }
        if (cmp == 0) {
            Py_DECREF(it);
            Py_RETURN_FALSE;
        }
    }
    Py_DECREF(it);
    if (PyErr_Occurred()) {
        if (PyErr_ExceptionMatches(PyExc_StopIteration))
            PyErr_Clear();
        else
            return NULL;
    }
    Py_RETURN_TRUE;
}

PyDoc_STRVAR(all_doc,
"all(iterable) -> bool\n\
\n\
Return True if bool(x) is True for all values x in the iterable.\n\
If the iterable is empty, return True.");

static PyObject *
builtin_any(PyObject *self, PyObject *v)
{
    PyObject *it, *item;
    PyObject *(*iternext)(PyObject *);
    int cmp;

    it = PyObject_GetIter(v);
    if (it == NULL)
        return NULL;
    iternext = *Py_TYPE(it)->tp_iternext;

    for (;;) {
        item = iternext(it);
        if (item == NULL)
            break;
        cmp = PyObject_IsTrue(item);
        Py_DECREF(item);
        if (cmp < 0) {
            Py_DECREF(it);
            return NULL;
        }
        if (cmp == 1) {
            Py_DECREF(it);
            Py_RETURN_TRUE;
        }
    }
    Py_DECREF(it);
    if (PyErr_Occurred()) {
        if (PyErr_ExceptionMatches(PyExc_StopIteration))
            PyErr_Clear();
        else
            return NULL;
    }
    Py_RETURN_FALSE;
}

PyDoc_STRVAR(any_doc,
"any(iterable) -> bool\n\
\n\
Return True if bool(x) is True for any x in the iterable.\n\
If the iterable is empty, return False.");

static PyObject *
builtin_ascii(PyObject *self, PyObject *v)
{
    return PyObject_ASCII(v);
}

PyDoc_STRVAR(ascii_doc,
"ascii(object) -> string\n\
\n\
As repr(), return a string containing a printable representation of an\n\
object, but escape the non-ASCII characters in the string returned by\n\
repr() using \\x, \\u or \\U escapes.  This generates a string similar\n\
to that returned by repr() in Python 2.");


static PyObject *
builtin_bin(PyObject *self, PyObject *v)
{
    return PyNumber_ToBase(v, 2);
}

PyDoc_STRVAR(bin_doc,
"bin(number) -> string\n\
\n\
Return the binary representation of an integer.\n\
\n\
   >>> bin(2796202)\n\
   '0b1010101010101010101010'\n\
");


static PyObject *
builtin_callable(PyObject *self, PyObject *v)
{
    return PyBool_FromLong((long)PyCallable_Check(v));
}

PyDoc_STRVAR(callable_doc,
"callable(object) -> bool\n\
\n\
Return whether the object is callable (i.e., some kind of function).\n\
Note that classes are callable, as are instances of classes with a\n\
__call__() method.");


typedef struct {
    PyObject_HEAD
    PyObject *func;
    PyObject *it;
} filterobject;

static PyObject *
filter_new(PyTypeObject *type, PyObject *args, PyObject *kwds)
{
    PyObject *func, *seq;
    PyObject *it;
    filterobject *lz;

    if (type == &PyFilter_Type && !_PyArg_NoKeywords("filter()", kwds))
        return NULL;

    if (!PyArg_UnpackTuple(args, "filter", 2, 2, &func, &seq))
        return NULL;

    /* Get iterator. */
    it = PyObject_GetIter(seq);
    if (it == NULL)
        return NULL;

    /* create filterobject structure */
    lz = (filterobject *)type->tp_alloc(type, 0);
    if (lz == NULL) {
        Py_DECREF(it);
        return NULL;
    }
    Py_INCREF(func);
    lz->func = func;
    lz->it = it;

    return (PyObject *)lz;
}

static void
filter_dealloc(filterobject *lz)
{
    PyObject_GC_UnTrack(lz);
    Py_XDECREF(lz->func);
    Py_XDECREF(lz->it);
    Py_TYPE(lz)->tp_free(lz);
}

static int
filter_traverse(filterobject *lz, visitproc visit, void *arg)
{
    Py_VISIT(lz->it);
    Py_VISIT(lz->func);
    return 0;
}

static PyObject *
filter_next(filterobject *lz)
{
    PyObject *item;
    PyObject *it = lz->it;
    long ok;
    PyObject *(*iternext)(PyObject *);

    iternext = *Py_TYPE(it)->tp_iternext;
    for (;;) {
        item = iternext(it);
        if (item == NULL)
            return NULL;

        if (lz->func == Py_None || lz->func == (PyObject *)&PyBool_Type) {
            ok = PyObject_IsTrue(item);
        } else {
            PyObject *good;
            good = PyObject_CallFunctionObjArgs(lz->func,
                                                item, NULL);
            if (good == NULL) {
                Py_DECREF(item);
                return NULL;
            }
            ok = PyObject_IsTrue(good);
            Py_DECREF(good);
        }
        if (ok > 0)
            return item;
        Py_DECREF(item);
        if (ok < 0)
            return NULL;
    }
}

static PyObject *
filter_reduce(filterobject *lz)
{
    return Py_BuildValue("O(OO)", Py_TYPE(lz), lz->func, lz->it);
}

PyDoc_STRVAR(reduce_doc, "Return state information for pickling.");

static PyMethodDef filter_methods[] = {
    {"__reduce__",   (PyCFunction)filter_reduce,   METH_NOARGS, reduce_doc},
    {NULL,           NULL}           /* sentinel */
};

PyDoc_STRVAR(filter_doc,
"filter(function or None, iterable) --> filter object\n\
\n\
Return an iterator yielding those items of iterable for which function(item)\n\
is true. If function is None, return the items that are true.");

PyTypeObject PyFilter_Type = {
    PyVarObject_HEAD_INIT(&PyType_Type, 0)
    "filter",                           /* tp_name */
    sizeof(filterobject),               /* tp_basicsize */
    0,                                  /* tp_itemsize */
    /* methods */
    (destructor)filter_dealloc,         /* tp_dealloc */
    0,                                  /* tp_print */
    0,                                  /* tp_getattr */
    0,                                  /* tp_setattr */
    0,                                  /* tp_reserved */
    0,                                  /* tp_repr */
    0,                                  /* tp_as_number */
    0,                                  /* tp_as_sequence */
    0,                                  /* tp_as_mapping */
    0,                                  /* tp_hash */
    0,                                  /* tp_call */
    0,                                  /* tp_str */
    PyObject_GenericGetAttr,            /* tp_getattro */
    0,                                  /* tp_setattro */
    0,                                  /* tp_as_buffer */
    Py_TPFLAGS_DEFAULT | Py_TPFLAGS_HAVE_GC |
        Py_TPFLAGS_BASETYPE,            /* tp_flags */
    filter_doc,                         /* tp_doc */
    (traverseproc)filter_traverse,      /* tp_traverse */
    0,                                  /* tp_clear */
    0,                                  /* tp_richcompare */
    0,                                  /* tp_weaklistoffset */
    PyObject_SelfIter,                  /* tp_iter */
    (iternextfunc)filter_next,          /* tp_iternext */
    filter_methods,                     /* tp_methods */
    0,                                  /* tp_members */
    0,                                  /* tp_getset */
    0,                                  /* tp_base */
    0,                                  /* tp_dict */
    0,                                  /* tp_descr_get */
    0,                                  /* tp_descr_set */
    0,                                  /* tp_dictoffset */
    0,                                  /* tp_init */
    PyType_GenericAlloc,                /* tp_alloc */
    filter_new,                         /* tp_new */
    PyObject_GC_Del,                    /* tp_free */
};


static PyObject *
builtin_format(PyObject *self, PyObject *args)
{
    PyObject *value;
    PyObject *format_spec = NULL;

    if (!PyArg_ParseTuple(args, "O|U:format", &value, &format_spec))
        return NULL;

    return PyObject_Format(value, format_spec);
}

PyDoc_STRVAR(format_doc,
"format(value[, format_spec]) -> string\n\
\n\
Returns value.__format__(format_spec)\n\
format_spec defaults to \"\"");

static PyObject *
builtin_chr(PyObject *self, PyObject *args)
{
    int x;

    if (!PyArg_ParseTuple(args, "i:chr", &x))
        return NULL;

    return PyUnicode_FromOrdinal(x);
}

PyDoc_STRVAR(chr_doc,
"chr(i) -> Unicode character\n\
\n\
Return a Unicode string of one character with ordinal i; 0 <= i <= 0x10ffff.");


static char *
source_as_string(PyObject *cmd, char *funcname, char *what, PyCompilerFlags *cf)
{
    char *str;
    Py_ssize_t size;

    if (PyUnicode_Check(cmd)) {
        cf->cf_flags |= PyCF_IGNORE_COOKIE;
        str = PyUnicode_AsUTF8AndSize(cmd, &size);
        if (str == NULL)
            return NULL;
    }
    else if (!PyObject_CheckReadBuffer(cmd)) {
        PyErr_Format(PyExc_TypeError,
          "%s() arg 1 must be a %s object",
          funcname, what);
        return NULL;
    }
    else if (PyObject_AsReadBuffer(cmd, (const void **)&str, &size) < 0) {
        return NULL;
    }

    if (strlen(str) != size) {
        PyErr_SetString(PyExc_TypeError,
                        "source code string cannot contain null bytes");
        return NULL;
    }
    return str;
}

static PyObject *
builtin_compile(PyObject *self, PyObject *args, PyObject *kwds)
{
    char *str;
    PyObject *filename;
    char *startstr;
    int mode = -1;
    int dont_inherit = 0;
    int supplied_flags = 0;
    int optimize = -1;
    int is_ast;
    PyCompilerFlags cf;
    PyObject *cmd;
    static char *kwlist[] = {"source", "filename", "mode", "flags",
                             "dont_inherit", "optimize", NULL};
    int start[] = {Py_file_input, Py_eval_input, Py_single_input};
    PyObject *result;

    if (!PyArg_ParseTupleAndKeywords(args, kwds, "OO&s|iii:compile",  kwlist,
                                     &cmd,
                                     PyUnicode_FSDecoder, &filename,
                                     &startstr, &supplied_flags,
                                     &dont_inherit, &optimize))
        return NULL;

    cf.cf_flags = supplied_flags | PyCF_SOURCE_IS_UTF8;

    if (supplied_flags &
        ~(PyCF_MASK | PyCF_MASK_OBSOLETE | PyCF_DONT_IMPLY_DEDENT | PyCF_ONLY_AST))
    {
        PyErr_SetString(PyExc_ValueError,
                        "compile(): unrecognised flags");
        goto error;
    }
    /* XXX Warn if (supplied_flags & PyCF_MASK_OBSOLETE) != 0? */

    if (optimize < -1 || optimize > 2) {
        PyErr_SetString(PyExc_ValueError,
                        "compile(): invalid optimize value");
        goto error;
    }

    if (!dont_inherit) {
        PyEval_MergeCompilerFlags(&cf);
    }

    if (strcmp(startstr, "exec") == 0)
        mode = 0;
    else if (strcmp(startstr, "eval") == 0)
        mode = 1;
    else if (strcmp(startstr, "single") == 0)
        mode = 2;
    else {
        PyErr_SetString(PyExc_ValueError,
                        "compile() arg 3 must be 'exec', 'eval' or 'single'");
        goto error;
    }

    is_ast = PyAST_Check(cmd);
    if (is_ast == -1)
        goto error;
    if (is_ast) {
        if (supplied_flags & PyCF_ONLY_AST) {
            Py_INCREF(cmd);
            result = cmd;
        }
        else {
            PyArena *arena;
            mod_ty mod;

            arena = PyArena_New();
            if (arena == NULL)
                goto error;
            mod = PyAST_obj2mod(cmd, arena, mode);
            if (mod == NULL) {
                PyArena_Free(arena);
                goto error;
            }
            if (!PyAST_Validate(mod)) {
                PyArena_Free(arena);
                goto error;
            }
            result = (PyObject*)PyAST_CompileObject(mod, filename,
                                                    &cf, optimize, arena);
            PyArena_Free(arena);
        }
        goto finally;
    }

    str = source_as_string(cmd, "compile", "string, bytes or AST", &cf);
    if (str == NULL)
        goto error;

    result = Py_CompileStringObject(str, filename, start[mode], &cf, optimize);
    goto finally;

error:
    result = NULL;
finally:
    Py_DECREF(filename);
    return result;
}

PyDoc_STRVAR(compile_doc,
"compile(source, filename, mode[, flags[, dont_inherit]]) -> code object\n\
\n\
Compile the source (a Python module, statement or expression)\n\
into a code object that can be executed by exec() or eval().\n\
The filename will be used for run-time error messages.\n\
The mode must be 'exec' to compile a module, 'single' to compile a\n\
single (interactive) statement, or 'eval' to compile an expression.\n\
The flags argument, if present, controls which future statements influence\n\
the compilation of the code.\n\
The dont_inherit argument, if non-zero, stops the compilation inheriting\n\
the effects of any future statements in effect in the code calling\n\
compile; if absent or zero these statements do influence the compilation,\n\
in addition to any features explicitly specified.");

static PyObject *
builtin_dir(PyObject *self, PyObject *args)
{
    PyObject *arg = NULL;

    if (!PyArg_UnpackTuple(args, "dir", 0, 1, &arg))
        return NULL;
    return PyObject_Dir(arg);
}

PyDoc_STRVAR(dir_doc,
"dir([object]) -> list of strings\n"
"\n"
"If called without an argument, return the names in the current scope.\n"
"Else, return an alphabetized list of names comprising (some of) the attributes\n"
"of the given object, and of attributes reachable from it.\n"
"If the object supplies a method named __dir__, it will be used; otherwise\n"
"the default dir() logic is used and returns:\n"
"  for a module object: the module's attributes.\n"
"  for a class object:  its attributes, and recursively the attributes\n"
"    of its bases.\n"
"  for any other object: its attributes, its class's attributes, and\n"
"    recursively the attributes of its class's base classes.");

static PyObject *
builtin_divmod(PyObject *self, PyObject *args)
{
    PyObject *v, *w;

    if (!PyArg_UnpackTuple(args, "divmod", 2, 2, &v, &w))
        return NULL;
    return PyNumber_Divmod(v, w);
}

PyDoc_STRVAR(divmod_doc,
"divmod(x, y) -> (div, mod)\n\
\n\
Return the tuple ((x-x%y)/y, x%y).  Invariant: div*y + mod == x.");


static PyObject *
builtin_eval(PyObject *self, PyObject *args)
{
    PyObject *cmd, *result, *tmp = NULL;
    PyObject *globals = Py_None, *locals = Py_None;
    char *str;
    PyCompilerFlags cf;

    if (!PyArg_UnpackTuple(args, "eval", 1, 3, &cmd, &globals, &locals))
        return NULL;
    if (locals != Py_None && !PyMapping_Check(locals)) {
        PyErr_SetString(PyExc_TypeError, "locals must be a mapping");
        return NULL;
    }
    if (globals != Py_None && !PyDict_Check(globals)) {
        PyErr_SetString(PyExc_TypeError, PyMapping_Check(globals) ?
            "globals must be a real dict; try eval(expr, {}, mapping)"
            : "globals must be a dict");
        return NULL;
    }
    if (globals == Py_None) {
        globals = PyEval_GetGlobals();
        if (locals == Py_None) {
            locals = PyEval_GetLocals();
            if (locals == NULL)
                return NULL;
        }
    }
    else if (locals == Py_None)
        locals = globals;

    if (globals == NULL || locals == NULL) {
        PyErr_SetString(PyExc_TypeError,
            "eval must be given globals and locals "
            "when called without a frame");
        return NULL;
    }

    if (_PyDict_GetItemId(globals, &PyId___builtins__) == NULL) {
        if (_PyDict_SetItemId(globals, &PyId___builtins__,
                              PyEval_GetBuiltins()) != 0)
            return NULL;
    }

    if (PyCode_Check(cmd)) {
        if (PyCode_GetNumFree((PyCodeObject *)cmd) > 0) {
            PyErr_SetString(PyExc_TypeError,
        "code object passed to eval() may not contain free variables");
            return NULL;
        }
        return PyEval_EvalCode(cmd, globals, locals);
    }

    cf.cf_flags = PyCF_SOURCE_IS_UTF8;
    str = source_as_string(cmd, "eval", "string, bytes or code", &cf);
    if (str == NULL)
        return NULL;

    while (*str == ' ' || *str == '\t')
        str++;

    (void)PyEval_MergeCompilerFlags(&cf);
    result = PyRun_StringFlags(str, Py_eval_input, globals, locals, &cf);
    Py_XDECREF(tmp);
    return result;
}

PyDoc_STRVAR(eval_doc,
"eval(source[, globals[, locals]]) -> value\n\
\n\
Evaluate the source in the context of globals and locals.\n\
The source may be a string representing a Python expression\n\
or a code object as returned by compile().\n\
The globals must be a dictionary and locals can be any mapping,\n\
defaulting to the current globals and locals.\n\
If only globals is given, locals defaults to it.\n");

static PyObject *
builtin_exec(PyObject *self, PyObject *args)
{
    PyObject *v;
    PyObject *prog, *globals = Py_None, *locals = Py_None;

    if (!PyArg_UnpackTuple(args, "exec", 1, 3, &prog, &globals, &locals))
        return NULL;

    if (globals == Py_None) {
        globals = PyEval_GetGlobals();
        if (locals == Py_None) {
            locals = PyEval_GetLocals();
            if (locals == NULL)
                return NULL;
        }
        if (!globals || !locals) {
            PyErr_SetString(PyExc_SystemError,
                            "globals and locals cannot be NULL");
            return NULL;
        }
    }
    else if (locals == Py_None)
        locals = globals;

    if (!PyDict_Check(globals)) {
        PyErr_Format(PyExc_TypeError, "exec() arg 2 must be a dict, not %.100s",
                     globals->ob_type->tp_name);
        return NULL;
    }
    if (!PyMapping_Check(locals)) {
        PyErr_Format(PyExc_TypeError,
            "arg 3 must be a mapping or None, not %.100s",
            locals->ob_type->tp_name);
        return NULL;
    }
    if (_PyDict_GetItemId(globals, &PyId___builtins__) == NULL) {
        if (_PyDict_SetItemId(globals, &PyId___builtins__,
                              PyEval_GetBuiltins()) != 0)
            return NULL;
    }

    if (PyCode_Check(prog)) {
        if (PyCode_GetNumFree((PyCodeObject *)prog) > 0) {
            PyErr_SetString(PyExc_TypeError,
                "code object passed to exec() may not "
                "contain free variables");
            return NULL;
        }
        v = PyEval_EvalCode(prog, globals, locals);
    }
    else {
        char *str;
        PyCompilerFlags cf;
        cf.cf_flags = PyCF_SOURCE_IS_UTF8;
        str = source_as_string(prog, "exec",
                                     "string, bytes or code", &cf);
        if (str == NULL)
            return NULL;
        if (PyEval_MergeCompilerFlags(&cf))
            v = PyRun_StringFlags(str, Py_file_input, globals,
                                  locals, &cf);
        else
            v = PyRun_String(str, Py_file_input, globals, locals);
    }
    if (v == NULL)
        return NULL;
    Py_DECREF(v);
    Py_RETURN_NONE;
}

PyDoc_STRVAR(exec_doc,
"exec(object[, globals[, locals]])\n\
\n\
Read and execute code from an object, which can be a string or a code\n\
object.\n\
The globals and locals are dictionaries, defaulting to the current\n\
globals and locals.  If only globals is given, locals defaults to it.");


static PyObject *
builtin_getattr(PyObject *self, PyObject *args)
{
    PyObject *v, *result, *dflt = NULL;
    PyObject *name;

    if (!PyArg_UnpackTuple(args, "getattr", 2, 3, &v, &name, &dflt))
        return NULL;

    if (!PyUnicode_Check(name)) {
        PyErr_SetString(PyExc_TypeError,
                        "getattr(): attribute name must be string");
        return NULL;
    }
    result = PyObject_GetAttr(v, name);
    if (result == NULL && dflt != NULL &&
        PyErr_ExceptionMatches(PyExc_AttributeError))
    {
        PyErr_Clear();
        Py_INCREF(dflt);
        result = dflt;
    }
    return result;
}

PyDoc_STRVAR(getattr_doc,
"getattr(object, name[, default]) -> value\n\
\n\
Get a named attribute from an object; getattr(x, 'y') is equivalent to x.y.\n\
When a default argument is given, it is returned when the attribute doesn't\n\
exist; without it, an exception is raised in that case.");


static PyObject *
builtin_globals(PyObject *self)
{
    PyObject *d;

    d = PyEval_GetGlobals();
    Py_XINCREF(d);
    return d;
}

PyDoc_STRVAR(globals_doc,
"globals() -> dictionary\n\
\n\
Return the dictionary containing the current scope's global variables.");


static PyObject *
builtin_hasattr(PyObject *self, PyObject *args)
{
    PyObject *v;
    PyObject *name;

    if (!PyArg_UnpackTuple(args, "hasattr", 2, 2, &v, &name))
        return NULL;
    if (!PyUnicode_Check(name)) {
        PyErr_SetString(PyExc_TypeError,
                        "hasattr(): attribute name must be string");
        return NULL;
    }
    v = PyObject_GetAttr(v, name);
    if (v == NULL) {
        if (PyErr_ExceptionMatches(PyExc_AttributeError)) {
            PyErr_Clear();
            Py_RETURN_FALSE;
        }
        return NULL;
    }
    Py_DECREF(v);
    Py_RETURN_TRUE;
}

PyDoc_STRVAR(hasattr_doc,
"hasattr(object, name) -> bool\n\
\n\
Return whether the object has an attribute with the given name.\n\
(This is done by calling getattr(object, name) and catching AttributeError.)");


static PyObject *
builtin_id(PyObject *self, PyObject *v)
{
    return PyLong_FromVoidPtr(v);
}

PyDoc_STRVAR(id_doc,
"id(object) -> integer\n\
\n\
Return the identity of an object.  This is guaranteed to be unique among\n\
simultaneously existing objects.  (Hint: it's the object's memory address.)");


/* map object ************************************************************/

typedef struct {
    PyObject_HEAD
    PyObject *iters;
    PyObject *func;
} mapobject;

static PyObject *
map_new(PyTypeObject *type, PyObject *args, PyObject *kwds)
{
    PyObject *it, *iters, *func;
    mapobject *lz;
    Py_ssize_t numargs, i;

    if (type == &PyMap_Type && !_PyArg_NoKeywords("map()", kwds))
        return NULL;

    numargs = PyTuple_Size(args);
    if (numargs < 2) {
        PyErr_SetString(PyExc_TypeError,
           "map() must have at least two arguments.");
        return NULL;
    }

    iters = PyTuple_New(numargs-1);
    if (iters == NULL)
        return NULL;

    for (i=1 ; i<numargs ; i++) {
        /* Get iterator. */
        it = PyObject_GetIter(PyTuple_GET_ITEM(args, i));
        if (it == NULL) {
            Py_DECREF(iters);
            return NULL;
        }
        PyTuple_SET_ITEM(iters, i-1, it);
    }

    /* create mapobject structure */
    lz = (mapobject *)type->tp_alloc(type, 0);
    if (lz == NULL) {
        Py_DECREF(iters);
        return NULL;
    }
    lz->iters = iters;
    func = PyTuple_GET_ITEM(args, 0);
    Py_INCREF(func);
    lz->func = func;

    return (PyObject *)lz;
}

static void
map_dealloc(mapobject *lz)
{
    PyObject_GC_UnTrack(lz);
    Py_XDECREF(lz->iters);
    Py_XDECREF(lz->func);
    Py_TYPE(lz)->tp_free(lz);
}

static int
map_traverse(mapobject *lz, visitproc visit, void *arg)
{
    Py_VISIT(lz->iters);
    Py_VISIT(lz->func);
    return 0;
}

static PyObject *
map_next(mapobject *lz)
{
    PyObject *val;
    PyObject *argtuple;
    PyObject *result;
    Py_ssize_t numargs, i;

    numargs = PyTuple_Size(lz->iters);
    argtuple = PyTuple_New(numargs);
    if (argtuple == NULL)
        return NULL;

    for (i=0 ; i<numargs ; i++) {
        val = PyIter_Next(PyTuple_GET_ITEM(lz->iters, i));
        if (val == NULL) {
            Py_DECREF(argtuple);
            return NULL;
        }
        PyTuple_SET_ITEM(argtuple, i, val);
    }
    result = PyObject_Call(lz->func, argtuple, NULL);
    Py_DECREF(argtuple);
    return result;
}

static PyObject *
map_reduce(mapobject *lz)
{
    Py_ssize_t numargs = PyTuple_GET_SIZE(lz->iters);
    PyObject *args = PyTuple_New(numargs+1);
    Py_ssize_t i;
    if (args == NULL)
        return NULL;
    Py_INCREF(lz->func);
    PyTuple_SET_ITEM(args, 0, lz->func);
    for (i = 0; i<numargs; i++){
        PyObject *it = PyTuple_GET_ITEM(lz->iters, i);
        Py_INCREF(it);
        PyTuple_SET_ITEM(args, i+1, it);
    }

    return Py_BuildValue("ON", Py_TYPE(lz), args);
}

static PyMethodDef map_methods[] = {
    {"__reduce__",   (PyCFunction)map_reduce,   METH_NOARGS, reduce_doc},
    {NULL,           NULL}           /* sentinel */
};


PyDoc_STRVAR(map_doc,
"map(func, *iterables) --> map object\n\
\n\
Make an iterator that computes the function using arguments from\n\
each of the iterables.  Stops when the shortest iterable is exhausted.");

PyTypeObject PyMap_Type = {
    PyVarObject_HEAD_INIT(&PyType_Type, 0)
    "map",                              /* tp_name */
    sizeof(mapobject),                  /* tp_basicsize */
    0,                                  /* tp_itemsize */
    /* methods */
    (destructor)map_dealloc,            /* tp_dealloc */
    0,                                  /* tp_print */
    0,                                  /* tp_getattr */
    0,                                  /* tp_setattr */
    0,                                  /* tp_reserved */
    0,                                  /* tp_repr */
    0,                                  /* tp_as_number */
    0,                                  /* tp_as_sequence */
    0,                                  /* tp_as_mapping */
    0,                                  /* tp_hash */
    0,                                  /* tp_call */
    0,                                  /* tp_str */
    PyObject_GenericGetAttr,            /* tp_getattro */
    0,                                  /* tp_setattro */
    0,                                  /* tp_as_buffer */
    Py_TPFLAGS_DEFAULT | Py_TPFLAGS_HAVE_GC |
        Py_TPFLAGS_BASETYPE,            /* tp_flags */
    map_doc,                            /* tp_doc */
    (traverseproc)map_traverse,         /* tp_traverse */
    0,                                  /* tp_clear */
    0,                                  /* tp_richcompare */
    0,                                  /* tp_weaklistoffset */
    PyObject_SelfIter,                  /* tp_iter */
    (iternextfunc)map_next,     /* tp_iternext */
    map_methods,                        /* tp_methods */
    0,                                  /* tp_members */
    0,                                  /* tp_getset */
    0,                                  /* tp_base */
    0,                                  /* tp_dict */
    0,                                  /* tp_descr_get */
    0,                                  /* tp_descr_set */
    0,                                  /* tp_dictoffset */
    0,                                  /* tp_init */
    PyType_GenericAlloc,                /* tp_alloc */
    map_new,                            /* tp_new */
    PyObject_GC_Del,                    /* tp_free */
};

static PyObject *
builtin_next(PyObject *self, PyObject *args)
{
    PyObject *it, *res;
    PyObject *def = NULL;

    if (!PyArg_UnpackTuple(args, "next", 1, 2, &it, &def))
        return NULL;
    if (!PyIter_Check(it)) {
        PyErr_Format(PyExc_TypeError,
            "'%.200s' object is not an iterator",
            it->ob_type->tp_name);
        return NULL;
    }

    res = (*it->ob_type->tp_iternext)(it);
    if (res != NULL) {
        return res;
    } else if (def != NULL) {
        if (PyErr_Occurred()) {
            if(!PyErr_ExceptionMatches(PyExc_StopIteration))
                return NULL;
            PyErr_Clear();
        }
        Py_INCREF(def);
        return def;
    } else if (PyErr_Occurred()) {
        return NULL;
    } else {
        PyErr_SetNone(PyExc_StopIteration);
        return NULL;
    }
}

PyDoc_STRVAR(next_doc,
"next(iterator[, default])\n\
\n\
Return the next item from the iterator. If default is given and the iterator\n\
is exhausted, it is returned instead of raising StopIteration.");


static PyObject *
builtin_setattr(PyObject *self, PyObject *args)
{
    PyObject *v;
    PyObject *name;
    PyObject *value;

    if (!PyArg_UnpackTuple(args, "setattr", 3, 3, &v, &name, &value))
        return NULL;
    if (PyObject_SetAttr(v, name, value) != 0)
        return NULL;
    Py_INCREF(Py_None);
    return Py_None;
}

PyDoc_STRVAR(setattr_doc,
"setattr(object, name, value)\n\
\n\
Set a named attribute on an object; setattr(x, 'y', v) is equivalent to\n\
``x.y = v''.");


static PyObject *
builtin_delattr(PyObject *self, PyObject *args)
{
    PyObject *v;
    PyObject *name;

    if (!PyArg_UnpackTuple(args, "delattr", 2, 2, &v, &name))
        return NULL;
    if (PyObject_SetAttr(v, name, (PyObject *)NULL) != 0)
        return NULL;
    Py_INCREF(Py_None);
    return Py_None;
}

PyDoc_STRVAR(delattr_doc,
"delattr(object, name)\n\
\n\
Delete a named attribute on an object; delattr(x, 'y') is equivalent to\n\
``del x.y''.");


static PyObject *
builtin_hash(PyObject *self, PyObject *v)
{
    Py_hash_t x;

    x = PyObject_Hash(v);
    if (x == -1)
        return NULL;
    return PyLong_FromSsize_t(x);
}

PyDoc_STRVAR(hash_doc,
"hash(object) -> integer\n\
\n\
Return a hash value for the object.  Two objects with the same value have\n\
the same hash value.  The reverse is not necessarily true, but likely.");


static PyObject *
builtin_hex(PyObject *self, PyObject *v)
{
    return PyNumber_ToBase(v, 16);
}

PyDoc_STRVAR(hex_doc,
"hex(number) -> string\n\
\n\
Return the hexadecimal representation of an integer.\n\
\n\
   >>> hex(3735928559)\n\
   '0xdeadbeef'\n\
");


static PyObject *
builtin_iter(PyObject *self, PyObject *args)
{
    PyObject *v, *w = NULL;

    if (!PyArg_UnpackTuple(args, "iter", 1, 2, &v, &w))
        return NULL;
    if (w == NULL)
        return PyObject_GetIter(v);
    if (!PyCallable_Check(v)) {
        PyErr_SetString(PyExc_TypeError,
                        "iter(v, w): v must be callable");
        return NULL;
    }
    return PyCallIter_New(v, w);
}

PyDoc_STRVAR(iter_doc,
"iter(iterable) -> iterator\n\
iter(callable, sentinel) -> iterator\n\
\n\
Get an iterator from an object.  In the first form, the argument must\n\
supply its own iterator, or be a sequence.\n\
In the second form, the callable is called until it returns the sentinel.");


static PyObject *
builtin_len(PyObject *self, PyObject *v)
{
    Py_ssize_t res;

    res = PyObject_Size(v);
    if (res < 0 && PyErr_Occurred())
        return NULL;
    return PyLong_FromSsize_t(res);
}

PyDoc_STRVAR(len_doc,
"len(object)\n\
\n\
Return the number of items of a sequence or collection.");


static PyObject *
builtin_locals(PyObject *self)
{
    PyObject *d;

    d = PyEval_GetLocals();
    Py_XINCREF(d);
    return d;
}

PyDoc_STRVAR(locals_doc,
"locals() -> dictionary\n\
\n\
Update and return a dictionary containing the current scope's local variables.");


static PyObject *
min_max(PyObject *args, PyObject *kwds, int op)
{
    PyObject *v, *it, *item, *val, *maxitem, *maxval, *keyfunc=NULL;
    PyObject *emptytuple, *defaultval = NULL;
    static char *kwlist[] = {"key", "default", NULL};
    const char *name = op == Py_LT ? "min" : "max";
    const int positional = PyTuple_Size(args) > 1;
    int ret;

    if (positional)
        v = args;
    else if (!PyArg_UnpackTuple(args, name, 1, 1, &v))
        return NULL;

    emptytuple = PyTuple_New(0);
    if (emptytuple == NULL)
        return NULL;
    ret = PyArg_ParseTupleAndKeywords(emptytuple, kwds, "|$OO", kwlist,
                                      &keyfunc, &defaultval);
    Py_DECREF(emptytuple);
    if (!ret)
        return NULL;

    if (positional && defaultval != NULL) {
        PyErr_Format(PyExc_TypeError,
                        "Cannot specify a default for %s() with multiple "
                        "positional arguments", name);
        return NULL;
    }

    it = PyObject_GetIter(v);
    if (it == NULL) {
        return NULL;
    }

    maxitem = NULL; /* the result */
    maxval = NULL;  /* the value associated with the result */
    while (( item = PyIter_Next(it) )) {
        /* get the value from the key function */
        if (keyfunc != NULL) {
            val = PyObject_CallFunctionObjArgs(keyfunc, item, NULL);
            if (val == NULL)
                goto Fail_it_item;
        }
        /* no key function; the value is the item */
        else {
            val = item;
            Py_INCREF(val);
        }

        /* maximum value and item are unset; set them */
        if (maxval == NULL) {
            maxitem = item;
            maxval = val;
        }
        /* maximum value and item are set; update them as necessary */
        else {
            int cmp = PyObject_RichCompareBool(val, maxval, op);
            if (cmp < 0)
                goto Fail_it_item_and_val;
            else if (cmp > 0) {
                Py_DECREF(maxval);
                Py_DECREF(maxitem);
                maxval = val;
                maxitem = item;
            }
            else {
                Py_DECREF(item);
                Py_DECREF(val);
            }
        }
    }
    if (PyErr_Occurred())
        goto Fail_it;
    if (maxval == NULL) {
        assert(maxitem == NULL);
        if (defaultval != NULL) {
            Py_INCREF(defaultval);
            maxitem = defaultval;
        } else {
            PyErr_Format(PyExc_ValueError,
                         "%s() arg is an empty sequence", name);
        }
    }
    else
        Py_DECREF(maxval);
    Py_DECREF(it);
    return maxitem;

Fail_it_item_and_val:
    Py_DECREF(val);
Fail_it_item:
    Py_DECREF(item);
Fail_it:
    Py_XDECREF(maxval);
    Py_XDECREF(maxitem);
    Py_DECREF(it);
    return NULL;
}

static PyObject *
builtin_min(PyObject *self, PyObject *args, PyObject *kwds)
{
    return min_max(args, kwds, Py_LT);
}

PyDoc_STRVAR(min_doc,
"min(iterable, *[, default=obj, key=func]) -> value\n\
min(arg1, arg2, *args, *[, key=func]) -> value\n\
\n\
With a single iterable argument, return its smallest item. The\n\
default keyword-only argument specifies an object to return if\n\
the provided iterable is empty.\n\
With two or more arguments, return the smallest argument.");


static PyObject *
builtin_max(PyObject *self, PyObject *args, PyObject *kwds)
{
    return min_max(args, kwds, Py_GT);
}

PyDoc_STRVAR(max_doc,
"max(iterable, *[, default=obj, key=func]) -> value\n\
max(arg1, arg2, *args, *[, key=func]) -> value\n\
\n\
With a single iterable argument, return its biggest item. The\n\
default keyword-only argument specifies an object to return if\n\
the provided iterable is empty.\n\
With two or more arguments, return the largest argument.");


static PyObject *
builtin_oct(PyObject *self, PyObject *v)
{
    return PyNumber_ToBase(v, 8);
}

PyDoc_STRVAR(oct_doc,
"oct(number) -> string\n\
\n\
Return the octal representation of an integer.\n\
\n\
   >>> oct(342391)\n\
   '0o1234567'\n\
");


static PyObject *
builtin_ord(PyObject *self, PyObject* obj)
{
    long ord;
    Py_ssize_t size;

    if (PyBytes_Check(obj)) {
        size = PyBytes_GET_SIZE(obj);
        if (size == 1) {
            ord = (long)((unsigned char)*PyBytes_AS_STRING(obj));
            return PyLong_FromLong(ord);
        }
    }
    else if (PyUnicode_Check(obj)) {
        if (PyUnicode_READY(obj) == -1)
            return NULL;
        size = PyUnicode_GET_LENGTH(obj);
        if (size == 1) {
            ord = (long)PyUnicode_READ_CHAR(obj, 0);
            return PyLong_FromLong(ord);
        }
    }
    else if (PyByteArray_Check(obj)) {
        /* XXX Hopefully this is temporary */
        size = PyByteArray_GET_SIZE(obj);
        if (size == 1) {
            ord = (long)((unsigned char)*PyByteArray_AS_STRING(obj));
            return PyLong_FromLong(ord);
        }
    }
    else {
        PyErr_Format(PyExc_TypeError,
                     "ord() expected string of length 1, but " \
                     "%.200s found", obj->ob_type->tp_name);
        return NULL;
    }

    PyErr_Format(PyExc_TypeError,
                 "ord() expected a character, "
                 "but string of length %zd found",
                 size);
    return NULL;
}

PyDoc_VAR(ord_doc) = PyDoc_STR(
"ord(c) -> integer\n\
\n\
Return the integer ordinal of a one-character string."
);


static PyObject *
builtin_pow(PyObject *self, PyObject *args)
{
    PyObject *v, *w, *z = Py_None;

    if (!PyArg_UnpackTuple(args, "pow", 2, 3, &v, &w, &z))
        return NULL;
    return PyNumber_Power(v, w, z);
}

PyDoc_STRVAR(pow_doc,
"pow(x, y[, z]) -> number\n\
\n\
With two arguments, equivalent to x**y.  With three arguments,\n\
equivalent to (x**y) % z, but may be more efficient (e.g. for ints).");



static PyObject *
builtin_print(PyObject *self, PyObject *args, PyObject *kwds)
{
    static char *kwlist[] = {"sep", "end", "file", "flush", 0};
    static PyObject *dummy_args;
    PyObject *sep = NULL, *end = NULL, *file = NULL, *flush = NULL;
    int i, err;

    if (dummy_args == NULL && !(dummy_args = PyTuple_New(0)))
        return NULL;
    if (!PyArg_ParseTupleAndKeywords(dummy_args, kwds, "|OOOO:print",
                                     kwlist, &sep, &end, &file, &flush))
        return NULL;
    if (file == NULL || file == Py_None) {
        file = _PySys_GetObjectId(&PyId_stdout);
        if (file == NULL) {
            PyErr_SetString(PyExc_RuntimeError, "lost sys.stdout");
            return NULL;
        }

        /* sys.stdout may be None when FILE* stdout isn't connected */
        if (file == Py_None)
            Py_RETURN_NONE;
    }

    if (sep == Py_None) {
        sep = NULL;
    }
    else if (sep && !PyUnicode_Check(sep)) {
        PyErr_Format(PyExc_TypeError,
                     "sep must be None or a string, not %.200s",
                     sep->ob_type->tp_name);
        return NULL;
    }
    if (end == Py_None) {
        end = NULL;
    }
    else if (end && !PyUnicode_Check(end)) {
        PyErr_Format(PyExc_TypeError,
                     "end must be None or a string, not %.200s",
                     end->ob_type->tp_name);
        return NULL;
    }

    for (i = 0; i < PyTuple_Size(args); i++) {
        if (i > 0) {
            if (sep == NULL)
                err = PyFile_WriteString(" ", file);
            else
                err = PyFile_WriteObject(sep, file,
                                         Py_PRINT_RAW);
            if (err)
                return NULL;
        }
        err = PyFile_WriteObject(PyTuple_GetItem(args, i), file,
                                 Py_PRINT_RAW);
        if (err)
            return NULL;
    }

    if (end == NULL)
        err = PyFile_WriteString("\n", file);
    else
        err = PyFile_WriteObject(end, file, Py_PRINT_RAW);
    if (err)
        return NULL;

    if (flush != NULL) {
        PyObject *tmp;
        int do_flush = PyObject_IsTrue(flush);
        if (do_flush == -1)
            return NULL;
        else if (do_flush) {
            tmp = _PyObject_CallMethodId(file, &PyId_flush, "");
            if (tmp == NULL)
                return NULL;
            else
                Py_DECREF(tmp);
        }
    }

    Py_RETURN_NONE;
}

PyDoc_STRVAR(print_doc,
"print(value, ..., sep=' ', end='\\n', file=sys.stdout, flush=False)\n\
\n\
Prints the values to a stream, or to sys.stdout by default.\n\
Optional keyword arguments:\n\
file:  a file-like object (stream); defaults to the current sys.stdout.\n\
sep:   string inserted between values, default a space.\n\
end:   string appended after the last value, default a newline.\n\
flush: whether to forcibly flush the stream.");


static PyObject *
builtin_input(PyObject *self, PyObject *args)
{
    PyObject *promptarg = NULL;
    PyObject *fin = _PySys_GetObjectId(&PyId_stdin);
    PyObject *fout = _PySys_GetObjectId(&PyId_stdout);
    PyObject *ferr = _PySys_GetObjectId(&PyId_stderr);
    PyObject *tmp;
    long fd;
    int tty;

    /* Parse arguments */
    if (!PyArg_UnpackTuple(args, "input", 0, 1, &promptarg))
        return NULL;

    /* Check that stdin/out/err are intact */
    if (fin == NULL || fin == Py_None) {
        PyErr_SetString(PyExc_RuntimeError,
                        "input(): lost sys.stdin");
        return NULL;
    }
    if (fout == NULL || fout == Py_None) {
        PyErr_SetString(PyExc_RuntimeError,
                        "input(): lost sys.stdout");
        return NULL;
    }
    if (ferr == NULL || ferr == Py_None) {
        PyErr_SetString(PyExc_RuntimeError,
                        "input(): lost sys.stderr");
        return NULL;
    }

    /* First of all, flush stderr */
    tmp = _PyObject_CallMethodId(ferr, &PyId_flush, "");
    if (tmp == NULL)
        PyErr_Clear();
    else
        Py_DECREF(tmp);

    /* We should only use (GNU) readline if Python's sys.stdin and
       sys.stdout are the same as C's stdin and stdout, because we
       need to pass it those. */
    tmp = _PyObject_CallMethodId(fin, &PyId_fileno, "");
    if (tmp == NULL) {
        PyErr_Clear();
        tty = 0;
    }
    else {
        fd = PyLong_AsLong(tmp);
        Py_DECREF(tmp);
        if (fd < 0 && PyErr_Occurred())
            return NULL;
        tty = fd == fileno(stdin) && isatty(fd);
    }
    if (tty) {
        tmp = _PyObject_CallMethodId(fout, &PyId_fileno, "");
        if (tmp == NULL)
            PyErr_Clear();
        else {
            fd = PyLong_AsLong(tmp);
            Py_DECREF(tmp);
            if (fd < 0 && PyErr_Occurred())
                return NULL;
            tty = fd == fileno(stdout) && isatty(fd);
        }
    }

    /* If we're interactive, use (GNU) readline */
    if (tty) {
        PyObject *po = NULL;
        char *prompt;
        char *s = NULL;
        PyObject *stdin_encoding = NULL, *stdin_errors = NULL;
        PyObject *stdout_encoding = NULL, *stdout_errors = NULL;
        char *stdin_encoding_str, *stdin_errors_str;
        PyObject *result;
        size_t len;

        stdin_encoding = _PyObject_GetAttrId(fin, &PyId_encoding);
        stdin_errors = _PyObject_GetAttrId(fin, &PyId_errors);
        if (!stdin_encoding || !stdin_errors)
            /* stdin is a text stream, so it must have an
               encoding. */
            goto _readline_errors;
        stdin_encoding_str = _PyUnicode_AsString(stdin_encoding);
        stdin_errors_str = _PyUnicode_AsString(stdin_errors);
        if (!stdin_encoding_str || !stdin_errors_str)
            goto _readline_errors;
        tmp = _PyObject_CallMethodId(fout, &PyId_flush, "");
        if (tmp == NULL)
            PyErr_Clear();
        else
            Py_DECREF(tmp);
        if (promptarg != NULL) {
            /* We have a prompt, encode it as stdout would */
            char *stdout_encoding_str, *stdout_errors_str;
            PyObject *stringpo;
            stdout_encoding = _PyObject_GetAttrId(fout, &PyId_encoding);
            stdout_errors = _PyObject_GetAttrId(fout, &PyId_errors);
            if (!stdout_encoding || !stdout_errors)
                goto _readline_errors;
            stdout_encoding_str = _PyUnicode_AsString(stdout_encoding);
            stdout_errors_str = _PyUnicode_AsString(stdout_errors);
            if (!stdout_encoding_str || !stdout_errors_str)
                goto _readline_errors;
            stringpo = PyObject_Str(promptarg);
            if (stringpo == NULL)
                goto _readline_errors;
            po = PyUnicode_AsEncodedString(stringpo,
                stdout_encoding_str, stdout_errors_str);
            Py_CLEAR(stdout_encoding);
            Py_CLEAR(stdout_errors);
            Py_CLEAR(stringpo);
            if (po == NULL)
                goto _readline_errors;
            prompt = PyBytes_AsString(po);
            if (prompt == NULL)
                goto _readline_errors;
        }
        else {
            po = NULL;
            prompt = "";
        }
        s = PyOS_Readline(stdin, stdout, prompt);
        if (s == NULL) {
            PyErr_CheckSignals();
            if (!PyErr_Occurred())
                PyErr_SetNone(PyExc_KeyboardInterrupt);
            goto _readline_errors;
        }

        len = strlen(s);
        if (len == 0) {
            PyErr_SetNone(PyExc_EOFError);
            result = NULL;
        }
        else {
            if (len > PY_SSIZE_T_MAX) {
                PyErr_SetString(PyExc_OverflowError,
                                "input: input too long");
                result = NULL;
            }
            else {
                len--;   /* strip trailing '\n' */
                if (len != 0 && s[len-1] == '\r')
                    len--;   /* strip trailing '\r' */
                result = PyUnicode_Decode(s, len, stdin_encoding_str,
                                                  stdin_errors_str);
            }
        }
        Py_DECREF(stdin_encoding);
        Py_DECREF(stdin_errors);
        Py_XDECREF(po);
        PyMem_FREE(s);
        return result;
    _readline_errors:
        Py_XDECREF(stdin_encoding);
        Py_XDECREF(stdout_encoding);
        Py_XDECREF(stdin_errors);
        Py_XDECREF(stdout_errors);
        Py_XDECREF(po);
        return NULL;
    }

    /* Fallback if we're not interactive */
    if (promptarg != NULL) {
        if (PyFile_WriteObject(promptarg, fout, Py_PRINT_RAW) != 0)
            return NULL;
    }
    tmp = _PyObject_CallMethodId(fout, &PyId_flush, "");
    if (tmp == NULL)
        PyErr_Clear();
    else
        Py_DECREF(tmp);
    return PyFile_GetLine(fin, -1);
}

PyDoc_STRVAR(input_doc,
"input([prompt]) -> string\n\
\n\
Read a string from standard input.  The trailing newline is stripped.\n\
If the user hits EOF (Unix: Ctl-D, Windows: Ctl-Z+Return), raise EOFError.\n\
On Unix, GNU readline is used if enabled.  The prompt string, if given,\n\
is printed without a trailing newline before reading.");


static PyObject *
builtin_repr(PyObject *self, PyObject *v)
{
    return PyObject_Repr(v);
}

PyDoc_STRVAR(repr_doc,
"repr(object) -> string\n\
\n\
Return the canonical string representation of the object.\n\
For most object types, eval(repr(object)) == object.");


static PyObject *
builtin_round(PyObject *self, PyObject *args, PyObject *kwds)
{
    PyObject *ndigits = NULL;
    static char *kwlist[] = {"number", "ndigits", 0};
    PyObject *number, *round, *result;

    if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|O:round",
                                     kwlist, &number, &ndigits))
        return NULL;

    if (Py_TYPE(number)->tp_dict == NULL) {
        if (PyType_Ready(Py_TYPE(number)) < 0)
            return NULL;
    }

    round = _PyObject_LookupSpecial(number, &PyId___round__);
    if (round == NULL) {
        if (!PyErr_Occurred())
            PyErr_Format(PyExc_TypeError,
                         "type %.100s doesn't define __round__ method",
                         Py_TYPE(number)->tp_name);
        return NULL;
    }

    if (ndigits == NULL)
        result = PyObject_CallFunctionObjArgs(round, NULL);
    else
        result = PyObject_CallFunctionObjArgs(round, ndigits, NULL);
    Py_DECREF(round);
    return result;
}

PyDoc_STRVAR(round_doc,
"round(number[, ndigits]) -> number\n\
\n\
Round a number to a given precision in decimal digits (default 0 digits).\n\
This returns an int when called with one argument, otherwise the\n\
same type as the number. ndigits may be negative.");


static PyObject *
builtin_sorted(PyObject *self, PyObject *args, PyObject *kwds)
{
    PyObject *newlist, *v, *seq, *keyfunc=NULL, *newargs;
    PyObject *callable;
    static char *kwlist[] = {"iterable", "key", "reverse", 0};
    int reverse;

    /* args 1-3 should match listsort in Objects/listobject.c */
    if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|Oi:sorted",
        kwlist, &seq, &keyfunc, &reverse))
        return NULL;

    newlist = PySequence_List(seq);
    if (newlist == NULL)
        return NULL;

    callable = _PyObject_GetAttrId(newlist, &PyId_sort);
    if (callable == NULL) {
        Py_DECREF(newlist);
        return NULL;
    }

    newargs = PyTuple_GetSlice(args, 1, 4);
    if (newargs == NULL) {
        Py_DECREF(newlist);
        Py_DECREF(callable);
        return NULL;
    }

    v = PyObject_Call(callable, newargs, kwds);
    Py_DECREF(newargs);
    Py_DECREF(callable);
    if (v == NULL) {
        Py_DECREF(newlist);
        return NULL;
    }
    Py_DECREF(v);
    return newlist;
}

PyDoc_STRVAR(sorted_doc,
"sorted(iterable, key=None, reverse=False) --> new sorted list");

static PyObject *
builtin_vars(PyObject *self, PyObject *args)
{
    PyObject *v = NULL;
    PyObject *d;

    if (!PyArg_UnpackTuple(args, "vars", 0, 1, &v))
        return NULL;
    if (v == NULL) {
        d = PyEval_GetLocals();
        if (d == NULL)
            return NULL;
        Py_INCREF(d);
    }
    else {
        d = _PyObject_GetAttrId(v, &PyId___dict__);
        if (d == NULL) {
            PyErr_SetString(PyExc_TypeError,
                "vars() argument must have __dict__ attribute");
            return NULL;
        }
    }
    return d;
}

PyDoc_STRVAR(vars_doc,
"vars([object]) -> dictionary\n\
\n\
Without arguments, equivalent to locals().\n\
With an argument, equivalent to object.__dict__.");

static PyObject*
builtin_sum(PyObject *self, PyObject *args)
{
    PyObject *seq;
    PyObject *result = NULL;
    PyObject *temp, *item, *iter;

    if (!PyArg_UnpackTuple(args, "sum", 1, 2, &seq, &result))
        return NULL;

    iter = PyObject_GetIter(seq);
    if (iter == NULL)
        return NULL;

    if (result == NULL) {
        result = PyLong_FromLong(0);
        if (result == NULL) {
            Py_DECREF(iter);
            return NULL;
        }
    } else {
        /* reject string values for 'start' parameter */
        if (PyUnicode_Check(result)) {
            PyErr_SetString(PyExc_TypeError,
                "sum() can't sum strings [use ''.join(seq) instead]");
            Py_DECREF(iter);
            return NULL;
        }
        if (PyBytes_Check(result)) {
            PyErr_SetString(PyExc_TypeError,
                "sum() can't sum bytes [use b''.join(seq) instead]");
            Py_DECREF(iter);
            return NULL;
        }
        if (PyByteArray_Check(result)) {
            PyErr_SetString(PyExc_TypeError,
                "sum() can't sum bytearray [use b''.join(seq) instead]");
            Py_DECREF(iter);
            return NULL;
        }

        Py_INCREF(result);
    }

#ifndef SLOW_SUM
    /* Fast addition by keeping temporary sums in C instead of new Python objects.
       Assumes all inputs are the same type.  If the assumption fails, default
       to the more general routine.
    */
    if (PyLong_CheckExact(result)) {
        int overflow;
        long i_result = PyLong_AsLongAndOverflow(result, &overflow);
        /* If this already overflowed, don't even enter the loop. */
        if (overflow == 0) {
            Py_DECREF(result);
            result = NULL;
        }
        while(result == NULL) {
            item = PyIter_Next(iter);
            if (item == NULL) {
                Py_DECREF(iter);
                if (PyErr_Occurred())
                    return NULL;
                return PyLong_FromLong(i_result);
            }
            if (PyLong_CheckExact(item)) {
                long b = PyLong_AsLongAndOverflow(item, &overflow);
                long x = i_result + b;
                if (overflow == 0 && ((x^i_result) >= 0 || (x^b) >= 0)) {
                    i_result = x;
                    Py_DECREF(item);
                    continue;
                }
            }
            /* Either overflowed or is not an int. Restore real objects and process normally */
            result = PyLong_FromLong(i_result);
            if (result == NULL) {
                Py_DECREF(item);
                Py_DECREF(iter);
                return NULL;
            }
            temp = PyNumber_Add(result, item);
            Py_DECREF(result);
            Py_DECREF(item);
            result = temp;
            if (result == NULL) {
                Py_DECREF(iter);
                return NULL;
            }
        }
    }

    if (PyFloat_CheckExact(result)) {
        double f_result = PyFloat_AS_DOUBLE(result);
        Py_DECREF(result);
        result = NULL;
        while(result == NULL) {
            item = PyIter_Next(iter);
            if (item == NULL) {
                Py_DECREF(iter);
                if (PyErr_Occurred())
                    return NULL;
                return PyFloat_FromDouble(f_result);
            }
            if (PyFloat_CheckExact(item)) {
                PyFPE_START_PROTECT("add", Py_DECREF(item); Py_DECREF(iter); return 0)
                f_result += PyFloat_AS_DOUBLE(item);
                PyFPE_END_PROTECT(f_result)
                Py_DECREF(item);
                continue;
            }
            if (PyLong_CheckExact(item)) {
                long value;
                int overflow;
                value = PyLong_AsLongAndOverflow(item, &overflow);
                if (!overflow) {
                    PyFPE_START_PROTECT("add", Py_DECREF(item); Py_DECREF(iter); return 0)
                    f_result += (double)value;
                    PyFPE_END_PROTECT(f_result)
                    Py_DECREF(item);
                    continue;
                }
            }
            result = PyFloat_FromDouble(f_result);
            temp = PyNumber_Add(result, item);
            Py_DECREF(result);
            Py_DECREF(item);
            result = temp;
            if (result == NULL) {
                Py_DECREF(iter);
                return NULL;
            }
        }
    }
#endif

    for(;;) {
        item = PyIter_Next(iter);
        if (item == NULL) {
            /* error, or end-of-sequence */
            if (PyErr_Occurred()) {
                Py_DECREF(result);
                result = NULL;
            }
            break;
        }
        /* It's tempting to use PyNumber_InPlaceAdd instead of
           PyNumber_Add here, to avoid quadratic running time
           when doing 'sum(list_of_lists, [])'.  However, this
           would produce a change in behaviour: a snippet like

             empty = []
             sum([[x] for x in range(10)], empty)

           would change the value of empty. */
        temp = PyNumber_Add(result, item);
        Py_DECREF(result);
        Py_DECREF(item);
        result = temp;
        if (result == NULL)
            break;
    }
    Py_DECREF(iter);
    return result;
}

PyDoc_STRVAR(sum_doc,
"sum(iterable[, start]) -> value\n\
\n\
Return the sum of an iterable of numbers (NOT strings) plus the value\n\
of parameter 'start' (which defaults to 0).  When the iterable is\n\
empty, return start.");


static PyObject *
builtin_isinstance(PyObject *self, PyObject *args)
{
    PyObject *inst;
    PyObject *cls;
    int retval;

    if (!PyArg_UnpackTuple(args, "isinstance", 2, 2, &inst, &cls))
        return NULL;

    retval = PyObject_IsInstance(inst, cls);
    if (retval < 0)
        return NULL;
    return PyBool_FromLong(retval);
}

PyDoc_STRVAR(isinstance_doc,
"isinstance(object, class-or-type-or-tuple) -> bool\n\
\n\
Return whether an object is an instance of a class or of a subclass thereof.\n\
With a type as second argument, return whether that is the object's type.\n\
The form using a tuple, isinstance(x, (A, B, ...)), is a shortcut for\n\
isinstance(x, A) or isinstance(x, B) or ... (etc.).");


static PyObject *
builtin_issubclass(PyObject *self, PyObject *args)
{
    PyObject *derived;
    PyObject *cls;
    int retval;

    if (!PyArg_UnpackTuple(args, "issubclass", 2, 2, &derived, &cls))
        return NULL;

    retval = PyObject_IsSubclass(derived, cls);
    if (retval < 0)
        return NULL;
    return PyBool_FromLong(retval);
}

PyDoc_STRVAR(issubclass_doc,
"issubclass(C, B) -> bool\n\
\n\
Return whether class C is a subclass (i.e., a derived class) of class B.\n\
When using a tuple as the second argument issubclass(X, (A, B, ...)),\n\
is a shortcut for issubclass(X, A) or issubclass(X, B) or ... (etc.).");


typedef struct {
    PyObject_HEAD
    Py_ssize_t          tuplesize;
    PyObject *ittuple;                  /* tuple of iterators */
    PyObject *result;
} zipobject;

static PyObject *
zip_new(PyTypeObject *type, PyObject *args, PyObject *kwds)
{
    zipobject *lz;
    Py_ssize_t i;
    PyObject *ittuple;  /* tuple of iterators */
    PyObject *result;
    Py_ssize_t tuplesize = PySequence_Length(args);

    if (type == &PyZip_Type && !_PyArg_NoKeywords("zip()", kwds))
        return NULL;

    /* args must be a tuple */
    assert(PyTuple_Check(args));

    /* obtain iterators */
    ittuple = PyTuple_New(tuplesize);
    if (ittuple == NULL)
        return NULL;
    for (i=0; i < tuplesize; ++i) {
        PyObject *item = PyTuple_GET_ITEM(args, i);
        PyObject *it = PyObject_GetIter(item);
        if (it == NULL) {
            if (PyErr_ExceptionMatches(PyExc_TypeError))
                PyErr_Format(PyExc_TypeError,
                    "zip argument #%zd must support iteration",
                    i+1);
            Py_DECREF(ittuple);
            return NULL;
        }
        PyTuple_SET_ITEM(ittuple, i, it);
    }

    /* create a result holder */
    result = PyTuple_New(tuplesize);
    if (result == NULL) {
        Py_DECREF(ittuple);
        return NULL;
    }
    for (i=0 ; i < tuplesize ; i++) {
        Py_INCREF(Py_None);
        PyTuple_SET_ITEM(result, i, Py_None);
    }

    /* create zipobject structure */
    lz = (zipobject *)type->tp_alloc(type, 0);
    if (lz == NULL) {
        Py_DECREF(ittuple);
        Py_DECREF(result);
        return NULL;
    }
    lz->ittuple = ittuple;
    lz->tuplesize = tuplesize;
    lz->result = result;

    return (PyObject *)lz;
}

static void
zip_dealloc(zipobject *lz)
{
    PyObject_GC_UnTrack(lz);
    Py_XDECREF(lz->ittuple);
    Py_XDECREF(lz->result);
    Py_TYPE(lz)->tp_free(lz);
}

static int
zip_traverse(zipobject *lz, visitproc visit, void *arg)
{
    Py_VISIT(lz->ittuple);
    Py_VISIT(lz->result);
    return 0;
}

static PyObject *
zip_next(zipobject *lz)
{
    Py_ssize_t i;
    Py_ssize_t tuplesize = lz->tuplesize;
    PyObject *result = lz->result;
    PyObject *it;
    PyObject *item;
    PyObject *olditem;

    if (tuplesize == 0)
        return NULL;
    if (Py_REFCNT(result) == 1) {
        Py_INCREF(result);
        for (i=0 ; i < tuplesize ; i++) {
            it = PyTuple_GET_ITEM(lz->ittuple, i);
            item = (*Py_TYPE(it)->tp_iternext)(it);
            if (item == NULL) {
                Py_DECREF(result);
                return NULL;
            }
            olditem = PyTuple_GET_ITEM(result, i);
            PyTuple_SET_ITEM(result, i, item);
            Py_DECREF(olditem);
        }
    } else {
        result = PyTuple_New(tuplesize);
        if (result == NULL)
            return NULL;
        for (i=0 ; i < tuplesize ; i++) {
            it = PyTuple_GET_ITEM(lz->ittuple, i);
            item = (*Py_TYPE(it)->tp_iternext)(it);
            if (item == NULL) {
                Py_DECREF(result);
                return NULL;
            }
            PyTuple_SET_ITEM(result, i, item);
        }
    }
    return result;
}

static PyObject *
zip_reduce(zipobject *lz)
{
    /* Just recreate the zip with the internal iterator tuple */
    return Py_BuildValue("OO", Py_TYPE(lz), lz->ittuple);
}

static PyMethodDef zip_methods[] = {
    {"__reduce__",   (PyCFunction)zip_reduce,   METH_NOARGS, reduce_doc},
    {NULL,           NULL}           /* sentinel */
};

PyDoc_STRVAR(zip_doc,
"zip(iter1 [,iter2 [...]]) --> zip object\n\
\n\
Return a zip object whose .__next__() method returns a tuple where\n\
the i-th element comes from the i-th iterable argument.  The .__next__()\n\
method continues until the shortest iterable in the argument sequence\n\
is exhausted and then it raises StopIteration.");

PyTypeObject PyZip_Type = {
    PyVarObject_HEAD_INIT(&PyType_Type, 0)
    "zip",                              /* tp_name */
    sizeof(zipobject),                  /* tp_basicsize */
    0,                                  /* tp_itemsize */
    /* methods */
    (destructor)zip_dealloc,            /* tp_dealloc */
    0,                                  /* tp_print */
    0,                                  /* tp_getattr */
    0,                                  /* tp_setattr */
    0,                                  /* tp_reserved */
    0,                                  /* tp_repr */
    0,                                  /* tp_as_number */
    0,                                  /* tp_as_sequence */
    0,                                  /* tp_as_mapping */
    0,                                  /* tp_hash */
    0,                                  /* tp_call */
    0,                                  /* tp_str */
    PyObject_GenericGetAttr,            /* tp_getattro */
    0,                                  /* tp_setattro */
    0,                                  /* tp_as_buffer */
    Py_TPFLAGS_DEFAULT | Py_TPFLAGS_HAVE_GC |
        Py_TPFLAGS_BASETYPE,            /* tp_flags */
    zip_doc,                            /* tp_doc */
    (traverseproc)zip_traverse,    /* tp_traverse */
    0,                                  /* tp_clear */
    0,                                  /* tp_richcompare */
    0,                                  /* tp_weaklistoffset */
    PyObject_SelfIter,                  /* tp_iter */
    (iternextfunc)zip_next,     /* tp_iternext */
    zip_methods,                        /* tp_methods */
    0,                                  /* tp_members */
    0,                                  /* tp_getset */
    0,                                  /* tp_base */
    0,                                  /* tp_dict */
    0,                                  /* tp_descr_get */
    0,                                  /* tp_descr_set */
    0,                                  /* tp_dictoffset */
    0,                                  /* tp_init */
    PyType_GenericAlloc,                /* tp_alloc */
    zip_new,                            /* tp_new */
    PyObject_GC_Del,                    /* tp_free */
};


static PyMethodDef builtin_methods[] = {
    {"__build_class__", (PyCFunction)builtin___build_class__,
     METH_VARARGS | METH_KEYWORDS, build_class_doc},
    {"__import__",      (PyCFunction)builtin___import__, METH_VARARGS | METH_KEYWORDS, import_doc},
    {"abs",             builtin_abs,        METH_O, abs_doc},
    {"all",             builtin_all,        METH_O, all_doc},
    {"any",             builtin_any,        METH_O, any_doc},
    {"ascii",           builtin_ascii,      METH_O, ascii_doc},
    {"bin",             builtin_bin,        METH_O, bin_doc},
    {"callable",        builtin_callable,   METH_O, callable_doc},
    {"chr",             builtin_chr,        METH_VARARGS, chr_doc},
    {"compile",         (PyCFunction)builtin_compile,    METH_VARARGS | METH_KEYWORDS, compile_doc},
    {"delattr",         builtin_delattr,    METH_VARARGS, delattr_doc},
    {"dir",             builtin_dir,        METH_VARARGS, dir_doc},
    {"divmod",          builtin_divmod,     METH_VARARGS, divmod_doc},
    {"eval",            builtin_eval,       METH_VARARGS, eval_doc},
    {"exec",        builtin_exec,       METH_VARARGS, exec_doc},
    {"format",          builtin_format,     METH_VARARGS, format_doc},
    {"getattr",         builtin_getattr,    METH_VARARGS, getattr_doc},
    {"globals",         (PyCFunction)builtin_globals,    METH_NOARGS, globals_doc},
    {"hasattr",         builtin_hasattr,    METH_VARARGS, hasattr_doc},
    {"hash",            builtin_hash,       METH_O, hash_doc},
    {"hex",             builtin_hex,        METH_O, hex_doc},
    {"id",              builtin_id,         METH_O, id_doc},
    {"input",           builtin_input,      METH_VARARGS, input_doc},
    {"isinstance",  builtin_isinstance, METH_VARARGS, isinstance_doc},
    {"issubclass",  builtin_issubclass, METH_VARARGS, issubclass_doc},
    {"iter",            builtin_iter,       METH_VARARGS, iter_doc},
    {"len",             builtin_len,        METH_O, len_doc},
    {"locals",          (PyCFunction)builtin_locals,     METH_NOARGS, locals_doc},
    {"max",             (PyCFunction)builtin_max,        METH_VARARGS | METH_KEYWORDS, max_doc},
    {"min",             (PyCFunction)builtin_min,        METH_VARARGS | METH_KEYWORDS, min_doc},
    {"next",            (PyCFunction)builtin_next,       METH_VARARGS, next_doc},
    {"oct",             builtin_oct,        METH_O, oct_doc},
    {"ord",             builtin_ord,        METH_O, ord_doc},
    {"pow",             builtin_pow,        METH_VARARGS, pow_doc},
    {"print",           (PyCFunction)builtin_print,      METH_VARARGS | METH_KEYWORDS, print_doc},
    {"repr",            builtin_repr,       METH_O, repr_doc},
    {"round",           (PyCFunction)builtin_round,      METH_VARARGS | METH_KEYWORDS, round_doc},
    {"setattr",         builtin_setattr,    METH_VARARGS, setattr_doc},
    {"sorted",          (PyCFunction)builtin_sorted,     METH_VARARGS | METH_KEYWORDS, sorted_doc},
    {"sum",             builtin_sum,        METH_VARARGS, sum_doc},
    {"vars",            builtin_vars,       METH_VARARGS, vars_doc},
    {NULL,              NULL},
};

PyDoc_STRVAR(builtin_doc,
"Built-in functions, exceptions, and other objects.\n\
\n\
Noteworthy: None is the `nil' object; Ellipsis represents `...' in slices.");

static struct PyModuleDef builtinsmodule = {
    PyModuleDef_HEAD_INIT,
    "builtins",
    builtin_doc,
    -1, /* multiple "initialization" just copies the module dict. */
    builtin_methods,
    NULL,
    NULL,
    NULL,
    NULL
};


PyObject *
_PyBuiltin_Init(void)
{
    PyObject *mod, *dict, *debug;

    if (PyType_Ready(&PyFilter_Type) < 0 ||
        PyType_Ready(&PyMap_Type) < 0 ||
        PyType_Ready(&PyZip_Type) < 0)
        return NULL;

    mod = PyModule_Create(&builtinsmodule);
    if (mod == NULL)
        return NULL;
    dict = PyModule_GetDict(mod);

#ifdef Py_TRACE_REFS
    /* "builtins" exposes a number of statically allocated objects
     * that, before this code was added in 2.3, never showed up in
     * the list of "all objects" maintained by Py_TRACE_REFS.  As a
     * result, programs leaking references to None and False (etc)
     * couldn't be diagnosed by examining sys.getobjects(0).
     */
#define ADD_TO_ALL(OBJECT) _Py_AddToAllObjects((PyObject *)(OBJECT), 0)
#else
#define ADD_TO_ALL(OBJECT) (void)0
#endif

#define SETBUILTIN(NAME, OBJECT) \
    if (PyDict_SetItemString(dict, NAME, (PyObject *)OBJECT) < 0)       \
        return NULL;                                                    \
    ADD_TO_ALL(OBJECT)

    SETBUILTIN("None",                  Py_None);
    SETBUILTIN("Ellipsis",              Py_Ellipsis);
    SETBUILTIN("NotImplemented",        Py_NotImplemented);
    SETBUILTIN("False",                 Py_False);
    SETBUILTIN("True",                  Py_True);
    SETBUILTIN("bool",                  &PyBool_Type);
    SETBUILTIN("memoryview",        &PyMemoryView_Type);
    SETBUILTIN("bytearray",             &PyByteArray_Type);
    SETBUILTIN("bytes",                 &PyBytes_Type);
    SETBUILTIN("classmethod",           &PyClassMethod_Type);
    SETBUILTIN("complex",               &PyComplex_Type);
    SETBUILTIN("dict",                  &PyDict_Type);
    SETBUILTIN("enumerate",             &PyEnum_Type);
    SETBUILTIN("filter",                &PyFilter_Type);
    SETBUILTIN("float",                 &PyFloat_Type);
    SETBUILTIN("frozenset",             &PyFrozenSet_Type);
    SETBUILTIN("property",              &PyProperty_Type);
    SETBUILTIN("int",                   &PyLong_Type);
    SETBUILTIN("list",                  &PyList_Type);
    SETBUILTIN("map",                   &PyMap_Type);
    SETBUILTIN("object",                &PyBaseObject_Type);
    SETBUILTIN("range",                 &PyRange_Type);
    SETBUILTIN("reversed",              &PyReversed_Type);
    SETBUILTIN("set",                   &PySet_Type);
    SETBUILTIN("slice",                 &PySlice_Type);
    SETBUILTIN("staticmethod",          &PyStaticMethod_Type);
    SETBUILTIN("str",                   &PyUnicode_Type);
    SETBUILTIN("super",                 &PySuper_Type);
    SETBUILTIN("tuple",                 &PyTuple_Type);
    SETBUILTIN("type",                  &PyType_Type);
    SETBUILTIN("zip",                   &PyZip_Type);
    debug = PyBool_FromLong(Py_OptimizeFlag == 0);
    if (PyDict_SetItemString(dict, "__debug__", debug) < 0) {
        Py_XDECREF(debug);
        return NULL;
    }
    Py_XDECREF(debug);

    return mod;
#undef ADD_TO_ALL
#undef SETBUILTIN
}
pan>interp, part1Ptr, part2Ptr, newValuePtr, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be found. */ register Tcl_Obj *part1Ptr; /* Points to an object holding the name of * an array (if part2 is non-NULL) or the * name of a variable. */ register Tcl_Obj *part2Ptr; /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *newValuePtr; /* New value for variable. */ int flags; /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; char *part1, *part2; part1 = TclGetString(part1Ptr); part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr)); /* Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG |TCL_APPEND_VALUE|TCL_LIST_ELEMENT); varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags); } /* *---------------------------------------------------------------------- * * TclPtrSetVar -- * * This function is the same as Tcl_SetVar2Ex above, except that * it requires pointers to the variable's Var structs in addition * to the variable names. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the write operation was disallowed because an array was * expected but not found (or vice versa), then NULL is returned; if * the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will * be left in the interpreter's result. Note that the returned object * may not be the same one referenced by newValuePtr; this is because * variable traces may modify the variable's value. * * Side effects: * The value of the given variable is set. If either the array or the * entry didn't exist then a new variable is created. * *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be looked up. */ register Var *varPtr; Var *arrayPtr; CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr; /* New value for variable. */ CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, * and TCL_LEAVE_ERR_MSG bits. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldValuePtr; Tcl_Obj *resultPtr = NULL; int result; /* * If the variable is in a hashtable and its hPtr field is NULL, then we * may have an upvar to an array element where the array was deleted * or an upvar to a namespace variable whose namespace was deleted. * Generate an error (allowing the variable to be reset would screw up * our storage allocation and is meaningless anyway). */ if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) { if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarArrayElement(varPtr)) { VarErrMsg(interp, part1, part2, "set", danglingElement); } else { VarErrMsg(interp, part1, part2, "set", danglingVar); } } return NULL; } /* * It's an error to try to set an array variable itself. */ if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, part1, part2, "set", isArray); } return NULL; } /* * Invoke any read traces that have been set for the variable if it * is requested; this is only done in the core by the INST_LAPPEND_* * instructions. */ if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { return NULL; } } /* * Set the variable's new value. If appending, append the new value to * the variable, either as a list element or as a string. Also, if * appending, then if the variable's old value is unshared we can modify * it directly, otherwise we must create a new copy to modify: this is * "copy on write". */ if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) { TclSetVarUndefined(varPtr); } oldValuePtr = varPtr->value.objPtr; if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) { if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) { Tcl_DecrRefCount(oldValuePtr); /* discard old value */ varPtr->value.objPtr = NULL; oldValuePtr = NULL; } if (flags & TCL_LIST_ELEMENT) { /* append list element */ if (oldValuePtr == NULL) { TclNewObj(oldValuePtr); varPtr->value.objPtr = oldValuePtr; Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ } else if (Tcl_IsShared(oldValuePtr)) { varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); Tcl_DecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ } result = Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr); if (result != TCL_OK) { return NULL; } } else { /* append string */ /* * We append newValuePtr's bytes but don't change its ref count. */ if (oldValuePtr == NULL) { varPtr->value.objPtr = newValuePtr; Tcl_IncrRefCount(newValuePtr); } else { if (Tcl_IsShared(oldValuePtr)) { /* append to copy */ varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; Tcl_IncrRefCount(oldValuePtr); /* since var is ref */ } Tcl_AppendObjToObj(oldValuePtr, newValuePtr); } } } else if (newValuePtr != oldValuePtr) { /* * In this case we are replacing the value, so we don't need to * do more than swap the objects. */ varPtr->value.objPtr = newValuePtr; Tcl_IncrRefCount(newValuePtr); /* var is another ref */ if (oldValuePtr != NULL) { TclDecrRefCount(oldValuePtr); /* discard old value */ } } TclSetVarScalar(varPtr); TclClearVarUndefined(varPtr); if (arrayPtr != NULL) { TclClearVarUndefined(arrayPtr); } /* * Invoke any write traces for the variable. */ if ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) { goto cleanup; } } /* * Return the variable's value unless the variable was changed in some * gross way by a trace (e.g. it was unset and then recreated as an * array). */ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) { return varPtr->value.objPtr; } /* * A trace changed the value in some gross way. Return an empty string * object. */ resultPtr = iPtr->emptyObjPtr; /* * If the variable doesn't exist anymore and no-one's using it, then * free up the relevant structures and hash table entries. */ cleanup: if (TclIsVarUndefined(varPtr)) { CleanupVar(varPtr, arrayPtr); } return resultPtr; } /* *---------------------------------------------------------------------- * * TclIncrVar2 -- * * Given a two-part variable name, which may refer either to a scalar * variable or an element of an array, increment the Tcl object value * of the variable by a specified amount. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the specified variable doesn't exist, or there is a * clash in array usage, or an error occurs while executing variable * traces, then NULL is returned and a message will be left in * the interpreter's result. * * Side effects: * The value of the given variable is incremented by the specified * amount. If either the array or the entry didn't exist then a new * variable is created. The ref count for the returned object is _not_ * incremented to reflect the returned reference; if you want to keep a * reference to the object you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be found. */ Tcl_Obj *part1Ptr; /* Points to an object holding the name of * an array (if part2 is non-NULL) or the * name of a variable. */ Tcl_Obj *part2Ptr; /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ long incrAmount; /* Amount to be added to variable. */ int flags; /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; char *part1, *part2; part1 = TclGetString(part1Ptr); part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr)); varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read", 0, 1, &arrayPtr); if (varPtr == NULL) { Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); return NULL; } return TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags); } /* *---------------------------------------------------------------------- * * TclPtrIncrVar -- * * Given the pointers to a variable and possible containing array, * increment the Tcl object value of the variable by a specified * amount. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the specified variable doesn't exist, or there is a * clash in array usage, or an error occurs while executing variable * traces, then NULL is returned and a message will be left in * the interpreter's result. * * Side effects: * The value of the given variable is incremented by the specified * amount. If either the array or the entry didn't exist then a new * variable is created. The ref count for the returned object is _not_ * incremented to reflect the returned reference; if you want to keep a * reference to the object you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be found. */ Var *varPtr; Var *arrayPtr; CONST char *part1; /* Points to an object holding the name of * an array (if part2 is non-NULL) or the * name of a variable. */ CONST char *part2; /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ CONST long incrAmount; /* Amount to be added to variable. */ CONST int flags; /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ { register Tcl_Obj *varValuePtr; int createdNewObj; /* Set 1 if var's value object is shared * so we must increment a copy (i.e. copy * on write). */ long i; varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); if (varValuePtr == NULL) { Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); return NULL; } /* * Increment the variable's value. If the object is unshared we can * modify it directly, otherwise we must create a new copy to modify: * this is "copy on write". Then free the variable's old string * representation, if any, since it will no longer be valid. */ createdNewObj = 0; if (Tcl_IsShared(varValuePtr)) { varValuePtr = Tcl_DuplicateObj(varValuePtr); createdNewObj = 1; } if (varValuePtr->typePtr == &tclWideIntType) { Tcl_WideInt wide; TclGetWide(wide,varValuePtr); Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); } else if (varValuePtr->typePtr == &tclIntType) { i = varValuePtr->internalRep.longValue; Tcl_SetIntObj(varValuePtr, i + incrAmount); } else { /* * Not an integer or wide internal-rep... */ Tcl_WideInt wide; if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) { if (createdNewObj) { Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ } return NULL; } if (wide <= Tcl_LongAsWide(LONG_MAX) && wide >= Tcl_LongAsWide(LONG_MIN)) { Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount); } else { Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); } } /* * Store the variable's new value and run any write traces. */ return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, varValuePtr, flags); } /* *---------------------------------------------------------------------- * * Tcl_UnsetVar -- * * Delete a variable, so that it may not be accessed anymore. * * Results: * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR * if the variable can't be unset. In the event of an error, * if the TCL_LEAVE_ERR_MSG flag is set then an error message * is left in the interp's result. * * Side effects: * If varName is defined as a local or global variable in interp, * it is deleted. * *---------------------------------------------------------------------- */ int Tcl_UnsetVar(interp, varName, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ CONST char *varName; /* Name of a variable in interp. May be * either a scalar name or an array name * or an element in an array. */ int flags; /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or * TCL_LEAVE_ERR_MSG. */ { return Tcl_UnsetVar2(interp, varName, (char *) NULL, flags); } /* *---------------------------------------------------------------------- * * Tcl_UnsetVar2 -- * * Delete a variable, given a 2-part name. * * Results: * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR * if the variable can't be unset. In the event of an error, * if the TCL_LEAVE_ERR_MSG flag is set then an error message * is left in the interp's result. * * Side effects: * If part1 and part2 indicate a local or global variable in interp, * it is deleted. If part1 is an array name and part2 is NULL, then * the whole array is deleted. * *---------------------------------------------------------------------- */ int Tcl_UnsetVar2(interp, part1, part2, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array or NULL. */ int flags; /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { int result; Tcl_Obj *part1Ptr; part1Ptr = Tcl_NewStringObj(part1, -1); Tcl_IncrRefCount(part1Ptr); /* Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); result = TclObjUnsetVar2(interp, part1Ptr, part2, flags); TclDecrRefCount(part1Ptr); return result; } /* *---------------------------------------------------------------------- * * TclObjUnsetVar2 -- * * Delete a variable, given a 2-object name. * * Results: * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR * if the variable can't be unset. In the event of an error, * if the TCL_LEAVE_ERR_MSG flag is set then an error message * is left in the interp's result. * * Side effects: * If part1ptr and part2Ptr indicate a local or global variable in interp, * it is deleted. If part1Ptr is an array name and part2Ptr is NULL, then * the whole array is deleted. * *---------------------------------------------------------------------- */ int TclObjUnsetVar2(interp, part1Ptr, part2, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ Tcl_Obj *part1Ptr; /* Name of variable or array. */ CONST char *part2; /* Name of element within array or NULL. */ int flags; /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { Var *varPtr; Interp *iPtr = (Interp *) interp; Var *arrayPtr; int result; char *part1; part1 = TclGetString(part1Ptr); varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset", /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK); /* * Keep the variable alive until we're done with it. We used to * increase/decrease the refCount for each operation, making it * hard to find [Bug 735335] - caused by unsetting the variable * whose value was the variable's name. */ varPtr->refCount++; UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags); /* * It's an error to unset an undefined variable. */ if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, part1, part2, "unset", ((arrayPtr == NULL) ? noSuchVar : noSuchElement)); } } /* * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType * keeping a reference. This removes some additional exteriorisations of * [Bug 736729], but may be a good thing independently of the bug. */ if (part1Ptr->typePtr == &tclNsVarNameType) { part1Ptr->typePtr->freeIntRepProc(part1Ptr); part1Ptr->typePtr = NULL; } /* * Finally, if the variable is truly not in use then free up its Var * structure and remove it from its hash table, if any. The ref count of * its value object, if any, was decremented above. */ varPtr->refCount--; CleanupVar(varPtr, arrayPtr); return result; } /* *---------------------------------------------------------------------- * * UnsetVarStruct -- * * Unset and delete a variable. This does the internal work for * TclObjUnsetVar2 and TclDeleteNamespaceVars, which call here for each * variable to be unset and deleted. * * Results: * None. * * Side effects: * If the arguments indicate a local or global variable in iPtr, it is * unset and deleted. * *---------------------------------------------------------------------- */ static void UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags) Var *varPtr; Var *arrayPtr; Interp *iPtr; CONST char *part1; CONST char *part2; int flags; { Var dummyVar; Var *dummyVarPtr; ActiveVarTrace *activePtr; if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) { DeleteSearches(arrayPtr); } /* * For global/upvar variables referenced in procedures, decrement * the reference count on the variable referred to, and free * the referenced variable if it's no longer needed. */ if (TclIsVarLink(varPtr)) { Var *linkPtr = varPtr->value.linkPtr; linkPtr->refCount--; if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr) && (linkPtr->tracePtr == NULL) && (linkPtr->flags & VAR_IN_HASHTABLE)) { if (linkPtr->hPtr != NULL) { Tcl_DeleteHashEntry(linkPtr->hPtr); } ckfree((char *) linkPtr); } } /* * The code below is tricky, because of the possibility that * a trace procedure might try to access a variable being * deleted. To handle this situation gracefully, do things * in three steps: * 1. Copy the contents of the variable to a dummy variable * structure, and mark the original Var structure as undefined. * 2. Invoke traces and clean up the variable, using the dummy copy. * 3. If at the end of this the original variable is still * undefined and has no outstanding references, then delete * it (but it could have gotten recreated by a trace). */ dummyVar = *varPtr; TclSetVarUndefined(varPtr); TclSetVarScalar(varPtr); varPtr->value.objPtr = NULL; /* dummyVar points to any value object */ varPtr->tracePtr = NULL; varPtr->searchPtr = NULL; /* * Call trace procedures for the variable being deleted. Then delete * its traces. Be sure to abort any other traces for the variable * that are still pending. Special tricks: * 1. We need to increment varPtr's refCount around this: CallVarTraces * will use dummyVar so it won't increment varPtr's refCount itself. * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to * call unset traces even if other traces are pending. */ if ((dummyVar.tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { dummyVar.flags &= ~VAR_TRACE_ACTIVE; CallVarTraces(iPtr, arrayPtr, &dummyVar, part1, part2, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0); while (dummyVar.tracePtr != NULL) { VarTrace *tracePtr = dummyVar.tracePtr; dummyVar.tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } } } /* * If the variable is an array, delete all of its elements. This must be * done after calling the traces on the array, above (that's the way * traces are defined). If it is a scalar, "discard" its object * (decrement the ref count of its object, if any). */ dummyVarPtr = &dummyVar; if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) { DeleteArray(iPtr, part1, dummyVarPtr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS); } if (TclIsVarScalar(dummyVarPtr) && (dummyVarPtr->value.objPtr != NULL)) { Tcl_Obj *objPtr = dummyVarPtr->value.objPtr; TclDecrRefCount(objPtr); dummyVarPtr->value.objPtr = NULL; } /* * If the variable was a namespace variable, decrement its reference count. */ if (varPtr->flags & VAR_NAMESPACE_VAR) { varPtr->flags &= ~VAR_NAMESPACE_VAR; varPtr->refCount--; } } /* *---------------------------------------------------------------------- * * Tcl_TraceVar -- * * Arrange for reads and/or writes to a variable to cause a * procedure to be invoked, which can monitor the operations * and/or change their actions. * * Results: * A standard Tcl return value. * * Side effects: * A trace is set up on the variable given by varName, such that * future references to the variable will be intermediated by * proc. See the manual entry for complete details on the calling * sequence for proc. * *---------------------------------------------------------------------- */ int Tcl_TraceVar(interp, varName, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter in which variable is * to be traced. */ CONST char *varName; /* Name of variable; may end with "(index)" * to signify an array reference. */ int flags; /* OR-ed collection of bits, including any * of TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc; /* Procedure to call when specified ops are * invoked upon varName. */ ClientData clientData; /* Arbitrary argument to pass to proc. */ { return Tcl_TraceVar2(interp, varName, (char *) NULL, flags, proc, clientData); } /* *---------------------------------------------------------------------- * * Tcl_TraceVar2 -- * * Arrange for reads and/or writes to a variable to cause a * procedure to be invoked, which can monitor the operations * and/or change their actions. * * Results: * A standard Tcl return value. * * Side effects: * A trace is set up on the variable given by part1 and part2, such * that future references to the variable will be intermediated by * proc. See the manual entry for complete details on the calling * sequence for proc. * *---------------------------------------------------------------------- */ int Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter in which variable is * to be traced. */ CONST char *part1; /* Name of scalar variable or array. */ CONST char *part2; /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ int flags; /* OR-ed collection of bits, including any * of TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, * and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc; /* Procedure to call when specified ops are * invoked upon varName. */ ClientData clientData; /* Arbitrary argument to pass to proc. */ { Var *varPtr, *arrayPtr; register VarTrace *tracePtr; int flagMask; /* * We strip 'flags' down to just the parts which are relevant to * TclLookupVar, to avoid conflicts between trace flags and * internal namespace flags such as 'FIND_ONLY_NS'. This can * now occur since we have trace flags with values 0x1000 and higher. */ flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY; varPtr = TclLookupVar(interp, part1, part2, (flags & flagMask) | TCL_LEAVE_ERR_MSG, "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } /* * Check for a nonsense flag combination. Note that this is a * panic() because there should be no code path that ever sets * both flags. */ if ((flags&TCL_TRACE_RESULT_DYNAMIC) && (flags&TCL_TRACE_RESULT_OBJECT)) { panic("bad result flag combination"); } /* * Set up trace information. */ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; #ifndef TCL_REMOVE_OBSOLETE_TRACES flagMask |= TCL_TRACE_OLD_STYLE; #endif tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags & flagMask; tracePtr->nextPtr = varPtr->tracePtr; varPtr->tracePtr = tracePtr; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_UntraceVar -- * * Remove a previously-created trace for a variable. * * Results: * None. * * Side effects: * If there exists a trace for the variable given by varName * with the given flags, proc, and clientData, then that trace * is removed. * *---------------------------------------------------------------------- */ void Tcl_UntraceVar(interp, varName, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter containing variable. */ CONST char *varName; /* Name of variable; may end with "(index)" * to signify an array reference. */ int flags; /* OR-ed collection of bits describing * current trace, including any of * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY * and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */ ClientData clientData; /* Arbitrary argument to pass to proc. */ { Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData); } /* *---------------------------------------------------------------------- * * Tcl_UntraceVar2 -- * * Remove a previously-created trace for a variable. * * Results: * None. * * Side effects: * If there exists a trace for the variable given by part1 * and part2 with the given flags, proc, and clientData, then * that trace is removed. * *---------------------------------------------------------------------- */ void Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter containing variable. */ CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ int flags; /* OR-ed collection of bits describing * current trace, including any of * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, * and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */ ClientData clientData; /* Arbitrary argument to pass to proc. */ { register VarTrace *tracePtr; VarTrace *prevPtr; Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; ActiveVarTrace *activePtr; int flagMask; /* * Set up a mask to mask out the parts of the flags that we are not * interested in now. */ flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY; varPtr = TclLookupVar(interp, part1, part2, flags & flagMask, /*msg*/ (char *) NULL, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { return; } /* * Set up a mask to mask out the parts of the flags that we are not * interested in now. */ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; #ifndef TCL_REMOVE_OBSOLETE_TRACES flagMask |= TCL_TRACE_OLD_STYLE; #endif flags &= flagMask; for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr == NULL) { return; } if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags) && (tracePtr->clientData == clientData)) { break; } } /* * The code below makes it possible to delete traces while traces * are active: it makes sure that the deleted trace won't be * processed by CallVarTraces. */ for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->nextTracePtr == tracePtr) { activePtr->nextTracePtr = tracePtr->nextPtr; } } if (prevPtr == NULL) { varPtr->tracePtr = tracePtr->nextPtr; } else { prevPtr->nextPtr = tracePtr->nextPtr; } Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); /* * If this is the last trace on the variable, and the variable is * unset and unused, then free up the variable. */ if (TclIsVarUndefined(varPtr)) { CleanupVar(varPtr, (Var *) NULL); } } /* *---------------------------------------------------------------------- * * Tcl_VarTraceInfo -- * * Return the clientData value associated with a trace on a * variable. This procedure can also be used to step through * all of the traces on a particular variable that have the * same trace procedure. * * Results: * The return value is the clientData value associated with * a trace on the given variable. Information will only be * returned for a trace with proc as trace procedure. If * the clientData argument is NULL then the first such trace is * returned; otherwise, the next relevant one after the one * given by clientData will be returned. If the variable * doesn't exist, or if there are no (more) traces for it, * then NULL is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) Tcl_Interp *interp; /* Interpreter containing variable. */ CONST char *varName; /* Name of variable; may end with "(index)" * to signify an array reference. */ int flags; /* OR-ed combo or TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY (can be 0). */ Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */ ClientData prevClientData; /* If non-NULL, gives last value returned * by this procedure, so this call will * return the next trace after that one. * If NULL, this call will return the * first trace. */ { return Tcl_VarTraceInfo2(interp, varName, (char *) NULL, flags, proc, prevClientData); } /* *---------------------------------------------------------------------- * * Tcl_VarTraceInfo2 -- * * Same as Tcl_VarTraceInfo, except takes name in two pieces * instead of one. * * Results: * Same as Tcl_VarTraceInfo. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData) Tcl_Interp *interp; /* Interpreter containing variable. */ CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */ ClientData prevClientData; /* If non-NULL, gives last value returned * by this procedure, so this call will * return the next trace after that one. * If NULL, this call will return the * first trace. */ { register VarTrace *tracePtr; Var *varPtr, *arrayPtr; varPtr = TclLookupVar(interp, part1, part2, flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), /*msg*/ (char *) NULL, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { return NULL; } /* * Find the relevant trace, if any, and return its clientData. */ tracePtr = varPtr->tracePtr; if (prevClientData != NULL) { for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { if ((tracePtr->clientData == prevClientData) && (tracePtr->traceProc == proc)) { tracePtr = tracePtr->nextPtr; break; } } } for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { if (tracePtr->traceProc == proc) { return tracePtr->clientData; } } return NULL; } /* *---------------------------------------------------------------------- * * Tcl_UnsetObjCmd -- * * This object-based procedure is invoked to process the "unset" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_UnsetObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { register int i, flags = TCL_LEAVE_ERR_MSG; register char *name; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?--? ?varName varName ...?"); return TCL_ERROR; } else if (objc == 1) { /* * Do nothing if no arguments supplied, so as to match * command documentation. */ return TCL_OK; } /* * Simple, restrictive argument parsing. The only options are -- * and -nocomplain (which must come first and be given exactly to * be an option). */ i = 1; name = TclGetString(objv[i]); if (name[0] == '-') { if (strcmp("-nocomplain", name) == 0) { i++; if (i == objc) { return TCL_OK; } flags = 0; name = TclGetString(objv[i]); } if (strcmp("--", name) == 0) { i++; } } for (; i < objc; i++) { if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK) && (flags == TCL_LEAVE_ERR_MSG)) { return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_AppendObjCmd -- * * This object-based procedure is invoked to process the "append" * Tcl command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * A variable's value may be changed. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_AppendObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { Var *varPtr, *arrayPtr; char *part1; register Tcl_Obj *varValuePtr = NULL; /* Initialized to avoid compiler * warning. */ int i; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?"); return TCL_ERROR; } if (objc == 2) { varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (varValuePtr == NULL) { return TCL_ERROR; } } else { varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); part1 = TclGetString(objv[1]); if (varPtr == NULL) { return TCL_ERROR; } for (i = 2; i < objc; i++) { /* * Note that we do not need to increase the refCount of * the Var pointers: should a trace delete the variable, * the return value of TclPtrSetVar will be NULL, and we * will not access the variable again. */ varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG)); if (varValuePtr == NULL) { return TCL_ERROR; } } } Tcl_SetObjResult(interp, varValuePtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LappendObjCmd -- * * This object-based procedure is invoked to process the "lappend" * Tcl command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * A variable's value may be changed. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_LappendObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Obj *varValuePtr, *newValuePtr; register List *listRepPtr; register Tcl_Obj **elemPtrs; int numElems, numRequired, createdNewObj, i, j; Var *varPtr, *arrayPtr; char *part1; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?"); return TCL_ERROR; } if (objc == 2) { newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL, 0); if (newValuePtr == NULL) { /* * The variable doesn't exist yet. Just create it with an empty * initial value. */ varValuePtr = Tcl_NewObj(); Tcl_IncrRefCount(varValuePtr); newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(varValuePtr); if (newValuePtr == NULL) { return TCL_ERROR; } } else { int result; result = Tcl_ListObjLength(interp, newValuePtr, &numElems); if (result != TCL_OK) { return result; } } } else { /* * We have arguments to append. We used to call Tcl_SetVar2 to * append each argument one at a time to ensure that traces were run * for each append step. We now append the arguments all at once * because it's faster. Note that a read trace and a write trace for * the variable will now each only be called once. Also, if the * variable's old value is unshared we modify it directly, otherwise * we create a new copy to modify: this is "copy on write". * * Note that you have to protect the variable pointers around * the TclPtrGetVar call to insure that they remain valid * even if the variable was undefined and unused. */ varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } varPtr->refCount++; if (arrayPtr != NULL) { arrayPtr->refCount++; } part1 = TclGetString(objv[1]); varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL, TCL_LEAVE_ERR_MSG); varPtr->refCount--; if (arrayPtr != NULL) { arrayPtr->refCount--; } createdNewObj = 0; if (varValuePtr == NULL) { /* * We couldn't read the old value: either the var doesn't yet * exist or it's an array element. If it's new, we will try to * create it with Tcl_ObjSetVar2 below. */ varValuePtr = Tcl_NewObj(); createdNewObj = 1; } else if (Tcl_IsShared(varValuePtr)) { varValuePtr = Tcl_DuplicateObj(varValuePtr); createdNewObj = 1; } /* * Convert the variable's old value to a list object if necessary. */ if (varValuePtr->typePtr != &tclListType) { int result = tclListType.setFromAnyProc(interp, varValuePtr); if (result != TCL_OK) { if (createdNewObj) { Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */ } return result; } } listRepPtr = (List *) varValuePtr->internalRep.twoPtrValue.ptr1; elemPtrs = listRepPtr->elements; numElems = listRepPtr->elemCount; /* * If there is no room in the current array of element pointers, * allocate a new, larger array and copy the pointers to it. */ numRequired = numElems + (objc-2); if (numRequired > listRepPtr->maxElemCount) { int newMax = (2 * numRequired); Tcl_Obj **newElemPtrs = (Tcl_Obj **) ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *))); memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs, (size_t) (numElems * sizeof(Tcl_Obj *))); listRepPtr->maxElemCount = newMax; listRepPtr->elements = newElemPtrs; ckfree((char *) elemPtrs); elemPtrs = newElemPtrs; } /* * Insert the new elements at the end of the list. */ for (i = 2, j = numElems; i < objc; i++, j++) { elemPtrs[j] = objv[i]; Tcl_IncrRefCount(objv[i]); } listRepPtr->elemCount = numRequired; /* * Invalidate and free any old string representation since it no * longer reflects the list's internal representation. */ Tcl_InvalidateStringRep(varValuePtr); /* * Now store the list object back into the variable. If there is an * error setting the new value, decrement its ref count if it * was new and we didn't create the variable. */ Tcl_IncrRefCount(varValuePtr); newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, varValuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(varValuePtr); if (newValuePtr == NULL) { return TCL_ERROR; } } /* * Set the interpreter's object result to refer to the variable's value * object. */ Tcl_SetObjResult(interp, newValuePtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_ArrayObjCmd -- * * This object-based procedure is invoked to process the "array" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result object. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_ArrayObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { /* * The list of constants below should match the arrayOptions string array * below. */ enum {ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET, ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE, ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET}; static CONST char *arrayOptions[] = { "anymore", "donesearch", "exists", "get", "names", "nextelement", "set", "size", "startsearch", "statistics", "unset", (char *) NULL }; Interp *iPtr = (Interp *) interp; Var *varPtr, *arrayPtr; Tcl_HashEntry *hPtr; Tcl_Obj *resultPtr, *varNamePtr; int notArray; char *varName; int index, result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } /* * Locate the array variable */ varNamePtr = objv[2]; varName = TclGetString(varNamePtr); varPtr = TclObjLookupVar(interp, varNamePtr, NULL, /*flags*/ 0, /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); /* * Special array trace used to keep the env array in sync for * array names, array get, etc. */ if (varPtr != NULL && varPtr->tracePtr != NULL && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, varName, NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| TCL_TRACE_ARRAY), /* leaveErrMsg */ 1)) { return TCL_ERROR; } } /* * Verify that it is indeed an array variable. This test comes after * the traces - the variable may actually become an array as an effect * of said traces. */ notArray = 0; if ((varPtr == NULL) || !TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr)) { notArray = 1; } /* * We have to wait to get the resultPtr until here because * CallVarTraces can affect the result. */ resultPtr = Tcl_GetObjResult(interp); switch (index) { case ARRAY_ANYMORE: { ArraySearch *searchPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); return TCL_ERROR; } if (notArray) { goto error; } searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); if (searchPtr == NULL) { return TCL_ERROR; } while (1) { Var *varPtr2; if (searchPtr->nextEntry != NULL) { varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry); if (!TclIsVarUndefined(varPtr2)) { break; } } searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search); if (searchPtr->nextEntry == NULL) { Tcl_SetIntObj(resultPtr, 0); return TCL_OK; } } Tcl_SetIntObj(resultPtr, 1); break; } case ARRAY_DONESEARCH: { ArraySearch *searchPtr, *prevPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); return TCL_ERROR; } if (notArray) { goto error; } searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); if (searchPtr == NULL) { return TCL_ERROR; } if (varPtr->searchPtr == searchPtr) { varPtr->searchPtr = searchPtr->nextPtr; } else { for (prevPtr = varPtr->searchPtr; ; prevPtr = prevPtr->nextPtr) { if (prevPtr->nextPtr == searchPtr) { prevPtr->nextPtr = searchPtr->nextPtr; break; } } } ckfree((char *) searchPtr); break; } case ARRAY_EXISTS: { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); return TCL_ERROR; } Tcl_SetIntObj(resultPtr, !notArray); break; } case ARRAY_GET: { Tcl_HashSearch search; Var *varPtr2; char *pattern = NULL; char *name; Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr; int i, count; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?"); return TCL_ERROR; } if (notArray) { return TCL_OK; } if (objc == 4) { pattern = TclGetString(objv[3]); } /* * Store the array names in a new object. */ nameLstPtr = Tcl_NewObj(); Tcl_IncrRefCount(nameLstPtr); for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { varPtr2 = (Var *) Tcl_GetHashValue(hPtr); if (TclIsVarUndefined(varPtr2)) { continue; } name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); if ((objc == 4) && !Tcl_StringMatch(name, pattern)) { continue; /* element name doesn't match pattern */ } namePtr = Tcl_NewStringObj(name, -1); result = Tcl_ListObjAppendElement(interp, nameLstPtr, namePtr); if (result != TCL_OK) { Tcl_DecrRefCount(namePtr); /* free unneeded name obj */ Tcl_DecrRefCount(nameLstPtr); return result; } } /* * Make sure the Var structure of the array is not removed by * a trace while we're working. */ varPtr->refCount++; /* * Get the array values corresponding to each element name */ tmpResPtr = Tcl_NewObj(); result = Tcl_ListObjGetElements(interp, nameLstPtr, &count, &namePtrPtr); if (result != TCL_OK) { goto errorInArrayGet; } for (i = 0; i < count; i++) { namePtr = *namePtrPtr++; valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr, TCL_LEAVE_ERR_MSG); if (valuePtr == NULL) { /* * Some trace played a trick on us; we need to diagnose to * adapt our behaviour: was the array element unset, or did * the modification modify the complete array? */ if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { /* * The array itself looks OK, the variable was * undefined: forget it. */ continue; } else { result = TCL_ERROR; goto errorInArrayGet; } } result = Tcl_ListObjAppendElement(interp, tmpResPtr, namePtr); if (result != TCL_OK) { goto errorInArrayGet; } result = Tcl_ListObjAppendElement(interp, tmpResPtr, valuePtr); if (result != TCL_OK) { goto errorInArrayGet; } } varPtr->refCount--; Tcl_SetObjResult(interp, tmpResPtr); Tcl_DecrRefCount(nameLstPtr); break; errorInArrayGet: varPtr->refCount--; Tcl_DecrRefCount(nameLstPtr); Tcl_DecrRefCount(tmpResPtr); /* free unneeded temp result obj */ return result; } case ARRAY_NAMES: { Tcl_HashSearch search; Var *varPtr2; char *pattern = NULL; char *name; Tcl_Obj *namePtr; int mode, matched = 0; static CONST char *options[] = { "-exact", "-glob", "-regexp", (char *) NULL }; enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP }; mode = OPT_GLOB; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?mode? ?pattern?"); return TCL_ERROR; } if (notArray) { return TCL_OK; } if (objc == 4) { pattern = Tcl_GetString(objv[3]); } else if (objc == 5) { pattern = Tcl_GetString(objv[4]); if (Tcl_GetIndexFromObj(interp, objv[3], options, "option", 0, &mode) != TCL_OK) { return TCL_ERROR; } } for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { varPtr2 = (Var *) Tcl_GetHashValue(hPtr); if (TclIsVarUndefined(varPtr2)) { continue; } name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); if (objc > 3) { switch ((enum options) mode) { case OPT_EXACT: matched = (strcmp(name, pattern) == 0); break; case OPT_GLOB: matched = Tcl_StringMatch(name, pattern); break; case OPT_REGEXP: matched = Tcl_RegExpMatch(interp, name, pattern); if (matched < 0) { return TCL_ERROR; } break; } if (matched == 0) { continue; } } namePtr = Tcl_NewStringObj(name, -1); result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr); if (result != TCL_OK) { Tcl_DecrRefCount(namePtr); /* free unneeded name obj */ return result; } } break; } case ARRAY_NEXTELEMENT: { ArraySearch *searchPtr; Tcl_HashEntry *hPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); return TCL_ERROR; } if (notArray) { goto error; } searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); if (searchPtr == NULL) { return TCL_ERROR; } while (1) { Var *varPtr2; hPtr = searchPtr->nextEntry; if (hPtr == NULL) { hPtr = Tcl_NextHashEntry(&searchPtr->search); if (hPtr == NULL) { return TCL_OK; } } else { searchPtr->nextEntry = NULL; } varPtr2 = (Var *) Tcl_GetHashValue(hPtr); if (!TclIsVarUndefined(varPtr2)) { break; } } Tcl_SetStringObj(resultPtr, Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1); break; } case ARRAY_SET: { if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName list"); return TCL_ERROR; } return(TclArraySet(interp, objv[2], objv[3])); } case ARRAY_SIZE: { Tcl_HashSearch search; Var *varPtr2; int size; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); return TCL_ERROR; } size = 0; if (!notArray) { for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { varPtr2 = (Var *) Tcl_GetHashValue(hPtr); if (TclIsVarUndefined(varPtr2)) { continue; } size++; } } Tcl_SetIntObj(resultPtr, size); break; } case ARRAY_STARTSEARCH: { ArraySearch *searchPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); return TCL_ERROR; } if (notArray) { goto error; } searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch)); if (varPtr->searchPtr == NULL) { searchPtr->id = 1; Tcl_AppendStringsToObj(resultPtr, "s-1-", varName, (char *) NULL); } else { char string[TCL_INTEGER_SPACE]; searchPtr->id = varPtr->searchPtr->id + 1; TclFormatInt(string, searchPtr->id); Tcl_AppendStringsToObj(resultPtr, "s-", string, "-", varName, (char *) NULL); } searchPtr->varPtr = varPtr; searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr, &searchPtr->search); searchPtr->nextPtr = varPtr->searchPtr; varPtr->searchPtr = searchPtr; break; } case ARRAY_STATISTICS: { CONST char *stats; if (notArray) { goto error; } stats = Tcl_HashStats(varPtr->value.tablePtr); if (stats != NULL) { Tcl_SetStringObj(Tcl_GetObjResult(interp), stats, -1); ckfree((void *)stats); } else { Tcl_SetResult(interp, "error reading array statistics", TCL_STATIC); return TCL_ERROR; } break; } case ARRAY_UNSET: { Tcl_HashSearch search; Var *varPtr2; char *pattern = NULL; char *name; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?"); return TCL_ERROR; } if (notArray) { return TCL_OK; } if (objc == 3) { /* * When no pattern is given, just unset the whole array */ if (TclObjUnsetVar2(interp, varNamePtr, NULL, 0) != TCL_OK) { return TCL_ERROR; } } else { pattern = Tcl_GetString(objv[3]); for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { varPtr2 = (Var *) Tcl_GetHashValue(hPtr); if (TclIsVarUndefined(varPtr2)) { continue; } name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); if (Tcl_StringMatch(name, pattern) && (TclObjUnsetVar2(interp, varNamePtr, name, 0) != TCL_OK)) { return TCL_ERROR; } } } break; } } return TCL_OK; error: Tcl_AppendStringsToObj(resultPtr, "\"", varName, "\" isn't an array", (char *) NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TclArraySet -- * * Set the elements of an array. If there are no elements to * set, create an empty array. This routine is used by the * Tcl_ArrayObjCmd and by the TclSetupEnv routine. * * Results: * A standard Tcl result object. * * Side effects: * A variable will be created if one does not already exist. * *---------------------------------------------------------------------- */ int TclArraySet(interp, arrayNameObj, arrayElemObj) Tcl_Interp *interp; /* Current interpreter. */ Tcl_Obj *arrayNameObj; /* The array name. */ Tcl_Obj *arrayElemObj; /* The array elements list. If this is * NULL, create an empty array. */ { Var *varPtr, *arrayPtr; Tcl_Obj **elemPtrs; int result, elemLen, i, nameLen; char *varName, *p; varName = Tcl_GetStringFromObj(arrayNameObj, &nameLen); p = varName + nameLen - 1; if (*p == ')') { while (--p >= varName) { if (*p == '(') { VarErrMsg(interp, varName, NULL, "set", needArray); return TCL_ERROR; } } } varPtr = TclObjLookupVar(interp, arrayNameObj, NULL, /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } if (arrayElemObj != NULL) { result = Tcl_ListObjGetElements(interp, arrayElemObj, &elemLen, &elemPtrs); if (result != TCL_OK) { return result; } if (elemLen & 1) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "list must have an even number of elements", -1); return TCL_ERROR; } if (elemLen > 0) { /* * We needn't worry about traces invalidating arrayPtr: * should that be the case, TclPtrSetVar will return NULL * so that we break out of the loop and return an error. */ for (i = 0; i < elemLen; i += 2) { char *part2 = TclGetString(elemPtrs[i]); Var *elemVarPtr = TclLookupArrayElement(interp, varName, part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr); if ((elemVarPtr == NULL) || (TclPtrSetVar(interp, elemVarPtr, varPtr, varName, part2, elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL)) { result = TCL_ERROR; break; } /* * The TclPtrSetVar call might have shimmered * arrayElemObj to another type, so re-fetch * the pointers for safety. */ Tcl_ListObjGetElements(NULL, arrayElemObj, &elemLen, &elemPtrs); } return result; } } /* * The list is empty make sure we have an array, or create * one if necessary. */ if (varPtr != NULL) { if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) { /* * Already an array, done. */ return TCL_OK; } if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) { /* * Either an array element, or a scalar: lose! */ VarErrMsg(interp, varName, (char *)NULL, "array set", needArray); return TCL_ERROR; } } TclSetVarArray(varPtr); TclClearVarUndefined(varPtr); varPtr->value.tablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS); return TCL_OK; } /* *---------------------------------------------------------------------- * * ObjMakeUpvar -- * * This procedure does all of the work of the "global" and "upvar" * commands. * * Results: * A standard Tcl completion code. If an error occurs then an * error message is left in iPtr->result. * * Side effects: * The variable given by myName is linked to the variable in framePtr * given by otherP1 and otherP2, so that references to myName are * redirected to the other variable like a symbolic link. * *---------------------------------------------------------------------- */ static int ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, index) Tcl_Interp *interp; /* Interpreter containing variables. Used * for error messages, too. */ CallFrame *framePtr; /* Call frame containing "other" variable. * NULL means use global :: context. */ Tcl_Obj *otherP1Ptr; CONST char *otherP2; /* Two-part name of variable in framePtr. */ CONST int otherFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of "other" variable. */ CONST char *myName; /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ int myFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ int index; /* If the variable to be linked is an indexed * scalar, this is its index. Otherwise, -1. */ { Interp *iPtr = (Interp *) interp; Var *otherPtr, *varPtr, *arrayPtr; CallFrame *varFramePtr; CONST char *errMsg; /* * Find "other" in "framePtr". If not looking up other in just the * current namespace, temporarily replace the current var frame * pointer in the interpreter in order to use TclObjLookupVar. */ varFramePtr = iPtr->varFramePtr; if (!(otherFlags & TCL_NAMESPACE_ONLY)) { iPtr->varFramePtr = framePtr; } otherPtr = TclObjLookupVar(interp, otherP1Ptr, otherP2, (otherFlags | TCL_LEAVE_ERR_MSG), "access", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (!(otherFlags & TCL_NAMESPACE_ONLY)) { iPtr->varFramePtr = varFramePtr; } if (otherPtr == NULL) { return TCL_ERROR; } if (index >= 0) { if (!varFramePtr->isProcCallFrame) { panic("ObjMakeUpvar called with an index outside from a proc.\n"); } varPtr = &(varFramePtr->compiledLocals[index]); } else { /* * Check that we are not trying to create a namespace var linked to * a local variable in a procedure. If we allowed this, the local * variable in the shorter-lived procedure frame could go away * leaving the namespace var's reference invalid. */ if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) || (varFramePtr == NULL) || !varFramePtr->isProcCallFrame || (strstr(myName, "::") != NULL))) { Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"", myName, "\": upvar won't create namespace variable that ", "refers to procedure variable", (char *) NULL); return TCL_ERROR; } /* * Lookup and eventually create the new variable. Set the flag bit * LOOKUP_FOR_UPVAR to indicate the special resolution rules for * upvar purposes: * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers */ varPtr = TclLookupSimpleVar(interp, myName, (myFlags | LOOKUP_FOR_UPVAR), /* create */ 1, &errMsg, &index); if (varPtr == NULL) { VarErrMsg(interp, myName, NULL, "create", errMsg); return TCL_ERROR; } } if (varPtr == otherPtr) { Tcl_SetResult((Tcl_Interp *) iPtr, "can't upvar from variable to itself", TCL_STATIC); return TCL_ERROR; } if (varPtr->tracePtr != NULL) { Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName, "\" has traces: can't use for upvar", (char *) NULL); return TCL_ERROR; } else if (!TclIsVarUndefined(varPtr)) { /* * The variable already existed. Make sure this variable "varPtr" * isn't the same as "otherPtr" (avoid circular links). Also, if * it's not an upvar then it's an error. If it is an upvar, then * just disconnect it from the thing it currently refers to. */ if (TclIsVarLink(varPtr)) { Var *linkPtr = varPtr->value.linkPtr; if (linkPtr == otherPtr) { return TCL_OK; } linkPtr->refCount--; if (TclIsVarUndefined(linkPtr)) { CleanupVar(linkPtr, (Var *) NULL); } } else { Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName, "\" already exists", (char *) NULL); return TCL_ERROR; } } TclSetVarLink(varPtr); TclClearVarUndefined(varPtr); varPtr->value.linkPtr = otherPtr; otherPtr->refCount++; return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_UpVar -- * * This procedure links one variable to another, just like * the "upvar" command. * * Results: * A standard Tcl completion code. If an error occurs then * an error message is left in the interp's result. * * Side effects: * The variable in frameName whose name is given by varName becomes * accessible under the name localName, so that references to * localName are redirected to the other variable like a symbolic * link. * *---------------------------------------------------------------------- */ int Tcl_UpVar(interp, frameName, varName, localName, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ CONST char *frameName; /* Name of the frame containing the source * variable, such as "1" or "#0". */ CONST char *varName; /* Name of a variable in interp to link to. * May be either a scalar name or an * element in an array. */ CONST char *localName; /* Name of link variable. */ int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of localName. */ { return Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags); } /* *---------------------------------------------------------------------- * * Tcl_UpVar2 -- * * This procedure links one variable to another, just like * the "upvar" command. * * Results: * A standard Tcl completion code. If an error occurs then * an error message is left in the interp's result. * * Side effects: * The variable in frameName whose name is given by part1 and * part2 becomes accessible under the name localName, so that * references to localName are redirected to the other variable * like a symbolic link. * *---------------------------------------------------------------------- */ int Tcl_UpVar2(interp, frameName, part1, part2, localName, flags) Tcl_Interp *interp; /* Interpreter containing variables. Used * for error messages too. */ CONST char *frameName; /* Name of the frame containing the source * variable, such as "1" or "#0". */ CONST char *part1; CONST char *part2; /* Two parts of source variable name to * link to. */ CONST char *localName; /* Name of link variable. */ int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of localName. */ { int result; CallFrame *framePtr; Tcl_Obj *part1Ptr; if (TclGetFrame(interp, frameName, &framePtr) == -1) { return TCL_ERROR; } part1Ptr = Tcl_NewStringObj(part1, -1); Tcl_IncrRefCount(part1Ptr); result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0, localName, flags, -1); TclDecrRefCount(part1Ptr); return result; } /* *---------------------------------------------------------------------- * * Tcl_GetVariableFullName -- * * Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this * procedure appends to an object the namespace variable's full * name, qualified by a sequence of parent namespace names. * * Results: * None. * * Side effects: * The variable's fully-qualified name is appended to the string * representation of objPtr. * *---------------------------------------------------------------------- */ void Tcl_GetVariableFullName(interp, variable, objPtr) Tcl_Interp *interp; /* Interpreter containing the variable. */ Tcl_Var variable; /* Token for the variable returned by a * previous call to Tcl_FindNamespaceVar. */ Tcl_Obj *objPtr; /* Points to the object onto which the * variable's full name is appended. */ { Interp *iPtr = (Interp *) interp; register Var *varPtr = (Var *) variable; char *name; /* * Add the full name of the containing namespace (if any), followed by * the "::" separator, then the variable name. */ if (varPtr != NULL) { if (!TclIsVarArrayElement(varPtr)) { if (varPtr->nsPtr != NULL) { Tcl_AppendToObj(objPtr, varPtr->nsPtr->fullName, -1); if (varPtr->nsPtr != iPtr->globalNsPtr) { Tcl_AppendToObj(objPtr, "::", 2); } } if (varPtr->name != NULL) { Tcl_AppendToObj(objPtr, varPtr->name, -1); } else if (varPtr->hPtr != NULL) { name = Tcl_GetHashKey(varPtr->hPtr->tablePtr, varPtr->hPtr); Tcl_AppendToObj(objPtr, name, -1); } } } } /* *---------------------------------------------------------------------- * * Tcl_GlobalObjCmd -- * * This object-based procedure is invoked to process the "global" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_GlobalObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { Interp *iPtr = (Interp *) interp; register Tcl_Obj *objPtr; char *varName; register char *tail; int result, i; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?"); return TCL_ERROR; } /* * If we are not executing inside a Tcl procedure, just return. */ if ((iPtr->varFramePtr == NULL) || !iPtr->varFramePtr->isProcCallFrame) { return TCL_OK; } for (i = 1; i < objc; i++) { /* * Make a local variable linked to its counterpart in the global :: * namespace. */ objPtr = objv[i]; varName = TclGetString(objPtr); /* * The variable name might have a scope qualifier, but the name for * the local "link" variable must be the simple name at the tail. */ for (tail = varName; *tail != '\0'; tail++) { /* empty body */ } while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) { tail--; } if ((*tail == ':') && (tail > varName)) { tail++; } /* * Link to the variable "varName" in the global :: namespace. */ result = ObjMakeUpvar(interp, (CallFrame *) NULL, objPtr, NULL, /*otherFlags*/ TCL_GLOBAL_ONLY, /*myName*/ tail, /*myFlags*/ 0, -1); if (result != TCL_OK) { return result; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_VariableObjCmd -- * * Invoked to implement the "variable" command that creates one or more * global variables. Handles the following syntax: * * variable ?name value...? name ?value? * * One or more variables can be created. The variables are initialized * with the specified values. The value for the last variable is * optional. * * If the variable does not exist, it is created and given the optional * value. If it already exists, it is simply set to the optional * value. Normally, "name" is an unqualified name, so it is created in * the current namespace. If it includes namespace qualifiers, it can * be created in another namespace. * * If the variable command is executed inside a Tcl procedure, it * creates a local variable linked to the newly-created namespace * variable. * * Results: * Returns TCL_OK if the variable is found or created. Returns * TCL_ERROR if anything goes wrong. * * Side effects: * If anything goes wrong, this procedure returns an error message * as the result in the interpreter's result object. * *---------------------------------------------------------------------- */ int Tcl_VariableObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { Interp *iPtr = (Interp *) interp; char *varName, *tail, *cp; Var *varPtr, *arrayPtr; Tcl_Obj *varValuePtr; int i, result; Tcl_Obj *varNamePtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?"); return TCL_ERROR; } for (i = 1; i < objc; i = i+2) { /* * Look up each variable in the current namespace context, creating * it if necessary. */ varNamePtr = objv[i]; varName = TclGetString(varNamePtr); varPtr = TclObjLookupVar(interp, varNamePtr, NULL, (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define", /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); if (arrayPtr != NULL) { /* * Variable cannot be an element in an array. If arrayPtr is * non-null, it is, so throw up an error and return. */ VarErrMsg(interp, varName, NULL, "define", isArrayElement); return TCL_ERROR; } if (varPtr == NULL) { return TCL_ERROR; } /* * Mark the variable as a namespace variable and increment its * reference count so that it will persist until its namespace is * destroyed or until the variable is unset. */ if (!(varPtr->flags & VAR_NAMESPACE_VAR)) { varPtr->flags |= VAR_NAMESPACE_VAR; varPtr->refCount++; } /* * If a value was specified, set the variable to that value. * Otherwise, if the variable is new, leave it undefined. * (If the variable already exists and no value was specified, * leave its value unchanged; just create the local link if * we're in a Tcl procedure). */ if (i+1 < objc) { /* a value was specified */ varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varName, NULL, objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG)); if (varValuePtr == NULL) { return TCL_ERROR; } } /* * If we are executing inside a Tcl procedure, create a local * variable linked to the new namespace variable "varName". */ if ((iPtr->varFramePtr != NULL) && iPtr->varFramePtr->isProcCallFrame) { /* * varName might have a scope qualifier, but the name for the * local "link" variable must be the simple name at the tail. * * Locate tail in one pass: drop any prefix after two *or more* * consecutive ":" characters). */ for (tail = cp = varName; *cp != '\0'; ) { if (*cp++ == ':') { while (*cp == ':') { tail = ++cp; } } } /* * Create a local link "tail" to the variable "varName" in the * current namespace. */ result = ObjMakeUpvar(interp, (CallFrame *) NULL, /*otherP1*/ varNamePtr, /*otherP2*/ NULL, /*otherFlags*/ TCL_NAMESPACE_ONLY, /*myName*/ tail, /*myFlags*/ 0, -1); if (result != TCL_OK) { return result; } } } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_UpvarObjCmd -- * * This object-based procedure is invoked to process the "upvar" * Tcl command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_UpvarObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { CallFrame *framePtr; char *frameSpec, *localName; int result; if (objc < 3) { upvarSyntax: Tcl_WrongNumArgs(interp, 1, objv, "?level? otherVar localVar ?otherVar localVar ...?"); return TCL_ERROR; } /* * Find the call frame containing each of the "other variables" to be * linked to. */ frameSpec = TclGetString(objv[1]); result = TclGetFrame(interp, frameSpec, &framePtr); if (result == -1) { return TCL_ERROR; } objc -= result+1; if ((objc & 1) != 0) { goto upvarSyntax; } objv += result+1; /* * Iterate over each (other variable, local variable) pair. * Divide the other variable name into two parts, then call * MakeUpvar to do all the work of linking it to the local variable. */ for ( ; objc > 0; objc -= 2, objv += 2) { localName = TclGetString(objv[1]); result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0], NULL, 0, /* myVarName */ localName, /*flags*/ 0, -1); if (result != TCL_OK) { return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * DisposeTraceResult-- * * This procedure is called to dispose of the result returned from * a trace procedure. The disposal method appropriate to the type * of result is determined by flags. * * Results: * None. * * Side effects: * The memory allocated for the trace result may be freed. * *---------------------------------------------------------------------- */ static void DisposeTraceResult(flags, result) int flags; /* Indicates type of result to determine * proper disposal method */ char *result; /* The result returned from a trace * procedure to be disposed */ { if (flags & TCL_TRACE_RESULT_DYNAMIC) { ckfree(result); } else if (flags & TCL_TRACE_RESULT_OBJECT) { Tcl_DecrRefCount((Tcl_Obj *) result); } } /* *---------------------------------------------------------------------- * * CallVarTraces -- * * This procedure is invoked to find and invoke relevant * trace procedures associated with a particular operation on * a variable. This procedure invokes traces both on the * variable and on its containing array (where relevant). * * Results: * Returns TCL_OK to indicate normal operation. Returns TCL_ERROR * if invocation of a trace procedure indicated an error. When * TCL_ERROR is returned and leaveErrMsg is true, then the * ::errorInfo variable of iPtr has information about the error * appended to it. * * Side effects: * Almost anything can happen, depending on trace; this procedure * itself doesn't have any side effects. * *---------------------------------------------------------------------- */ static int CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) Interp *iPtr; /* Interpreter containing variable. */ register Var *arrayPtr; /* Pointer to array variable that contains * the variable, or NULL if the variable * isn't an element of an array. */ Var *varPtr; /* Variable whose traces are to be * invoked. */ CONST char *part1; CONST char *part2; /* Variable's two-part name. */ int flags; /* Flags passed to trace procedures: * indicates what's happening to variable, * plus other stuff like TCL_GLOBAL_ONLY, * or TCL_NAMESPACE_ONLY. */ CONST int leaveErrMsg; /* If true, and one of the traces indicates an * error, then leave an error message and stack * trace information in *iPTr. */ { register VarTrace *tracePtr; ActiveVarTrace active; char *result; CONST char *openParen, *p; Tcl_DString nameCopy; int copiedName; int code = TCL_OK; int disposeFlags = 0; int saveErrFlags = iPtr->flags & (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET); /* * If there are already similar trace procedures active for the * variable, don't call them again. */ if (varPtr->flags & VAR_TRACE_ACTIVE) { return code; } varPtr->flags |= VAR_TRACE_ACTIVE; varPtr->refCount++; if (arrayPtr != NULL) { arrayPtr->refCount++; } /* * If the variable name hasn't been parsed into array name and * element, do it here. If there really is an array element, * make a copy of the original name so that NULLs can be * inserted into it to separate the names (can't modify the name * string in place, because the string might get used by the * callbacks we invoke). */ copiedName = 0; if (part2 == NULL) { for (p = part1; *p ; p++) { if (*p == '(') { openParen = p; do { p++; } while (*p != '\0'); p--; if (*p == ')') { int offset = (openParen - part1); char *newPart1; Tcl_DStringInit(&nameCopy); Tcl_DStringAppend(&nameCopy, part1, (p-part1)); newPart1 = Tcl_DStringValue(&nameCopy); newPart1[offset] = 0; part1 = newPart1; part2 = newPart1 + offset + 1; copiedName = 1; } break; } } } /* * Invoke traces on the array containing the variable, if relevant. */ result = NULL; active.nextPtr = iPtr->activeVarTracePtr; iPtr->activeVarTracePtr = &active; Tcl_Preserve((ClientData) iPtr); if (arrayPtr != NULL && !(arrayPtr->flags & VAR_TRACE_ACTIVE)) { active.varPtr = arrayPtr; for (tracePtr = arrayPtr->tracePtr; tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve((ClientData) tracePtr); if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { flags |= TCL_INTERP_DESTROYED; } result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { /* Ignore errors in unset traces */ DisposeTraceResult(tracePtr->flags, result); } else { disposeFlags = tracePtr->flags; code = TCL_ERROR; } } Tcl_Release((ClientData) tracePtr); if (code == TCL_ERROR) { goto done; } } } /* * Invoke traces on the variable itself. */ if (flags & TCL_TRACE_UNSETS) { flags |= TCL_TRACE_DESTROYED; } active.varPtr = varPtr; for (tracePtr = varPtr->tracePtr; tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve((ClientData) tracePtr); if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { flags |= TCL_INTERP_DESTROYED; } result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { /* Ignore errors in unset traces */ DisposeTraceResult(tracePtr->flags, result); } else { disposeFlags = tracePtr->flags; code = TCL_ERROR; } } Tcl_Release((ClientData) tracePtr); if (code == TCL_ERROR) { goto done; } } /* * Restore the variable's flags, remove the record of our active * traces, and then return. */ done: if (code == TCL_OK) { iPtr->flags |= saveErrFlags; } if (code == TCL_ERROR) { if (leaveErrMsg) { CONST char *type = ""; switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) { case TCL_TRACE_READS: { type = "read"; break; } case TCL_TRACE_WRITES: { type = "set"; break; } case TCL_TRACE_ARRAY: { type = "trace array"; break; } } if (disposeFlags & TCL_TRACE_RESULT_OBJECT) { VarErrMsg((Tcl_Interp *) iPtr, part1, part2, type, Tcl_GetString((Tcl_Obj *) result)); } else { VarErrMsg((Tcl_Interp *) iPtr, part1, part2, type, result); } } DisposeTraceResult(disposeFlags,result); } if (arrayPtr != NULL) { arrayPtr->refCount--; } if (copiedName) { Tcl_DStringFree(&nameCopy); } varPtr->flags &= ~VAR_TRACE_ACTIVE; varPtr->refCount--; iPtr->activeVarTracePtr = active.nextPtr; Tcl_Release((ClientData) iPtr); return code; } /* *---------------------------------------------------------------------- * * NewVar -- * * Create a new heap-allocated variable that will eventually be * entered into a hashtable. * * Results: * The return value is a pointer to the new variable structure. It is * marked as a scalar variable (and not a link or array variable). Its * value initially is NULL. The variable is not part of any hash table * yet. Since it will be in a hashtable and not in a call frame, its * name field is set NULL. It is initially marked as undefined. * * Side effects: * Storage gets allocated. * *---------------------------------------------------------------------- */ static Var * NewVar() { register Var *varPtr; varPtr = (Var *) ckalloc(sizeof(Var)); varPtr->value.objPtr = NULL; varPtr->name = NULL; varPtr->nsPtr = NULL; varPtr->hPtr = NULL; varPtr->refCount = 0; varPtr->tracePtr = NULL; varPtr->searchPtr = NULL; varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE); return varPtr; } /* *---------------------------------------------------------------------- * * SetArraySearchObj -- * * This function converts the given tcl object into one that * has the "array search" internal type. * * Results: * TCL_OK if the conversion succeeded, and TCL_ERROR if it failed * (when an error message will be placed in the interpreter's * result.) * * Side effects: * Updates the internal type and representation of the object to * make this an array-search object. See the tclArraySearchType * declaration above for details of the internal representation. * *---------------------------------------------------------------------- */ static int SetArraySearchObj(interp, objPtr) Tcl_Interp *interp; Tcl_Obj *objPtr; { char *string; char *end; int id; size_t offset; /* * Get the string representation. Make it up-to-date if necessary. */ string = Tcl_GetString(objPtr); /* * Parse the id into the three parts separated by dashes. */ if ((string[0] != 's') || (string[1] != '-')) { syntax: Tcl_AppendResult(interp, "illegal search identifier \"", string, "\"", (char *) NULL); return TCL_ERROR; } id = strtoul(string+2, &end, 10); if ((end == (string+2)) || (*end != '-')) { goto syntax; } /* * Can't perform value check in this context, so place reference * to place in string to use for the check in the object instead. */ end++; offset = end - string; if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) { objPtr->typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &tclArraySearchType; objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)(((char *)NULL)+id); objPtr->internalRep.twoPtrValue.ptr2 = (VOID *)(((char *)NULL)+offset); return TCL_OK; } /* *---------------------------------------------------------------------- * * ParseSearchId -- * * This procedure translates from a tcl object to a pointer to an * active array search (if there is one that matches the string). * * Results: * The return value is a pointer to the array search indicated * by string, or NULL if there isn't one. If NULL is returned, * the interp's result contains an error message. * * Side effects: * The tcl object might have its internal type and representation * modified. * *---------------------------------------------------------------------- */ static ArraySearch * ParseSearchId(interp, varPtr, varName, handleObj) Tcl_Interp *interp; /* Interpreter containing variable. */ CONST Var *varPtr; /* Array variable search is for. */ CONST char *varName; /* Name of array variable that search is * supposed to be for. */ Tcl_Obj *handleObj; /* Object containing id of search. Must have * form "search-num-var" where "num" is a * decimal number and "var" is a variable * name. */ { register char *string; register size_t offset; int id; ArraySearch *searchPtr; /* * Parse the id. */ if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) { return NULL; } /* * Cast is safe, since always came from an int in the first place. */ id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) - ((char*)NULL)); string = Tcl_GetString(handleObj); offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) - ((char*)NULL)); /* * This test cannot be placed inside the Tcl_Obj machinery, since * it is dependent on the variable context. */ if (strcmp(string+offset, varName) != 0) { Tcl_AppendResult(interp, "search identifier \"", string, "\" isn't for variable \"", varName, "\"", (char *) NULL); return NULL; } /* * Search through the list of active searches on the interpreter * to see if the desired one exists. * * Note that we cannot store the searchPtr directly in the Tcl_Obj * as that would run into trouble when DeleteSearches() was called * so we must scan this list every time. */ for (searchPtr = varPtr->searchPtr; searchPtr != NULL; searchPtr = searchPtr->nextPtr) { if (searchPtr->id == id) { return searchPtr; } } Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", (char *) NULL); return NULL; } /* *---------------------------------------------------------------------- * * DeleteSearches -- * * This procedure is called to free up all of the searches * associated with an array variable. * * Results: * None. * * Side effects: * Memory is released to the storage allocator. * *---------------------------------------------------------------------- */ static void DeleteSearches(arrayVarPtr) register Var *arrayVarPtr; /* Variable whose searches are * to be deleted. */ { ArraySearch *searchPtr; while (arrayVarPtr->searchPtr != NULL) { searchPtr = arrayVarPtr->searchPtr; arrayVarPtr->searchPtr = searchPtr->nextPtr; ckfree((char *) searchPtr); } } /* *---------------------------------------------------------------------- * * TclDeleteNamespaceVars -- * * This procedure is called to recycle all the storage space * associated with a namespace's table of variables. * * Results: * None. * * Side effects: * Variables are deleted and trace procedures are invoked, if * any are declared. * *---------------------------------------------------------------------- */ void TclDeleteNamespaceVars(nsPtr) Namespace *nsPtr; { Tcl_HashTable *tablePtr = &nsPtr->varTable; Tcl_Interp *interp = nsPtr->interp; Interp *iPtr = (Interp *)interp; Tcl_HashSearch search; Tcl_HashEntry *hPtr; int flags = 0; Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); /* * Determine what flags to pass to the trace callback procedures. */ if (nsPtr == iPtr->globalNsPtr) { flags = TCL_GLOBAL_ONLY; } else if (nsPtr == currNsPtr) { flags = TCL_NAMESPACE_ONLY; } for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_FirstHashEntry(tablePtr, &search)) { register Var *varPtr = (Var *) Tcl_GetHashValue(hPtr); Tcl_Obj *objPtr = Tcl_NewObj(); varPtr->refCount++; /* Make sure we get to remove from hash */ Tcl_IncrRefCount(objPtr); Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr); UnsetVarStruct(varPtr, NULL, iPtr, Tcl_GetString(objPtr), NULL, flags); Tcl_DecrRefCount(objPtr); /* free no longer needed obj */ varPtr->refCount--; /* Remove the variable from the table and force it undefined * in case an unset trace brought it back from the dead */ Tcl_DeleteHashEntry(hPtr); varPtr->hPtr = NULL; TclSetVarUndefined(varPtr); TclSetVarScalar(varPtr); while (varPtr->tracePtr != NULL) { VarTrace *tracePtr = varPtr->tracePtr; varPtr->tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } CleanupVar(varPtr, NULL); } Tcl_DeleteHashTable(tablePtr); } /* *---------------------------------------------------------------------- * * TclDeleteVars -- * * This procedure is called to recycle all the storage space * associated with a table of variables. For this procedure * to work correctly, it must not be possible for any of the * variables in the table to be accessed from Tcl commands * (e.g. from trace procedures). * * Results: * None. * * Side effects: * Variables are deleted and trace procedures are invoked, if * any are declared. * *---------------------------------------------------------------------- */ void TclDeleteVars(iPtr, tablePtr) Interp *iPtr; /* Interpreter to which variables belong. */ Tcl_HashTable *tablePtr; /* Hash table containing variables to * delete. */ { Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; Tcl_HashEntry *hPtr; register Var *varPtr; Var *linkPtr; int flags; ActiveVarTrace *activePtr; Tcl_Obj *objPtr; Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); /* * Determine what flags to pass to the trace callback procedures. */ flags = TCL_TRACE_UNSETS; if (tablePtr == &iPtr->globalNsPtr->varTable) { flags |= TCL_GLOBAL_ONLY; } else if (tablePtr == &currNsPtr->varTable) { flags |= TCL_NAMESPACE_ONLY; } for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { varPtr = (Var *) Tcl_GetHashValue(hPtr); /* * For global/upvar variables referenced in procedures, decrement * the reference count on the variable referred to, and free * the referenced variable if it's no longer needed. Don't delete * the hash entry for the other variable if it's in the same table * as us: this will happen automatically later on. */ if (TclIsVarLink(varPtr)) { linkPtr = varPtr->value.linkPtr; linkPtr->refCount--; if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr) && (linkPtr->tracePtr == NULL) && (linkPtr->flags & VAR_IN_HASHTABLE)) { if (linkPtr->hPtr == NULL) { ckfree((char *) linkPtr); } else if (linkPtr->hPtr->tablePtr != tablePtr) { Tcl_DeleteHashEntry(linkPtr->hPtr); ckfree((char *) linkPtr); } } } /* * Invoke traces on the variable that is being deleted, then * free up the variable's space (no need to free the hash entry * here, unless we're dealing with a global variable: the * hash entries will be deleted automatically when the whole * table is deleted). Note that we give CallVarTraces the variable's * fully-qualified name so that any called trace procedures can * refer to these variables being deleted. */ if (varPtr->tracePtr != NULL) { objPtr = Tcl_NewObj(); Tcl_IncrRefCount(objPtr); /* until done with traces */ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr); CallVarTraces(iPtr, (Var *) NULL, varPtr, Tcl_GetString(objPtr), NULL, flags, /* leaveErrMsg */ 0); Tcl_DecrRefCount(objPtr); /* free no longer needed obj */ while (varPtr->tracePtr != NULL) { VarTrace *tracePtr = varPtr->tracePtr; varPtr->tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } } } if (TclIsVarArray(varPtr)) { DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr, flags); varPtr->value.tablePtr = NULL; } if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) { objPtr = varPtr->value.objPtr; TclDecrRefCount(objPtr); varPtr->value.objPtr = NULL; } varPtr->hPtr = NULL; varPtr->tracePtr = NULL; TclSetVarUndefined(varPtr); TclSetVarScalar(varPtr); /* * If the variable was a namespace variable, decrement its * reference count. We are in the process of destroying its * namespace so that namespace will no longer "refer" to the * variable. */ if (varPtr->flags & VAR_NAMESPACE_VAR) { varPtr->flags &= ~VAR_NAMESPACE_VAR; varPtr->refCount--; } /* * Recycle the variable's memory space if there aren't any upvar's * pointing to it. If there are upvars to this variable, then the * variable will get freed when the last upvar goes away. */ if (varPtr->refCount == 0) { ckfree((char *) varPtr); /* this Var must be VAR_IN_HASHTABLE */ } } Tcl_DeleteHashTable(tablePtr); } /* *---------------------------------------------------------------------- * * TclDeleteCompiledLocalVars -- * * This procedure is called to recycle storage space associated with * the compiler-allocated array of local variables in a procedure call * frame. This procedure resembles TclDeleteVars above except that each * variable is stored in a call frame and not a hash table. For this * procedure to work correctly, it must not be possible for any of the * variable in the table to be accessed from Tcl commands (e.g. from * trace procedures). * * Results: * None. * * Side effects: * Variables are deleted and trace procedures are invoked, if * any are declared. * *---------------------------------------------------------------------- */ void TclDeleteCompiledLocalVars(iPtr, framePtr) Interp *iPtr; /* Interpreter to which variables belong. */ CallFrame *framePtr; /* Procedure call frame containing * compiler-assigned local variables to * delete. */ { register Var *varPtr; int flags; /* Flags passed to trace procedures. */ Var *linkPtr; ActiveVarTrace *activePtr; int numLocals, i; flags = TCL_TRACE_UNSETS; numLocals = framePtr->numCompiledLocals; varPtr = framePtr->compiledLocals; for (i = 0; i < numLocals; i++) { /* * For global/upvar variables referenced in procedures, decrement * the reference count on the variable referred to, and free * the referenced variable if it's no longer needed. Don't delete * the hash entry for the other variable if it's in the same table * as us: this will happen automatically later on. */ if (TclIsVarLink(varPtr)) { linkPtr = varPtr->value.linkPtr; linkPtr->refCount--; if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr) && (linkPtr->tracePtr == NULL) && (linkPtr->flags & VAR_IN_HASHTABLE)) { if (linkPtr->hPtr == NULL) { ckfree((char *) linkPtr); } else { Tcl_DeleteHashEntry(linkPtr->hPtr); ckfree((char *) linkPtr); } } } /* * Invoke traces on the variable that is being deleted. Then delete * the variable's trace records. */ if (varPtr->tracePtr != NULL) { CallVarTraces(iPtr, (Var *) NULL, varPtr, varPtr->name, NULL, flags, /* leaveErrMsg */ 0); while (varPtr->tracePtr != NULL) { VarTrace *tracePtr = varPtr->tracePtr; varPtr->tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } } } /* * Now if the variable is an array, delete its element hash table. * Otherwise, if it's a scalar variable, decrement the ref count * of its value. */ if (TclIsVarArray(varPtr) && (varPtr->value.tablePtr != NULL)) { DeleteArray(iPtr, varPtr->name, varPtr, flags); } if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) { TclDecrRefCount(varPtr->value.objPtr); varPtr->value.objPtr = NULL; } varPtr->hPtr = NULL; varPtr->tracePtr = NULL; TclSetVarUndefined(varPtr); TclSetVarScalar(varPtr); varPtr++; } } /* *---------------------------------------------------------------------- * * DeleteArray -- * * This procedure is called to free up everything in an array * variable. It's the caller's responsibility to make sure * that the array is no longer accessible before this procedure * is called. * * Results: * None. * * Side effects: * All storage associated with varPtr's array elements is deleted * (including the array's hash table). Deletion trace procedures for * array elements are invoked, then deleted. Any pending traces for * array elements are also deleted. * *---------------------------------------------------------------------- */ static void DeleteArray(iPtr, arrayName, varPtr, flags) Interp *iPtr; /* Interpreter containing array. */ CONST char *arrayName; /* Name of array (used for trace * callbacks). */ Var *varPtr; /* Pointer to variable structure. */ int flags; /* Flags to pass to CallVarTraces: * TCL_TRACE_UNSETS and sometimes * TCL_NAMESPACE_ONLY, or * TCL_GLOBAL_ONLY. */ { Tcl_HashSearch search; register Tcl_HashEntry *hPtr; register Var *elPtr; ActiveVarTrace *activePtr; Tcl_Obj *objPtr; DeleteSearches(varPtr); for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { elPtr = (Var *) Tcl_GetHashValue(hPtr); if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) { objPtr = elPtr->value.objPtr; TclDecrRefCount(objPtr); elPtr->value.objPtr = NULL; } elPtr->hPtr = NULL; if (elPtr->tracePtr != NULL) { elPtr->flags &= ~VAR_TRACE_ACTIVE; CallVarTraces(iPtr, (Var *) NULL, elPtr, arrayName, Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags, /* leaveErrMsg */ 0); while (elPtr->tracePtr != NULL) { VarTrace *tracePtr = elPtr->tracePtr; elPtr->tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr,TCL_DYNAMIC); } for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == elPtr) { activePtr->nextTracePtr = NULL; } } } TclSetVarUndefined(elPtr); TclSetVarScalar(elPtr); /* * Even though array elements are not supposed to be namespace * variables, some combinations of [upvar] and [variable] may * create such beasts - see [Bug 604239]. This is necessary to * avoid leaking the corresponding Var struct, and is otherwise * harmless. */ if (elPtr->flags & VAR_NAMESPACE_VAR) { elPtr->flags &= ~VAR_NAMESPACE_VAR; elPtr->refCount--; } if (elPtr->refCount == 0) { ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */ } } Tcl_DeleteHashTable(varPtr->value.tablePtr); ckfree((char *) varPtr->value.tablePtr); } /* *---------------------------------------------------------------------- * * CleanupVar -- * * This procedure is called when it looks like it may be OK to free up * a variable's storage. If the variable is in a hashtable, its Var * structure and hash table entry will be freed along with those of its * containing array, if any. This procedure is called, for example, * when a trace on a variable deletes a variable. * * Results: * None. * * Side effects: * If the variable (or its containing array) really is dead and in a * hashtable, then its Var structure, and possibly its hash table * entry, is freed up. * *---------------------------------------------------------------------- */ static void CleanupVar(varPtr, arrayPtr) Var *varPtr; /* Pointer to variable that may be a * candidate for being expunged. */ Var *arrayPtr; /* Array that contains the variable, or * NULL if this variable isn't an array * element. */ { if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0) && (varPtr->tracePtr == NULL) && (varPtr->flags & VAR_IN_HASHTABLE)) { if (varPtr->hPtr != NULL) { Tcl_DeleteHashEntry(varPtr->hPtr); } ckfree((char *) varPtr); } if (arrayPtr != NULL) { if (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0) && (arrayPtr->tracePtr == NULL) && (arrayPtr->flags & VAR_IN_HASHTABLE)) { if (arrayPtr->hPtr != NULL) { Tcl_DeleteHashEntry(arrayPtr->hPtr); } ckfree((char *) arrayPtr); } } } /* *---------------------------------------------------------------------- * * VarErrMsg -- * * Generate a reasonable error message describing why a variable * operation failed. * * Results: * None. * * Side effects: * The interp's result is set to hold a message identifying the * variable given by part1 and part2 and describing why the * variable operation failed. * *---------------------------------------------------------------------- */ static void VarErrMsg(interp, part1, part2, operation, reason) Tcl_Interp *interp; /* Interpreter in which to record message. */ CONST char *part1; CONST char *part2; /* Variable's two-part name. */ CONST char *operation; /* String describing operation that failed, * e.g. "read", "set", or "unset". */ CONST char *reason; /* String describing why operation failed. */ { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't ", operation, " \"", part1, (char *) NULL); if (part2 != NULL) { Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL); } Tcl_AppendResult(interp, "\": ", reason, (char *) NULL); } /* *---------------------------------------------------------------------- * * TclTraceVarExists -- * * This is called from info exists. We need to trigger read * and/or array traces because they may end up creating a * variable that doesn't currently exist. * * Results: * A pointer to the Var structure, or NULL. * * Side effects: * May fill in error messages in the interp. * *---------------------------------------------------------------------- */ Var * TclVarTraceExists(interp, varName) Tcl_Interp *interp; /* The interpreter */ CONST char *varName; /* The variable name */ { Var *varPtr; Var *arrayPtr; /* * The choice of "create" flag values is delicate here, and * matches the semantics of GetVar. Things are still not perfect, * however, because if you do "info exists x" you get a varPtr * and therefore trigger traces. However, if you do * "info exists x(i)", then you only get a varPtr if x is already * known to be an array. Otherwise you get NULL, and no trace * is triggered. This matches Tcl 7.6 semantics. */ varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, "access", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } if ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { CallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL, TCL_TRACE_READS, /* leaveErrMsg */ 0); } /* * If the variable doesn't exist anymore and no-one's using * it, then free up the relevant structures and hash table entries. */ if (TclIsVarUndefined(varPtr)) { CleanupVar(varPtr, arrayPtr); return NULL; } return varPtr; } /* *---------------------------------------------------------------------- * * Internal functions for variable name object types -- * *---------------------------------------------------------------------- */ /* * localVarName - * * INTERNALREP DEFINITION: * twoPtrValue.ptr1 = pointer to the corresponding Proc * twoPtrValue.ptr2 = index into locals table */ static void FreeLocalVarName(objPtr) Tcl_Obj *objPtr; { register Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1; procPtr->refCount--; if (procPtr->refCount <= 0) { TclProcCleanupProc(procPtr); } } static void DupLocalVarName(srcPtr, dupPtr) Tcl_Obj *srcPtr; Tcl_Obj *dupPtr; { register Proc *procPtr = (Proc *) srcPtr->internalRep.twoPtrValue.ptr1; dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr; dupPtr->internalRep.twoPtrValue.ptr2 = srcPtr->internalRep.twoPtrValue.ptr2; procPtr->refCount++; dupPtr->typePtr = &tclLocalVarNameType; } static void UpdateLocalVarName(objPtr) Tcl_Obj *objPtr; { Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1; unsigned int index = (unsigned int) objPtr->internalRep.twoPtrValue.ptr2; CompiledLocal *localPtr = procPtr->firstLocalPtr; unsigned int nameLen; if (localPtr == NULL) { goto emptyName; } while (index--) { localPtr = localPtr->nextPtr; if (localPtr == NULL) { goto emptyName; } } nameLen = (unsigned int) localPtr->nameLength; objPtr->bytes = ckalloc(nameLen + 1); memcpy(objPtr->bytes, localPtr->name, nameLen + 1); objPtr->length = nameLen; return; emptyName: objPtr->bytes = ckalloc(1); *(objPtr->bytes) = '\0'; objPtr->length = 0; } /* * nsVarName - * * INTERNALREP DEFINITION: * twoPtrValue.ptr1: pointer to the namespace containing the * reference. * twoPtrValue.ptr2: pointer to the corresponding Var */ static void FreeNsVarName(objPtr) Tcl_Obj *objPtr; { register Var *varPtr = (Var *) objPtr->internalRep.twoPtrValue.ptr2; varPtr->refCount--; if (TclIsVarUndefined(varPtr) && (varPtr->refCount <= 0)) { if (TclIsVarLink(varPtr)) { Var *linkPtr = varPtr->value.linkPtr; linkPtr->refCount--; if (TclIsVarUndefined(linkPtr) && (linkPtr->refCount <= 0)) { CleanupVar(linkPtr, (Var *) NULL); } } CleanupVar(varPtr, NULL); } } static void DupNsVarName(srcPtr, dupPtr) Tcl_Obj *srcPtr; Tcl_Obj *dupPtr; { Namespace *nsPtr = (Namespace *) srcPtr->internalRep.twoPtrValue.ptr1; register Var *varPtr = (Var *) srcPtr->internalRep.twoPtrValue.ptr2; dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) nsPtr; dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr; varPtr->refCount++; dupPtr->typePtr = &tclNsVarNameType; } /* * parsedVarName - * * INTERNALREP DEFINITION: * twoPtrValue.ptr1 = pointer to the array name Tcl_Obj * (NULL if scalar) * twoPtrValue.ptr2 = pointer to the element name string * (owned by this Tcl_Obj), or NULL if * it is a scalar variable */ static void FreeParsedVarName(objPtr) Tcl_Obj *objPtr; { register Tcl_Obj *arrayPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1; register char *elem = (char *) objPtr->internalRep.twoPtrValue.ptr2; if (arrayPtr != NULL) { TclDecrRefCount(arrayPtr); ckfree(elem); } } static void DupParsedVarName(srcPtr, dupPtr) Tcl_Obj *srcPtr; Tcl_Obj *dupPtr; { register Tcl_Obj *arrayPtr = (Tcl_Obj *) srcPtr->internalRep.twoPtrValue.ptr1; register char *elem = (char *) srcPtr->internalRep.twoPtrValue.ptr2; char *elemCopy; unsigned int elemLen; if (arrayPtr != NULL) { Tcl_IncrRefCount(arrayPtr); elemLen = strlen(elem); elemCopy = ckalloc(elemLen+1); memcpy(elemCopy, elem, elemLen); *(elemCopy + elemLen) = '\0'; elem = elemCopy; } dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) arrayPtr; dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) elem; dupPtr->typePtr = &tclParsedVarNameType; } static void UpdateParsedVarName(objPtr) Tcl_Obj *objPtr; { Tcl_Obj *arrayPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1; char *part2 = (char *) objPtr->internalRep.twoPtrValue.ptr2; char *part1, *p; int len1, len2, totalLen; if (arrayPtr == NULL) { /* * This is a parsed scalar name: what is it * doing here? */ panic("ERROR: scalar parsedVarName without a string rep.\n"); } part1 = Tcl_GetStringFromObj(arrayPtr, &len1); len2 = strlen(part2); totalLen = len1 + len2 + 2; p = ckalloc((unsigned int) totalLen + 1); objPtr->bytes = p; objPtr->length = totalLen; memcpy(p, part1, (unsigned int) len1); p += len1; *p++ = '('; memcpy(p, part2, (unsigned int) len2); p += len2; *p++ = ')'; *p = '\0'; }