From a909d048fd109763623768ebf02db83a81275dd7 Mon Sep 17 00:00:00 2001 From: Guillaume Nargeot Date: Sun, 18 Oct 2009 23:45:33 +0900 Subject: [PATCH 001/109] Solution to Project Euler problem 81 --- extra/project-euler/081/081-tests.factor | 4 ++ extra/project-euler/081/081.factor | 75 ++++++++++++++++++++++ extra/project-euler/081/authors.txt | 1 + extra/project-euler/081/matrix.txt | 80 ++++++++++++++++++++++++ extra/project-euler/project-euler.factor | 13 ++-- 5 files changed, 167 insertions(+), 6 deletions(-) create mode 100644 extra/project-euler/081/081-tests.factor create mode 100644 extra/project-euler/081/081.factor create mode 100644 extra/project-euler/081/authors.txt create mode 100644 extra/project-euler/081/matrix.txt diff --git a/extra/project-euler/081/081-tests.factor b/extra/project-euler/081/081-tests.factor new file mode 100644 index 0000000000..aba9676f87 --- /dev/null +++ b/extra/project-euler/081/081-tests.factor @@ -0,0 +1,4 @@ +USING: project-euler.081 tools.test ; +IN: project-euler.081.tests + +[ 427337 ] [ euler081 ] unit-test diff --git a/extra/project-euler/081/081.factor b/extra/project-euler/081/081.factor new file mode 100644 index 0000000000..35bc1f1067 --- /dev/null +++ b/extra/project-euler/081/081.factor @@ -0,0 +1,75 @@ +! Copyright (c) 2009 Guillaume Nargeot. +! See http://factorcode.org/license.txt for BSD license. +USING: fry io.encodings.ascii io.files locals kernel math +math.order math.parser math.ranges sequences splitting +project-euler.common ; +IN: project-euler.081 + +! http://projecteuler.net/index.php?section=problems&id=081 + +! DESCRIPTION +! ----------- + +! In the 5 by 5 matrix below, the minimal path sum from the top +! left to the bottom right, by only moving to the right and +! down, is indicated in bold red and is equal to 2427. + +! 131 673 234 103 18 +! 201 96 342 965 150 +! 630 803 746 422 111 +! 537 699 497 121 956 +! 805 732 524 37 331 + +! Find the minimal path sum, in matrix.txt (right click and +! 'Save Link/Target As...'), a 31K text file containing a 80 by +! 80 matrix, from the top left to the bottom right by only +! moving right and down. + + +! SOLUTION +! -------- + +! Shortest path problem solved using Dijkstra algorithm. + +number ] map ] map ; + +: get-matrix ( x y matrix -- n ) nth nth ; + +: change-matrix ( x y matrix quot -- ) + [ nth ] dip change-nth ; inline + +:: minimal-path-sum-to ( x y matrix -- n ) + x y + zero? [ 0 ] [ + x zero? [ 0 y 1 - matrix get-matrix + ] [ + y zero? [ + x 1 - 0 matrix get-matrix + ] [ + x 1 - y matrix get-matrix + x y 1 - matrix get-matrix + min + ] if + ] if + ] if ; + +: update-minimal-path-sum ( x y matrix -- ) + 3dup minimal-path-sum-to '[ _ + ] change-matrix ; + +: (euler081) ( matrix -- n ) + dup first length [0,b) dup cartesian-product + [ first2 pick update-minimal-path-sum ] each + last last ; + +PRIVATE> + +: euler081 ( -- answer ) + source-081 (euler081) ; + +! [ euler081 ] 100 ave-time +! 9 ms ave run time - 0.39 SD (100 trials) + +SOLUTION: euler081 diff --git a/extra/project-euler/081/authors.txt b/extra/project-euler/081/authors.txt new file mode 100644 index 0000000000..6eb6698c00 --- /dev/null +++ b/extra/project-euler/081/authors.txt @@ -0,0 +1 @@ +Guillaume Nargeot diff --git a/extra/project-euler/081/matrix.txt b/extra/project-euler/081/matrix.txt new file mode 100644 index 0000000000..1e9e6cde0f --- /dev/null +++ b/extra/project-euler/081/matrix.txt @@ -0,0 +1,80 @@ +4445,2697,5115,718,2209,2212,654,4348,3079,6821,7668,3276,8874,4190,3785,2752,9473,7817,9137,496,7338,3434,7152,4355,4552,7917,7827,2460,2350,691,3514,5880,3145,7633,7199,3783,5066,7487,3285,1084,8985,760,872,8609,8051,1134,9536,5750,9716,9371,7619,5617,275,9721,2997,2698,1887,8825,6372,3014,2113,7122,7050,6775,5948,2758,1219,3539,348,7989,2735,9862,1263,8089,6401,9462,3168,2758,3748,5870 +1096,20,1318,7586,5167,2642,1443,5741,7621,7030,5526,4244,2348,4641,9827,2448,6918,5883,3737,300,7116,6531,567,5997,3971,6623,820,6148,3287,1874,7981,8424,7672,7575,6797,6717,1078,5008,4051,8795,5820,346,1851,6463,2117,6058,3407,8211,117,4822,1317,4377,4434,5925,8341,4800,1175,4173,690,8978,7470,1295,3799,8724,3509,9849,618,3320,7068,9633,2384,7175,544,6583,1908,9983,481,4187,9353,9377 +9607,7385,521,6084,1364,8983,7623,1585,6935,8551,2574,8267,4781,3834,2764,2084,2669,4656,9343,7709,2203,9328,8004,6192,5856,3555,2260,5118,6504,1839,9227,1259,9451,1388,7909,5733,6968,8519,9973,1663,5315,7571,3035,4325,4283,2304,6438,3815,9213,9806,9536,196,5542,6907,2475,1159,5820,9075,9470,2179,9248,1828,4592,9167,3713,4640,47,3637,309,7344,6955,346,378,9044,8635,7466,5036,9515,6385,9230 +7206,3114,7760,1094,6150,5182,7358,7387,4497,955,101,1478,7777,6966,7010,8417,6453,4955,3496,107,449,8271,131,2948,6185,784,5937,8001,6104,8282,4165,3642,710,2390,575,715,3089,6964,4217,192,5949,7006,715,3328,1152,66,8044,4319,1735,146,4818,5456,6451,4113,1063,4781,6799,602,1504,6245,6550,1417,1343,2363,3785,5448,4545,9371,5420,5068,4613,4882,4241,5043,7873,8042,8434,3939,9256,2187 +3620,8024,577,9997,7377,7682,1314,1158,6282,6310,1896,2509,5436,1732,9480,706,496,101,6232,7375,2207,2306,110,6772,3433,2878,8140,5933,8688,1399,2210,7332,6172,6403,7333,4044,2291,1790,2446,7390,8698,5723,3678,7104,1825,2040,140,3982,4905,4160,2200,5041,2512,1488,2268,1175,7588,8321,8078,7312,977,5257,8465,5068,3453,3096,1651,7906,253,9250,6021,8791,8109,6651,3412,345,4778,5152,4883,7505 +1074,5438,9008,2679,5397,5429,2652,3403,770,9188,4248,2493,4361,8327,9587,707,9525,5913,93,1899,328,2876,3604,673,8576,6908,7659,2544,3359,3883,5273,6587,3065,1749,3223,604,9925,6941,2823,8767,7039,3290,3214,1787,7904,3421,7137,9560,8451,2669,9219,6332,1576,5477,6755,8348,4164,4307,2984,4012,6629,1044,2874,6541,4942,903,1404,9125,5160,8836,4345,2581,460,8438,1538,5507,668,3352,2678,6942 +4295,1176,5596,1521,3061,9868,7037,7129,8933,6659,5947,5063,3653,9447,9245,2679,767,714,116,8558,163,3927,8779,158,5093,2447,5782,3967,1716,931,7772,8164,1117,9244,5783,7776,3846,8862,6014,2330,6947,1777,3112,6008,3491,1906,5952,314,4602,8994,5919,9214,3995,5026,7688,6809,5003,3128,2509,7477,110,8971,3982,8539,2980,4689,6343,5411,2992,5270,5247,9260,2269,7474,1042,7162,5206,1232,4556,4757 +510,3556,5377,1406,5721,4946,2635,7847,4251,8293,8281,6351,4912,287,2870,3380,3948,5322,3840,4738,9563,1906,6298,3234,8959,1562,6297,8835,7861,239,6618,1322,2553,2213,5053,5446,4402,6500,5182,8585,6900,5756,9661,903,5186,7687,5998,7997,8081,8955,4835,6069,2621,1581,732,9564,1082,1853,5442,1342,520,1737,3703,5321,4793,2776,1508,1647,9101,2499,6891,4336,7012,3329,3212,1442,9993,3988,4930,7706 +9444,3401,5891,9716,1228,7107,109,3563,2700,6161,5039,4992,2242,8541,7372,2067,1294,3058,1306,320,8881,5756,9326,411,8650,8824,5495,8282,8397,2000,1228,7817,2099,6473,3571,5994,4447,1299,5991,543,7874,2297,1651,101,2093,3463,9189,6872,6118,872,1008,1779,2805,9084,4048,2123,5877,55,3075,1737,9459,4535,6453,3644,108,5982,4437,5213,1340,6967,9943,5815,669,8074,1838,6979,9132,9315,715,5048 +3327,4030,7177,6336,9933,5296,2621,4785,2755,4832,2512,2118,2244,4407,2170,499,7532,9742,5051,7687,970,6924,3527,4694,5145,1306,2165,5940,2425,8910,3513,1909,6983,346,6377,4304,9330,7203,6605,3709,3346,970,369,9737,5811,4427,9939,3693,8436,5566,1977,3728,2399,3985,8303,2492,5366,9802,9193,7296,1033,5060,9144,2766,1151,7629,5169,5995,58,7619,7565,4208,1713,6279,3209,4908,9224,7409,1325,8540 +6882,1265,1775,3648,4690,959,5837,4520,5394,1378,9485,1360,4018,578,9174,2932,9890,3696,116,1723,1178,9355,7063,1594,1918,8574,7594,7942,1547,6166,7888,354,6932,4651,1010,7759,6905,661,7689,6092,9292,3845,9605,8443,443,8275,5163,7720,7265,6356,7779,1798,1754,5225,6661,1180,8024,5666,88,9153,1840,3508,1193,4445,2648,3538,6243,6375,8107,5902,5423,2520,1122,5015,6113,8859,9370,966,8673,2442 +7338,3423,4723,6533,848,8041,7921,8277,4094,5368,7252,8852,9166,2250,2801,6125,8093,5738,4038,9808,7359,9494,601,9116,4946,2702,5573,2921,9862,1462,1269,2410,4171,2709,7508,6241,7522,615,2407,8200,4189,5492,5649,7353,2590,5203,4274,710,7329,9063,956,8371,3722,4253,4785,1194,4828,4717,4548,940,983,2575,4511,2938,1827,2027,2700,1236,841,5760,1680,6260,2373,3851,1841,4968,1172,5179,7175,3509 +4420,1327,3560,2376,6260,2988,9537,4064,4829,8872,9598,3228,1792,7118,9962,9336,4368,9189,6857,1829,9863,6287,7303,7769,2707,8257,2391,2009,3975,4993,3068,9835,3427,341,8412,2134,4034,8511,6421,3041,9012,2983,7289,100,1355,7904,9186,6920,5856,2008,6545,8331,3655,5011,839,8041,9255,6524,3862,8788,62,7455,3513,5003,8413,3918,2076,7960,6108,3638,6999,3436,1441,4858,4181,1866,8731,7745,3744,1000 +356,8296,8325,1058,1277,4743,3850,2388,6079,6462,2815,5620,8495,5378,75,4324,3441,9870,1113,165,1544,1179,2834,562,6176,2313,6836,8839,2986,9454,5199,6888,1927,5866,8760,320,1792,8296,7898,6121,7241,5886,5814,2815,8336,1576,4314,3109,2572,6011,2086,9061,9403,3947,5487,9731,7281,3159,1819,1334,3181,5844,5114,9898,4634,2531,4412,6430,4262,8482,4546,4555,6804,2607,9421,686,8649,8860,7794,6672 +9870,152,1558,4963,8750,4754,6521,6256,8818,5208,5691,9659,8377,9725,5050,5343,2539,6101,1844,9700,7750,8114,5357,3001,8830,4438,199,9545,8496,43,2078,327,9397,106,6090,8181,8646,6414,7499,5450,4850,6273,5014,4131,7639,3913,6571,8534,9703,4391,7618,445,1320,5,1894,6771,7383,9191,4708,9706,6939,7937,8726,9382,5216,3685,2247,9029,8154,1738,9984,2626,9438,4167,6351,5060,29,1218,1239,4785 +192,5213,8297,8974,4032,6966,5717,1179,6523,4679,9513,1481,3041,5355,9303,9154,1389,8702,6589,7818,6336,3539,5538,3094,6646,6702,6266,2759,4608,4452,617,9406,8064,6379,444,5602,4950,1810,8391,1536,316,8714,1178,5182,5863,5110,5372,4954,1978,2971,5680,4863,2255,4630,5723,2168,538,1692,1319,7540,440,6430,6266,7712,7385,5702,620,641,3136,7350,1478,3155,2820,9109,6261,1122,4470,14,8493,2095 +1046,4301,6082,474,4974,7822,2102,5161,5172,6946,8074,9716,6586,9962,9749,5015,2217,995,5388,4402,7652,6399,6539,1349,8101,3677,1328,9612,7922,2879,231,5887,2655,508,4357,4964,3554,5930,6236,7384,4614,280,3093,9600,2110,7863,2631,6626,6620,68,1311,7198,7561,1768,5139,1431,221,230,2940,968,5283,6517,2146,1646,869,9402,7068,8645,7058,1765,9690,4152,2926,9504,2939,7504,6074,2944,6470,7859 +4659,736,4951,9344,1927,6271,8837,8711,3241,6579,7660,5499,5616,3743,5801,4682,9748,8796,779,1833,4549,8138,4026,775,4170,2432,4174,3741,7540,8017,2833,4027,396,811,2871,1150,9809,2719,9199,8504,1224,540,2051,3519,7982,7367,2761,308,3358,6505,2050,4836,5090,7864,805,2566,2409,6876,3361,8622,5572,5895,3280,441,7893,8105,1634,2929,274,3926,7786,6123,8233,9921,2674,5340,1445,203,4585,3837 +5759,338,7444,7968,7742,3755,1591,4839,1705,650,7061,2461,9230,9391,9373,2413,1213,431,7801,4994,2380,2703,6161,6878,8331,2538,6093,1275,5065,5062,2839,582,1014,8109,3525,1544,1569,8622,7944,2905,6120,1564,1839,5570,7579,1318,2677,5257,4418,5601,7935,7656,5192,1864,5886,6083,5580,6202,8869,1636,7907,4759,9082,5854,3185,7631,6854,5872,5632,5280,1431,2077,9717,7431,4256,8261,9680,4487,4752,4286 +1571,1428,8599,1230,7772,4221,8523,9049,4042,8726,7567,6736,9033,2104,4879,4967,6334,6716,3994,1269,8995,6539,3610,7667,6560,6065,874,848,4597,1711,7161,4811,6734,5723,6356,6026,9183,2586,5636,1092,7779,7923,8747,6887,7505,9909,1792,3233,4526,3176,1508,8043,720,5212,6046,4988,709,5277,8256,3642,1391,5803,1468,2145,3970,6301,7767,2359,8487,9771,8785,7520,856,1605,8972,2402,2386,991,1383,5963 +1822,4824,5957,6511,9868,4113,301,9353,6228,2881,2966,6956,9124,9574,9233,1601,7340,973,9396,540,4747,8590,9535,3650,7333,7583,4806,3593,2738,8157,5215,8472,2284,9473,3906,6982,5505,6053,7936,6074,7179,6688,1564,1103,6860,5839,2022,8490,910,7551,7805,881,7024,1855,9448,4790,1274,3672,2810,774,7623,4223,4850,6071,9975,4935,1915,9771,6690,3846,517,463,7624,4511,614,6394,3661,7409,1395,8127 +8738,3850,9555,3695,4383,2378,87,6256,6740,7682,9546,4255,6105,2000,1851,4073,8957,9022,6547,5189,2487,303,9602,7833,1628,4163,6678,3144,8589,7096,8913,5823,4890,7679,1212,9294,5884,2972,3012,3359,7794,7428,1579,4350,7246,4301,7779,7790,3294,9547,4367,3549,1958,8237,6758,3497,3250,3456,6318,1663,708,7714,6143,6890,3428,6853,9334,7992,591,6449,9786,1412,8500,722,5468,1371,108,3939,4199,2535 +7047,4323,1934,5163,4166,461,3544,2767,6554,203,6098,2265,9078,2075,4644,6641,8412,9183,487,101,7566,5622,1975,5726,2920,5374,7779,5631,3753,3725,2672,3621,4280,1162,5812,345,8173,9785,1525,955,5603,2215,2580,5261,2765,2990,5979,389,3907,2484,1232,5933,5871,3304,1138,1616,5114,9199,5072,7442,7245,6472,4760,6359,9053,7876,2564,9404,3043,9026,2261,3374,4460,7306,2326,966,828,3274,1712,3446 +3975,4565,8131,5800,4570,2306,8838,4392,9147,11,3911,7118,9645,4994,2028,6062,5431,2279,8752,2658,7836,994,7316,5336,7185,3289,1898,9689,2331,5737,3403,1124,2679,3241,7748,16,2724,5441,6640,9368,9081,5618,858,4969,17,2103,6035,8043,7475,2181,939,415,1617,8500,8253,2155,7843,7974,7859,1746,6336,3193,2617,8736,4079,6324,6645,8891,9396,5522,6103,1857,8979,3835,2475,1310,7422,610,8345,7615 +9248,5397,5686,2988,3446,4359,6634,9141,497,9176,6773,7448,1907,8454,916,1596,2241,1626,1384,2741,3649,5362,8791,7170,2903,2475,5325,6451,924,3328,522,90,4813,9737,9557,691,2388,1383,4021,1609,9206,4707,5200,7107,8104,4333,9860,5013,1224,6959,8527,1877,4545,7772,6268,621,4915,9349,5970,706,9583,3071,4127,780,8231,3017,9114,3836,7503,2383,1977,4870,8035,2379,9704,1037,3992,3642,1016,4303 +5093,138,4639,6609,1146,5565,95,7521,9077,2272,974,4388,2465,2650,722,4998,3567,3047,921,2736,7855,173,2065,4238,1048,5,6847,9548,8632,9194,5942,4777,7910,8971,6279,7253,2516,1555,1833,3184,9453,9053,6897,7808,8629,4877,1871,8055,4881,7639,1537,7701,2508,7564,5845,5023,2304,5396,3193,2955,1088,3801,6203,1748,3737,1276,13,4120,7715,8552,3047,2921,106,7508,304,1280,7140,2567,9135,5266 +6237,4607,7527,9047,522,7371,4883,2540,5867,6366,5301,1570,421,276,3361,527,6637,4861,2401,7522,5808,9371,5298,2045,5096,5447,7755,5115,7060,8529,4078,1943,1697,1764,5453,7085,960,2405,739,2100,5800,728,9737,5704,5693,1431,8979,6428,673,7540,6,7773,5857,6823,150,5869,8486,684,5816,9626,7451,5579,8260,3397,5322,6920,1879,2127,2884,5478,4977,9016,6165,6292,3062,5671,5968,78,4619,4763 +9905,7127,9390,5185,6923,3721,9164,9705,4341,1031,1046,5127,7376,6528,3248,4941,1178,7889,3364,4486,5358,9402,9158,8600,1025,874,1839,1783,309,9030,1843,845,8398,1433,7118,70,8071,2877,3904,8866,6722,4299,10,1929,5897,4188,600,1889,3325,2485,6473,4474,7444,6992,4846,6166,4441,2283,2629,4352,7775,1101,2214,9985,215,8270,9750,2740,8361,7103,5930,8664,9690,8302,9267,344,2077,1372,1880,9550 +5825,8517,7769,2405,8204,1060,3603,7025,478,8334,1997,3692,7433,9101,7294,7498,9415,5452,3850,3508,6857,9213,6807,4412,7310,854,5384,686,4978,892,8651,3241,2743,3801,3813,8588,6701,4416,6990,6490,3197,6838,6503,114,8343,5844,8646,8694,65,791,5979,2687,2621,2019,8097,1423,3644,9764,4921,3266,3662,5561,2476,8271,8138,6147,1168,3340,1998,9874,6572,9873,6659,5609,2711,3931,9567,4143,7833,8887 +6223,2099,2700,589,4716,8333,1362,5007,2753,2848,4441,8397,7192,8191,4916,9955,6076,3370,6396,6971,3156,248,3911,2488,4930,2458,7183,5455,170,6809,6417,3390,1956,7188,577,7526,2203,968,8164,479,8699,7915,507,6393,4632,1597,7534,3604,618,3280,6061,9793,9238,8347,568,9645,2070,5198,6482,5000,9212,6655,5961,7513,1323,3872,6170,3812,4146,2736,67,3151,5548,2781,9679,7564,5043,8587,1893,4531 +5826,3690,6724,2121,9308,6986,8106,6659,2142,1642,7170,2877,5757,6494,8026,6571,8387,9961,6043,9758,9607,6450,8631,8334,7359,5256,8523,2225,7487,1977,9555,8048,5763,2414,4948,4265,2427,8978,8088,8841,9208,9601,5810,9398,8866,9138,4176,5875,7212,3272,6759,5678,7649,4922,5422,1343,8197,3154,3600,687,1028,4579,2084,9467,4492,7262,7296,6538,7657,7134,2077,1505,7332,6890,8964,4879,7603,7400,5973,739 +1861,1613,4879,1884,7334,966,2000,7489,2123,4287,1472,3263,4726,9203,1040,4103,6075,6049,330,9253,4062,4268,1635,9960,577,1320,3195,9628,1030,4092,4979,6474,6393,2799,6967,8687,7724,7392,9927,2085,3200,6466,8702,265,7646,8665,7986,7266,4574,6587,612,2724,704,3191,8323,9523,3002,704,5064,3960,8209,2027,2758,8393,4875,4641,9584,6401,7883,7014,768,443,5490,7506,1852,2005,8850,5776,4487,4269 +4052,6687,4705,7260,6645,6715,3706,5504,8672,2853,1136,8187,8203,4016,871,1809,1366,4952,9294,5339,6872,2645,6083,7874,3056,5218,7485,8796,7401,3348,2103,426,8572,4163,9171,3176,948,7654,9344,3217,1650,5580,7971,2622,76,2874,880,2034,9929,1546,2659,5811,3754,7096,7436,9694,9960,7415,2164,953,2360,4194,2397,1047,2196,6827,575,784,2675,8821,6802,7972,5996,6699,2134,7577,2887,1412,4349,4380 +4629,2234,6240,8132,7592,3181,6389,1214,266,1910,2451,8784,2790,1127,6932,1447,8986,2492,5476,397,889,3027,7641,5083,5776,4022,185,3364,5701,2442,2840,4160,9525,4828,6602,2614,7447,3711,4505,7745,8034,6514,4907,2605,7753,6958,7270,6936,3006,8968,439,2326,4652,3085,3425,9863,5049,5361,8688,297,7580,8777,7916,6687,8683,7141,306,9569,2384,1500,3346,4601,7329,9040,6097,2727,6314,4501,4974,2829 +8316,4072,2025,6884,3027,1808,5714,7624,7880,8528,4205,8686,7587,3230,1139,7273,6163,6986,3914,9309,1464,9359,4474,7095,2212,7302,2583,9462,7532,6567,1606,4436,8981,5612,6796,4385,5076,2007,6072,3678,8331,1338,3299,8845,4783,8613,4071,1232,6028,2176,3990,2148,3748,103,9453,538,6745,9110,926,3125,473,5970,8728,7072,9062,1404,1317,5139,9862,6496,6062,3338,464,1600,2532,1088,8232,7739,8274,3873 +2341,523,7096,8397,8301,6541,9844,244,4993,2280,7689,4025,4196,5522,7904,6048,2623,9258,2149,9461,6448,8087,7245,1917,8340,7127,8466,5725,6996,3421,5313,512,9164,9837,9794,8369,4185,1488,7210,1524,1016,4620,9435,2478,7765,8035,697,6677,3724,6988,5853,7662,3895,9593,1185,4727,6025,5734,7665,3070,138,8469,6748,6459,561,7935,8646,2378,462,7755,3115,9690,8877,3946,2728,8793,244,6323,8666,4271 +6430,2406,8994,56,1267,3826,9443,7079,7579,5232,6691,3435,6718,5698,4144,7028,592,2627,217,734,6194,8156,9118,58,2640,8069,4127,3285,694,3197,3377,4143,4802,3324,8134,6953,7625,3598,3584,4289,7065,3434,2106,7132,5802,7920,9060,7531,3321,1725,1067,3751,444,5503,6785,7937,6365,4803,198,6266,8177,1470,6390,1606,2904,7555,9834,8667,2033,1723,5167,1666,8546,8152,473,4475,6451,7947,3062,3281 +2810,3042,7759,1741,2275,2609,7676,8640,4117,1958,7500,8048,1757,3954,9270,1971,4796,2912,660,5511,3553,1012,5757,4525,6084,7198,8352,5775,7726,8591,7710,9589,3122,4392,6856,5016,749,2285,3356,7482,9956,7348,2599,8944,495,3462,3578,551,4543,7207,7169,7796,1247,4278,6916,8176,3742,8385,2310,1345,8692,2667,4568,1770,8319,3585,4920,3890,4928,7343,5385,9772,7947,8786,2056,9266,3454,2807,877,2660 +6206,8252,5928,5837,4177,4333,207,7934,5581,9526,8906,1498,8411,2984,5198,5134,2464,8435,8514,8674,3876,599,5327,826,2152,4084,2433,9327,9697,4800,2728,3608,3849,3861,3498,9943,1407,3991,7191,9110,5666,8434,4704,6545,5944,2357,1163,4995,9619,6754,4200,9682,6654,4862,4744,5953,6632,1054,293,9439,8286,2255,696,8709,1533,1844,6441,430,1999,6063,9431,7018,8057,2920,6266,6799,356,3597,4024,6665 +3847,6356,8541,7225,2325,2946,5199,469,5450,7508,2197,9915,8284,7983,6341,3276,3321,16,1321,7608,5015,3362,8491,6968,6818,797,156,2575,706,9516,5344,5457,9210,5051,8099,1617,9951,7663,8253,9683,2670,1261,4710,1068,8753,4799,1228,2621,3275,6188,4699,1791,9518,8701,5932,4275,6011,9877,2933,4182,6059,2930,6687,6682,9771,654,9437,3169,8596,1827,5471,8909,2352,123,4394,3208,8756,5513,6917,2056 +5458,8173,3138,3290,4570,4892,3317,4251,9699,7973,1163,1935,5477,6648,9614,5655,9592,975,9118,2194,7322,8248,8413,3462,8560,1907,7810,6650,7355,2939,4973,6894,3933,3784,3200,2419,9234,4747,2208,2207,1945,2899,1407,6145,8023,3484,5688,7686,2737,3828,3704,9004,5190,9740,8643,8650,5358,4426,1522,1707,3613,9887,6956,2447,2762,833,1449,9489,2573,1080,4167,3456,6809,2466,227,7125,2759,6250,6472,8089 +3266,7025,9756,3914,1265,9116,7723,9788,6805,5493,2092,8688,6592,9173,4431,4028,6007,7131,4446,4815,3648,6701,759,3312,8355,4485,4187,5188,8746,7759,3528,2177,5243,8379,3838,7233,4607,9187,7216,2190,6967,2920,6082,7910,5354,3609,8958,6949,7731,494,8753,8707,1523,4426,3543,7085,647,6771,9847,646,5049,824,8417,5260,2730,5702,2513,9275,4279,2767,8684,1165,9903,4518,55,9682,8963,6005,2102,6523 +1998,8731,936,1479,5259,7064,4085,91,7745,7136,3773,3810,730,8255,2705,2653,9790,6807,2342,355,9344,2668,3690,2028,9679,8102,574,4318,6481,9175,5423,8062,2867,9657,7553,3442,3920,7430,3945,7639,3714,3392,2525,4995,4850,2867,7951,9667,486,9506,9888,781,8866,1702,3795,90,356,1483,4200,2131,6969,5931,486,6880,4404,1084,5169,4910,6567,8335,4686,5043,2614,3352,2667,4513,6472,7471,5720,1616 +8878,1613,1716,868,1906,2681,564,665,5995,2474,7496,3432,9491,9087,8850,8287,669,823,347,6194,2264,2592,7871,7616,8508,4827,760,2676,4660,4881,7572,3811,9032,939,4384,929,7525,8419,5556,9063,662,8887,7026,8534,3111,1454,2082,7598,5726,6687,9647,7608,73,3014,5063,670,5461,5631,3367,9796,8475,7908,5073,1565,5008,5295,4457,1274,4788,1728,338,600,8415,8535,9351,7750,6887,5845,1741,125 +3637,6489,9634,9464,9055,2413,7824,9517,7532,3577,7050,6186,6980,9365,9782,191,870,2497,8498,2218,2757,5420,6468,586,3320,9230,1034,1393,9886,5072,9391,1178,8464,8042,6869,2075,8275,3601,7715,9470,8786,6475,8373,2159,9237,2066,3264,5000,679,355,3069,4073,494,2308,5512,4334,9438,8786,8637,9774,1169,1949,6594,6072,4270,9158,7916,5752,6794,9391,6301,5842,3285,2141,3898,8027,4310,8821,7079,1307 +8497,6681,4732,7151,7060,5204,9030,7157,833,5014,8723,3207,9796,9286,4913,119,5118,7650,9335,809,3675,2597,5144,3945,5090,8384,187,4102,1260,2445,2792,4422,8389,9290,50,1765,1521,6921,8586,4368,1565,5727,7855,2003,4834,9897,5911,8630,5070,1330,7692,7557,7980,6028,5805,9090,8265,3019,3802,698,9149,5748,1965,9658,4417,5994,5584,8226,2937,272,5743,1278,5698,8736,2595,6475,5342,6596,1149,6920 +8188,8009,9546,6310,8772,2500,9846,6592,6872,3857,1307,8125,7042,1544,6159,2330,643,4604,7899,6848,371,8067,2062,3200,7295,1857,9505,6936,384,2193,2190,301,8535,5503,1462,7380,5114,4824,8833,1763,4974,8711,9262,6698,3999,2645,6937,7747,1128,2933,3556,7943,2885,3122,9105,5447,418,2899,5148,3699,9021,9501,597,4084,175,1621,1,1079,6067,5812,4326,9914,6633,5394,4233,6728,9084,1864,5863,1225 +9935,8793,9117,1825,9542,8246,8437,3331,9128,9675,6086,7075,319,1334,7932,3583,7167,4178,1726,7720,695,8277,7887,6359,5912,1719,2780,8529,1359,2013,4498,8072,1129,9998,1147,8804,9405,6255,1619,2165,7491,1,8882,7378,3337,503,5758,4109,3577,985,3200,7615,8058,5032,1080,6410,6873,5496,1466,2412,9885,5904,4406,3605,8770,4361,6205,9193,1537,9959,214,7260,9566,1685,100,4920,7138,9819,5637,976 +3466,9854,985,1078,7222,8888,5466,5379,3578,4540,6853,8690,3728,6351,7147,3134,6921,9692,857,3307,4998,2172,5783,3931,9417,2541,6299,13,787,2099,9131,9494,896,8600,1643,8419,7248,2660,2609,8579,91,6663,5506,7675,1947,6165,4286,1972,9645,3805,1663,1456,8853,5705,9889,7489,1107,383,4044,2969,3343,152,7805,4980,9929,5033,1737,9953,7197,9158,4071,1324,473,9676,3984,9680,3606,8160,7384,5432 +1005,4512,5186,3953,2164,3372,4097,3247,8697,3022,9896,4101,3871,6791,3219,2742,4630,6967,7829,5991,6134,1197,1414,8923,8787,1394,8852,5019,7768,5147,8004,8825,5062,9625,7988,1110,3992,7984,9966,6516,6251,8270,421,3723,1432,4830,6935,8095,9059,2214,6483,6846,3120,1587,6201,6691,9096,9627,6671,4002,3495,9939,7708,7465,5879,6959,6634,3241,3401,2355,9061,2611,7830,3941,2177,2146,5089,7079,519,6351 +7280,8586,4261,2831,7217,3141,9994,9940,5462,2189,4005,6942,9848,5350,8060,6665,7519,4324,7684,657,9453,9296,2944,6843,7499,7847,1728,9681,3906,6353,5529,2822,3355,3897,7724,4257,7489,8672,4356,3983,1948,6892,7415,4153,5893,4190,621,1736,4045,9532,7701,3671,1211,1622,3176,4524,9317,7800,5638,6644,6943,5463,3531,2821,1347,5958,3436,1438,2999,994,850,4131,2616,1549,3465,5946,690,9273,6954,7991 +9517,399,3249,2596,7736,2142,1322,968,7350,1614,468,3346,3265,7222,6086,1661,5317,2582,7959,4685,2807,2917,1037,5698,1529,3972,8716,2634,3301,3412,8621,743,8001,4734,888,7744,8092,3671,8941,1487,5658,7099,2781,99,1932,4443,4756,4652,9328,1581,7855,4312,5976,7255,6480,3996,2748,1973,9731,4530,2790,9417,7186,5303,3557,351,7182,9428,1342,9020,7599,1392,8304,2070,9138,7215,2008,9937,1106,7110 +7444,769,9688,632,1571,6820,8743,4338,337,3366,3073,1946,8219,104,4210,6986,249,5061,8693,7960,6546,1004,8857,5997,9352,4338,6105,5008,2556,6518,6694,4345,3727,7956,20,3954,8652,4424,9387,2035,8358,5962,5304,5194,8650,8282,1256,1103,2138,6679,1985,3653,2770,2433,4278,615,2863,1715,242,3790,2636,6998,3088,1671,2239,957,5411,4595,6282,2881,9974,2401,875,7574,2987,4587,3147,6766,9885,2965 +3287,3016,3619,6818,9073,6120,5423,557,2900,2015,8111,3873,1314,4189,1846,4399,7041,7583,2427,2864,3525,5002,2069,748,1948,6015,2684,438,770,8367,1663,7887,7759,1885,157,7770,4520,4878,3857,1137,3525,3050,6276,5569,7649,904,4533,7843,2199,5648,7628,9075,9441,3600,7231,2388,5640,9096,958,3058,584,5899,8150,1181,9616,1098,8162,6819,8171,1519,1140,7665,8801,2632,1299,9192,707,9955,2710,7314 +1772,2963,7578,3541,3095,1488,7026,2634,6015,4633,4370,2762,1650,2174,909,8158,2922,8467,4198,4280,9092,8856,8835,5457,2790,8574,9742,5054,9547,4156,7940,8126,9824,7340,8840,6574,3547,1477,3014,6798,7134,435,9484,9859,3031,4,1502,4133,1738,1807,4825,463,6343,9701,8506,9822,9555,8688,8168,3467,3234,6318,1787,5591,419,6593,7974,8486,9861,6381,6758,194,3061,4315,2863,4665,3789,2201,1492,4416 +126,8927,6608,5682,8986,6867,1715,6076,3159,788,3140,4744,830,9253,5812,5021,7616,8534,1546,9590,1101,9012,9821,8132,7857,4086,1069,7491,2988,1579,2442,4321,2149,7642,6108,250,6086,3167,24,9528,7663,2685,1220,9196,1397,5776,1577,1730,5481,977,6115,199,6326,2183,3767,5928,5586,7561,663,8649,9688,949,5913,9160,1870,5764,9887,4477,6703,1413,4995,5494,7131,2192,8969,7138,3997,8697,646,1028 +8074,1731,8245,624,4601,8706,155,8891,309,2552,8208,8452,2954,3124,3469,4246,3352,1105,4509,8677,9901,4416,8191,9283,5625,7120,2952,8881,7693,830,4580,8228,9459,8611,4499,1179,4988,1394,550,2336,6089,6872,269,7213,1848,917,6672,4890,656,1478,6536,3165,4743,4990,1176,6211,7207,5284,9730,4738,1549,4986,4942,8645,3698,9429,1439,2175,6549,3058,6513,1574,6988,8333,3406,5245,5431,7140,7085,6407 +7845,4694,2530,8249,290,5948,5509,1588,5940,4495,5866,5021,4626,3979,3296,7589,4854,1998,5627,3926,8346,6512,9608,1918,7070,4747,4182,2858,2766,4606,6269,4107,8982,8568,9053,4244,5604,102,2756,727,5887,2566,7922,44,5986,621,1202,374,6988,4130,3627,6744,9443,4568,1398,8679,397,3928,9159,367,2917,6127,5788,3304,8129,911,2669,1463,9749,264,4478,8940,1109,7309,2462,117,4692,7724,225,2312 +4164,3637,2000,941,8903,39,3443,7172,1031,3687,4901,8082,4945,4515,7204,9310,9349,9535,9940,218,1788,9245,2237,1541,5670,6538,6047,5553,9807,8101,1925,8714,445,8332,7309,6830,5786,5736,7306,2710,3034,1838,7969,6318,7912,2584,2080,7437,6705,2254,7428,820,782,9861,7596,3842,3631,8063,5240,6666,394,4565,7865,4895,9890,6028,6117,4724,9156,4473,4552,602,470,6191,4927,5387,884,3146,1978,3000 +4258,6880,1696,3582,5793,4923,2119,1155,9056,9698,6603,3768,5514,9927,9609,6166,6566,4536,4985,4934,8076,9062,6741,6163,7399,4562,2337,5600,2919,9012,8459,1308,6072,1225,9306,8818,5886,7243,7365,8792,6007,9256,6699,7171,4230,7002,8720,7839,4533,1671,478,7774,1607,2317,5437,4705,7886,4760,6760,7271,3081,2997,3088,7675,6208,3101,6821,6840,122,9633,4900,2067,8546,4549,2091,7188,5605,8599,6758,5229 +7854,5243,9155,3556,8812,7047,2202,1541,5993,4600,4760,713,434,7911,7426,7414,8729,322,803,7960,7563,4908,6285,6291,736,3389,9339,4132,8701,7534,5287,3646,592,3065,7582,2592,8755,6068,8597,1982,5782,1894,2900,6236,4039,6569,3037,5837,7698,700,7815,2491,7272,5878,3083,6778,6639,3589,5010,8313,2581,6617,5869,8402,6808,2951,2321,5195,497,2190,6187,1342,1316,4453,7740,4154,2959,1781,1482,8256 +7178,2046,4419,744,8312,5356,6855,8839,319,2962,5662,47,6307,8662,68,4813,567,2712,9931,1678,3101,8227,6533,4933,6656,92,5846,4780,6256,6361,4323,9985,1231,2175,7178,3034,9744,6155,9165,7787,5836,9318,7860,9644,8941,6480,9443,8188,5928,161,6979,2352,5628,6991,1198,8067,5867,6620,3778,8426,2994,3122,3124,6335,3918,8897,2655,9670,634,1088,1576,8935,7255,474,8166,7417,9547,2886,5560,3842 +6957,3111,26,7530,7143,1295,1744,6057,3009,1854,8098,5405,2234,4874,9447,2620,9303,27,7410,969,40,2966,5648,7596,8637,4238,3143,3679,7187,690,9980,7085,7714,9373,5632,7526,6707,3951,9734,4216,2146,3602,5371,6029,3039,4433,4855,4151,1449,3376,8009,7240,7027,4602,2947,9081,4045,8424,9352,8742,923,2705,4266,3232,2264,6761,363,2651,3383,7770,6730,7856,7340,9679,2158,610,4471,4608,910,6241 +4417,6756,1013,8797,658,8809,5032,8703,7541,846,3357,2920,9817,1745,9980,7593,4667,3087,779,3218,6233,5568,4296,2289,2654,7898,5021,9461,5593,8214,9173,4203,2271,7980,2983,5952,9992,8399,3468,1776,3188,9314,1720,6523,2933,621,8685,5483,8986,6163,3444,9539,4320,155,3992,2828,2150,6071,524,2895,5468,8063,1210,3348,9071,4862,483,9017,4097,6186,9815,3610,5048,1644,1003,9865,9332,2145,1944,2213 +9284,3803,4920,1927,6706,4344,7383,4786,9890,2010,5228,1224,3158,6967,8580,8990,8883,5213,76,8306,2031,4980,5639,9519,7184,5645,7769,3259,8077,9130,1317,3096,9624,3818,1770,695,2454,947,6029,3474,9938,3527,5696,4760,7724,7738,2848,6442,5767,6845,8323,4131,2859,7595,2500,4815,3660,9130,8580,7016,8231,4391,8369,3444,4069,4021,556,6154,627,2778,1496,4206,6356,8434,8491,3816,8231,3190,5575,1015 +3787,7572,1788,6803,5641,6844,1961,4811,8535,9914,9999,1450,8857,738,4662,8569,6679,2225,7839,8618,286,2648,5342,2294,3205,4546,176,8705,3741,6134,8324,8021,7004,5205,7032,6637,9442,5539,5584,4819,5874,5807,8589,6871,9016,983,1758,3786,1519,6241,185,8398,495,3370,9133,3051,4549,9674,7311,9738,3316,9383,2658,2776,9481,7558,619,3943,3324,6491,4933,153,9738,4623,912,3595,7771,7939,1219,4405 +2650,3883,4154,5809,315,7756,4430,1788,4451,1631,6461,7230,6017,5751,138,588,5282,2442,9110,9035,6349,2515,1570,6122,4192,4174,3530,1933,4186,4420,4609,5739,4135,2963,6308,1161,8809,8619,2796,3819,6971,8228,4188,1492,909,8048,2328,6772,8467,7671,9068,2226,7579,6422,7056,8042,3296,2272,3006,2196,7320,3238,3490,3102,37,1293,3212,4767,5041,8773,5794,4456,6174,7279,7054,2835,7053,9088,790,6640 +3101,1057,7057,3826,6077,1025,2955,1224,1114,6729,5902,4698,6239,7203,9423,1804,4417,6686,1426,6941,8071,1029,4985,9010,6122,6597,1622,1574,3513,1684,7086,5505,3244,411,9638,4150,907,9135,829,981,1707,5359,8781,9751,5,9131,3973,7159,1340,6955,7514,7993,6964,8198,1933,2797,877,3993,4453,8020,9349,8646,2779,8679,2961,3547,3374,3510,1129,3568,2241,2625,9138,5974,8206,7669,7678,1833,8700,4480 +4865,9912,8038,8238,782,3095,8199,1127,4501,7280,2112,2487,3626,2790,9432,1475,6312,8277,4827,2218,5806,7132,8752,1468,7471,6386,739,8762,8323,8120,5169,9078,9058,3370,9560,7987,8585,8531,5347,9312,1058,4271,1159,5286,5404,6925,8606,9204,7361,2415,560,586,4002,2644,1927,2824,768,4409,2942,3345,1002,808,4941,6267,7979,5140,8643,7553,9438,7320,4938,2666,4609,2778,8158,6730,3748,3867,1866,7181 +171,3771,7134,8927,4778,2913,3326,2004,3089,7853,1378,1729,4777,2706,9578,1360,5693,3036,1851,7248,2403,2273,8536,6501,9216,613,9671,7131,7719,6425,773,717,8803,160,1114,7554,7197,753,4513,4322,8499,4533,2609,4226,8710,6627,644,9666,6260,4870,5744,7385,6542,6203,7703,6130,8944,5589,2262,6803,6381,7414,6888,5123,7320,9392,9061,6780,322,8975,7050,5089,1061,2260,3199,1150,1865,5386,9699,6501 +3744,8454,6885,8277,919,1923,4001,6864,7854,5519,2491,6057,8794,9645,1776,5714,9786,9281,7538,6916,3215,395,2501,9618,4835,8846,9708,2813,3303,1794,8309,7176,2206,1602,1838,236,4593,2245,8993,4017,10,8215,6921,5206,4023,5932,6997,7801,262,7640,3107,8275,4938,7822,2425,3223,3886,2105,8700,9526,2088,8662,8034,7004,5710,2124,7164,3574,6630,9980,4242,2901,9471,1491,2117,4562,1130,9086,4117,6698 +2810,2280,2331,1170,4554,4071,8387,1215,2274,9848,6738,1604,7281,8805,439,1298,8318,7834,9426,8603,6092,7944,1309,8828,303,3157,4638,4439,9175,1921,4695,7716,1494,1015,1772,5913,1127,1952,1950,8905,4064,9890,385,9357,7945,5035,7082,5369,4093,6546,5187,5637,2041,8946,1758,7111,6566,1027,1049,5148,7224,7248,296,6169,375,1656,7993,2816,3717,4279,4675,1609,3317,42,6201,3100,3144,163,9530,4531 +7096,6070,1009,4988,3538,5801,7149,3063,2324,2912,7911,7002,4338,7880,2481,7368,3516,2016,7556,2193,1388,3865,8125,4637,4096,8114,750,3144,1938,7002,9343,4095,1392,4220,3455,6969,9647,1321,9048,1996,1640,6626,1788,314,9578,6630,2813,6626,4981,9908,7024,4355,3201,3521,3864,3303,464,1923,595,9801,3391,8366,8084,9374,1041,8807,9085,1892,9431,8317,9016,9221,8574,9981,9240,5395,2009,6310,2854,9255 +8830,3145,2960,9615,8220,6061,3452,2918,6481,9278,2297,3385,6565,7066,7316,5682,107,7646,4466,68,1952,9603,8615,54,7191,791,6833,2560,693,9733,4168,570,9127,9537,1925,8287,5508,4297,8452,8795,6213,7994,2420,4208,524,5915,8602,8330,2651,8547,6156,1812,6271,7991,9407,9804,1553,6866,1128,2119,4691,9711,8315,5879,9935,6900,482,682,4126,1041,428,6247,3720,5882,7526,2582,4327,7725,3503,2631 +2738,9323,721,7434,1453,6294,2957,3786,5722,6019,8685,4386,3066,9057,6860,499,5315,3045,5194,7111,3137,9104,941,586,3066,755,4177,8819,7040,5309,3583,3897,4428,7788,4721,7249,6559,7324,825,7311,3760,6064,6070,9672,4882,584,1365,9739,9331,5783,2624,7889,1604,1303,1555,7125,8312,425,8936,3233,7724,1480,403,7440,1784,1754,4721,1569,652,3893,4574,5692,9730,4813,9844,8291,9199,7101,3391,8914 +6044,2928,9332,3328,8588,447,3830,1176,3523,2705,8365,6136,5442,9049,5526,8575,8869,9031,7280,706,2794,8814,5767,4241,7696,78,6570,556,5083,1426,4502,3336,9518,2292,1885,3740,3153,9348,9331,8051,2759,5407,9028,7840,9255,831,515,2612,9747,7435,8964,4971,2048,4900,5967,8271,1719,9670,2810,6777,1594,6367,6259,8316,3815,1689,6840,9437,4361,822,9619,3065,83,6344,7486,8657,8228,9635,6932,4864 +8478,4777,6334,4678,7476,4963,6735,3096,5860,1405,5127,7269,7793,4738,227,9168,2996,8928,765,733,1276,7677,6258,1528,9558,3329,302,8901,1422,8277,6340,645,9125,8869,5952,141,8141,1816,9635,4025,4184,3093,83,2344,2747,9352,7966,1206,1126,1826,218,7939,2957,2729,810,8752,5247,4174,4038,8884,7899,9567,301,5265,5752,7524,4381,1669,3106,8270,6228,6373,754,2547,4240,2313,5514,3022,1040,9738 +2265,8192,1763,1369,8469,8789,4836,52,1212,6690,5257,8918,6723,6319,378,4039,2421,8555,8184,9577,1432,7139,8078,5452,9628,7579,4161,7490,5159,8559,1011,81,478,5840,1964,1334,6875,8670,9900,739,1514,8692,522,9316,6955,1345,8132,2277,3193,9773,3923,4177,2183,1236,6747,6575,4874,6003,6409,8187,745,8776,9440,7543,9825,2582,7381,8147,7236,5185,7564,6125,218,7991,6394,391,7659,7456,5128,5294 +2132,8992,8160,5782,4420,3371,3798,5054,552,5631,7546,4716,1332,6486,7892,7441,4370,6231,4579,2121,8615,1145,9391,1524,1385,2400,9437,2454,7896,7467,2928,8400,3299,4025,7458,4703,7206,6358,792,6200,725,4275,4136,7390,5984,4502,7929,5085,8176,4600,119,3568,76,9363,6943,2248,9077,9731,6213,5817,6729,4190,3092,6910,759,2682,8380,1254,9604,3011,9291,5329,9453,9746,2739,6522,3765,5634,1113,5789 +5304,5499,564,2801,679,2653,1783,3608,7359,7797,3284,796,3222,437,7185,6135,8571,2778,7488,5746,678,6140,861,7750,803,9859,9918,2425,3734,2698,9005,4864,9818,6743,2475,132,9486,3825,5472,919,292,4411,7213,7699,6435,9019,6769,1388,802,2124,1345,8493,9487,8558,7061,8777,8833,2427,2238,5409,4957,8503,3171,7622,5779,6145,2417,5873,5563,5693,9574,9491,1937,7384,4563,6842,5432,2751,3406,7981 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 401e53d185..e64bd61852 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -19,12 +19,13 @@ USING: definitions io io.files io.pathnames kernel math math.parser project-euler.058 project-euler.059 project-euler.063 project-euler.065 project-euler.067 project-euler.069 project-euler.071 project-euler.072 project-euler.073 project-euler.074 project-euler.075 project-euler.076 - project-euler.079 project-euler.085 project-euler.092 project-euler.097 - project-euler.099 project-euler.100 project-euler.102 project-euler.112 - project-euler.116 project-euler.117 project-euler.124 project-euler.134 - project-euler.148 project-euler.150 project-euler.151 project-euler.164 - project-euler.169 project-euler.173 project-euler.175 project-euler.186 - project-euler.188 project-euler.190 project-euler.203 project-euler.215 ; + project-euler.079 project-euler.081 project-euler.085 project-euler.092 + project-euler.097 project-euler.099 project-euler.100 project-euler.102 + project-euler.112 project-euler.116 project-euler.117 project-euler.124 + project-euler.134 project-euler.148 project-euler.150 project-euler.151 + project-euler.164 project-euler.169 project-euler.173 project-euler.175 + project-euler.186 project-euler.188 project-euler.190 project-euler.203 + project-euler.215 ; IN: project-euler Date: Mon, 19 Oct 2009 16:47:50 +1300 Subject: [PATCH 002/109] Basic peg.ebnf docs --- basis/peg/ebnf/ebnf-docs.factor | 454 ++++++++++++++++++++++++++++++++ basis/peg/ebnf/ebnf.factor | 4 + 2 files changed, 458 insertions(+) create mode 100644 basis/peg/ebnf/ebnf-docs.factor diff --git a/basis/peg/ebnf/ebnf-docs.factor b/basis/peg/ebnf/ebnf-docs.factor new file mode 100644 index 0000000000..e2a422952f --- /dev/null +++ b/basis/peg/ebnf/ebnf-docs.factor @@ -0,0 +1,454 @@ +! Copyright (C) 2009 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup peg peg.search ; +IN: peg.ebnf + +HELP: " } +{ $values { "...ebnf..." "EBNF DSL text" } } +{ $description + "Creates a " { $vocab-link "peg" } + " object that parses a string using the syntax " + "defined with the EBNF DSL. The peg object can be run using the " { $link parse } + "word and can be used with the " { $link search } " and " { $link replace } " words." +} +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf peg.search ;" + "\"abcdab\" [[ drop \"foo\" ]] EBNF> replace ." + "\"foocdfoo\"" + } +} ; + +HELP: [EBNF +{ $syntax "[EBNF ...ebnf... EBNF]" } +{ $values { "...ebnf..." "EBNF DSL text" } } +{ $description + "Creates and calls a quotation that parses a string using the syntax " + "defined with the EBNF DSL. The quotation has stack effect " + { $snippet "( string -- ast )" } " where 'string' is the text to be parsed " + "and 'ast' is the resulting abstract syntax tree. If the parsing fails the " + "quotation throws an exception." +} +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"ab\" [EBNF rule=\"a\" \"b\" EBNF] ." + "V{ \"a\" \"b\" }" + } +} ; + +HELP: EBNF: +{ $syntax "EBNF: word ...ebnf... ;EBNF" } +{ $values { "word" "a word" } { "...ebnf..." "EBNF DSL text" } } +{ $description + "Defines a word that when called will parse a string using the syntax " + "defined with the EBNF DSL. The word has stack effect " + { $snippet "( string -- ast )" } " where 'string' is the text to be parsed " + "and 'ast' is the resulting abstract syntax tree. If the parsing fails the " + "word throws an exception." +} +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "EBNF: foo rule=\"a\" \"b\" ;EBNF" + "\"ab\" foo ." + "V{ \"a\" \"b\" }" + } +} ; + +ARTICLE: "peg.ebnf.strings" "Strings" +"A string in a rule will match that sequence of characters from the input string. " +"The AST result from the match is the string itself." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"helloworld\" [EBNF rule=\"hello\" \"world\" EBNF] ." + "V{ \"hello\" \"world\" }" + } +} ; + +ARTICLE: "peg.ebnf.any" "Any" +"A full stop character (.) will match any single token in the input string. " +"The AST resulting from this is the token itself." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"abc\" [EBNF rule=\"a\" . \"c\" EBNF] ." + "V{ \"a\" 98 \"c\" }" + } +} ; + +ARTICLE: "peg.ebnf.sequence" "Sequence" +"Any white space separated rule element is considered a sequence. Each rule " +"in the sequence is matched from the input stream, consuming the input as it " +"goes. The AST result is a vector containing the results of each rule element in " +"the sequence." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"helloworld\" [EBNF rule=\"a\" (\"b\")* \"a\" EBNF] ." + "V{ \"a\" V{ \"b\" \"b\" \"b\" } \"a\" }" + } +} +; + +ARTICLE: "peg.ebnf.choice" "Choice" +"Any rule element separated by a pipe character (|) is considered a choice. Choices " +"are matched against the input stream in order. If a match succeeds then the remaining " +"choices are discarded and the result of the match is the AST result of the choice." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"a\" [EBNF rule=\"a\" | \"b\" | \"c\" EBNF] ." + "\"a\"" + "\"b\" [EBNF rule=\"a\" | \"b\" | \"c\" EBNF] ." + "\"b\"" + "\"d\" [EBNF rule=\"a\" | \"b\" | \"c\" EBNF] ." + "Peg parsing error at character position 0. Expected token 'c' or token 'b' or token 'a'" + } +} +; + +ARTICLE: "peg.ebnf.option" "Option" +"Any rule element followed by a question mark (?) is considered optional. The " +"rule is tested against the input. If it succeeds the result is stored in the AST. " +"If it fails then the parse still suceeds and false (f) is stored in the AST." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"abc\" [EBNF rule=\"a\" \"b\"? \"c\" EBNF] ." + "V{ \"a\" \"b\" \"c\" }" + "\"ac\" [EBNF rule=\"a\" \"b\"? \"c\" EBNF] ." + "V{ \"a\" f \"c\" }" + } +} +; + +ARTICLE: "peg.ebnf.character-class" "Character Class" +"Character class matching can be done using a range of characters defined in " +"square brackets. Multiple ranges can be included in a single character class " +"definition. The syntax for the range is a start character, followed by a minus " +"(-) followed by an end character. For example " { $snippet "[a-zA-Z]" } ". " +"The AST resulting from the match is an integer of the character code for the " +"character that matched." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"123\" [EBNF rule=[0-9]+ EBNF] ." + "V{ 49 50 51 }" + } +} +; + +ARTICLE: "peg.ebnf.one-or-more" "One or more" +"Any rule element followed by a plus (+) matches one or more instances of the rule " +"from the input string. The AST result is the vector of the AST results from " +"the matched rule." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"aab\" [EBNF rule=\"a\"+ \"b\" EBNF] ." + "V{ V{ \"a\" \"a\" } \"b\" }" + } +} +; + +ARTICLE: "peg.ebnf.zero-or-more" "Zero or more" +"Any rule element followed by an asterisk (*) matches zero or more instances of the rule " +"from the input string. The AST result is the vector of the AST results from " +"the matched rule. This will be empty if there are no matches." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"aab\" [EBNF rule=\"a\"* \"b\" EBNF] ." + "V{ V{ \"a\" \"a\" } \"b\" }" + "\"b\" [EBNF rule=\"a\"* \"b\" EBNF] ." + "V{ V{ } \"b\" }" + } +} +; + +ARTICLE: "peg.ebnf.and" "And" +"Any rule element prefixed by an ampersand (&) performs the Parsing Expression " +"Grammar 'And Predicate' match. It attempts to match the rule against the input " +"string. It will cause the parse to succeed or fail depending on if the rule " +"succeeds or fails. It will not consume anything from the input string however and " +"does not leave any result in the AST. This can be used for lookahead and " +"disambiguation in choices." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"ab\" [EBNF rule=&(\"a\") \"a\" \"b\" EBNF] ." + "V{ \"a\" \"b\" }" + } +} +; + +ARTICLE: "peg.ebnf.not" "Not" +"Any rule element prefixed by an exclamation mark (!) performs the Parsing Expression " +"Grammar 'Not Predicate' match. It attempts to match the rule against the input " +"string. It will cause the parse to succeed if the rule match fails, and to fail " +"if the rule match succeeds. It will not consume anything from the input string " +"however and does not leave any result in the AST. This can be used for lookahead and " +"disambiguation in choices." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"\" [EBNF rule=\"<\" (!(\">\") .)* \">\" EBNF] ." + "V{ \"<\" V{ 97 98 99 100 } \">\" }" + } +} +; + +ARTICLE: "peg.ebnf.action" "Action" +"An action is a quotation that is run after a rule matches. The quotation " +"consumes the AST of the rule match and leaves a new AST as the result. " +"The stack effect of the action can be " { $snippet "( ast -- ast )" } " or " +{ $snippet "( -- ast )" } ". " +"If it is the latter then the original AST is implcitly dropped and will be " +"replaced by the AST left on the stack. This is mostly useful if variables are " +"used in the rule since they can be referenced like locals in the action quotation. " +"The action is defined by having a ' => ' at the end of a rule and " +"using '[[' and ']]' to open and close the quotation. " +"If an action leaves the object 'ignore' on the stack then the result of that " +"action will not be put in the AST of the result." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf math.parser ;" + "\"\" [EBNF rule=\"<\" ((!(\">\") .)* => [[ >string ]]) \">\" EBNF] ." + "V{ \"<\" \"abcd\" \">\" }" + "\"123\" [EBNF rule=[0-9]+ => [[ string>number ]] EBNF] ." + "123" + } +} +; + +ARTICLE: "peg.ebnf.semantic-action" "Semantic Action" +"Semantic actions allow providing a quotation that gets run on the AST of a " +"matched rule that returns success or failure. The result of the parse is decided by " +"the result of the semantic action. The stack effect for the quotation is " +{ $snippet ( ast -- ? ) } ". " +"A semantic action follows the rule it applies to and is delimeted by '?[' and ']?'." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"1\" [EBNF rule=[0-9] ?[ digit> odd? ]? EBNF] ." + "49" + "\"2\" [EBNF rule=[0-9] ?[ digit> odd? ]? EBNF] ." + "..error.." + } +} +; + +ARTICLE: "peg.ebnf.variable" "Variable" +"Variables names can be suffixed to a rule element using the colon character (:) " +"followed by the variable name. These can then be used in rule actions to refer to " +"the AST result of the rule element with that variable name." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "\"1+2\" [EBNF rule=[0-9]:a \"+\" [0-9]:b => [[ a digit> b digit> + ]] EBNF] ." + "3" + } +} +; + +ARTICLE: "peg.ebnf.foreign-rules" "Foreign Rules" +"Rules can call outto other peg.ebnf defined parsers. The result of " +"the foreign call then becomes the AST of the successful parse. Foreign rules " +"are invoked using '' or ''. The " +"latter allows calling a specific rule in a previously designed peg.ebnf parser. " +"If the 'word-name' is not the name of a peg.ebnf defined parser then it must be " +"a word with stack effect " { $snippet "( -- parser )" } ". It must return a " +{ $vocab-link "peg" } " defined parser and it will be called to perform the parse " +"for that rule." +{ $examples + { $unchecked-example + "USING: prettyprint peg.ebnf ;" + "EBNF: parse-string" + "StringBody = (!('\"') .)*" + "String= '\"' StringBody:b '\"' => [[ b >string ]]" + ";EBNF" + "EBNF: parse-two-strings" + "TwoStrings = " + ";EBNF" + "EBNF: parse-two-strings" + "TwoString = " + ";EBNF" + } + { $unchecked-example + ": a-token ( -- parser ) \"a\" token ;" + "EBNF: parse-abc" + "abc = 'b' 'c'" + ";EBNF" + } +} +; + +ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" +"It is possible to override the tokenizer in an EBNF defined parser. " +"Usually the input sequence to be parsed is an array of characters or a string. " +"Terminals in a rule match successive characters in the array or string. " +{ $examples + { $unchecked-example + "EBNF: foo" + "rule = \"++\" \"--\"" + ";EBNF" + } +} +"This parser when run with the string \"++--\" or the array " +"{ CHAR: + CHAR: + CHAR: - CHAR: - } will succeed with an AST of { \"++\" \"--\" }. " +"If you want to add whitespace handling to the grammar you need to put it " +"between the terminals: " +{ $examples + { $unchecked-example + "EBNF: foo" + "space = (\" \" | \"\\r\" | \"\\t\" | \"\\n\")" + "spaces = space* => [[ drop ignore ]]" + "rule = spaces \"++\" spaces \"--\" spaces" + ";EBNF" + } +} +"In a large grammar this gets tedious and makes the grammar hard to read. " +"Instead you can write a rule to split the input sequence into tokens, and " +"have the grammar operate on these tokens. This is how the previous example " +"might look: " +{ $examples + { $unchecked-example + "EBNF: foo" + "space = (\" \" | \"\\r\" | \"\\t\" | \"\\n\")" + "spaces = space* => [[ drop ignore ]]" + "tokenizer = spaces ( \"++\" | \"--\" )" + "rule = \"++\" \"--\"" + ";EBNF" + } +} +"'tokenizer' is the name of a built in rule. Once defined it is called to " +"retrieve the next complete token from the input sequence. So the first part " +"of 'rule' is to try and match \"++\". It calls the tokenizer to get the next " +"complete token. This ignores spaces until it finds a \"++\" or \"--\". " +"It is as if the input sequence for the parser was actually { \"++\" \"--\" } " +"instead of the string \"++--\". With the new tokenizer \"....\" sequences " +"in the grammar are matched for equality against the token, rather than a " +"string comparison against successive items in the sequence. This can be used " +"to match an AST from a tokenizer: " +{ $examples + { $unchecked-example + "TUPLE: ast-number value ;" + "TUPLE: ast-string value ;" + "" + "EBNF: foo-tokenizer" + "space = (\" \" | \"\\r\" | \"\\t\" | \"\\n\")" + "spaces = space* => [[ drop ignore ]]" + "" + "number = [0-9]* => [[ >string string>number ast-number boa ]]" + "string = => [[ ast-string boa ]]" + "operator = (\"+\" | \"-\")" + "" + "token = spaces ( number | string | operator )" + "tokens = token*" + ";EBNF" + "" + "ENBF: foo" + "tokenizer = " + "" + "number = . ?[ ast-number? ]? => [[ value>> ]]" + "string = . ?[ ast-string? ]? => [[ value>> ]]" + "" + "rule = string:a number:b \"+\" number:c => [[ a b c + 2array ]]" + ";EBNF" + } +} +"In this example I split the tokenizer into a separate parser and use " +"'foreign' to call it from the main one. This allows testing of the " +"tokenizer separately: " +{ $examples + { $unchecked-example + "\"123 456 +\" foo-tokenizer ast>> ." + "{ T{ ast-number f 123 } T{ ast-number f 456 } \"+\" }" + } +} +"The '.' EBNF production means match a single object in the source sequence. " +"Usually this is a character. With the replacement tokenizer it is either a " +"number object, a string object or a string containing the operator. " +"Using a tokenizer in language grammars makes it easier to deal with whitespace. " +"Defining tokenizers in this way has the advantage of the tokenizer and parser " +"working in one pass. There is no tokenization occurring over the whole string " +"followed by the parse of that result. It tokenizes as it needs to. You can even " +"switch tokenizers multiple times during a grammar. Rules use the tokenizer that " +"was defined lexically before the rule. This is usefull in the JavaScript grammar: " +{ $examples + { $unchecked-example + "EBNF: javascript" + "tokenizer = default" + "nl = \"\\r\" \"\\n\" | \"\\n\"" + "tokenizer = " + "..." + "End = !(.)" + "Name = . ?[ ast-name? ]? => [[ value>> ]] " + "Number = . ?[ ast-number? ]? => [[ value>> ]]" + "String = . ?[ ast-string? ]? => [[ value>> ]]" + "RegExp = . ?[ ast-regexp? ]? => [[ value>> ]]" + "SpacesNoNl = (!(nl) Space)* => [[ ignore ]]" + "Sc = SpacesNoNl (nl | &(\"}\") | End)| \";\"" + } +} +"Here the rule 'nl' is defined using the default tokenizer of sequential " +"characters ('default' has the special meaning of the built in tokenizer). " +"This is followed by using the JavaScript tokenizer for the remaining rules. " +"This tokenizer strips out whitespace and newlines. Some rules in the grammar " +"require checking for a newline. In particular the automatic semicolon insertion " +"rule (managed by the 'Sc' rule here). If there is a newline, the semicolon can " +"be optional in places. " +{ $examples + { $unchecked-example + "\"do\" Stmt:s \"while\" \"(\" Expr:c \")\" Sc => [[ s c ast-do-while boa ]]" + } +} +"Even though the JavaScript tokenizer has removed the newlines, the 'nl' rule can " +"be used to detect them since it is using the default tokenizer. This allows " +"grammars to mix and match the tokenizer as required to make them more readable." +; + +ARTICLE: "peg.ebnf" "EBNF" +"This vocubalary provides a DSL that allows writing PEG parsers that look like " +"EBNF syntax. It provides three parsing words described below. These words all " +"accept the same EBNF syntax. The difference is in how they are used." +{ $subsection POSTPONE: with-compilation-unit ; FROM: vocabs.parser => search ; IN: peg.ebnf +> ] curry ; +PRIVATE> + SYNTAX: " reset-tokenizer parse-multiline-string parse-ebnf main swap at From 06a70fd3c67316eb21c43131e0c59490a7a3fb6a Mon Sep 17 00:00:00 2001 From: Chris Double Date: Mon, 19 Oct 2009 18:14:13 +1300 Subject: [PATCH 003/109] Tweak what EBNF words are private --- basis/peg/ebnf/ebnf.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index def856de30..136007e7ce 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -10,14 +10,14 @@ FROM: compiler.units => with-compilation-unit ; FROM: vocabs.parser => search ; IN: peg.ebnf - Date: Mon, 19 Oct 2009 18:26:19 +1300 Subject: [PATCH 004/109] peg.ebnf doc fixes to appease help.lint --- basis/peg/ebnf/ebnf-docs.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/peg/ebnf/ebnf-docs.factor b/basis/peg/ebnf/ebnf-docs.factor index e2a422952f..5057693334 100644 --- a/basis/peg/ebnf/ebnf-docs.factor +++ b/basis/peg/ebnf/ebnf-docs.factor @@ -210,7 +210,7 @@ ARTICLE: "peg.ebnf.action" "Action" "replaced by the AST left on the stack. This is mostly useful if variables are " "used in the rule since they can be referenced like locals in the action quotation. " "The action is defined by having a ' => ' at the end of a rule and " -"using '[[' and ']]' to open and close the quotation. " +"using '[[' and ']]' to open and close the quotation. " "If an action leaves the object 'ignore' on the stack then the result of that " "action will not be put in the AST of the result." { $examples @@ -287,7 +287,7 @@ ARTICLE: "peg.ebnf.foreign-rules" "Foreign Rules" ; ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" -"It is possible to override the tokenizer in an EBNF defined parser. " +"It is possible to override the tokenizer in an EBNF defined parser. " "Usually the input sequence to be parsed is an array of characters or a string. " "Terminals in a rule match successive characters in the array or string. " { $examples @@ -414,7 +414,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" ARTICLE: "peg.ebnf" "EBNF" "This vocubalary provides a DSL that allows writing PEG parsers that look like " "EBNF syntax. It provides three parsing words described below. These words all " -"accept the same EBNF syntax. The difference is in how they are used." +"accept the same EBNF syntax. The difference is in how they are used. " { $subsection POSTPONE: Date: Mon, 19 Oct 2009 02:21:11 -0500 Subject: [PATCH 005/109] vm: new mark_bits data structure replaces hashtable when compacting code heap --- vm/code_block.cpp | 2 +- vm/code_heap.cpp | 47 ++++++++++++++++++++++++++++++++++++++----- vm/factor.cpp | 2 +- vm/full_collector.cpp | 44 ++-------------------------------------- vm/heap.cpp | 2 -- vm/heap.hpp | 7 +++---- vm/mach_signal.cpp | 2 +- vm/mark_bits.hpp | 24 ++++------------------ vm/master.hpp | 19 +---------------- vm/vm.hpp | 6 ++++-- 10 files changed, 59 insertions(+), 96 deletions(-) diff --git a/vm/code_block.cpp b/vm/code_block.cpp index 1f77148b5c..d2337d71de 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -379,7 +379,7 @@ struct literal_and_word_references_updater { } }; -void factor_vm::update_code_block_for_full_gc(code_block *compiled) +void factor_vm::update_code_block_words_and_literals(code_block *compiled) { if(code->needs_fixup_p(compiled)) relocate_code_block(compiled); diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index b058248bee..020c8c2ba8 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -73,6 +73,44 @@ void factor_vm::update_code_heap_words() iterate_code_heap(updater); } +/* After a full GC that did not grow the heap, we have to update references +to literals and other words. */ +struct word_and_literal_code_heap_updater { + factor_vm *parent; + + word_and_literal_code_heap_updater(factor_vm *parent_) : parent(parent_) {} + + void operator()(heap_block *block) + { + parent->update_code_block_words_and_literals((code_block *)block); + } +}; + +void factor_vm::update_code_heap_words_and_literals() +{ + word_and_literal_code_heap_updater updater(this); + code->sweep_heap(updater); +} + +/* After growing the heap, we have to perform a full relocation to update +references to card and deck arrays. */ +struct code_heap_relocator { + factor_vm *parent; + + code_heap_relocator(factor_vm *parent_) : parent(parent_) {} + + void operator()(heap_block *block) + { + parent->relocate_code_block((code_block *)block); + } +}; + +void factor_vm::relocate_code_heap() +{ + code_heap_relocator relocator(this); + code->sweep_heap(relocator); +} + void factor_vm::primitive_modify_code_heap() { gc_root alist(dpop(),this); @@ -139,11 +177,7 @@ void factor_vm::primitive_code_room() code_block *code_heap::forward_code_block(code_block *compiled) { - code_block *block1 = (code_block *)state->forward_block(compiled); - code_block *block2 = (code_block *)forwarding[compiled]; - printf("%lx %lx\n",block1,block2); - assert(block1 == block2); - return block2; + return (code_block *)state->forward_block(compiled); } struct callframe_forwarder { @@ -248,6 +282,9 @@ void factor_vm::compact_code_heap(bool trace_contexts_p) forward_context_xts(); forward_callback_xts(); } + + code_heap_relocator relocator(this); + iterate_code_heap(relocator); } struct stack_trace_stripper { diff --git a/vm/factor.cpp b/vm/factor.cpp index 5548ebd610..f2b0d4c92a 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -4,7 +4,7 @@ namespace factor { factor_vm *vm; -unordered_map thread_vms; +std::map thread_vms; void init_globals() { diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index f9db1c8653..61827fba41 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -104,32 +104,6 @@ void full_collector::cheneys_algorithm() } } -/* After growing the heap, we have to perform a full relocation to update -references to card and deck arrays. */ -struct big_code_heap_updater { - factor_vm *parent; - - big_code_heap_updater(factor_vm *parent_) : parent(parent_) {} - - void operator()(heap_block *block) - { - parent->relocate_code_block((code_block *)block); - } -}; - -/* After a full GC that did not grow the heap, we have to update references -to literals and other words. */ -struct small_code_heap_updater { - factor_vm *parent; - - small_code_heap_updater(factor_vm *parent_) : parent(parent_) {} - - void operator()(heap_block *block) - { - parent->update_code_block_for_full_gc((code_block *)block); - } -}; - void factor_vm::collect_full_impl(bool trace_contexts_p) { full_collector collector(this); @@ -161,16 +135,9 @@ void factor_vm::collect_growing_heap(cell requested_bytes, delete old; if(compact_code_heap_p) - { compact_code_heap(trace_contexts_p); - big_code_heap_updater updater(this); - iterate_code_heap(updater); - } else - { - big_code_heap_updater updater(this); - code->free_unmarked(updater); - } + relocate_code_heap(); code->clear_remembered_set(); } @@ -183,16 +150,9 @@ void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p) collect_full_impl(trace_contexts_p); if(compact_code_heap_p) - { compact_code_heap(trace_contexts_p); - big_code_heap_updater updater(this); - iterate_code_heap(updater); - } else - { - small_code_heap_updater updater(this); - code->free_unmarked(updater); - } + update_code_heap_words_and_literals(); code->clear_remembered_set(); } diff --git a/vm/heap.cpp b/vm/heap.cpp index 8cbf914130..c2a44e42a4 100644 --- a/vm/heap.cpp +++ b/vm/heap.cpp @@ -191,7 +191,6 @@ cell heap::heap_size() void heap::compact_heap() { - forwarding.clear(); state->compute_forwarding(); heap_block *scan = first_block(); @@ -208,7 +207,6 @@ void heap::compact_heap() { cell size = scan->size(); memmove(address,scan,size); - forwarding[scan] = address; address += size; } diff --git a/vm/heap.hpp b/vm/heap.hpp index 8575dac2a1..ba00b9ba6c 100644 --- a/vm/heap.hpp +++ b/vm/heap.hpp @@ -14,7 +14,6 @@ struct heap { segment *seg; heap_free_list free; mark_bits *state; - unordered_map forwarding; explicit heap(bool secure_gc_, cell size, bool executable_p); ~heap(); @@ -45,9 +44,9 @@ struct heap { heap_block *free_allocated(heap_block *prev, heap_block *scan); - /* After code GC, all referenced code blocks have status set to B_MARKED, so any - which are allocated and not marked can be reclaimed. */ - template void free_unmarked(Iterator &iter) + /* After code GC, all live code blocks are marked, so any + which are not marked can be reclaimed. */ + template void sweep_heap(Iterator &iter) { clear_free_list(); diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp index 2d76b12c38..d733e6b3bc 100644 --- a/vm/mach_signal.cpp +++ b/vm/mach_signal.cpp @@ -78,7 +78,7 @@ static void call_fault_handler( { THREADHANDLE thread_id = pthread_from_mach_thread_np(thread); assert(thread_id); - unordered_map::const_iterator vm = thread_vms.find(thread_id); + std::map::const_iterator vm = thread_vms.find(thread_id); if (vm != thread_vms.end()) vm->second->call_fault_handler(exception,code,exc_state,thread_state,float_state); } diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index b13f6889bd..f123701816 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -92,11 +92,8 @@ template struct mark_bits { { bits[start.first] |= ~start_mask; - if(end.first != 0) - { - for(cell index = start.first + 1; index < end.first - 1; index++) - bits[index] = (u64)-1; - } + for(cell index = start.first + 1; index < end.first; index++) + bits[index] = (u64)-1; bits[end.first] |= end_mask; } @@ -122,21 +119,9 @@ template struct mark_bits { set_bitmap_range(allocated,address); } - cell popcount1(u64 x) - { - cell accum = 0; - while(x > 0) - { - accum += (x & 1); - x >>= 1; - } - return accum; - } - /* From http://chessprogramming.wikispaces.com/Population+Count */ cell popcount(u64 x) { - cell old = x; u64 k1 = 0x5555555555555555ll; u64 k2 = 0x3333333333333333ll; u64 k4 = 0x0f0f0f0f0f0f0f0fll; @@ -145,13 +130,12 @@ template struct mark_bits { x = (x & k2) + ((x >> 2) & k2); // put count of each 4 bits into those 4 bits x = (x + (x >> 4)) & k4 ; // put count of each 8 bits into those 8 bits x = (x * kf) >> 56; // returns 8 most significant bits of x + (x<<8) + (x<<16) + (x<<24) + ... - - assert(x == popcount1(old)); + return (cell)x; } /* The eventual destination of a block after compaction is just the number - of marked blocks before it. */ + of marked blocks before it. Live blocks must be marked on entry. */ void compute_forwarding() { cell accum = 0; diff --git a/vm/master.hpp b/vm/master.hpp index 847980fac6..b0e73a4b29 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -25,27 +25,10 @@ /* C++ headers */ #include +#include #include #include -#if __GNUC__ == 4 - #include - - namespace factor - { - using std::tr1::unordered_map; - } -#elif __GNUC__ == 3 - #include - - namespace factor - { - using boost::unordered_map; - } -#else - #error Factor requires GCC 3.x or later -#endif - /* Forward-declare this since it comes up in function prototypes */ namespace factor { diff --git a/vm/vm.hpp b/vm/vm.hpp index a5cb2562d1..7742ea8d60 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -494,7 +494,7 @@ struct factor_vm void update_literal_references(code_block *compiled); void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled); void update_word_references(code_block *compiled); - void update_code_block_for_full_gc(code_block *compiled); + void update_code_block_words_and_literals(code_block *compiled); void check_code_address(cell address); void relocate_code_block(code_block *compiled); void fixup_labels(array *labels, code_block *compiled); @@ -513,6 +513,8 @@ struct factor_vm bool in_code_heap_p(cell ptr); void jit_compile_word(cell word_, cell def_, bool relocate); void update_code_heap_words(); + void update_code_heap_words_and_literals(); + void relocate_code_heap(); void primitive_modify_code_heap(); void primitive_code_room(); void forward_object_xts(); @@ -711,6 +713,6 @@ struct factor_vm }; -extern unordered_map thread_vms; +extern std::map thread_vms; } From 4ddd63d83ef6c920cf7b31fe46142771c516b146 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 03:05:20 -0500 Subject: [PATCH 006/109] vm: move compaction algorithm to mark_bits.hpp since it doesn't rely on properties of heaps per se --- vm/code_heap.cpp | 23 ++++++++----- vm/heap.cpp | 29 ---------------- vm/heap.hpp | 85 +++++++++++++++++++++++++++++++---------------- vm/image.cpp | 2 +- vm/mark_bits.hpp | 19 +++++++++++ vm/quotations.cpp | 1 - vm/vm.hpp | 20 ++++++----- 7 files changed, 102 insertions(+), 77 deletions(-) diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 020c8c2ba8..756dfdbff6 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -59,7 +59,7 @@ struct word_updater { factor_vm *parent; explicit word_updater(factor_vm *parent_) : parent(parent_) {} - void operator()(code_block *compiled) + void operator()(code_block *compiled, cell size) { parent->update_word_references(compiled); } @@ -80,7 +80,7 @@ struct word_and_literal_code_heap_updater { word_and_literal_code_heap_updater(factor_vm *parent_) : parent(parent_) {} - void operator()(heap_block *block) + void operator()(heap_block *block, cell size) { parent->update_code_block_words_and_literals((code_block *)block); } @@ -99,16 +99,17 @@ struct code_heap_relocator { code_heap_relocator(factor_vm *parent_) : parent(parent_) {} - void operator()(heap_block *block) + void operator()(code_block *block, cell size) { - parent->relocate_code_block((code_block *)block); + parent->relocate_code_block(block); } }; void factor_vm::relocate_code_heap() { code_heap_relocator relocator(this); - code->sweep_heap(relocator); + code_heap_iterator iter(relocator); + code->sweep_heap(iter); } void factor_vm::primitive_modify_code_heap() @@ -275,7 +276,10 @@ on entry to this function. XTs in code blocks must be updated after this function returns. */ void factor_vm::compact_code_heap(bool trace_contexts_p) { - code->compact_heap(); + /* Figure out where blocks are going to go */ + code->state->compute_forwarding(); + + /* Update references to the code heap from the data heap */ forward_object_xts(); if(trace_contexts_p) { @@ -283,14 +287,17 @@ void factor_vm::compact_code_heap(bool trace_contexts_p) forward_callback_xts(); } + /* Move code blocks and update references amongst them (this requires + that the data heap is up to date since relocation looks up object XTs) */ code_heap_relocator relocator(this); - iterate_code_heap(relocator); + code_heap_iterator iter(relocator); + code->compact_heap(iter); } struct stack_trace_stripper { explicit stack_trace_stripper() {} - void operator()(code_block *compiled) + void operator()(code_block *compiled, cell size) { compiled->owner = false_object; } diff --git a/vm/heap.cpp b/vm/heap.cpp index c2a44e42a4..2132ba1a20 100644 --- a/vm/heap.cpp +++ b/vm/heap.cpp @@ -189,35 +189,6 @@ cell heap::heap_size() return (cell)scan - (cell)first_block(); } -void heap::compact_heap() -{ - state->compute_forwarding(); - - heap_block *scan = first_block(); - heap_block *end = last_block(); - - char *address = (char *)scan; - - /* Slide blocks up while building the forwarding hashtable. */ - while(scan != end) - { - heap_block *next = scan->next(); - - if(state->is_marked_p(scan)) - { - cell size = scan->size(); - memmove(address,scan,size); - address += size; - } - - scan = next; - } - - /* Now update the free list; there will be a single free block at - the end */ - build_free_list((cell)address - seg->start); -} - heap_block *heap::free_allocated(heap_block *prev, heap_block *scan) { if(secure_gc) diff --git a/vm/heap.hpp b/vm/heap.hpp index ba00b9ba6c..1cdca5180c 100644 --- a/vm/heap.hpp +++ b/vm/heap.hpp @@ -29,7 +29,6 @@ struct heap { } void clear_free_list(); - void new_heap(cell size); void add_to_free_list(free_heap_block *block); void build_free_list(cell size); void assert_free_block(free_heap_block *block); @@ -44,41 +43,69 @@ struct heap { heap_block *free_allocated(heap_block *prev, heap_block *scan); - /* After code GC, all live code blocks are marked, so any - which are not marked can be reclaimed. */ - template void sweep_heap(Iterator &iter) + template void sweep_heap(Iterator &iter); + template void compact_heap(Iterator &iter); + + template void iterate_heap(Iterator &iter) { - clear_free_list(); - - heap_block *prev = NULL; heap_block *scan = first_block(); heap_block *end = last_block(); - + while(scan != end) { - if(scan->type() == FREE_BLOCK_TYPE) - { - if(prev && prev->type() == FREE_BLOCK_TYPE) - prev->set_size(prev->size() + scan->size()); - else - prev = scan; - } - else if(state->is_marked_p(scan)) - { - if(prev && prev->type() == FREE_BLOCK_TYPE) - add_to_free_list((free_heap_block *)prev); - prev = scan; - iter(scan); - } - else - prev = free_allocated(prev,scan); - - scan = scan->next(); + heap_block *next = scan->next(); + if(scan->type() != FREE_BLOCK_TYPE) iter(scan,scan->size()); + scan = next; } - - if(prev && prev->type() == FREE_BLOCK_TYPE) - add_to_free_list((free_heap_block *)prev); } }; +/* After code GC, all live code blocks are marked, so any +which are not marked can be reclaimed. */ +template void heap::sweep_heap(Iterator &iter) +{ + this->clear_free_list(); + + heap_block *prev = NULL; + heap_block *scan = this->first_block(); + heap_block *end = this->last_block(); + + while(scan != end) + { + if(scan->type() == FREE_BLOCK_TYPE) + { + if(prev && prev->type() == FREE_BLOCK_TYPE) + prev->set_size(prev->size() + scan->size()); + else + prev = scan; + } + else if(this->state->is_marked_p(scan)) + { + if(prev && prev->type() == FREE_BLOCK_TYPE) + this->add_to_free_list((free_heap_block *)prev); + prev = scan; + iter(scan,scan->size()); + } + else + prev = this->free_allocated(prev,scan); + + scan = scan->next(); + } + + if(prev && prev->type() == FREE_BLOCK_TYPE) + this->add_to_free_list((free_heap_block *)prev); +} + +/* The forwarding map must be computed first by calling +state->compute_forwarding(). */ +template void heap::compact_heap(Iterator &iter) +{ + heap_compacter compacter(state,first_block(),iter); + this->iterate_heap(compacter); + + /* Now update the free list; there will be a single free block at + the end */ + this->build_free_list((cell)compacter.address - this->seg->start); +} + } diff --git a/vm/image.cpp b/vm/image.cpp index c6d1ad7aca..c96da6b703 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -225,7 +225,7 @@ struct code_block_fixupper { code_block_fixupper(factor_vm *parent_, cell data_relocation_base_) : parent(parent_), data_relocation_base(data_relocation_base_) { } - void operator()(code_block *compiled) + void operator()(code_block *compiled, cell size) { parent->fixup_code_block(compiled,data_relocation_base); } diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index f123701816..ad3eda89df 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -159,4 +159,23 @@ template struct mark_bits { } }; +template struct heap_compacter { + mark_bits *state; + char *address; + Iterator &iter; + + explicit heap_compacter(mark_bits *state_, Block *address_, Iterator &iter_) : + state(state_), address((char *)address_), iter(iter_) {} + + void operator()(Block *block, cell size) + { + if(this->state->is_marked_p(block)) + { + memmove(address,block,size); + iter((Block *)address,size); + address += size; + } + } +}; + } diff --git a/vm/quotations.cpp b/vm/quotations.cpp index 9c2c85215d..d75d1c680c 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -283,7 +283,6 @@ void quotation_jit::iterate_quotation() void factor_vm::set_quot_xt(quotation *quot, code_block *code) { - assert(code->type() == QUOTATION_TYPE); quot->code = code; quot->xt = code->xt(); } diff --git a/vm/vm.hpp b/vm/vm.hpp index 7742ea8d60..05a918c5e9 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -524,17 +524,19 @@ struct factor_vm void primitive_strip_stack_traces(); /* Apply a function to every code block */ - template void iterate_code_heap(Iterator &iter) - { - heap_block *scan = code->first_block(); - heap_block *end = code->last_block(); - - while(scan != end) + template struct code_heap_iterator { + Iterator &iter; + explicit code_heap_iterator(Iterator &iter_) : iter(iter_) {} + void operator()(heap_block *block, cell size) { - if(scan->type() != FREE_BLOCK_TYPE) - iter((code_block *)scan); - scan = scan->next(); + iter((code_block *)block,size); } + }; + + template void iterate_code_heap(Iterator &iter_) + { + code_heap_iterator iter(iter_); + code->iterate_heap(iter); } //callbacks From bf5d0de8404c838cde7fe1a90177c84d49093bab Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 03:44:50 -0500 Subject: [PATCH 007/109] peg.ebnf: turn $unchecked-examples into $examples --- basis/eval/eval.factor | 7 +- basis/peg/ebnf/ebnf-docs.factor | 114 ++++++++++-------- basis/stack-checker/stack-checker-docs.factor | 6 +- 3 files changed, 74 insertions(+), 53 deletions(-) diff --git a/basis/eval/eval.factor b/basis/eval/eval.factor index c4eab2d6ab..65f13261a9 100644 --- a/basis/eval/eval.factor +++ b/basis/eval/eval.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: splitting parser parser.notes compiler.units kernel namespaces -debugger io.streams.string fry combinators effects.parser ; +USING: splitting parser parser.notes compiler.units kernel +namespaces debugger io.streams.string fry combinators +effects.parser continuations ; IN: eval : parse-string ( str -- quot ) @@ -19,7 +20,7 @@ SYNTAX: eval( \ eval parse-call( ; [ "quiet" on parser-notes off - '[ _ (( -- )) (eval) ] try + '[ _ (( -- )) (eval) ] [ print-error ] recover ] with-string-writer ; : eval>string ( str -- output ) diff --git a/basis/peg/ebnf/ebnf-docs.factor b/basis/peg/ebnf/ebnf-docs.factor index 5057693334..8a7ca96d5b 100644 --- a/basis/peg/ebnf/ebnf-docs.factor +++ b/basis/peg/ebnf/ebnf-docs.factor @@ -10,11 +10,11 @@ HELP: [[ drop \"foo\" ]] EBNF> replace ." "\"foocdfoo\"" } @@ -31,7 +31,7 @@ HELP: [EBNF "quotation throws an exception." } { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"ab\" [EBNF rule=\"a\" \"b\" EBNF] ." "V{ \"a\" \"b\" }" @@ -49,8 +49,9 @@ HELP: EBNF: "word throws an exception." } { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" + "IN: scratchpad" "EBNF: foo rule=\"a\" \"b\" ;EBNF" "\"ab\" foo ." "V{ \"a\" \"b\" }" @@ -61,7 +62,7 @@ ARTICLE: "peg.ebnf.strings" "Strings" "A string in a rule will match that sequence of characters from the input string. " "The AST result from the match is the string itself." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"helloworld\" [EBNF rule=\"hello\" \"world\" EBNF] ." "V{ \"hello\" \"world\" }" @@ -72,7 +73,7 @@ ARTICLE: "peg.ebnf.any" "Any" "A full stop character (.) will match any single token in the input string. " "The AST resulting from this is the token itself." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"abc\" [EBNF rule=\"a\" . \"c\" EBNF] ." "V{ \"a\" 98 \"c\" }" @@ -85,9 +86,9 @@ ARTICLE: "peg.ebnf.sequence" "Sequence" "goes. The AST result is a vector containing the results of each rule element in " "the sequence." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" - "\"helloworld\" [EBNF rule=\"a\" (\"b\")* \"a\" EBNF] ." + "\"abbba\" [EBNF rule=\"a\" (\"b\"*) \"a\" EBNF] ." "V{ \"a\" V{ \"b\" \"b\" \"b\" } \"a\" }" } } @@ -98,14 +99,20 @@ ARTICLE: "peg.ebnf.choice" "Choice" "are matched against the input stream in order. If a match succeeds then the remaining " "choices are discarded and the result of the match is the AST result of the choice." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"a\" [EBNF rule=\"a\" | \"b\" | \"c\" EBNF] ." "\"a\"" + } + { $example + "USING: prettyprint peg.ebnf ;" "\"b\" [EBNF rule=\"a\" | \"b\" | \"c\" EBNF] ." "\"b\"" + } + { $example + "USING: prettyprint peg.ebnf ;" "\"d\" [EBNF rule=\"a\" | \"b\" | \"c\" EBNF] ." - "Peg parsing error at character position 0. Expected token 'c' or token 'b' or token 'a'" + "Peg parsing error at character position 0.\nExpected token 'c' or token 'b' or token 'a'" } } ; @@ -115,10 +122,13 @@ ARTICLE: "peg.ebnf.option" "Option" "rule is tested against the input. If it succeeds the result is stored in the AST. " "If it fails then the parse still suceeds and false (f) is stored in the AST." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"abc\" [EBNF rule=\"a\" \"b\"? \"c\" EBNF] ." "V{ \"a\" \"b\" \"c\" }" + } + { $example + "USING: prettyprint peg.ebnf ;" "\"ac\" [EBNF rule=\"a\" \"b\"? \"c\" EBNF] ." "V{ \"a\" f \"c\" }" } @@ -133,7 +143,7 @@ ARTICLE: "peg.ebnf.character-class" "Character Class" "The AST resulting from the match is an integer of the character code for the " "character that matched." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"123\" [EBNF rule=[0-9]+ EBNF] ." "V{ 49 50 51 }" @@ -146,7 +156,7 @@ ARTICLE: "peg.ebnf.one-or-more" "One or more" "from the input string. The AST result is the vector of the AST results from " "the matched rule." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"aab\" [EBNF rule=\"a\"+ \"b\" EBNF] ." "V{ V{ \"a\" \"a\" } \"b\" }" @@ -159,10 +169,13 @@ ARTICLE: "peg.ebnf.zero-or-more" "Zero or more" "from the input string. The AST result is the vector of the AST results from " "the matched rule. This will be empty if there are no matches." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"aab\" [EBNF rule=\"a\"* \"b\" EBNF] ." "V{ V{ \"a\" \"a\" } \"b\" }" + } + { $example + "USING: prettyprint peg.ebnf ;" "\"b\" [EBNF rule=\"a\"* \"b\" EBNF] ." "V{ V{ } \"b\" }" } @@ -177,7 +190,7 @@ ARTICLE: "peg.ebnf.and" "And" "does not leave any result in the AST. This can be used for lookahead and " "disambiguation in choices." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"ab\" [EBNF rule=&(\"a\") \"a\" \"b\" EBNF] ." "V{ \"a\" \"b\" }" @@ -193,7 +206,7 @@ ARTICLE: "peg.ebnf.not" "Not" "however and does not leave any result in the AST. This can be used for lookahead and " "disambiguation in choices." { $examples - { $unchecked-example + { $example "USING: prettyprint peg.ebnf ;" "\"\" [EBNF rule=\"<\" (!(\">\") .)* \">\" EBNF] ." "V{ \"<\" V{ 97 98 99 100 } \">\" }" @@ -214,10 +227,13 @@ ARTICLE: "peg.ebnf.action" "Action" "If an action leaves the object 'ignore' on the stack then the result of that " "action will not be put in the AST of the result." { $examples - { $unchecked-example - "USING: prettyprint peg.ebnf math.parser ;" + { $example + "USING: prettyprint peg.ebnf strings ;" "\"\" [EBNF rule=\"<\" ((!(\">\") .)* => [[ >string ]]) \">\" EBNF] ." "V{ \"<\" \"abcd\" \">\" }" + } + { $example + "USING: prettyprint peg.ebnf math.parser ;" "\"123\" [EBNF rule=[0-9]+ => [[ string>number ]] EBNF] ." "123" } @@ -231,12 +247,15 @@ ARTICLE: "peg.ebnf.semantic-action" "Semantic Action" { $snippet ( ast -- ? ) } ". " "A semantic action follows the rule it applies to and is delimeted by '?[' and ']?'." { $examples - { $unchecked-example - "USING: prettyprint peg.ebnf ;" + { $example + "USING: prettyprint peg.ebnf math math.parser ;" "\"1\" [EBNF rule=[0-9] ?[ digit> odd? ]? EBNF] ." "49" + } + { $example + "USING: prettyprint peg.ebnf math math.parser ;" "\"2\" [EBNF rule=[0-9] ?[ digit> odd? ]? EBNF] ." - "..error.." + "Sequence index out of bounds\nindex 0\nseq V{ }" } } ; @@ -246,8 +265,8 @@ ARTICLE: "peg.ebnf.variable" "Variable" "followed by the variable name. These can then be used in rule actions to refer to " "the AST result of the rule element with that variable name." { $examples - { $unchecked-example - "USING: prettyprint peg.ebnf ;" + { $example + "USING: prettyprint peg.ebnf math.parser ;" "\"1+2\" [EBNF rule=[0-9]:a \"+\" [0-9]:b => [[ a digit> b digit> + ]] EBNF] ." "3" } @@ -264,7 +283,7 @@ ARTICLE: "peg.ebnf.foreign-rules" "Foreign Rules" { $vocab-link "peg" } " defined parser and it will be called to perform the parse " "for that rule." { $examples - { $unchecked-example + { $code "USING: prettyprint peg.ebnf ;" "EBNF: parse-string" "StringBody = (!('\"') .)*" @@ -277,7 +296,7 @@ ARTICLE: "peg.ebnf.foreign-rules" "Foreign Rules" "TwoString = " ";EBNF" } - { $unchecked-example + { $code ": a-token ( -- parser ) \"a\" token ;" "EBNF: parse-abc" "abc = 'b' 'c'" @@ -291,7 +310,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" "Usually the input sequence to be parsed is an array of characters or a string. " "Terminals in a rule match successive characters in the array or string. " { $examples - { $unchecked-example + { $code "EBNF: foo" "rule = \"++\" \"--\"" ";EBNF" @@ -302,7 +321,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" "If you want to add whitespace handling to the grammar you need to put it " "between the terminals: " { $examples - { $unchecked-example + { $code "EBNF: foo" "space = (\" \" | \"\\r\" | \"\\t\" | \"\\n\")" "spaces = space* => [[ drop ignore ]]" @@ -315,7 +334,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" "have the grammar operate on these tokens. This is how the previous example " "might look: " { $examples - { $unchecked-example + { $code "EBNF: foo" "space = (\" \" | \"\\r\" | \"\\t\" | \"\\n\")" "spaces = space* => [[ drop ignore ]]" @@ -332,9 +351,17 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" "instead of the string \"++--\". With the new tokenizer \"....\" sequences " "in the grammar are matched for equality against the token, rather than a " "string comparison against successive items in the sequence. This can be used " -"to match an AST from a tokenizer: " +"to match an AST from a tokenizer. " +$nl +"In this example I split the tokenizer into a separate parser and use " +"'foreign' to call it from the main one. This allows testing of the " +"tokenizer separately: " { $examples - { $unchecked-example + { $example + "USING: prettyprint peg peg.ebnf kernel math.parser strings" + "accessors math arrays ;" + "IN: scratchpad" + "" "TUPLE: ast-number value ;" "TUPLE: ast-string value ;" "" @@ -342,15 +369,14 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" "space = (\" \" | \"\\r\" | \"\\t\" | \"\\n\")" "spaces = space* => [[ drop ignore ]]" "" - "number = [0-9]* => [[ >string string>number ast-number boa ]]" - "string = => [[ ast-string boa ]]" + "number = [0-9]+ => [[ >string string>number ast-number boa ]]" "operator = (\"+\" | \"-\")" "" - "token = spaces ( number | string | operator )" + "token = spaces ( number | operator )" "tokens = token*" ";EBNF" "" - "ENBF: foo" + "EBNF: foo" "tokenizer = " "" "number = . ?[ ast-number? ]? => [[ value>> ]]" @@ -358,15 +384,9 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" "" "rule = string:a number:b \"+\" number:c => [[ a b c + 2array ]]" ";EBNF" - } -} -"In this example I split the tokenizer into a separate parser and use " -"'foreign' to call it from the main one. This allows testing of the " -"tokenizer separately: " -{ $examples - { $unchecked-example - "\"123 456 +\" foo-tokenizer ast>> ." - "{ T{ ast-number f 123 } T{ ast-number f 456 } \"+\" }" + "" + "\"123 456 +\" foo-tokenizer ." + "V{\n T{ ast-number { value 123 } }\n T{ ast-number { value 456 } }\n \"+\"\n}" } } "The '.' EBNF production means match a single object in the source sequence. " @@ -379,7 +399,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" "switch tokenizers multiple times during a grammar. Rules use the tokenizer that " "was defined lexically before the rule. This is usefull in the JavaScript grammar: " { $examples - { $unchecked-example + { $code "EBNF: javascript" "tokenizer = default" "nl = \"\\r\" \"\\n\" | \"\\n\"" @@ -402,7 +422,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" "rule (managed by the 'Sc' rule here). If there is a newline, the semicolon can " "be optional in places. " { $examples - { $unchecked-example + { $code "\"do\" Stmt:s \"while\" \"(\" Expr:c \")\" Sc => [[ s c ast-do-while boa ]]" } } @@ -412,7 +432,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers" ; ARTICLE: "peg.ebnf" "EBNF" -"This vocubalary provides a DSL that allows writing PEG parsers that look like " +"The " { $vocab-link "peg.ebnf" } " vocabulary provides a DSL that allows writing PEG parsers that look like " "EBNF syntax. It provides three parsing words described below. These words all " "accept the same EBNF syntax. The difference is in how they are used. " { $subsection POSTPONE: Date: Mon, 19 Oct 2009 04:05:26 -0500 Subject: [PATCH 008/109] peg.ebnf: fix --- basis/peg/ebnf/ebnf-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/peg/ebnf/ebnf-docs.factor b/basis/peg/ebnf/ebnf-docs.factor index 8a7ca96d5b..9bfd8ce499 100644 --- a/basis/peg/ebnf/ebnf-docs.factor +++ b/basis/peg/ebnf/ebnf-docs.factor @@ -88,7 +88,7 @@ ARTICLE: "peg.ebnf.sequence" "Sequence" { $examples { $example "USING: prettyprint peg.ebnf ;" - "\"abbba\" [EBNF rule=\"a\" (\"b\"*) \"a\" EBNF] ." + "\"abbba\" [EBNF rule=\"a\" (\"b\")* \"a\" EBNF] ." "V{ \"a\" V{ \"b\" \"b\" \"b\" } \"a\" }" } } From 102af9badb1a4d02a09521882710fc9b0282de67 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 04:41:53 -0500 Subject: [PATCH 009/109] specialized-arrays, specialized-vectors: fix potential problem if two vocabularies define different C types with the same name --- basis/images/bitmap/bitmap.factor | 4 +-- basis/io/mmap/mmap-tests.factor | 3 ++- .../specialized-arrays-docs.factor | 2 +- .../specialized-arrays-tests.factor | 11 +++++--- .../specialized-arrays.factor | 24 +++++++++-------- .../specialized-vectors-docs.factor | 13 +++++++++ .../specialized-vectors-tests.factor | 3 +-- .../specialized-vectors.factor | 27 ++++++++++++++----- extra/random/cmwc/cmwc-tests.factor | 3 ++- extra/random/cmwc/cmwc.factor | 3 ++- .../lagged-fibonacci-tests.factor | 3 ++- 11 files changed, 65 insertions(+), 31 deletions(-) diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index f14dd3290c..fa12aaa320 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -6,8 +6,8 @@ images.loader images.normalization io io.binary io.encodings.binary io.encodings.string io.files io.streams.limited kernel locals macros math math.bitwise math.functions namespaces sequences specialized-arrays -specialized-arrays.instances.uint -specialized-arrays.instances.ushort strings summary ; +strings summary ; +SPECIALIZED-ARRAYS: uint ushort ; IN: images.bitmap SINGLETON: bmp-image diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor index 94f8c77883..967009243e 100644 --- a/basis/io/mmap/mmap-tests.factor +++ b/basis/io/mmap/mmap-tests.factor @@ -1,7 +1,8 @@ USING: alien.c-types alien.data compiler.tree.debugger continuations io.directories io.encodings.ascii io.files io.files.temp io.mmap kernel math sequences sequences.private -specialized-arrays specialized-arrays.instances.uint tools.test ; +specialized-arrays tools.test ; +SPECIALIZED-ARRAY: uint IN: io.mmap.tests [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors diff --git a/basis/specialized-arrays/specialized-arrays-docs.factor b/basis/specialized-arrays/specialized-arrays-docs.factor index 50e94b65e9..68ce02e71e 100755 --- a/basis/specialized-arrays/specialized-arrays-docs.factor +++ b/basis/specialized-arrays/specialized-arrays-docs.factor @@ -86,7 +86,7 @@ ARTICLE: "specialized-array-examples" "Specialized array examples" ARTICLE: "specialized-arrays" "Specialized arrays" "The " { $vocab-link "specialized-arrays" } " vocabulary implements fixed-length sequence types for storing machine values in a space-efficient manner without boxing." $nl -"A specialized array type needs to be generated for each element type. This is done with a parsing word:" +"A specialized array type needs to be generated for each element type. This is done with parsing words:" { $subsections POSTPONE: SPECIALIZED-ARRAY: POSTPONE: SPECIALIZED-ARRAYS: diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 1ee8776085..3226557494 100755 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -4,7 +4,7 @@ specialized-arrays.private sequences alien.c-types accessors kernel arrays combinators compiler compiler.units classes.struct combinators.smart compiler.tree.debugger math libc destructors sequences.private multiline eval words vocabs namespaces -assocs prettyprint alien.data math.vectors ; +assocs prettyprint alien.data math.vectors definitions ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: int @@ -120,9 +120,10 @@ SPECIALIZED-ARRAY: fixed-string [ "int-array@ f 100" ] [ f 100 unparse ] unit-test ! If the C type doesn't exist, don't generate a vocab +SYMBOL: __does_not_exist__ + [ ] [ - [ "__does_not_exist__" specialized-array-vocab forget-vocab ] with-compilation-unit - "__does_not_exist__" c-types get delete-at + [ __does_not_exist__ specialized-array-vocab forget-vocab ] with-compilation-unit ] unit-test [ @@ -146,6 +147,8 @@ SPECIALIZED-ARRAY: __does_not_exist__ [ f ] [ "__does_not_exist__-array{" - "__does_not_exist__" specialized-array-vocab lookup + __does_not_exist__ specialized-array-vocab lookup deferred? ] unit-test + +[ \ __does_not_exist__ forget ] with-compilation-unit diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index c5de95b5b5..67c58987a1 100755 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -6,7 +6,7 @@ libc math math.vectors math.vectors.private math.vectors.specialization namespaces parser prettyprint.custom sequences sequences.private strings summary vocabs vocabs.loader vocabs.parser vocabs.generated -words fry combinators present ; +words fry combinators make ; IN: specialized-arrays MIXIN: specialized-array @@ -125,11 +125,13 @@ M: word (underlying-type) "c-type" word-prop ; [ drop ] } cond ; -: underlying-type-name ( c-type -- name ) - underlying-type present ; - : specialized-array-vocab ( c-type -- vocab ) - present "specialized-arrays.instances." prepend ; + [ + "specialized-arrays.instances." % + [ vocabulary>> % "." % ] + [ name>> % ] + bi + ] "" make ; PRIVATE> @@ -143,18 +145,18 @@ M: c-type-name require-c-array define-array-vocab drop ; ERROR: specialized-array-vocab-not-loaded c-type ; M: c-type-name c-array-constructor - underlying-type-name - dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup + underlying-type + dup [ name>> "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable M: c-type-name c-(array)-constructor - underlying-type-name - dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup + underlying-type + dup [ name>> "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable M: c-type-name c-direct-array-constructor - underlying-type-name - dup [ "" surround ] [ specialized-array-vocab ] bi lookup + underlying-type + dup [ name>> "" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable SYNTAX: SPECIALIZED-ARRAYS: diff --git a/basis/specialized-vectors/specialized-vectors-docs.factor b/basis/specialized-vectors/specialized-vectors-docs.factor index 6b53885e13..e54f26ac57 100644 --- a/basis/specialized-vectors/specialized-vectors-docs.factor +++ b/basis/specialized-vectors/specialized-vectors-docs.factor @@ -6,6 +6,13 @@ HELP: SPECIALIZED-VECTOR: { $values { "type" "a C type" } } { $description "Brings a specialized vector for holding values of " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-vector-words" } "." } ; +HELP: SPECIALIZED-VECTORS: +{ $syntax "SPECIALIZED-VECTORS: type type type ... ;" } +{ $values { "type" "a C type" } } +{ $description "Brings a set of specialized vectors for holding values of each " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-vector-words" } "." } ; + +{ POSTPONE: SPECIALIZED-VECTOR: POSTPONE: SPECIALIZED-VECTORS: } related-words + ARTICLE: "specialized-vector-words" "Specialized vector words" "The " { $link POSTPONE: SPECIALIZED-VECTOR: } " parsing word generates the specialized vector type if it hasn't been generated already, and adds the following words to the vocabulary search path, where " { $snippet "T" } " is the C type in question:" { $table @@ -21,6 +28,12 @@ ARTICLE: "specialized-vector-c" "Passing specialized vectors to C functions" ARTICLE: "specialized-vectors" "Specialized vectors" "The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing." +$nl +"A specialized vector type needs to be generated for each element type. This is done with parsing words:" +{ $subsections + POSTPONE: SPECIALIZED-VECTOR: + POSTPONE: SPECIALIZED-VECTORS: +} { $subsections "specialized-vector-words" "specialized-vector-c" diff --git a/basis/specialized-vectors/specialized-vectors-tests.factor b/basis/specialized-vectors/specialized-vectors-tests.factor index c7a045a7e1..1519ad415e 100644 --- a/basis/specialized-vectors/specialized-vectors-tests.factor +++ b/basis/specialized-vectors/specialized-vectors-tests.factor @@ -2,8 +2,7 @@ IN: specialized-vectors.tests USING: specialized-arrays specialized-vectors tools.test kernel sequences alien.c-types ; SPECIALIZED-ARRAY: float -SPECIALIZED-VECTOR: float -SPECIALIZED-VECTOR: double +SPECIALIZED-VECTORS: float double ; [ 3 ] [ double-vector{ 1 2 } 3 over push length ] unit-test diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor index 7cda026cb3..75197d9ec0 100644 --- a/basis/specialized-vectors/specialized-vectors.factor +++ b/basis/specialized-vectors/specialized-vectors.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types assocs compiler.units functors -growable kernel lexer namespaces parser prettyprint.custom -sequences specialized-arrays specialized-arrays.private strings -vocabs vocabs.parser vocabs.generated fry ; +USING: accessors alien.c-types alien.parser assocs +compiler.units functors growable kernel lexer namespaces parser +prettyprint.custom sequences specialized-arrays +specialized-arrays.private strings vocabs vocabs.parser +vocabs.generated fry make ; QUALIFIED: vectors.functor IN: specialized-vectors @@ -41,8 +42,13 @@ INSTANCE: V S ;FUNCTOR -: specialized-vector-vocab ( type -- vocab ) - "specialized-vectors.instances." prepend ; +: specialized-vector-vocab ( c-type -- vocab ) + [ + "specialized-vectors.instances." % + [ vocabulary>> % "." % ] + [ name>> % ] + bi + ] "" make ; PRIVATE> @@ -51,7 +57,14 @@ PRIVATE> [ specialized-vector-vocab ] [ '[ _ define-vector ] ] bi generate-vocab ; +SYNTAX: SPECIALIZED-VECTORS: + ";" parse-tokens [ + parse-c-type + [ define-array-vocab use-vocab ] + [ define-vector-vocab use-vocab ] bi + ] each ; + SYNTAX: SPECIALIZED-VECTOR: - scan + scan-c-type [ define-array-vocab use-vocab ] [ define-vector-vocab use-vocab ] bi ; diff --git a/extra/random/cmwc/cmwc-tests.factor b/extra/random/cmwc/cmwc-tests.factor index 8dc9f8764f..d5e1fe6858 100644 --- a/extra/random/cmwc/cmwc-tests.factor +++ b/extra/random/cmwc/cmwc-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types arrays kernel random random.cmwc sequences -specialized-arrays specialized-arrays.instances.uint tools.test ; +specialized-arrays tools.test ; +SPECIALIZED-ARRAY: uint IN: random.cmwc.tests [ ] [ diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor index 941840f23a..3fda392d80 100644 --- a/extra/random/cmwc/cmwc.factor +++ b/extra/random/cmwc/cmwc.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types arrays fry kernel locals math math.bitwise random sequences sequences.private -specialized-arrays specialized-arrays.instances.uint ; +specialized-arrays ; +SPECIALIZED-ARRAY: uint IN: random.cmwc ! Multiply-with-carry RNG diff --git a/extra/random/lagged-fibonacci/lagged-fibonacci-tests.factor b/extra/random/lagged-fibonacci/lagged-fibonacci-tests.factor index e830c466c2..df90d4d40f 100644 --- a/extra/random/lagged-fibonacci/lagged-fibonacci-tests.factor +++ b/extra/random/lagged-fibonacci/lagged-fibonacci-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: fry kernel math.functions random random.lagged-fibonacci -sequences specialized-arrays.instances.double tools.test ; +sequences tools.test specialized-arrays alien.c-types ; +SPECIALIZED-ARRAY: double IN: random.lagged-fibonacci.tests [ t ] [ From 2d5cdd19ec5d5ee17a521afd0723cf749d814aee Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 04:58:29 -0500 Subject: [PATCH 010/109] compiler: on PPC, ANDI, ORI and XORI instructions take an unsigned 16-bit immediate, unlike ADDI, SUBI and MULLI which take a signed 16-bit immediate. The code generator was not aware of this, and so for example '[ >fixnum -16 bitand ]' would generate incorrect code. Split up small-enough? hook into immediate-arithmetic? and immediate-bitwise? and update value numbering to be aware of this. Fixes classes.struct bitfields test failure --- .../cfg/intrinsics/slots/slots.factor | 17 +++++-- .../value-numbering/rewrite/rewrite.factor | 46 ++++++++++++++----- basis/compiler/tests/intrinsics.factor | 3 ++ .../tree/propagation/info/info.factor | 15 ------ basis/cpu/architecture/architecture.factor | 10 ++-- basis/cpu/ppc/ppc.factor | 4 +- basis/cpu/x86/x86.factor | 5 +- 7 files changed, 64 insertions(+), 36 deletions(-) diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor index 8a86c984fe..e1088a80ef 100644 --- a/basis/compiler/cfg/intrinsics/slots/slots.factor +++ b/basis/compiler/cfg/intrinsics/slots/slots.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: layouts namespaces kernel accessors sequences -classes.algebra locals compiler.tree.propagation.info -compiler.cfg.stacks compiler.cfg.hats compiler.cfg.registers +USING: layouts namespaces kernel accessors sequences math +classes.algebra locals combinators cpu.architecture +compiler.tree.propagation.info compiler.cfg.stacks +compiler.cfg.hats compiler.cfg.registers compiler.cfg.instructions compiler.cfg.utilities compiler.cfg.builder.blocks compiler.constants ; IN: compiler.cfg.intrinsics.slots @@ -22,11 +23,17 @@ IN: compiler.cfg.intrinsics.slots [ [ second literal>> ] [ first value-tag ] bi ] bi* ^^slot-imm ; +: immediate-slot-offset? ( value-info -- ? ) + literal>> { + { [ dup fixnum? ] [ tag-fixnum immediate-arithmetic? ] } + [ drop f ] + } cond ; + : emit-slot ( node -- ) dup node-input-infos dup first value-tag [ nip - dup second value-info-small-fixnum? + dup second immediate-slot-offset? [ (emit-slot-imm) ] [ (emit-slot) ] if ds-push ] [ drop emit-primitive ] if ; @@ -61,7 +68,7 @@ IN: compiler.cfg.intrinsics.slots dup node-input-infos dup second value-tag [ nip - dup third value-info-small-fixnum? + dup third immediate-slot-offset? [ (emit-set-slot-imm) ] [ (emit-set-slot) ] if ] [ drop emit-primitive ] if ; diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index 3842942a3b..bc228cb3b4 100755 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -13,11 +13,18 @@ compiler.cfg.value-numbering.graph compiler.cfg.value-numbering.simplify ; IN: compiler.cfg.value-numbering.rewrite -: vreg-small-constant? ( vreg -- ? ) +: vreg-immediate-arithmetic? ( vreg -- ? ) vreg>expr { [ constant-expr? ] [ value>> fixnum? ] - [ value>> small-enough? ] + [ value>> immediate-arithmetic? ] + } 1&& ; + +: vreg-immediate-bitwise? ( vreg -- ? ) + vreg>expr { + [ constant-expr? ] + [ value>> fixnum? ] + [ value>> immediate-bitwise? ] } 1&& ; ! Outputs f to mean no change @@ -174,8 +181,8 @@ M: ##compare-imm-branch rewrite M: ##compare-branch rewrite { - { [ dup src1>> vreg-small-constant? ] [ t >compare-imm-branch ] } - { [ dup src2>> vreg-small-constant? ] [ f >compare-imm-branch ] } + { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-imm-branch ] } + { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-imm-branch ] } { [ dup self-compare? ] [ rewrite-self-compare-branch ] } [ drop f ] } cond ; @@ -205,8 +212,8 @@ M: ##compare-branch rewrite M: ##compare rewrite { - { [ dup src1>> vreg-small-constant? ] [ t >compare-imm ] } - { [ dup src2>> vreg-small-constant? ] [ f >compare-imm ] } + { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-imm ] } + { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-imm ] } { [ dup self-compare? ] [ rewrite-self-compare ] } [ drop f ] } cond ; @@ -264,6 +271,19 @@ M: ##neg rewrite M: ##not rewrite maybe-unary-constant-fold ; +: arithmetic-op? ( op -- ? ) + { + ##add + ##add-imm + ##sub + ##sub-imm + ##mul + ##mul-imm + } memq? ; + +: immediate? ( value op -- ? ) + arithmetic-op? [ immediate-arithmetic? ] [ immediate-bitwise? ] if ; + : reassociate ( insn op -- insn ) [ { @@ -273,7 +293,7 @@ M: ##not rewrite [ ] } cleave constant-fold* ] dip - over small-enough? [ new-insn ] [ 2drop 2drop f ] if ; inline + 2dup immediate? [ new-insn ] [ 2drop 2drop f ] if ; inline M: ##add-imm rewrite { @@ -283,7 +303,7 @@ M: ##add-imm rewrite } cond ; : sub-imm>add-imm ( insn -- insn' ) - [ dst>> ] [ src1>> ] [ src2>> neg ] tri dup small-enough? + [ dst>> ] [ src1>> ] [ src2>> neg ] tri dup immediate-arithmetic? [ \ ##add-imm new-insn ] [ 3drop f ] if ; M: ##sub-imm rewrite @@ -358,16 +378,20 @@ M: ##sar-imm rewrite [ swap ] when vreg>constant ] dip new-insn ; inline +: vreg-immediate? ( vreg op -- ? ) + arithmetic-op? + [ vreg-immediate-arithmetic? ] [ vreg-immediate-bitwise? ] if ; + : rewrite-arithmetic ( insn op -- ? ) { - { [ over src2>> vreg-small-constant? ] [ f insn>imm-insn ] } + { [ over src2>> over vreg-immediate? ] [ f insn>imm-insn ] } [ 2drop f ] } cond ; inline : rewrite-arithmetic-commutative ( insn op -- ? ) { - { [ over src2>> vreg-small-constant? ] [ f insn>imm-insn ] } - { [ over src1>> vreg-small-constant? ] [ t insn>imm-insn ] } + { [ over src2>> over vreg-immediate? ] [ f insn>imm-insn ] } + { [ over src1>> over vreg-immediate? ] [ t insn>imm-insn ] } [ 2drop f ] } cond ; inline diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index 24114e0ccb..6431ba1d9c 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -87,14 +87,17 @@ IN: compiler.tests.intrinsics [ 4 ] [ 12 7 [ fixnum-bitand ] compile-call ] unit-test [ 4 ] [ 12 [ 7 fixnum-bitand ] compile-call ] unit-test [ 4 ] [ [ 12 7 fixnum-bitand ] compile-call ] unit-test +[ -16 ] [ -1 [ -16 fixnum-bitand ] compile-call ] unit-test [ 15 ] [ 12 7 [ fixnum-bitor ] compile-call ] unit-test [ 15 ] [ 12 [ 7 fixnum-bitor ] compile-call ] unit-test [ 15 ] [ [ 12 7 fixnum-bitor ] compile-call ] unit-test +[ -1 ] [ -1 [ -16 fixnum-bitor ] compile-call ] unit-test [ 11 ] [ 12 7 [ fixnum-bitxor ] compile-call ] unit-test [ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-call ] unit-test [ 11 ] [ [ 12 7 fixnum-bitxor ] compile-call ] unit-test +[ -16 ] [ -1 [ -16 fixnum-bitxor ] compile-call ] unit-test [ f ] [ 12 7 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test [ f ] [ 12 [ 7 fixnum< [ t ] [ f ] if ] compile-call ] unit-test diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 53b2109bbb..9030914e34 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -340,18 +340,3 @@ SYMBOL: value-infos dup in-d>> last node-value-info literal>> first immutable-tuple-class? ] [ drop f ] if ; - -: value-info-small-fixnum? ( value-info -- ? ) - literal>> { - { [ dup fixnum? ] [ tag-fixnum small-enough? ] } - [ drop f ] - } cond ; - -: value-info-small-tagged? ( value-info -- ? ) - dup literal?>> [ - literal>> { - { [ dup fixnum? ] [ tag-fixnum small-enough? ] } - { [ dup not ] [ drop t ] } - [ drop f ] - } cond - ] [ drop f ] if ; diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index d5b84b7002..2f0bdbdcbf 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -440,9 +440,13 @@ M: reg-class param-reg param-regs nth ; M: stack-params param-reg drop ; -! Is this integer small enough to appear in value template -! slots? -HOOK: small-enough? cpu ( n -- ? ) +! Is this integer small enough to be an immediate operand for +! %add-imm, %sub-imm, and %mul-imm? +HOOK: immediate-arithmetic? cpu ( n -- ? ) + +! Is this integer small enough to be an immediate operand for +! %and-imm, %or-imm, and %xor-imm? +HOOK: immediate-bitwise? cpu ( n -- ? ) ! Is this structure small enough to be returned in registers? HOOK: return-struct-in-registers? cpu ( c-type -- ? ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 48eaf54f46..02e1d7cb94 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -681,7 +681,9 @@ M: ppc %callback-value ( ctype -- ) ! Unbox former top of data stack to return registers unbox-return ; -M: ppc small-enough? ( n -- ? ) -32768 32767 between? ; +M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ; + +M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ; M: ppc return-struct-in-registers? ( c-type -- ? ) c-type return-in-registers?>> ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 60d47b78ff..5db2641907 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -1337,7 +1337,10 @@ M:: x86 %save-context ( temp1 temp2 callback-allowed? -- ) M: x86 value-struct? drop t ; -M: x86 small-enough? ( n -- ? ) +M: x86 immediate-arithmetic? ( n -- ? ) + HEX: -80000000 HEX: 7fffffff between? ; + +M: x86 immediate-bitwise? ( n -- ? ) HEX: -80000000 HEX: 7fffffff between? ; : next-stack@ ( n -- operand ) From 6a2434b56c3feb904d9e4ca035fb60ef055dcffd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 05:03:02 -0500 Subject: [PATCH 011/109] compiler: fix low-level-ir test on PowerPC --- basis/compiler/tests/low-level-ir.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor index e508b55b8d..14c470d63f 100644 --- a/basis/compiler/tests/low-level-ir.factor +++ b/basis/compiler/tests/low-level-ir.factor @@ -98,7 +98,7 @@ IN: compiler.tests.low-level-ir V{ T{ ##load-reference f 1 B{ 31 67 52 } } T{ ##unbox-any-c-ptr f 0 1 2 } - T{ ##alien-unsigned-1 f 0 0 } + T{ ##alien-unsigned-1 f 0 0 0 } T{ ##shl-imm f 0 0 3 } } compile-test-bb ] unit-test From b2592e01c106e57553f2faec59cc591fc2bbf117 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 05:16:04 -0500 Subject: [PATCH 012/109] compiler: fix typo in intrinsics tests --- basis/compiler/tests/intrinsics.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index 6431ba1d9c..75cfc1d67f 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -97,7 +97,7 @@ IN: compiler.tests.intrinsics [ 11 ] [ 12 7 [ fixnum-bitxor ] compile-call ] unit-test [ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-call ] unit-test [ 11 ] [ [ 12 7 fixnum-bitxor ] compile-call ] unit-test -[ -16 ] [ -1 [ -16 fixnum-bitxor ] compile-call ] unit-test +[ 15 ] [ -1 [ -16 fixnum-bitxor ] compile-call ] unit-test [ f ] [ 12 7 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test [ f ] [ 12 [ 7 fixnum< [ t ] [ f ] if ] compile-call ] unit-test From 2b868bd1c33cb81f0e566b04f267e0d48000f9bd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 05:22:43 -0500 Subject: [PATCH 013/109] random.sfmt: make it endian-agnostic --- basis/random/sfmt/sfmt.factor | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/basis/random/sfmt/sfmt.factor b/basis/random/sfmt/sfmt.factor index 28883838ce..eb78d7e812 100644 --- a/basis/random/sfmt/sfmt.factor +++ b/basis/random/sfmt/sfmt.factor @@ -4,7 +4,7 @@ USING: accessors alien.c-types kernel locals math math.ranges math.bitwise math.vectors math.vectors.simd random sequences specialized-arrays sequences.private classes.struct combinators.short-circuit fry ; -SIMD: uint +SIMDS: uchar uint ; SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: uint-4 IN: random.sfmt @@ -28,14 +28,25 @@ TUPLE: sfmt { uint-array uint-array } { uint-4-array uint-4-array } ; +: endian-shuffle ( v -- w ) + little-endian? [ + B{ 3 2 1 0 7 6 5 4 11 10 9 8 15 14 13 12 } uint-4 boa vshuffle + ] unless ; inline + +: hlshift* ( v n -- w ) + [ endian-shuffle ] dip hlshift endian-shuffle ; inline + +: hrshift* ( v n -- w ) + [ endian-shuffle ] dip hrshift endian-shuffle ; inline + : wA ( w -- wA ) - dup 1 hlshift vbitxor ; inline + dup 1 hlshift* vbitxor ; inline : wB ( w mask -- wB ) [ 11 vrshift ] dip vbitand ; inline : wC ( w -- wC ) - 1 hrshift ; inline + 1 hrshift* ; inline : wD ( w -- wD ) 18 vlshift ; inline From d5ea962bcb79f63368b46efaa53e1d080d4c445a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 05:56:35 -0500 Subject: [PATCH 014/109] Move modules and peg-lexer to unmaintained --- {extra => unmaintained}/modules/rpc-server/authors.txt | 0 {extra => unmaintained}/modules/rpc-server/rpc-server-docs.factor | 0 {extra => unmaintained}/modules/rpc-server/rpc-server.factor | 0 {extra => unmaintained}/modules/rpc-server/summary.txt | 0 {extra => unmaintained}/modules/rpc/authors.txt | 0 {extra => unmaintained}/modules/rpc/rpc-docs.factor | 0 {extra => unmaintained}/modules/rpc/rpc.factor | 0 {extra => unmaintained}/modules/rpc/summary.txt | 0 {extra => unmaintained}/modules/using/authors.txt | 0 {extra => unmaintained}/modules/using/summary.txt | 0 {extra => unmaintained}/modules/using/using-docs.factor | 0 {extra => unmaintained}/modules/using/using.factor | 0 {extra => unmaintained}/peg-lexer/authors.txt | 0 {extra => unmaintained}/peg-lexer/peg-lexer-docs.factor | 0 {extra => unmaintained}/peg-lexer/peg-lexer-tests.factor | 0 {extra => unmaintained}/peg-lexer/peg-lexer.factor | 0 {extra => unmaintained}/peg-lexer/summary.txt | 0 {extra => unmaintained}/peg-lexer/tags.txt | 0 .../peg-lexer/test-parsers/test-parsers.factor | 0 19 files changed, 0 insertions(+), 0 deletions(-) rename {extra => unmaintained}/modules/rpc-server/authors.txt (100%) rename {extra => unmaintained}/modules/rpc-server/rpc-server-docs.factor (100%) rename {extra => unmaintained}/modules/rpc-server/rpc-server.factor (100%) rename {extra => unmaintained}/modules/rpc-server/summary.txt (100%) rename {extra => unmaintained}/modules/rpc/authors.txt (100%) rename {extra => unmaintained}/modules/rpc/rpc-docs.factor (100%) rename {extra => unmaintained}/modules/rpc/rpc.factor (100%) rename {extra => unmaintained}/modules/rpc/summary.txt (100%) rename {extra => unmaintained}/modules/using/authors.txt (100%) rename {extra => unmaintained}/modules/using/summary.txt (100%) rename {extra => unmaintained}/modules/using/using-docs.factor (100%) rename {extra => unmaintained}/modules/using/using.factor (100%) rename {extra => unmaintained}/peg-lexer/authors.txt (100%) rename {extra => unmaintained}/peg-lexer/peg-lexer-docs.factor (100%) rename {extra => unmaintained}/peg-lexer/peg-lexer-tests.factor (100%) rename {extra => unmaintained}/peg-lexer/peg-lexer.factor (100%) rename {extra => unmaintained}/peg-lexer/summary.txt (100%) rename {extra => unmaintained}/peg-lexer/tags.txt (100%) rename {extra => unmaintained}/peg-lexer/test-parsers/test-parsers.factor (100%) diff --git a/extra/modules/rpc-server/authors.txt b/unmaintained/modules/rpc-server/authors.txt similarity index 100% rename from extra/modules/rpc-server/authors.txt rename to unmaintained/modules/rpc-server/authors.txt diff --git a/extra/modules/rpc-server/rpc-server-docs.factor b/unmaintained/modules/rpc-server/rpc-server-docs.factor similarity index 100% rename from extra/modules/rpc-server/rpc-server-docs.factor rename to unmaintained/modules/rpc-server/rpc-server-docs.factor diff --git a/extra/modules/rpc-server/rpc-server.factor b/unmaintained/modules/rpc-server/rpc-server.factor similarity index 100% rename from extra/modules/rpc-server/rpc-server.factor rename to unmaintained/modules/rpc-server/rpc-server.factor diff --git a/extra/modules/rpc-server/summary.txt b/unmaintained/modules/rpc-server/summary.txt similarity index 100% rename from extra/modules/rpc-server/summary.txt rename to unmaintained/modules/rpc-server/summary.txt diff --git a/extra/modules/rpc/authors.txt b/unmaintained/modules/rpc/authors.txt similarity index 100% rename from extra/modules/rpc/authors.txt rename to unmaintained/modules/rpc/authors.txt diff --git a/extra/modules/rpc/rpc-docs.factor b/unmaintained/modules/rpc/rpc-docs.factor similarity index 100% rename from extra/modules/rpc/rpc-docs.factor rename to unmaintained/modules/rpc/rpc-docs.factor diff --git a/extra/modules/rpc/rpc.factor b/unmaintained/modules/rpc/rpc.factor similarity index 100% rename from extra/modules/rpc/rpc.factor rename to unmaintained/modules/rpc/rpc.factor diff --git a/extra/modules/rpc/summary.txt b/unmaintained/modules/rpc/summary.txt similarity index 100% rename from extra/modules/rpc/summary.txt rename to unmaintained/modules/rpc/summary.txt diff --git a/extra/modules/using/authors.txt b/unmaintained/modules/using/authors.txt similarity index 100% rename from extra/modules/using/authors.txt rename to unmaintained/modules/using/authors.txt diff --git a/extra/modules/using/summary.txt b/unmaintained/modules/using/summary.txt similarity index 100% rename from extra/modules/using/summary.txt rename to unmaintained/modules/using/summary.txt diff --git a/extra/modules/using/using-docs.factor b/unmaintained/modules/using/using-docs.factor similarity index 100% rename from extra/modules/using/using-docs.factor rename to unmaintained/modules/using/using-docs.factor diff --git a/extra/modules/using/using.factor b/unmaintained/modules/using/using.factor similarity index 100% rename from extra/modules/using/using.factor rename to unmaintained/modules/using/using.factor diff --git a/extra/peg-lexer/authors.txt b/unmaintained/peg-lexer/authors.txt similarity index 100% rename from extra/peg-lexer/authors.txt rename to unmaintained/peg-lexer/authors.txt diff --git a/extra/peg-lexer/peg-lexer-docs.factor b/unmaintained/peg-lexer/peg-lexer-docs.factor similarity index 100% rename from extra/peg-lexer/peg-lexer-docs.factor rename to unmaintained/peg-lexer/peg-lexer-docs.factor diff --git a/extra/peg-lexer/peg-lexer-tests.factor b/unmaintained/peg-lexer/peg-lexer-tests.factor similarity index 100% rename from extra/peg-lexer/peg-lexer-tests.factor rename to unmaintained/peg-lexer/peg-lexer-tests.factor diff --git a/extra/peg-lexer/peg-lexer.factor b/unmaintained/peg-lexer/peg-lexer.factor similarity index 100% rename from extra/peg-lexer/peg-lexer.factor rename to unmaintained/peg-lexer/peg-lexer.factor diff --git a/extra/peg-lexer/summary.txt b/unmaintained/peg-lexer/summary.txt similarity index 100% rename from extra/peg-lexer/summary.txt rename to unmaintained/peg-lexer/summary.txt diff --git a/extra/peg-lexer/tags.txt b/unmaintained/peg-lexer/tags.txt similarity index 100% rename from extra/peg-lexer/tags.txt rename to unmaintained/peg-lexer/tags.txt diff --git a/extra/peg-lexer/test-parsers/test-parsers.factor b/unmaintained/peg-lexer/test-parsers/test-parsers.factor similarity index 100% rename from extra/peg-lexer/test-parsers/test-parsers.factor rename to unmaintained/peg-lexer/test-parsers/test-parsers.factor From b6a0324be660b0b3a7836bf18f8f8cc8c04d4f42 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 06:01:20 -0500 Subject: [PATCH 015/109] peg: fix unit test failures --- basis/peg/ebnf/ebnf-tests.factor | 6 +++--- extra/peg/javascript/parser/parser-tests.factor | 2 +- extra/peg/pl0/pl0-tests.factor | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/peg/ebnf/ebnf-tests.factor b/basis/peg/ebnf/ebnf-tests.factor index bcd881c03d..aba92899da 100644 --- a/basis/peg/ebnf/ebnf-tests.factor +++ b/basis/peg/ebnf/ebnf-tests.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: kernel tools.test peg peg.ebnf words math math.parser - sequences accessors peg.parsers parser namespaces arrays - strings eval unicode.data multiline ; +USING: kernel tools.test peg peg.ebnf peg.ebnf.private words +math math.parser sequences accessors peg.parsers parser +namespaces arrays strings eval unicode.data multiline ; IN: peg.ebnf.tests { T{ ebnf-non-terminal f "abc" } } [ diff --git a/extra/peg/javascript/parser/parser-tests.factor b/extra/peg/javascript/parser/parser-tests.factor index b587dab29d..87db981f40 100644 --- a/extra/peg/javascript/parser/parser-tests.factor +++ b/extra/peg/javascript/parser/parser-tests.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. ! USING: kernel tools.test peg peg.javascript.ast peg.javascript.parser - accessors sequences math peg.ebnf ; + accessors sequences math peg.ebnf peg.ebnf.private ; IN: peg.javascript.parser.tests { diff --git a/extra/peg/pl0/pl0-tests.factor b/extra/peg/pl0/pl0-tests.factor index 23e89bffdb..2d76c8df71 100644 --- a/extra/peg/pl0/pl0-tests.factor +++ b/extra/peg/pl0/pl0-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: kernel tools.test peg peg.ebnf peg.pl0 +USING: kernel tools.test peg peg.ebnf peg.ebnf.private peg.pl0 sequences accessors ; IN: peg.pl0.tests From 21d29b396158f898e5b3ecfb6a85de96685f6ed6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 06:10:39 -0500 Subject: [PATCH 016/109] vm: change code heap alignment to 16 bytes instead of 32 to reduce image size --- vm/heap.hpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vm/heap.hpp b/vm/heap.hpp index ef09c2b238..757364b3f6 100644 --- a/vm/heap.hpp +++ b/vm/heap.hpp @@ -1,8 +1,8 @@ namespace factor { -static const cell free_list_count = 16; -static const cell block_size_increment = 32; +static const cell free_list_count = 32; +static const cell block_size_increment = 16; struct heap_free_list { free_heap_block *small_blocks[free_list_count]; From b427eb3f9a950e3223196b151d785e2b179a1d01 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 06:11:00 -0500 Subject: [PATCH 017/109] tools.deploy: increase terrain size tolerance, decrease windows size tolerance --- basis/tools/deploy/deploy-tests.factor | 4 ++-- basis/tools/deploy/test/test.factor | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index e2d6f774e1..784b034665 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -22,7 +22,7 @@ IN: tools.deploy.tests [ t ] [ "spheres" shake-and-bake 1500000 small-enough? ] unit-test -[ t ] [ "terrain" shake-and-bake 1600000 small-enough? ] unit-test +[ t ] [ "terrain" shake-and-bake 1700000 small-enough? ] unit-test [ t ] [ "bunny" shake-and-bake 2500000 small-enough? ] unit-test @@ -114,4 +114,4 @@ os macosx? [ rest ] unit-test -[ ] [ "tools.deploy.test.16" shake-and-bake run-temp-image ] unit-test \ No newline at end of file +[ ] [ "tools.deploy.test.16" shake-and-bake run-temp-image ] unit-test diff --git a/basis/tools/deploy/test/test.factor b/basis/tools/deploy/test/test.factor index b93fddc3fe..c799ec615e 100755 --- a/basis/tools/deploy/test/test.factor +++ b/basis/tools/deploy/test/test.factor @@ -15,7 +15,7 @@ IN: tools.deploy.test [ cell 4 / * cpu ppc? [ 100000 + ] when - os windows? [ 250000 + ] when + os windows? [ 150000 + ] when ] bi* <= ; @@ -25,4 +25,4 @@ IN: tools.deploy.test "-i=" "test.image" temp-file append 2array ; : run-temp-image ( -- ) - deploy-test-command try-output-process ; \ No newline at end of file + deploy-test-command try-output-process ; From b411f1701a8b529919e73710af48c83e916f21b0 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 19 Oct 2009 12:25:55 -0500 Subject: [PATCH 018/109] make vshuffle-bytes intrinsic for any shuffle mask type --- basis/math/vectors/simd/functor/functor.factor | 1 + .../vectors/specialization/specialization.factor | 13 +++++++++++-- basis/math/vectors/vectors.factor | 2 +- basis/random/sfmt/sfmt.factor | 2 +- 4 files changed, 14 insertions(+), 4 deletions(-) diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor index fdb742a721..480981d165 100644 --- a/basis/math/vectors/simd/functor/functor.factor +++ b/basis/math/vectors/simd/functor/functor.factor @@ -280,6 +280,7 @@ simd new } >>special-wrappers { { { +vector+ +vector+ -> +vector+ } A-vv->v-op } + { { +vector+ +any-vector+ -> +vector+ } A-vv->v-op } { { +vector+ +scalar+ -> +vector+ } A-vn->v-op } { { +vector+ +literal+ -> +vector+ } A-vn->v-op } { { +vector+ +vector+ -> +scalar+ } A-vv->n-op } diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor index 62ebecff36..3ff286d508 100644 --- a/basis/math/vectors/specialization/specialization.factor +++ b/basis/math/vectors/specialization/specialization.factor @@ -7,12 +7,20 @@ namespaces assocs fry splitting classes.algebra generalizations locals compiler.tree.propagation.info ; IN: math.vectors.specialization -SYMBOLS: -> +vector+ +scalar+ +boolean+ +nonnegative+ +literal+ ; +SYMBOLS: -> +vector+ +any-vector+ +scalar+ +boolean+ +nonnegative+ +literal+ ; + +: parent-vector-class ( type -- type' ) + { + { [ dup simd-128 class<= ] [ drop simd-128 ] } + { [ dup simd-256 class<= ] [ drop simd-256 ] } + [ "Not a vector class" throw ] + } cond ; : signature-for-schema ( array-type elt-type schema -- signature ) [ { { +vector+ [ drop ] } + { +any-vector+ [ drop parent-vector-class ] } { +scalar+ [ nip ] } { +boolean+ [ 2drop boolean ] } { +nonnegative+ [ nip ] } @@ -32,6 +40,7 @@ SYMBOLS: -> +vector+ +scalar+ +boolean+ +nonnegative+ +literal+ ; [ { { +vector+ [ drop ] } + { +any-vector+ [ drop parent-vector-class ] } { +scalar+ [ nip ] } { +boolean+ [ 2drop boolean ] } { @@ -101,7 +110,7 @@ H{ { hlshift { +vector+ +literal+ -> +vector+ } } { hrshift { +vector+ +literal+ -> +vector+ } } { vshuffle-elements { +vector+ +literal+ -> +vector+ } } - { vshuffle-bytes { +vector+ +vector+ -> +vector+ } } + { vshuffle-bytes { +vector+ +any-vector+ -> +vector+ } } { vbroadcast { +vector+ +literal+ -> +vector+ } } { (vmerge-head) { +vector+ +vector+ -> +vector+ } } { (vmerge-tail) { +vector+ +vector+ -> +vector+ } } diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 0a984ba2e7..2426e4814b 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -92,7 +92,7 @@ PRIVATE> : vshuffle-bytes ( u perm -- v ) underlying>> [ - swap [ '[ _ nth ] ] keep map-as + swap [ '[ 15 bitand _ nth ] ] keep map-as ] curry change-underlying ; GENERIC: vshuffle ( u perm -- v ) diff --git a/basis/random/sfmt/sfmt.factor b/basis/random/sfmt/sfmt.factor index eb78d7e812..55606217c9 100644 --- a/basis/random/sfmt/sfmt.factor +++ b/basis/random/sfmt/sfmt.factor @@ -30,7 +30,7 @@ TUPLE: sfmt : endian-shuffle ( v -- w ) little-endian? [ - B{ 3 2 1 0 7 6 5 4 11 10 9 8 15 14 13 12 } uint-4 boa vshuffle + uchar-16{ 3 2 1 0 7 6 5 4 11 10 9 8 15 14 13 12 } vshuffle ] unless ; inline : hlshift* ( v n -- w ) From 97259c772f13ef45abaec15699517f130a203afa Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 19 Oct 2009 12:26:26 -0500 Subject: [PATCH 019/109] add a typed-disassemble convenience word to typed.debugger --- basis/typed/debugger/debugger.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/basis/typed/debugger/debugger.factor b/basis/typed/debugger/debugger.factor index c5f83c0378..dae30fa9d8 100644 --- a/basis/typed/debugger/debugger.factor +++ b/basis/typed/debugger/debugger.factor @@ -1,5 +1,6 @@ ! (c)Joe Groff bsd license -USING: typed compiler.cfg.debugger compiler.tree.debugger words ; +USING: typed compiler.cfg.debugger compiler.tree.debugger +tools.disassembler words ; IN: typed.debugger : typed-test-mr ( word -- mrs ) @@ -8,3 +9,6 @@ IN: typed.debugger "typed-word" word-prop test-mr mr. ; inline : typed-optimized. ( word -- ) "typed-word" word-prop optimized. ; inline + +: typed-disassemble ( word -- ) + "typed-word" word-prop disassemble ; inline From b212e8edd0b7e8b3cb146c24d02d99ccf46ce80f Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 19 Oct 2009 15:11:59 -0500 Subject: [PATCH 020/109] inline trilerp so that perlin-noise is pretty much instantaneous --- basis/math/vectors/vectors.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 2426e4814b..ee417de12b 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -163,7 +163,7 @@ PRIVATE> : trilerp ( aaa baa aba bba aab bab abb bbb {t,u,v} -- a_tuv ) [ first lerp ] [ second lerp ] [ third lerp ] tri-curry - [ 2tetra@ ] [ 2bi@ ] [ call ] tri* ; + [ 2tetra@ ] [ 2bi@ ] [ call ] tri* ; inline : bilerp ( aa ba ab bb {t,u} -- a_tu ) [ first lerp ] [ second lerp ] bi-curry From fc317d7714439f11f3a322b883a14125eff77470 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 19:17:38 -0500 Subject: [PATCH 021/109] help.tutorial: clarify role of ''reload'' word --- basis/help/tutorial/tutorial.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/help/tutorial/tutorial.factor b/basis/help/tutorial/tutorial.factor index 2a5a9c640d..ee22782fdc 100644 --- a/basis/help/tutorial/tutorial.factor +++ b/basis/help/tutorial/tutorial.factor @@ -33,7 +33,7 @@ ARTICLE: "first-program-logic" "Writing some logic in your first program" $nl "In order to be able to call the words defined in the " { $snippet "palindrome" } " vocabulary, you need to issue the following command in the listener:" { $code "USE: palindrome" } -"Now, we will be making some additions to the file. Since the file was loaded by the scaffold tool in the previous step, you need to tell Factor to reload it if it changes. Factor has a handy feature for this; pressing " { $command tool "common" refresh-all } " in the listener window will reload any changed source files. You can also force a single vocabulary to reload:" +"Now, we will be making some additions to the file. Since the file was loaded by the scaffold tool in the previous step, you need to tell Factor to reload it if it changes. Factor has a handy feature for this; pressing " { $command tool "common" refresh-all } " in the listener window will reload any changed source files. You can also force a single vocabulary to reload, in case the refresh feature does not pick up changes from disk:" { $code "\"palindrome\" reload" } "We will now write our first word using " { $link POSTPONE: : } ". This word will test if a string is a palindrome; it will take a string as input, and give back a boolean as output. We will call this word " { $snippet "palindrome?" } ", following a naming convention that words returning booleans have names ending with " { $snippet "?" } "." $nl From 304496e03765038b7d18de2806bfded9e4b650aa Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 19:18:08 -0500 Subject: [PATCH 022/109] Build fixes --- core/generic/single/single-tests.factor | 3 ++- extra/cpu/8080/emulator/emulator.factor | 1 - extra/space-invaders/space-invaders.factor | 6 ++---- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/core/generic/single/single-tests.factor b/core/generic/single/single-tests.factor index 554e287a3b..0f6c9bc0cd 100644 --- a/core/generic/single/single-tests.factor +++ b/core/generic/single/single-tests.factor @@ -4,7 +4,8 @@ accessors words byte-arrays bit-arrays parser namespaces make quotations stack-checker vectors growable hashtables sbufs prettyprint byte-vectors bit-vectors specialized-vectors definitions generic sets graphs assocs grouping see eval ; -SPECIALIZED-VECTOR: double +QUALIFIED-WITH: alien.c-types c +SPECIALIZED-VECTOR: c:double IN: generic.single.tests GENERIC: lo-tag-test ( obj -- obj' ) diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor index 04c47caf4a..ddea7e762a 100755 --- a/extra/cpu/8080/emulator/emulator.factor +++ b/extra/cpu/8080/emulator/emulator.factor @@ -24,7 +24,6 @@ USING: quotations sequences sequences.deep - syntax words ; IN: cpu.8080.emulator diff --git a/extra/space-invaders/space-invaders.factor b/extra/space-invaders/space-invaders.factor index cb0f4319d6..cbe2241604 100755 --- a/extra/space-invaders/space-invaders.factor +++ b/extra/space-invaders/space-invaders.factor @@ -22,15 +22,13 @@ USING: ui.gadgets ui.gestures ui.render + specialized-arrays ; QUALIFIED: threads QUALIFIED: system +SPECIALIZED-ARRAY: uchar IN: space-invaders -<< - "uchar" require-c-array ->> - TUPLE: space-invaders < cpu port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ; CONSTANT: game-width 224 CONSTANT: game-height 256 From 08b683de61457c5948092564e392d15be12cb954 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 22:46:46 -0500 Subject: [PATCH 023/109] ui.gadgets.editors: fix com-join-lines if there are more than two lines in the editor --- basis/ui/gadgets/editors/editors-tests.factor | 13 ++-- basis/ui/gadgets/editors/editors.factor | 59 +++++++++++++++---- 2 files changed, 57 insertions(+), 15 deletions(-) diff --git a/basis/ui/gadgets/editors/editors-tests.factor b/basis/ui/gadgets/editors/editors-tests.factor index 3ba32dc3c2..3fbdf12cbe 100644 --- a/basis/ui/gadgets/editors/editors-tests.factor +++ b/basis/ui/gadgets/editors/editors-tests.factor @@ -1,8 +1,8 @@ -USING: accessors ui.gadgets.editors tools.test kernel io -io.streams.plain definitions namespaces ui.gadgets -ui.gadgets.grids prettyprint documents ui.gestures ui.gadgets.debug -models documents.elements ui.gadgets.scrollers ui.gadgets.line-support -sequences ; +USING: accessors ui.gadgets.editors ui.gadgets.editors.private +tools.test kernel io io.streams.plain definitions namespaces +ui.gadgets ui.gadgets.grids prettyprint documents ui.gestures +ui.gadgets.debug models documents.elements ui.gadgets.scrollers +ui.gadgets.line-support sequences ; IN: ui.gadgets.editors.tests [ "foo bar" ] [ @@ -55,6 +55,9 @@ IN: ui.gadgets.editors.tests [ ] [ com-join-lines ] unit-test [ ] [ "A" over set-editor-string com-join-lines ] unit-test [ "A B" ] [ "A\nB" over set-editor-string [ com-join-lines ] [ editor-string ] bi ] unit-test +[ "A B\nC\nD" ] [ "A\nB\nC\nD" over set-editor-string { 0 0 } over set-caret dup mark>caret [ com-join-lines ] [ editor-string ] bi ] unit-test +[ "A\nB C\nD" ] [ "A\nB\nC\nD" over set-editor-string { 1 0 } over set-caret dup mark>caret [ com-join-lines ] [ editor-string ] bi ] unit-test +[ "A\nB\nC D" ] [ "A\nB\nC\nD" over set-editor-string { 2 0 } over set-caret dup mark>caret [ com-join-lines ] [ editor-string ] bi ] unit-test [ 2 ] [ 20 >>min-rows 20 >>min-cols pref-viewport-dim length ] unit-test diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index f83c5d710a..071ac1cffe 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -17,6 +17,8 @@ caret-color caret mark focused? blink blink-alarm ; + ( -- loc ) { 0 0 } ; : init-editor-locs ( editor -- editor ) @@ -27,6 +29,8 @@ focused? blink blink-alarm ; COLOR: red >>caret-color monospace-font >>font ; inline +PRIVATE> + : new-editor ( class -- editor ) new-line-gadget >>model @@ -36,6 +40,8 @@ focused? blink blink-alarm ; : ( -- editor ) editor new-editor ; + + M: editor graft* [ dup caret>> activate-editor-model ] [ dup mark>> activate-editor-model ] bi ; @@ -142,6 +150,8 @@ M: editor ungraft* ] keep scroll>rect ] [ drop ] if ; +> ] [ blink>> ] } 1&& ; @@ -189,6 +199,8 @@ TUPLE: selected-line start end first? last? ; ] 3bi ] if ; +PRIVATE> + M: editor draw-line ( line index editor -- ) [ selected-lines get at ] dip over [ draw-selected-line ] [ nip draw-unselected-line ] if ; @@ -206,6 +218,8 @@ M: editor baseline font>> font-metrics ascent>> ; M: editor cap-height font>> font-metrics cap-height>> ; +> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ] [ [ nip mark>> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ] @@ -214,6 +228,8 @@ M: editor cap-height font>> font-metrics cap-height>> ; : caret/mark-changed ( editor -- ) [ restart-blinking ] keep scroll>caret ; +PRIVATE> + M: editor model-changed { { [ 2dup model>> eq? ] [ contents-changed ] } @@ -513,6 +529,8 @@ PRIVATE> : change-selection ( editor quot -- ) '[ gadget-selection @ ] [ user-input* drop ] bi ; inline + [ " " join ] tri ; -: this-line-and-next ( document line -- start end ) - [ nip 0 swap 2array ] - [ 1 + [ nip ] [ swap doc-line length ] 2bi 2array ] - 2bi ; - : last-line? ( document line -- ? ) [ last-line# ] dip = ; +: prev-line-and-this ( document line -- start end ) + swap + [ drop 1 - 0 2array ] + [ [ drop ] [ doc-line length ] 2bi 2array ] + 2bi ; + +: join-with-prev ( document line -- ) + [ prev-line-and-this ] [ drop ] 2bi + [ join-lines ] change-doc-range ; + +: this-line-and-next ( document line -- start end ) + swap + [ drop 0 2array ] + [ [ 1 + ] dip [ drop ] [ doc-line length ] 2bi 2array ] + 2bi ; + +: join-with-next ( document line -- ) + [ this-line-and-next ] [ drop ] 2bi + [ join-lines ] change-doc-range ; + +PRIVATE> + : com-join-lines ( editor -- ) dup gadget-selection? [ [ join-lines ] change-selection ] [ - [ model>> ] [ editor-caret first ] bi - 2dup last-line? [ 2drop ] [ - [ this-line-and-next ] [ drop ] 2bi - [ join-lines ] change-doc-range - ] if + [ model>> ] [ editor-caret first ] bi { + { [ over last-line# 0 = ] [ 2drop ] } + { [ 2dup last-line? ] [ join-with-prev ] } + [ join-with-next ] + } cond ] if ; multiline-editor "multiline" f { @@ -566,6 +601,8 @@ TUPLE: source-editor < multiline-editor ; ! Fields wrap an editor TUPLE: field < border editor min-cols max-cols ; +>size { 1 0 } >>fill @@ -576,6 +613,8 @@ TUPLE: field < border editor min-cols max-cols ; { 1 0 } >>fill field-theme ; +PRIVATE> + : new-field ( class -- gadget ) [ ] dip new-border dup gadget-child >>editor From dafa068f348580207275edc404f41149303638bd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 02:18:21 -0500 Subject: [PATCH 024/109] ui.gadgets.controls: fix load error --- extra/ui/gadgets/controls/controls.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/ui/gadgets/controls/controls.factor b/extra/ui/gadgets/controls/controls.factor index 649c9052fd..0c7841b11f 100644 --- a/extra/ui/gadgets/controls/controls.factor +++ b/extra/ui/gadgets/controls/controls.factor @@ -1,7 +1,7 @@ USING: accessors assocs arrays kernel models monads sequences models.combinators ui.gadgets ui.gadgets.borders ui.gadgets.buttons -ui.gadgets.buttons.private ui.gadgets.editors words images.loader -ui.gadgets.scrollers ui.images vocabs.parser lexer +ui.gadgets.buttons.private ui.gadgets.editors ui.gadgets.editors.private +words images.loader ui.gadgets.scrollers ui.images vocabs.parser lexer models.range ui.gadgets.sliders ; QUALIFIED-WITH: ui.gadgets.sliders slider QUALIFIED-WITH: ui.gadgets.tables tbl From 5f3c94896fe6eeb4675ef73e6df386760943f420 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 02:18:28 -0500 Subject: [PATCH 025/109] specialized-arrays: fix unit test --- .../specialized-arrays-tests.factor | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 3226557494..423c7ad1ee 100755 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -122,10 +122,6 @@ SPECIALIZED-ARRAY: fixed-string ! If the C type doesn't exist, don't generate a vocab SYMBOL: __does_not_exist__ -[ ] [ - [ __does_not_exist__ specialized-array-vocab forget-vocab ] with-compilation-unit -] unit-test - [ """ IN: specialized-arrays.tests @@ -151,4 +147,9 @@ SPECIALIZED-ARRAY: __does_not_exist__ deferred? ] unit-test -[ \ __does_not_exist__ forget ] with-compilation-unit +[ ] [ + [ + \ __does_not_exist__ forget + __does_not_exist__ specialized-array-vocab forget-vocab + ] with-compilation-unit +] unit-test From 560b6f45cc6753c56e361acb0ca7e563fb1637e6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 04:15:10 -0500 Subject: [PATCH 026/109] compiler, cpu.x86.32: clean up FFI implementation, in particular 32-bit x86-specific backend --- .../remote-control/remote-control.factor | 11 +- basis/compiler/alien/alien.factor | 4 +- basis/compiler/codegen/codegen.factor | 15 +- basis/cpu/x86/32/32.factor | 212 +++++++----------- 4 files changed, 95 insertions(+), 147 deletions(-) diff --git a/basis/alien/remote-control/remote-control.factor b/basis/alien/remote-control/remote-control.factor index 4ccd0e7488..6a5644cceb 100644 --- a/basis/alien/remote-control/remote-control.factor +++ b/basis/alien/remote-control/remote-control.factor @@ -1,18 +1,19 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.data alien.strings parser -threads words kernel.private kernel io.encodings.utf8 eval ; +USING: accessors alien alien.c-types alien.data alien.strings +parser threads words kernel.private kernel io.encodings.utf8 +eval ; IN: alien.remote-control : eval-callback ( -- callback ) - "void*" { "char*" } "cdecl" + void* { char* } "cdecl" [ eval>string utf8 malloc-string ] alien-callback ; : yield-callback ( -- callback ) - "void" { } "cdecl" [ yield ] alien-callback ; + void { } "cdecl" [ yield ] alien-callback ; : sleep-callback ( -- callback ) - "void" { "long" } "cdecl" [ sleep ] alien-callback ; + void { long } "cdecl" [ sleep ] alien-callback ; : ?callback ( word -- alien ) dup optimized? [ execute ] [ drop f ] if ; inline diff --git a/basis/compiler/alien/alien.factor b/basis/compiler/alien/alien.factor index dd2b029266..f43c11abcf 100644 --- a/basis/compiler/alien/alien.factor +++ b/basis/compiler/alien/alien.factor @@ -9,10 +9,10 @@ IN: compiler.alien : alien-parameters ( params -- seq ) dup parameters>> - swap return>> large-struct? [ "void*" prefix ] when ; + swap return>> large-struct? [ void* prefix ] when ; : alien-return ( params -- ctype ) - return>> dup large-struct? [ drop "void" ] when ; + return>> dup large-struct? [ drop void ] when ; : c-type-stack-align ( type -- align ) dup c-type-stack-align? [ c-type-align ] [ drop cell ] if ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 31918658c4..ca037b4d6f 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -333,25 +333,22 @@ M: reg-class reg-class-full? [ alloc-stack-param ] [ alloc-fastcall-param ] if [ param-reg ] dip ; -: (flatten-int-type) ( size -- seq ) - cell /i "void*" c-type ; +: (flatten-int-type) ( type -- seq ) + stack-size cell align cell /i void* c-type ; GENERIC: flatten-value-type ( type -- types ) M: object flatten-value-type 1array ; - -M: struct-c-type flatten-value-type ( type -- types ) - stack-size cell align (flatten-int-type) ; - -M: long-long-type flatten-value-type ( type -- types ) - stack-size cell align (flatten-int-type) ; +M: struct-c-type flatten-value-type (flatten-int-type) ; +M: long-long-type flatten-value-type (flatten-int-type) ; +M: c-type-name flatten-value-type c-type flatten-value-type ; : flatten-value-types ( params -- params ) #! Convert value type structs to consecutive void*s. [ 0 [ c-type - [ parameter-align (flatten-int-type) % ] keep + [ parameter-align cell /i void* c-type % ] keep [ stack-size cell align + ] keep flatten-value-type % ] reduce drop diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 3ce1374491..41b4b9304d 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -57,12 +57,12 @@ M:: x86.32 %dispatch ( src temp -- ) M: x86.32 pic-tail-reg EBX ; -M: x86.32 reserved-area-size 0 ; +M: x86.32 reserved-area-size 4 cells ; M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ; -: push-vm-ptr ( -- ) - 0 PUSH 0 rc-absolute-cell rel-vm ; ! push the vm ptr as an argument +: save-vm-ptr ( n -- ) + stack@ 0 MOV 0 rc-absolute-cell rel-vm ; M: x86.32 return-struct-in-registers? ( c-type -- ? ) c-type @@ -72,44 +72,34 @@ M: x86.32 return-struct-in-registers? ( c-type -- ? ) and or ; : struct-return@ ( n -- operand ) - [ next-stack@ ] [ stack-frame get params>> stack@ ] if* ; + [ next-stack@ ] [ stack-frame get params>> param@ ] if* ; ! On x86, parameters are never passed in registers. M: int-regs return-reg drop EAX ; M: int-regs param-regs drop { } ; M: float-regs param-regs drop { } ; -GENERIC: push-return-reg ( rep -- ) -GENERIC: load-return-reg ( n rep -- ) -GENERIC: store-return-reg ( n rep -- ) +GENERIC: load-return-reg ( src rep -- ) +GENERIC: store-return-reg ( dst rep -- ) -M: int-rep push-return-reg drop EAX PUSH ; -M: int-rep load-return-reg drop EAX swap next-stack@ MOV ; -M: int-rep store-return-reg drop stack@ EAX MOV ; +M: int-rep load-return-reg drop EAX swap MOV ; +M: int-rep store-return-reg drop EAX MOV ; -M: float-rep push-return-reg drop ESP 4 SUB ESP [] FSTPS ; -M: float-rep load-return-reg drop next-stack@ FLDS ; -M: float-rep store-return-reg drop stack@ FSTPS ; +M: float-rep load-return-reg drop FLDS ; +M: float-rep store-return-reg drop FSTPS ; -M: double-rep push-return-reg drop ESP 8 SUB ESP [] FSTPL ; -M: double-rep load-return-reg drop next-stack@ FLDL ; -M: double-rep store-return-reg drop stack@ FSTPL ; - -: align-sub ( n -- ) - [ align-stack ] keep - decr-stack-reg ; - -: align-add ( n -- ) - align-stack incr-stack-reg ; - -: with-aligned-stack ( n quot -- ) - '[ align-sub @ ] [ align-add ] bi ; inline +M: double-rep load-return-reg drop FLDL ; +M: double-rep store-return-reg drop FSTPL ; M: x86.32 %prologue ( n -- ) dup PUSH 0 PUSH rc-absolute-cell rel-this 3 cells - decr-stack-reg ; -M: x86.32 %load-param-reg 3drop ; +M: x86.32 %load-param-reg + stack-params assert= + [ [ EAX ] dip param@ MOV ] dip + stack@ EAX MOV ; M: x86.32 %save-param-reg 3drop ; @@ -118,16 +108,14 @@ M: x86.32 %save-param-reg 3drop ; #! are boxing a return value of a C function. If n is an #! integer, push [ESP+n] on the stack; we are boxing a #! parameter being passed to a callback from C. - over [ load-return-reg ] [ 2drop ] if ; + over [ [ next-stack@ ] dip load-return-reg ] [ 2drop ] if ; M:: x86.32 %box ( n rep func -- ) n rep (%box) - rep rep-size cell + [ - push-vm-ptr - rep push-return-reg - func f %alien-invoke - ] with-aligned-stack ; - + rep rep-size save-vm-ptr + 0 stack@ rep store-return-reg + func f %alien-invoke ; + : (%box-long-long) ( n -- ) [ EDX over next-stack@ MOV @@ -136,41 +124,31 @@ M:: x86.32 %box ( n rep func -- ) M: x86.32 %box-long-long ( n func -- ) [ (%box-long-long) ] dip - 12 [ - push-vm-ptr - EDX PUSH - EAX PUSH - f %alien-invoke - ] with-aligned-stack ; + 8 save-vm-ptr + 4 stack@ EDX MOV + 0 stack@ EAX MOV + f %alien-invoke ; M:: x86.32 %box-large-struct ( n c-type -- ) - ! Compute destination address EDX n struct-return@ LEA - 12 [ - push-vm-ptr - ! Push struct size - c-type heap-size PUSH - ! Push destination address - EDX PUSH - ! Copy the struct from the C stack - "box_value_struct" f %alien-invoke - ] with-aligned-stack ; + 8 save-vm-ptr + 4 stack@ c-type heap-size MOV + 0 stack@ EDX MOV + "box_value_struct" f %alien-invoke ; M: x86.32 %prepare-box-struct ( -- ) ! Compute target address for value struct return EAX f struct-return@ LEA ! Store it as the first parameter - 0 stack@ EAX MOV ; + 0 param@ EAX MOV ; M: x86.32 %box-small-struct ( c-type -- ) #! Box a <= 8-byte struct returned in EAX:EDX. OS X only. - 16 [ - push-vm-ptr - heap-size PUSH - EDX PUSH - EAX PUSH - "box_small_struct" f %alien-invoke - ] with-aligned-stack ; + 12 save-vm-ptr + 8 stack@ swap heap-size MOV + 4 stack@ EDX MOV + 0 stack@ EAX MOV + "box_small_struct" f %alien-invoke ; M: x86.32 %prepare-unbox ( -- ) #! Move top of data stack to EAX. @@ -178,14 +156,9 @@ M: x86.32 %prepare-unbox ( -- ) ESI 4 SUB ; : call-unbox-func ( func -- ) - 8 [ - ! push the vm ptr as an argument - push-vm-ptr - ! Push parameter - EAX PUSH - ! Call the unboxer - f %alien-invoke - ] with-aligned-stack ; + 4 save-vm-ptr + 0 stack@ EAX MOV + f %alien-invoke ; M: x86.32 %unbox ( n rep func -- ) #! The value being unboxed must already be in EAX. @@ -194,37 +167,33 @@ M: x86.32 %unbox ( n rep func -- ) #! a parameter to a C function about to be called. call-unbox-func ! Store the return value on the C stack - over [ store-return-reg ] [ 2drop ] if ; + over [ [ param@ ] dip store-return-reg ] [ 2drop ] if ; M: x86.32 %unbox-long-long ( n func -- ) call-unbox-func ! Store the return value on the C stack [ - dup stack@ EAX MOV - cell + stack@ EDX MOV + dup param@ EAX MOV + 4 + param@ EDX MOV ] when* ; : %unbox-struct-1 ( -- ) #! Alien must be in EAX. - 8 [ - push-vm-ptr - EAX PUSH - "alien_offset" f %alien-invoke - ! Load first cell - EAX EAX [] MOV - ] with-aligned-stack ; + 4 save-vm-ptr + 0 stack@ EAX MOV + "alien_offset" f %alien-invoke + ! Load first cell + EAX EAX [] MOV ; : %unbox-struct-2 ( -- ) #! Alien must be in EAX. - 8 [ - push-vm-ptr - EAX PUSH - "alien_offset" f %alien-invoke - ! Load second cell - EDX EAX 4 [+] MOV - ! Load first cell - EAX EAX [] MOV - ] with-aligned-stack ; + 4 save-vm-ptr + 0 stack@ EAX MOV + "alien_offset" f %alien-invoke + ! Load second cell + EDX EAX 4 [+] MOV + ! Load first cell + EAX EAX [] MOV ; M: x86 %unbox-small-struct ( size -- ) #! Alien must be in EAX. @@ -236,63 +205,47 @@ M: x86 %unbox-small-struct ( size -- ) M:: x86.32 %unbox-large-struct ( n c-type -- ) ! Alien must be in EAX. ! Compute destination address - EDX n stack@ LEA - 16 [ - push-vm-ptr - ! Push struct size - c-type heap-size PUSH - ! Push destination address - EDX PUSH - ! Push source address - EAX PUSH - ! Copy the struct to the stack - "to_value_struct" f %alien-invoke - ] with-aligned-stack ; + EDX n param@ LEA + 12 save-vm-ptr + 8 stack@ c-type heap-size MOV + 4 stack@ EDX MOV + 0 stack@ EAX MOV + "to_value_struct" f %alien-invoke ; M: x86.32 %nest-stacks ( -- ) ! Save current frame. See comment in vm/contexts.hpp EAX stack-reg stack-frame get total-size>> 3 cells - [+] LEA - 8 [ - push-vm-ptr - EAX PUSH - "nest_stacks" f %alien-invoke - ] with-aligned-stack ; + 4 save-vm-ptr + 0 stack@ EAX MOV + "nest_stacks" f %alien-invoke ; M: x86.32 %unnest-stacks ( -- ) - 4 [ - push-vm-ptr - "unnest_stacks" f %alien-invoke - ] with-aligned-stack ; + 0 save-vm-ptr + "unnest_stacks" f %alien-invoke ; M: x86.32 %prepare-alien-indirect ( -- ) - 4 [ - push-vm-ptr - "unbox_alien" f %alien-invoke - ] with-aligned-stack + 0 save-vm-ptr + "unbox_alien" f %alien-invoke EBP EAX MOV ; M: x86.32 %alien-indirect ( -- ) EBP CALL ; M: x86.32 %alien-callback ( quot -- ) + ! Fastcall param-reg-1 swap %load-reference param-reg-2 %mov-vm-ptr "c_to_factor" f %alien-invoke ; M: x86.32 %callback-value ( ctype -- ) - ! Align C stack - ESP 12 SUB ! Save top of data stack in non-volatile register %prepare-unbox - EAX PUSH - push-vm-ptr + 4 stack@ EAX MOV + 0 save-vm-ptr ! Restore data/call/retain stacks "unnest_stacks" f %alien-invoke - ! Place top of data stack in EAX - temp-reg POP - EAX POP - ! Restore C stack - ESP 12 ADD + ! Place former top of data stack back in EAX + EAX 4 stack@ MOV ! Unbox EAX unbox-return ; @@ -358,16 +311,10 @@ M: x86.32 %callback-return ( n -- ) M:: x86.32 %call-gc ( gc-root-count temp -- ) temp gc-root-base param@ LEA - 12 [ - ! Pass the VM ptr as the third parameter - push-vm-ptr - ! Pass number of roots as second parameter - gc-root-count PUSH - ! Pass pointer to start of GC roots as first parameter - temp PUSH - ! Call GC - "inline_gc" f %alien-invoke - ] with-aligned-stack ; + 8 save-vm-ptr + 4 stack@ gc-root-count MOV + 0 stack@ temp MOV + "inline_gc" f %alien-invoke ; M: x86.32 dummy-stack-params? f ; @@ -375,10 +322,13 @@ M: x86.32 dummy-int-params? f ; M: x86.32 dummy-fp-params? f ; +! Dreadful +M: object flatten-value-type (flatten-int-type) ; + os windows? [ - cell "longlong" c-type (>>align) - cell "ulonglong" c-type (>>align) - 4 "double" c-type (>>align) + cell longlong c-type (>>align) + cell ulonglong c-type (>>align) + 4 double c-type (>>align) ] unless check-sse From 1e7893b6ce9a3d7a3c5c4174b26277d3d635c66d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 04:31:48 -0500 Subject: [PATCH 027/109] compiler: FFI is now slightly more efficient when unboxing parameters, only changes data stack height once --- basis/compiler/alien/alien.factor | 3 +-- basis/compiler/cfg/builder/builder.factor | 2 +- basis/compiler/codegen/codegen.factor | 20 ++++++++++++-------- basis/cpu/architecture/architecture.factor | 2 +- basis/cpu/ppc/ppc.factor | 6 ++---- basis/cpu/x86/32/32.factor | 7 ++----- basis/cpu/x86/64/64.factor | 10 +++------- 7 files changed, 22 insertions(+), 28 deletions(-) diff --git a/basis/compiler/alien/alien.factor b/basis/compiler/alien/alien.factor index f43c11abcf..6a63b719df 100644 --- a/basis/compiler/alien/alien.factor +++ b/basis/compiler/alien/alien.factor @@ -20,8 +20,7 @@ IN: compiler.alien : parameter-align ( n type -- n delta ) [ c-type-stack-align align dup ] [ drop ] 2bi - ; -: parameter-sizes ( types -- total offsets ) - #! Compute stack frame locations. +: parameter-offsets ( types -- total offsets ) [ 0 [ [ parameter-align drop dup , ] keep stack-size + diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 74586c6eeb..e0f921259c 100755 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -212,7 +212,7 @@ M: #terminate emit-node drop ##no-tco end-basic-block ; stack-frame new swap [ return>> return-size >>return ] - [ alien-parameters parameter-sizes drop >>params ] bi ; + [ alien-parameters parameter-offsets drop >>params ] bi ; : alien-node-height ( params -- ) [ out-d>> length ] [ in-d>> length ] bi - adjust-d ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index ca037b4d6f..e8f3ca7d64 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -355,10 +355,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ; ] { } make ; : each-parameter ( parameters quot -- ) - [ [ parameter-sizes nip ] keep ] dip 2each ; inline - -: reverse-each-parameter ( parameters quot -- ) - [ [ parameter-sizes nip ] keep ] dip 2reverse-each ; inline + [ [ parameter-offsets nip ] keep ] dip 2each ; inline : reset-fastcall-counts ( -- ) { int-regs float-regs stack-params } [ 0 swap set ] each ; @@ -375,10 +372,17 @@ M: c-type-name flatten-value-type c-type flatten-value-type ; [ '[ alloc-parameter _ execute ] ] bi* each-parameter ; inline +: reverse-each-parameter ( parameters quot -- ) + [ [ parameter-offsets nip ] keep ] dip 2reverse-each ; inline + +: prepare-unbox-parameters ( parameters -- offsets types indices ) + [ parameter-offsets nip ] [ ] [ length iota reverse ] tri ; + : unbox-parameters ( offset node -- ) - parameters>> [ - %prepare-unbox [ over + ] dip unbox-parameter - ] reverse-each-parameter drop ; + parameters>> swap + '[ prepare-unbox-parameters [ %prepare-unbox [ _ + ] dip unbox-parameter ] 3each ] + [ length neg %inc-d ] + bi ; : prepare-box-struct ( node -- offset ) #! Return offset on C stack where to store unboxed @@ -410,7 +414,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ; ] if ; : stdcall-mangle ( symbol params -- symbol ) - parameters>> parameter-sizes drop number>string "@" glue ; + parameters>> parameter-offsets drop number>string "@" glue ; : alien-invoke-dlsym ( params -- symbols dll ) [ [ function>> dup ] keep stdcall-mangle 2array ] diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 2f0bdbdcbf..c411d97558 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -463,7 +463,7 @@ HOOK: dummy-int-params? cpu ( -- ? ) ! If t, all int parameters are shadowed by dummy FP parameters HOOK: dummy-fp-params? cpu ( -- ? ) -HOOK: %prepare-unbox cpu ( -- ) +HOOK: %prepare-unbox cpu ( n -- ) HOOK: %unbox cpu ( n rep func -- ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 02e1d7cb94..517aa7587d 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -577,10 +577,8 @@ M:: ppc %save-param-reg ( stack reg rep -- ) M:: ppc %load-param-reg ( stack reg rep -- ) reg stack local@ rep load-from-frame ; -M: ppc %prepare-unbox ( -- ) - ! First parameter is top of stack - 3 ds-reg 0 LWZ - ds-reg dup cell SUBI ; +M: ppc %prepare-unbox ( n -- ) + [ 3 ] dip loc>operand LWZ ; M: ppc %unbox ( n rep func -- ) ! Value must be in r3 diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 41b4b9304d..4ab2e9ba7a 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -151,9 +151,7 @@ M: x86.32 %box-small-struct ( c-type -- ) "box_small_struct" f %alien-invoke ; M: x86.32 %prepare-unbox ( -- ) - #! Move top of data stack to EAX. - EAX ESI [] MOV - ESI 4 SUB ; + EAX swap ds-reg reg-stack MOV ; : call-unbox-func ( func -- ) 4 save-vm-ptr @@ -238,8 +236,7 @@ M: x86.32 %alien-callback ( quot -- ) "c_to_factor" f %alien-invoke ; M: x86.32 %callback-value ( ctype -- ) - ! Save top of data stack in non-volatile register - %prepare-unbox + 0 %prepare-unbox 4 stack@ EAX MOV 0 save-vm-ptr ! Restore data/call/retain stacks diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index c34530c307..1f6bba5a97 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -84,10 +84,8 @@ M: x86 %load-param-reg [ swap param@ ] dip %copy ; call ] with-scope ; inline -M: x86.64 %prepare-unbox ( -- ) - ! First parameter is top of stack - param-reg-1 R14 [] MOV - R14 cell SUB ; +M: x86.64 %prepare-unbox ( n -- ) + param-reg-1 swap ds-reg reg-stack MOV ; M:: x86.64 %unbox ( n rep func -- ) param-reg-2 %mov-vm-ptr @@ -217,9 +215,7 @@ M: x86.64 %alien-callback ( quot -- ) "c_to_factor" f %alien-invoke ; M: x86.64 %callback-value ( ctype -- ) - ! Save top of data stack - %prepare-unbox - ! Save top of data stack + 0 %prepare-unbox RSP 8 SUB param-reg-1 PUSH param-reg-1 %mov-vm-ptr From 18be7e1f37e4c0dfb8b90613bf4691ad4e4dcc09 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 05:02:42 -0500 Subject: [PATCH 028/109] cpu.x86.32: only create 16-byte parameter area if the word calls into the VM --- .../build-stack-frame.factor | 4 +- basis/compiler/cfg/builder/builder.factor | 3 +- .../cfg/stack-frame/stack-frame.factor | 7 +++- basis/cpu/x86/32/32.factor | 23 ++++++---- basis/cpu/x86/64/64.factor | 42 ++++++++++--------- basis/cpu/x86/64/unix/unix.factor | 2 +- basis/cpu/x86/64/winnt/winnt.factor | 2 +- basis/cpu/x86/x86.factor | 19 ++++++--- 8 files changed, 63 insertions(+), 39 deletions(-) diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor index b5510c7142..1f01bc438b 100644 --- a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor +++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor @@ -27,7 +27,9 @@ M: ##call compute-stack-frame* M: ##gc compute-stack-frame* frame-required? on - stack-frame new swap tagged-values>> length cells >>gc-root-size + stack-frame new + swap tagged-values>> length cells >>gc-root-size + t >>calls-vm? request-stack-frame ; M: _spill-area-size compute-stack-frame* diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index e0f921259c..11aae28bf3 100755 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -212,7 +212,8 @@ M: #terminate emit-node drop ##no-tco end-basic-block ; stack-frame new swap [ return>> return-size >>return ] - [ alien-parameters parameter-offsets drop >>params ] bi ; + [ alien-parameters parameter-offsets drop >>params ] bi + t >>calls-vm? ; : alien-node-height ( params -- ) [ out-d>> length ] [ in-d>> length ] bi - adjust-d ; diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor index 4b071cb43c..3cfade23e1 100644 --- a/basis/compiler/cfg/stack-frame/stack-frame.factor +++ b/basis/compiler/cfg/stack-frame/stack-frame.factor @@ -9,7 +9,8 @@ TUPLE: stack-frame { return integer } { total-size integer } { gc-root-size integer } -{ spill-area-size integer } ; +{ spill-area-size integer } +{ calls-vm? boolean } ; ! Stack frame utilities : param-base ( -- n ) @@ -35,7 +36,9 @@ TUPLE: stack-frame : max-stack-frame ( frame1 frame2 -- frame3 ) [ stack-frame new ] 2dip + { [ [ params>> ] bi@ max >>params ] [ [ return>> ] bi@ max >>return ] [ [ gc-root-size>> ] bi@ max >>gc-root-size ] - 2tri ; \ No newline at end of file + [ [ calls-vm?>> ] bi@ or >>calls-vm? ] + } 2cleave ; \ No newline at end of file diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 4ab2e9ba7a..cff5c561c8 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -25,6 +25,11 @@ M: x86.32 rs-reg EDI ; M: x86.32 stack-reg ESP ; M: x86.32 temp-reg ECX ; +: local@ ( n -- op ) + stack-frame get extra-stack-space dup 16 assert= + stack@ ; + +M: x86.32 extra-stack-space calls-vm?>> 16 0 ? ; + M: x86.32 %mark-card drop HEX: ffffffff [+] card-mark MOV building get pop @@ -57,7 +62,7 @@ M:: x86.32 %dispatch ( src temp -- ) M: x86.32 pic-tail-reg EBX ; -M: x86.32 reserved-area-size 4 cells ; +M: x86.32 reserved-stack-space 4 cells ; M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ; @@ -72,7 +77,7 @@ M: x86.32 return-struct-in-registers? ( c-type -- ? ) and or ; : struct-return@ ( n -- operand ) - [ next-stack@ ] [ stack-frame get params>> param@ ] if* ; + [ next-stack@ ] [ stack-frame get params>> local@ ] if* ; ! On x86, parameters are never passed in registers. M: int-regs return-reg drop EAX ; @@ -98,7 +103,7 @@ M: x86.32 %prologue ( n -- ) M: x86.32 %load-param-reg stack-params assert= - [ [ EAX ] dip param@ MOV ] dip + [ [ EAX ] dip local@ MOV ] dip stack@ EAX MOV ; M: x86.32 %save-param-reg 3drop ; @@ -140,7 +145,7 @@ M: x86.32 %prepare-box-struct ( -- ) ! Compute target address for value struct return EAX f struct-return@ LEA ! Store it as the first parameter - 0 param@ EAX MOV ; + 0 local@ EAX MOV ; M: x86.32 %box-small-struct ( c-type -- ) #! Box a <= 8-byte struct returned in EAX:EDX. OS X only. @@ -165,14 +170,14 @@ M: x86.32 %unbox ( n rep func -- ) #! a parameter to a C function about to be called. call-unbox-func ! Store the return value on the C stack - over [ [ param@ ] dip store-return-reg ] [ 2drop ] if ; + over [ [ local@ ] dip store-return-reg ] [ 2drop ] if ; M: x86.32 %unbox-long-long ( n func -- ) call-unbox-func ! Store the return value on the C stack [ - dup param@ EAX MOV - 4 + param@ EDX MOV + [ local@ EAX MOV ] + [ 4 + local@ EDX MOV ] bi ] when* ; : %unbox-struct-1 ( -- ) @@ -203,7 +208,7 @@ M: x86 %unbox-small-struct ( size -- ) M:: x86.32 %unbox-large-struct ( n c-type -- ) ! Alien must be in EAX. ! Compute destination address - EDX n param@ LEA + EDX n local@ LEA 12 save-vm-ptr 8 stack@ c-type heap-size MOV 4 stack@ EDX MOV @@ -307,7 +312,7 @@ M: x86.32 %callback-return ( n -- ) } cond RET ; M:: x86.32 %call-gc ( gc-root-count temp -- ) - temp gc-root-base param@ LEA + temp gc-root-base special@ LEA 8 save-vm-ptr 4 stack@ gc-root-count MOV 0 stack@ temp MOV diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 1f6bba5a97..cbc5c4d7e5 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -8,6 +8,22 @@ compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 cpu.architecture ; IN: cpu.x86.64 +: param-reg-1 ( -- reg ) int-regs param-regs first ; inline +: param-reg-2 ( -- reg ) int-regs param-regs second ; inline +: param-reg-3 ( -- reg ) int-regs param-regs third ; inline +: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline + +M: x86.64 pic-tail-reg RBX ; + +M: int-regs return-reg drop RAX ; +M: float-regs return-reg drop XMM0 ; + +M: x86.64 ds-reg R14 ; +M: x86.64 rs-reg R15 ; +M: x86.64 stack-reg RSP ; + +M: x86.64 extra-stack-space drop 0 ; + M: x86.64 machine-registers { { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 } } @@ -17,9 +33,13 @@ M: x86.64 machine-registers } } } ; -M: x86.64 ds-reg R14 ; -M: x86.64 rs-reg R15 ; -M: x86.64 stack-reg RSP ; +: param@ ( n -- op ) reserved-stack-space + stack@ ; + +M: x86.64 %prologue ( n -- ) + temp-reg 0 MOV rc-absolute-cell rel-this + dup PUSH + temp-reg PUSH + stack-reg swap 3 cells - SUB ; : load-cards-offset ( dst -- ) 0 MOV rc-absolute-cell rel-cards-offset ; @@ -50,22 +70,6 @@ M:: x86.64 %dispatch ( src temp -- ) [ align-code ] bi ; -: param-reg-1 ( -- reg ) int-regs param-regs first ; inline -: param-reg-2 ( -- reg ) int-regs param-regs second ; inline -: param-reg-3 ( -- reg ) int-regs param-regs third ; inline -: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline - -M: x86.64 pic-tail-reg RBX ; - -M: int-regs return-reg drop RAX ; -M: float-regs return-reg drop XMM0 ; - -M: x86.64 %prologue ( n -- ) - temp-reg 0 MOV rc-absolute-cell rel-this - dup PUSH - temp-reg PUSH - stack-reg swap 3 cells - SUB ; - M: stack-params copy-register* drop { diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor index b3d184bc97..2fb32ce733 100644 --- a/basis/cpu/x86/64/unix/unix.factor +++ b/basis/cpu/x86/64/unix/unix.factor @@ -12,7 +12,7 @@ M: int-regs param-regs M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ; -M: x86.64 reserved-area-size 0 ; +M: x86.64 reserved-stack-space 0 ; SYMBOL: (stack-value) ! The ABI for passing structs by value is pretty great diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index bbe943e06b..3ecd56bdd1 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -9,7 +9,7 @@ M: int-regs param-regs drop { RCX RDX R8 R9 } ; M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ; -M: x86.64 reserved-area-size 4 cells ; +M: x86.64 reserved-stack-space 4 cells ; M: x86.64 return-struct-in-registers? ( c-type -- ? ) heap-size { 1 2 4 8 } member? ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 5db2641907..4576956335 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -24,15 +24,20 @@ M: x86 vector-regs float-regs ; HOOK: stack-reg cpu ( -- reg ) -HOOK: reserved-area-size cpu ( -- n ) +HOOK: reserved-stack-space cpu ( -- n ) + +HOOK: extra-stack-space cpu ( stack-frame -- n ) : stack@ ( n -- op ) stack-reg swap [+] ; -: param@ ( n -- op ) reserved-area-size + stack@ ; +: special@ ( n -- op ) + stack-frame get extra-stack-space + + reserved-stack-space + + stack@ ; -: spill@ ( n -- op ) spill-offset param@ ; +: spill@ ( n -- op ) spill-offset special@ ; -: gc-root@ ( n -- op ) gc-root-offset param@ ; +: gc-root@ ( n -- op ) gc-root-offset special@ ; : decr-stack-reg ( n -- ) dup 0 = [ drop ] [ stack-reg swap SUB ] if ; @@ -44,7 +49,11 @@ HOOK: reserved-area-size cpu ( -- n ) os macosx? cpu x86.64? or [ 16 align ] when ; M: x86 stack-frame-size ( stack-frame -- i ) - (stack-frame-size) 3 cells reserved-area-size + + align-stack ; + [ (stack-frame-size) ] + [ extra-stack-space ] bi + + reserved-stack-space + + 3 cells + + align-stack ; ! Must be a volatile register not used for parameter passing, for safe ! use in calls in and out of C From 248f178e643991ca2cc0ad007b730da7dff3fefe Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 07:06:44 -0500 Subject: [PATCH 029/109] math.vectors: fix behavioral difference between generic vector vmin vmax and float specialized versions thereof --- basis/math/vectors/vectors.factor | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index ee417de12b..51e44d00f0 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays alien.c-types assocs kernel sequences math math.functions -hints math.order math.libm fry combinators byte-arrays accessors -locals ; +hints math.order math.libm math.floats.private fry combinators +byte-arrays accessors locals ; QUALIFIED-WITH: alien.c-types c IN: math.vectors @@ -29,8 +29,16 @@ M: object element-type drop f ; inline : [v-] ( u v -- w ) [ [-] ] 2map ; : v* ( u v -- w ) [ * ] 2map ; : v/ ( u v -- w ) [ / ] 2map ; -: vmax ( u v -- w ) [ max ] 2map ; -: vmin ( u v -- w ) [ min ] 2map ; + + + +: vmax ( u v -- w ) [ [ float-max ] [ max ] if-both-floats ] 2map ; +: vmin ( u v -- w ) [ [ float-min ] [ min ] if-both-floats ] 2map ; : v+- ( u v -- w ) [ t ] 2dip From 5346fb9f23ad111e192ee97161617196330d29f3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 07:07:03 -0500 Subject: [PATCH 030/109] help.handbook: remove 'type index' --- basis/help/handbook/handbook-tests.factor | 1 - basis/help/handbook/handbook.factor | 4 ---- 2 files changed, 5 deletions(-) diff --git a/basis/help/handbook/handbook-tests.factor b/basis/help/handbook/handbook-tests.factor index 709d56c5d6..157d4c76e0 100644 --- a/basis/help/handbook/handbook-tests.factor +++ b/basis/help/handbook/handbook-tests.factor @@ -4,5 +4,4 @@ IN: help.handbook.tests [ ] [ "article-index" print-topic ] unit-test [ ] [ "primitive-index" print-topic ] unit-test [ ] [ "error-index" print-topic ] unit-test -[ ] [ "type-index" print-topic ] unit-test [ ] [ "class-index" print-topic ] unit-test diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index 4dd3481f65..afb88bbd3c 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -239,9 +239,6 @@ ARTICLE: "primitive-index" "Primitive index" ARTICLE: "error-index" "Error index" { $index [ all-errors ] } ; -ARTICLE: "type-index" "Type index" -{ $index [ builtins get sift ] } ; - ARTICLE: "class-index" "Class index" { $heading "Built-in classes" } { $index [ classes [ builtin-class? ] filter ] } @@ -387,7 +384,6 @@ ARTICLE: "handbook" "Factor handbook" "article-index" "primitive-index" "error-index" - "type-index" "class-index" } { $heading "Explore the code base" } From 838a44e90165534be4907547ec2a58bf7b403d27 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 09:37:24 -0500 Subject: [PATCH 031/109] vm: change code heap layout somewhat, remove unused allocation bitmap from mark_bits --- vm/code_block.cpp | 14 ++++++----- vm/code_heap.cpp | 2 +- vm/debug.cpp | 2 +- vm/heap.cpp | 51 +++++++++++++++------------------------ vm/heap.hpp | 30 ++++++++++++++++------- vm/inline_cache.cpp | 12 +++------- vm/jit.cpp | 2 +- vm/jit.hpp | 4 ++-- vm/layouts.hpp | 58 ++++++++++++++++++++++++++++++++++++++------- vm/mark_bits.hpp | 20 ---------------- vm/profiler.cpp | 2 +- vm/quotations.cpp | 2 +- vm/quotations.hpp | 2 +- vm/tagged.hpp | 19 +++++++++++---- vm/vm.hpp | 4 ++-- vm/words.cpp | 3 ++- vm/words.hpp | 5 ---- 17 files changed, 128 insertions(+), 104 deletions(-) diff --git a/vm/code_block.cpp b/vm/code_block.cpp index d2337d71de..7e6892202a 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -346,7 +346,7 @@ void factor_vm::update_word_references(code_block *compiled) are referenced after this is done. So instead of polluting the code heap with dead PICs that will be freed on the next GC, we add them to the free list immediately. */ - else if(compiled->type() == PIC_TYPE) + else if(compiled->pic_p()) code->code_heap_free(compiled); else { @@ -437,9 +437,9 @@ void factor_vm::fixup_labels(array *labels, code_block *compiled) } /* Might GC */ -code_block *factor_vm::allot_code_block(cell size, cell type) +code_block *factor_vm::allot_code_block(cell size, code_block_type type) { - heap_block *block = code->heap_allot(size + sizeof(code_block),type); + heap_block *block = code->heap_allot(size + sizeof(code_block)); /* If allocation failed, do a full GC and compact the code heap. A full GC that occurs as a result of the data heap filling up does not @@ -449,7 +449,7 @@ code_block *factor_vm::allot_code_block(cell size, cell type) if(block == NULL) { primitive_compact_gc(); - block = code->heap_allot(size + sizeof(code_block),type); + block = code->heap_allot(size + sizeof(code_block)); /* Insufficient room even after code GC, give up */ if(block == NULL) @@ -465,11 +465,13 @@ code_block *factor_vm::allot_code_block(cell size, cell type) } } - return (code_block *)block; + code_block *compiled = (code_block *)block; + compiled->set_type(type); + return compiled; } /* Might GC */ -code_block *factor_vm::add_code_block(cell type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_) +code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_) { gc_root code(code_,this); gc_root labels(labels_,this); diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 756dfdbff6..19c9c87395 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -144,7 +144,7 @@ void factor_vm::primitive_modify_code_heap() cell code = array_nth(compiled_data,4); code_block *compiled = add_code_block( - WORD_TYPE, + code_block_optimized, code, labels, owner, diff --git a/vm/debug.cpp b/vm/debug.cpp index bcd9e6d4d6..a777c5f970 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -295,7 +295,7 @@ void factor_vm::dump_code_heap() while(scan != end) { const char *status; - if(scan->type() == FREE_BLOCK_TYPE) + if(scan->free_p()) status = "free"; else if(code->state->is_marked_p(scan)) { diff --git a/vm/heap.cpp b/vm/heap.cpp index 2132ba1a20..e13001ff4f 100644 --- a/vm/heap.cpp +++ b/vm/heap.cpp @@ -49,15 +49,16 @@ void heap::build_free_list(cell size) { clear_free_list(); free_heap_block *end = (free_heap_block *)(seg->start + size); - end->set_type(FREE_BLOCK_TYPE); + end->set_free(); end->set_size(seg->end - (cell)end); add_to_free_list(end); } void heap::assert_free_block(free_heap_block *block) { - if(block->type() != FREE_BLOCK_TYPE) - critical_error("Invalid block in free list",(cell)block); +#ifdef FACTOR_DEBUG + assert(block->free_p()); +#endif } free_heap_block *heap::find_free_block(cell size) @@ -102,11 +103,11 @@ free_heap_block *heap::find_free_block(cell size) free_heap_block *heap::split_free_block(free_heap_block *block, cell size) { - if(block->size() != size ) + if(block->size() != size) { /* split the block in two */ free_heap_block *split = (free_heap_block *)((cell)block + size); - split->set_type(FREE_BLOCK_TYPE); + split->set_free(); split->set_size(block->size() - size); split->next_free = block->next_free; block->set_size(size); @@ -116,27 +117,25 @@ free_heap_block *heap::split_free_block(free_heap_block *block, cell size) return block; } -/* Allocate a block of memory from the mark and sweep GC heap */ -heap_block *heap::heap_allot(cell size, cell type) +heap_block *heap::heap_allot(cell size) { - size = (size + block_size_increment - 1) & ~(block_size_increment - 1); + size = align(size,block_size_increment); free_heap_block *block = find_free_block(size); if(block) { block = split_free_block(block,size); - block->set_type(type); return block; } else return NULL; } -/* Deallocates a block manually */ void heap::heap_free(heap_block *block) { - block->set_type(FREE_BLOCK_TYPE); - add_to_free_list((free_heap_block *)block); + free_heap_block *free_block = (free_heap_block *)block; + free_block->set_free(); + add_to_free_list(free_block); } void heap::mark_block(heap_block *block) @@ -158,7 +157,7 @@ void heap::heap_usage(cell *used, cell *total_free, cell *max_free) { cell size = scan->size(); - if(scan->type() == FREE_BLOCK_TYPE) + if(scan->free_p()) { *total_free += size; if(size > *max_free) @@ -179,31 +178,19 @@ cell heap::heap_size() while(scan != end) { - if(scan->type() == FREE_BLOCK_TYPE) break; + if(scan->free_p()) break; else scan = scan->next(); } - assert(scan->type() == FREE_BLOCK_TYPE); - assert((cell)scan + scan->size() == seg->end); - - return (cell)scan - (cell)first_block(); -} - -heap_block *heap::free_allocated(heap_block *prev, heap_block *scan) -{ - if(secure_gc) - memset(scan + 1,0,scan->size() - sizeof(heap_block)); - - if(prev && prev->type() == FREE_BLOCK_TYPE) + if(scan != end) { - prev->set_size(prev->size() + scan->size()); - return prev; + assert(scan->free_p()); + assert((cell)scan + scan->size() == seg->end); + + return (cell)scan - (cell)first_block(); } else - { - scan->set_type(FREE_BLOCK_TYPE); - return scan; - } + return seg->size; } } diff --git a/vm/heap.hpp b/vm/heap.hpp index 70a4324798..7c3dca1eaf 100644 --- a/vm/heap.hpp +++ b/vm/heap.hpp @@ -34,15 +34,13 @@ struct heap { void assert_free_block(free_heap_block *block); free_heap_block *find_free_block(cell size); free_heap_block *split_free_block(free_heap_block *block, cell size); - heap_block *heap_allot(cell size, cell type); + heap_block *heap_allot(cell size); void heap_free(heap_block *block); void mark_block(heap_block *block); void heap_usage(cell *used, cell *total_free, cell *max_free); cell heap_size(); void compact_heap(); - heap_block *free_allocated(heap_block *prev, heap_block *scan); - template void sweep_heap(Iterator &iter); template void compact_heap(Iterator &iter); @@ -54,7 +52,7 @@ struct heap { while(scan != end) { heap_block *next = scan->next(); - if(scan->type() != FREE_BLOCK_TYPE) iter(scan,scan->size()); + if(!scan->free_p()) iter(scan,scan->size()); scan = next; } } @@ -72,27 +70,41 @@ template void heap::sweep_heap(Iterator &iter) while(scan != end) { - if(scan->type() == FREE_BLOCK_TYPE) + if(scan->free_p()) { - if(prev && prev->type() == FREE_BLOCK_TYPE) + if(prev && prev->free_p()) prev->set_size(prev->size() + scan->size()); else prev = scan; } else if(this->state->is_marked_p(scan)) { - if(prev && prev->type() == FREE_BLOCK_TYPE) + if(prev && prev->free_p()) this->add_to_free_list((free_heap_block *)prev); prev = scan; iter(scan,scan->size()); } else - prev = this->free_allocated(prev,scan); + { + if(secure_gc) + memset(scan + 1,0,scan->size() - sizeof(heap_block)); + + if(prev && prev->free_p()) + { + free_heap_block *free_prev = (free_heap_block *)prev; + free_prev->set_size(free_prev->size() + scan->size()); + } + else + { + scan->set_free(); + prev = scan; + } + } scan = scan->next(); } - if(prev && prev->type() == FREE_BLOCK_TYPE) + if(prev && prev->free_p()) this->add_to_free_list((free_heap_block *)prev); } diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index f6e756f758..772631d1ce 100755 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -19,15 +19,9 @@ void factor_vm::deallocate_inline_cache(cell return_address) check_code_pointer((cell)old_xt); code_block *old_block = (code_block *)old_xt - 1; - cell old_type = old_block->type(); -#ifdef FACTOR_DEBUG - /* The call target was either another PIC, - or a compiled quotation (megamorphic stub) */ - assert(old_type == PIC_TYPE || old_type == QUOTATION_TYPE); -#endif - - if(old_type == PIC_TYPE) + /* Free the old PIC since we know its unreachable */ + if(old_block->pic_p()) code->code_heap_free(old_block); } @@ -78,7 +72,7 @@ void factor_vm::update_pic_count(cell type) struct inline_cache_jit : public jit { fixnum index; - explicit inline_cache_jit(cell generic_word_,factor_vm *vm) : jit(PIC_TYPE,generic_word_,vm) {}; + explicit inline_cache_jit(cell generic_word_,factor_vm *vm) : jit(code_block_pic,generic_word_,vm) {}; void emit_check(cell klass); void compile_inline_cache(fixnum index, diff --git a/vm/jit.cpp b/vm/jit.cpp index ced487e659..98212d2efe 100644 --- a/vm/jit.cpp +++ b/vm/jit.cpp @@ -10,7 +10,7 @@ namespace factor - polymorphic inline caches (inline_cache.cpp) */ /* Allocates memory */ -jit::jit(cell type_, cell owner_, factor_vm *vm) +jit::jit(code_block_type type_, cell owner_, factor_vm *vm) : type(type_), owner(owner_,vm), code(vm), diff --git a/vm/jit.hpp b/vm/jit.hpp index d69f44d05d..4928962fc6 100644 --- a/vm/jit.hpp +++ b/vm/jit.hpp @@ -2,7 +2,7 @@ namespace factor { struct jit { - cell type; + code_block_type type; gc_root owner; growable_byte_array code; growable_byte_array relocation; @@ -12,7 +12,7 @@ struct jit { cell offset; factor_vm *parent; - explicit jit(cell jit_type, cell owner, factor_vm *vm); + explicit jit(code_block_type type, cell owner, factor_vm *parent); void compute_position(cell offset); void emit_relocation(cell code_template); diff --git a/vm/layouts.hpp b/vm/layouts.hpp index 5b94ddfaf5..3249aac946 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -62,8 +62,14 @@ inline static cell align8(cell a) #define TYPE_COUNT 15 /* Not real types, but code_block's type can be set to this */ -#define PIC_TYPE 16 -#define FREE_BLOCK_TYPE 17 + +enum code_block_type +{ + code_block_unoptimized, + code_block_optimized, + code_block_profiling, + code_block_pic +}; /* Constants used when floating-point trap exceptions are thrown */ enum @@ -201,16 +207,29 @@ struct heap_block { cell header; - cell type() { return (header >> 1) & 0x1f; } - void set_type(cell type) + bool free_p() { - header = ((header & ~(0x1f << 1)) | (type << 1)); + return header & 1 == 1; + } + + void set_free() + { + header |= 1; + } + + void clear_free() + { + header &= ~1; + } + + cell size() + { + return header >> 3; } - cell size() { return (header >> 6); } void set_size(cell size) { - header = (header & 0x2f) | (size << 6); + header = (header & 0x7) | (size << 3); } inline heap_block *next() @@ -230,7 +249,30 @@ struct code_block : public heap_block cell literals; /* tagged pointer to array or f */ cell relocation; /* tagged pointer to byte-array or f */ - void *xt() { return (void *)(this + 1); } + void *xt() + { + return (void *)(this + 1); + } + + cell type() + { + return (header >> 1) & 0x3; + } + + void set_type(code_block_type type) + { + header = ((header & ~0x7) | (type << 1)); + } + + bool pic_p() + { + return type() == code_block_pic; + } + + bool optimized_p() + { + return type() == code_block_optimized; + } }; /* Assembly code makes assumptions about the layout of this struct */ diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index ad3eda89df..a4dc715c50 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -8,7 +8,6 @@ template struct mark_bits { cell size; cell bits_size; u64 *marked; - u64 *allocated; cell *forwarding; void clear_mark_bits() @@ -16,11 +15,6 @@ template struct mark_bits { memset(marked,0,bits_size * sizeof(u64)); } - void clear_allocated_bits() - { - memset(allocated,0,bits_size * sizeof(u64)); - } - void clear_forwarding() { memset(forwarding,0,bits_size * sizeof(cell)); @@ -31,11 +25,9 @@ template struct mark_bits { size(size_), bits_size(size / Granularity / forwarding_granularity), marked(new u64[bits_size]), - allocated(new u64[bits_size]), forwarding(new cell[bits_size]) { clear_mark_bits(); - clear_allocated_bits(); clear_forwarding(); } @@ -43,8 +35,6 @@ template struct mark_bits { { delete[] marked; marked = NULL; - delete[] allocated; - allocated = NULL; delete[] forwarding; forwarding = NULL; } @@ -109,16 +99,6 @@ template struct mark_bits { set_bitmap_range(marked,address); } - bool is_allocated_p(Block *address) - { - return bitmap_elt(allocated,address); - } - - void set_allocated_p(Block *address) - { - set_bitmap_range(allocated,address); - } - /* From http://chessprogramming.wikispaces.com/Population+Count */ cell popcount(u64 x) { diff --git a/vm/profiler.cpp b/vm/profiler.cpp index 4674b726b1..df9d9ee67b 100755 --- a/vm/profiler.cpp +++ b/vm/profiler.cpp @@ -13,7 +13,7 @@ code_block *factor_vm::compile_profiling_stub(cell word_) { gc_root word(word_,this); - jit jit(WORD_TYPE,word.value(),this); + jit jit(code_block_profiling,word.value(),this); jit.emit_with(userenv[JIT_PROFILING],word.value()); return jit.to_code_block(); diff --git a/vm/quotations.cpp b/vm/quotations.cpp index d75d1c680c..e06b5c23d5 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -335,7 +335,7 @@ void factor_vm::compile_all_words() { gc_root word(array_nth(words.untagged(),i),this); - if(!word->code || !word_optimized_p(word.untagged())) + if(!word->code || !word->code->optimized_p()) jit_compile_word(word.value(),word->def,false); update_word_xt(word.value()); diff --git a/vm/quotations.hpp b/vm/quotations.hpp index feb2af1ce4..e6e6afcd0b 100755 --- a/vm/quotations.hpp +++ b/vm/quotations.hpp @@ -6,7 +6,7 @@ struct quotation_jit : public jit { bool compiling, relocate; explicit quotation_jit(cell quot, bool compiling_, bool relocate_, factor_vm *vm) - : jit(QUOTATION_TYPE,quot,vm), + : jit(code_block_unoptimized,quot,vm), elements(owner.as().untagged()->array,vm), compiling(compiling_), relocate(relocate_){}; diff --git a/vm/tagged.hpp b/vm/tagged.hpp index a61c599aeb..02fcdee26c 100755 --- a/vm/tagged.hpp +++ b/vm/tagged.hpp @@ -27,23 +27,34 @@ struct tagged return tag; } - bool type_p(cell type_) const { return type() == type_; } + bool type_p(cell type_) const + { + return type() == type_; + } + + bool type_p() const + { + if(Type::type_number == TYPE_COUNT) + return true; + else + return type_p(Type::type_number); + } Type *untag_check(factor_vm *parent) const { - if(Type::type_number != TYPE_COUNT && !type_p(Type::type_number)) + if(!type_p()) parent->type_error(Type::type_number,value_); return untagged(); } explicit tagged(cell tagged) : value_(tagged) { #ifdef FACTOR_DEBUG - untag_check(tls_vm()); + assert(type_p()); #endif } explicit tagged(Type *untagged) : value_(factor::tag(untagged)) { #ifdef FACTOR_DEBUG - untag_check(tls_vm()); + assert(type_p()); #endif } diff --git a/vm/vm.hpp b/vm/vm.hpp index 05a918c5e9..921e829bda 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -498,8 +498,8 @@ struct factor_vm void check_code_address(cell address); void relocate_code_block(code_block *compiled); void fixup_labels(array *labels, code_block *compiled); - code_block *allot_code_block(cell size, cell type); - code_block *add_code_block(cell type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_); + code_block *allot_code_block(cell size, code_block_type type); + code_block *add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_); //code heap inline void check_code_pointer(cell ptr) diff --git a/vm/words.cpp b/vm/words.cpp index 6193a5c93c..9d3ccff3c3 100644 --- a/vm/words.cpp +++ b/vm/words.cpp @@ -82,7 +82,8 @@ void factor_vm::update_word_xt(cell w_) void factor_vm::primitive_optimized_p() { - drepl(tag_boolean(word_optimized_p(untag_check(dpeek())))); + word *w = untag_check(dpeek()); + drepl(tag_boolean(w->code->optimized_p())); } void factor_vm::primitive_wrapper() diff --git a/vm/words.hpp b/vm/words.hpp index 1701def6dc..412ef35bb4 100644 --- a/vm/words.hpp +++ b/vm/words.hpp @@ -1,9 +1,4 @@ namespace factor { -inline bool word_optimized_p(word *word) -{ - return word->code->type() == WORD_TYPE; -} - } From acdcb181e04e077462723c56e3058a3716317b67 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 10:22:06 -0500 Subject: [PATCH 032/109] vm: working on making heap more generic --- Makefile | 1 - vm/code_heap.cpp | 3 +- vm/code_heap.hpp | 14 ++- vm/debug.cpp | 39 +++---- vm/heap.cpp | 196 ---------------------------------- vm/heap.hpp | 269 +++++++++++++++++++++++++++++++++++++++++------ vm/layouts.hpp | 5 - vm/mark_bits.hpp | 18 ++-- 8 files changed, 285 insertions(+), 260 deletions(-) delete mode 100644 vm/heap.cpp diff --git a/Makefile b/Makefile index 35cf7a05c4..5a44333d42 100755 --- a/Makefile +++ b/Makefile @@ -49,7 +49,6 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ vm/factor.o \ vm/full_collector.o \ vm/gc.o \ - vm/heap.o \ vm/image.o \ vm/inline_cache.o \ vm/io.o \ diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 19c9c87395..df557074af 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -3,7 +3,8 @@ namespace factor { -code_heap::code_heap(bool secure_gc, cell size) : heap(secure_gc,size,true) {} +code_heap::code_heap(bool secure_gc, cell size) : + heap(secure_gc,size,true) {} void code_heap::write_barrier(code_block *compiled) { diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp index 0a96a0b27b..e98d966afe 100755 --- a/vm/code_heap.hpp +++ b/vm/code_heap.hpp @@ -1,7 +1,19 @@ namespace factor { -struct code_heap : heap { +struct code_heap_layout { + cell block_size(heap_block *block) + { + return block->size(); + } + + heap_block *next_block_after(heap_block *block) + { + return (heap_block *)((cell)block + block_size(block)); + } +}; + +struct code_heap : heap { /* Set of blocks which need full relocation. */ std::set needs_fixup; diff --git a/vm/debug.cpp b/vm/debug.cpp index a777c5f970..ddf4877eab 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -284,41 +284,44 @@ void factor_vm::find_data_references(cell look_for) end_scan(); } -/* Dump all code blocks for debugging */ -void factor_vm::dump_code_heap() -{ - cell reloc_size = 0, literal_size = 0; +struct code_block_printer { + factor_vm *parent; + cell reloc_size, literal_size; - heap_block *scan = code->first_block(); - heap_block *end = code->last_block(); + code_block_printer(factor_vm *parent_) : + parent(parent_), reloc_size(0), literal_size(0) {} - while(scan != end) + void operator()(heap_block *scan, cell size) { const char *status; if(scan->free_p()) status = "free"; - else if(code->state->is_marked_p(scan)) + else if(parent->code->state->is_marked_p(scan)) { - reloc_size += object_size(((code_block *)scan)->relocation); - literal_size += object_size(((code_block *)scan)->literals); + reloc_size += parent->object_size(((code_block *)scan)->relocation); + literal_size += parent->object_size(((code_block *)scan)->literals); status = "marked"; } else { - reloc_size += object_size(((code_block *)scan)->relocation); - literal_size += object_size(((code_block *)scan)->literals); + reloc_size += parent->object_size(((code_block *)scan)->relocation); + literal_size += parent->object_size(((code_block *)scan)->literals); status = "allocated"; } print_cell_hex((cell)scan); print_string(" "); - print_cell_hex(scan->size()); print_string(" "); + print_cell_hex(size); print_string(" "); print_string(status); print_string("\n"); - - scan = scan->next(); } - - print_cell(reloc_size); print_string(" bytes of relocation data\n"); - print_cell(literal_size); print_string(" bytes of literal data\n"); +}; + +/* Dump all code blocks for debugging */ +void factor_vm::dump_code_heap() +{ + code_block_printer printer(this); + code->iterate_heap(printer); + print_cell(printer.reloc_size); print_string(" bytes of relocation data\n"); + print_cell(printer.literal_size); print_string(" bytes of literal data\n"); } void factor_vm::factorbug() diff --git a/vm/heap.cpp b/vm/heap.cpp deleted file mode 100644 index e13001ff4f..0000000000 --- a/vm/heap.cpp +++ /dev/null @@ -1,196 +0,0 @@ -#include "master.hpp" - -/* This malloc-style heap code is reasonably generic. Maybe in the future, it -will be used for the data heap too, if we ever get mark/sweep/compact GC. */ - -namespace factor -{ - -void heap::clear_free_list() -{ - memset(&free,0,sizeof(heap_free_list)); -} - -heap::heap(bool secure_gc_, cell size, bool executable_p) : secure_gc(secure_gc_) -{ - if(size > (1L << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size); - seg = new segment(align_page(size),executable_p); - if(!seg) fatal_error("Out of memory in heap allocator",size); - state = new mark_bits(seg->start,size); - clear_free_list(); -} - -heap::~heap() -{ - delete seg; - seg = NULL; - delete state; - state = NULL; -} - -void heap::add_to_free_list(free_heap_block *block) -{ - if(block->size() < free_list_count * block_size_increment) - { - int index = block->size() / block_size_increment; - block->next_free = free.small_blocks[index]; - free.small_blocks[index] = block; - } - else - { - block->next_free = free.large_blocks; - free.large_blocks = block; - } -} - -/* Called after reading the code heap from the image file, and after code heap -compaction. Makes a free list consisting of one free block, at the very end. */ -void heap::build_free_list(cell size) -{ - clear_free_list(); - free_heap_block *end = (free_heap_block *)(seg->start + size); - end->set_free(); - end->set_size(seg->end - (cell)end); - add_to_free_list(end); -} - -void heap::assert_free_block(free_heap_block *block) -{ -#ifdef FACTOR_DEBUG - assert(block->free_p()); -#endif -} - -free_heap_block *heap::find_free_block(cell size) -{ - cell attempt = size; - - while(attempt < free_list_count * block_size_increment) - { - int index = attempt / block_size_increment; - free_heap_block *block = free.small_blocks[index]; - if(block) - { - assert_free_block(block); - free.small_blocks[index] = block->next_free; - return block; - } - - attempt *= 2; - } - - free_heap_block *prev = NULL; - free_heap_block *block = free.large_blocks; - - while(block) - { - assert_free_block(block); - if(block->size() >= size) - { - if(prev) - prev->next_free = block->next_free; - else - free.large_blocks = block->next_free; - return block; - } - - prev = block; - block = block->next_free; - } - - return NULL; -} - -free_heap_block *heap::split_free_block(free_heap_block *block, cell size) -{ - if(block->size() != size) - { - /* split the block in two */ - free_heap_block *split = (free_heap_block *)((cell)block + size); - split->set_free(); - split->set_size(block->size() - size); - split->next_free = block->next_free; - block->set_size(size); - add_to_free_list(split); - } - - return block; -} - -heap_block *heap::heap_allot(cell size) -{ - size = align(size,block_size_increment); - - free_heap_block *block = find_free_block(size); - if(block) - { - block = split_free_block(block,size); - return block; - } - else - return NULL; -} - -void heap::heap_free(heap_block *block) -{ - free_heap_block *free_block = (free_heap_block *)block; - free_block->set_free(); - add_to_free_list(free_block); -} - -void heap::mark_block(heap_block *block) -{ - state->set_marked_p(block); -} - -/* Compute total sum of sizes of free blocks, and size of largest free block */ -void heap::heap_usage(cell *used, cell *total_free, cell *max_free) -{ - *used = 0; - *total_free = 0; - *max_free = 0; - - heap_block *scan = first_block(); - heap_block *end = last_block(); - - while(scan != end) - { - cell size = scan->size(); - - if(scan->free_p()) - { - *total_free += size; - if(size > *max_free) - *max_free = size; - } - else - *used += size; - - scan = scan->next(); - } -} - -/* The size of the heap after compaction */ -cell heap::heap_size() -{ - heap_block *scan = first_block(); - heap_block *end = last_block(); - - while(scan != end) - { - if(scan->free_p()) break; - else scan = scan->next(); - } - - if(scan != end) - { - assert(scan->free_p()); - assert((cell)scan + scan->size() == seg->end); - - return (cell)scan - (cell)first_block(); - } - else - return seg->size; -} - -} diff --git a/vm/heap.hpp b/vm/heap.hpp index 7c3dca1eaf..653ac2d93d 100644 --- a/vm/heap.hpp +++ b/vm/heap.hpp @@ -2,30 +2,30 @@ namespace factor { static const cell free_list_count = 32; -static const cell block_size_increment = 16; struct heap_free_list { free_heap_block *small_blocks[free_list_count]; free_heap_block *large_blocks; }; -struct heap { +template struct heap { bool secure_gc; segment *seg; heap_free_list free; - mark_bits *state; + mark_bits *state; + HeapLayout layout; explicit heap(bool secure_gc_, cell size, bool executable_p); ~heap(); - - inline heap_block *first_block() + + inline Block *first_block() { - return (heap_block *)seg->start; + return (Block *)seg->start; } - - inline heap_block *last_block() + + inline Block *last_block() { - return (heap_block *)seg->end; + return (Block *)seg->end; } void clear_free_list(); @@ -34,46 +34,253 @@ struct heap { void assert_free_block(free_heap_block *block); free_heap_block *find_free_block(cell size); free_heap_block *split_free_block(free_heap_block *block, cell size); - heap_block *heap_allot(cell size); - void heap_free(heap_block *block); - void mark_block(heap_block *block); + Block *heap_allot(cell size); + void heap_free(Block *block); + void mark_block(Block *block); void heap_usage(cell *used, cell *total_free, cell *max_free); cell heap_size(); - void compact_heap(); template void sweep_heap(Iterator &iter); template void compact_heap(Iterator &iter); template void iterate_heap(Iterator &iter) { - heap_block *scan = first_block(); - heap_block *end = last_block(); + Block *scan = first_block(); + Block *end = last_block(); while(scan != end) { - heap_block *next = scan->next(); - if(!scan->free_p()) iter(scan,scan->size()); + Block *next = layout.next_block_after(scan); + if(!scan->free_p()) iter(scan,layout.block_size(scan)); scan = next; } } }; +template +void heap::clear_free_list() +{ + memset(&free,0,sizeof(heap_free_list)); +} + +template +heap::heap(bool secure_gc_, cell size, bool executable_p) : secure_gc(secure_gc_) +{ + if(size > (1L << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size); + seg = new segment(align_page(size),executable_p); + if(!seg) fatal_error("Out of memory in heap allocator",size); + state = new mark_bits(seg->start,size); + clear_free_list(); +} + +template +heap::~heap() +{ + delete seg; + seg = NULL; + delete state; + state = NULL; +} + +template +void heap::add_to_free_list(free_heap_block *block) +{ + if(block->size() < free_list_count * block_granularity) + { + int index = block->size() / block_granularity; + block->next_free = free.small_blocks[index]; + free.small_blocks[index] = block; + } + else + { + block->next_free = free.large_blocks; + free.large_blocks = block; + } +} + +/* Called after reading the code heap from the image file, and after code heap +compaction. Makes a free list consisting of one free block, at the very end. */ +template +void heap::build_free_list(cell size) +{ + clear_free_list(); + free_heap_block *end = (free_heap_block *)(seg->start + size); + end->set_free(); + end->set_size(seg->end - (cell)end); + add_to_free_list(end); +} + +template +void heap::assert_free_block(free_heap_block *block) +{ +#ifdef FACTOR_DEBUG + assert(block->free_p()); +#endif +} + +template +free_heap_block *heap::find_free_block(cell size) +{ + cell attempt = size; + + while(attempt < free_list_count * block_granularity) + { + int index = attempt / block_granularity; + free_heap_block *block = free.small_blocks[index]; + if(block) + { + assert_free_block(block); + free.small_blocks[index] = block->next_free; + return block; + } + + attempt *= 2; + } + + free_heap_block *prev = NULL; + free_heap_block *block = free.large_blocks; + + while(block) + { + assert_free_block(block); + if(block->size() >= size) + { + if(prev) + prev->next_free = block->next_free; + else + free.large_blocks = block->next_free; + return block; + } + + prev = block; + block = block->next_free; + } + + return NULL; +} + +template +free_heap_block *heap::split_free_block(free_heap_block *block, cell size) +{ + if(block->size() != size) + { + /* split the block in two */ + free_heap_block *split = (free_heap_block *)((cell)block + size); + split->set_free(); + split->set_size(block->size() - size); + split->next_free = block->next_free; + block->set_size(size); + add_to_free_list(split); + } + + return block; +} + +template +Block *heap::heap_allot(cell size) +{ + size = align(size,block_granularity); + + free_heap_block *block = find_free_block(size); + if(block) + { + block = split_free_block(block,size); + return (Block *)block; + } + else + return NULL; +} + +template +void heap::heap_free(Block *block) +{ + free_heap_block *free_block = (free_heap_block *)block; + free_block->set_free(); + add_to_free_list(free_block); +} + +template +void heap::mark_block(Block *block) +{ + state->set_marked_p(block); +} + +/* Compute total sum of sizes of free blocks, and size of largest free block */ +template +void heap::heap_usage(cell *used, cell *total_free, cell *max_free) +{ + *used = 0; + *total_free = 0; + *max_free = 0; + + Block *scan = first_block(); + Block *end = last_block(); + + while(scan != end) + { + cell size = layout.block_size(scan); + + if(scan->free_p()) + { + *total_free += size; + if(size > *max_free) + *max_free = size; + } + else + *used += size; + + scan = layout.next_block_after(scan); + } +} + +/* The size of the heap after compaction */ +template +cell heap::heap_size() +{ + Block *scan = first_block(); + Block *end = last_block(); + + while(scan != end) + { + if(scan->free_p()) break; + else scan = layout.next_block_after(scan); + } + + if(scan != end) + { + free_heap_block *free_block = (free_heap_block *)scan; + assert(free_block->free_p()); + assert((cell)scan + scan->size() == seg->end); + + return (cell)scan - (cell)first_block(); + } + else + return seg->size; +} + /* After code GC, all live code blocks are marked, so any which are not marked can be reclaimed. */ -template void heap::sweep_heap(Iterator &iter) +template +template +void heap::sweep_heap(Iterator &iter) { this->clear_free_list(); - heap_block *prev = NULL; - heap_block *scan = this->first_block(); - heap_block *end = this->last_block(); + Block *prev = NULL; + Block *scan = this->first_block(); + Block *end = this->last_block(); while(scan != end) { if(scan->free_p()) { + free_heap_block *free_scan = (free_heap_block *)scan; + if(prev && prev->free_p()) - prev->set_size(prev->size() + scan->size()); + { + free_heap_block *free_prev = (free_heap_block *)prev; + free_prev->set_size(free_prev->size() + free_scan->size()); + } else prev = scan; } @@ -82,17 +289,17 @@ template void heap::sweep_heap(Iterator &iter) if(prev && prev->free_p()) this->add_to_free_list((free_heap_block *)prev); prev = scan; - iter(scan,scan->size()); + iter(scan,layout.block_size(scan)); } else { if(secure_gc) - memset(scan + 1,0,scan->size() - sizeof(heap_block)); + memset(scan + 1,0,layout.block_size(scan) - sizeof(heap_block)); if(prev && prev->free_p()) { free_heap_block *free_prev = (free_heap_block *)prev; - free_prev->set_size(free_prev->size() + scan->size()); + free_prev->set_size(free_prev->size() + layout.block_size(scan)); } else { @@ -101,7 +308,7 @@ template void heap::sweep_heap(Iterator &iter) } } - scan = scan->next(); + scan = layout.next_block_after(scan); } if(prev && prev->free_p()) @@ -110,14 +317,16 @@ template void heap::sweep_heap(Iterator &iter) /* The forwarding map must be computed first by calling state->compute_forwarding(). */ -template void heap::compact_heap(Iterator &iter) +template +template +void heap::compact_heap(Iterator &iter) { - heap_compacter compacter(state,first_block(),iter); - this->iterate_heap(compacter); + heap_compactor compactor(state,first_block(),iter); + this->iterate_heap(compactor); /* Now update the free list; there will be a single free block at the end */ - this->build_free_list((cell)compacter.address - this->seg->start); + this->build_free_list((cell)compactor.address - this->seg->start); } } diff --git a/vm/layouts.hpp b/vm/layouts.hpp index 3249aac946..6e8c89ceb3 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -231,11 +231,6 @@ struct heap_block { header = (header & 0x7) | (size << 3); } - - inline heap_block *next() - { - return (heap_block *)((cell)this + size()); - } }; struct free_heap_block : public heap_block diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index a4dc715c50..d9c9534edb 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -1,9 +1,11 @@ namespace factor { +const int block_granularity = 16; const int forwarding_granularity = 64; -template struct mark_bits { +template struct mark_bits { + HeapLayout layout; cell start; cell size; cell bits_size; @@ -23,7 +25,7 @@ template struct mark_bits { explicit mark_bits(cell start_, cell size_) : start(start_), size(size_), - bits_size(size / Granularity / forwarding_granularity), + bits_size(size / block_granularity / forwarding_granularity), marked(new u64[bits_size]), forwarding(new cell[bits_size]) { @@ -41,12 +43,12 @@ template struct mark_bits { cell block_line(Block *address) { - return (((cell)address - start) / Granularity); + return (((cell)address - start) / block_granularity); } Block *line_block(cell line) { - return (Block *)(line * Granularity + start); + return (Block *)(line * block_granularity + start); } std::pair bitmap_deref(Block *address) @@ -71,7 +73,7 @@ template struct mark_bits { void set_bitmap_range(u64 *bits, Block *address) { std::pair start = bitmap_deref(address); - std::pair end = bitmap_deref(address->next()); + std::pair end = bitmap_deref(layout.next_block_after(address)); u64 start_mask = ((u64)1 << start.second) - 1; u64 end_mask = ((u64)1 << end.second) - 1; @@ -139,12 +141,12 @@ template struct mark_bits { } }; -template struct heap_compacter { - mark_bits *state; +template struct heap_compactor { + mark_bits *state; char *address; Iterator &iter; - explicit heap_compacter(mark_bits *state_, Block *address_, Iterator &iter_) : + explicit heap_compactor(mark_bits *state_, Block *address_, Iterator &iter_) : state(state_), address((char *)address_), iter(iter_) {} void operator()(Block *block, cell size) From 50f9bf67a78a36e0bdb65c45cde8dba6f38eb1ba Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 12:19:02 -0500 Subject: [PATCH 033/109] vm: fix crash when converting a callstack to an array --- vm/callstack.cpp | 6 +++--- vm/code_block.cpp | 2 +- vm/vm.hpp | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/vm/callstack.cpp b/vm/callstack.cpp index 4721fc4ece..623db8a3fe 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -76,7 +76,7 @@ code_block *factor_vm::frame_code(stack_frame *frame) return (code_block *)frame->xt - 1; } -cell factor_vm::frame_type(stack_frame *frame) +code_block_type factor_vm::frame_type(stack_frame *frame) { return frame_code(frame)->type(); } @@ -97,7 +97,7 @@ cell factor_vm::frame_scan(stack_frame *frame) { switch(frame_type(frame)) { - case QUOTATION_TYPE: + case code_block_unoptimized: { cell quot = frame_executing(frame); if(to_boolean(quot)) @@ -111,7 +111,7 @@ cell factor_vm::frame_scan(stack_frame *frame) else return false_object; } - case WORD_TYPE: + case code_block_optimized: return false_object; default: critical_error("Bad frame type",frame_type(frame)); diff --git a/vm/code_block.cpp b/vm/code_block.cpp index 7e6892202a..e29d708c25 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -479,7 +479,7 @@ code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell lab gc_root relocation(relocation_,this); gc_root literals(literals_,this); - cell code_length = align8(array_capacity(code.untagged())); + cell code_length = array_capacity(code.untagged()); code_block *compiled = allot_code_block(code_length,type); compiled->owner = owner.value(); diff --git a/vm/vm.hpp b/vm/vm.hpp index 921e829bda..a2f979e400 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -571,7 +571,7 @@ struct factor_vm void primitive_callstack(); void primitive_set_callstack(); code_block *frame_code(stack_frame *frame); - cell frame_type(stack_frame *frame); + code_block_type frame_type(stack_frame *frame); cell frame_executing(stack_frame *frame); stack_frame *frame_successor(stack_frame *frame); cell frame_scan(stack_frame *frame); From d85d84697ab57fd0e1b83eb8dde7a0986a6aa1d8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 12:45:00 -0500 Subject: [PATCH 034/109] Change data heap alignment to 16 bytes --- basis/bootstrap/image/image.factor | 9 +++++++-- basis/compiler/constants/constants.factor | 2 +- basis/cpu/ppc/ppc.factor | 2 +- basis/cpu/x86/x86.factor | 2 +- core/bootstrap/layouts/layouts.factor | 2 ++ core/layouts/layouts.factor | 2 ++ vm/arrays.cpp | 8 ++++---- vm/bignum.cpp | 2 +- vm/byte_arrays.cpp | 4 ++-- vm/callbacks.cpp | 4 ++-- vm/contexts.cpp | 2 +- vm/data_heap.cpp | 2 +- vm/generic_arrays.hpp | 4 ++-- vm/io.cpp | 2 +- vm/layouts.hpp | 14 ++++++++------ vm/strings.cpp | 2 +- vm/vm.hpp | 2 +- vm/zone.hpp | 2 +- 18 files changed, 39 insertions(+), 28 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index e086215e91..711f2f36f3 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -218,8 +218,12 @@ USERENV: undefined-quot 60 : here-as ( tag -- pointer ) here bitor ; +: (align-here) ( alignment -- ) + [ here neg ] dip rem + [ bootstrap-cell /i [ 0 emit ] times ] unless-zero ; + : align-here ( -- ) - here 8 mod 4 = [ 0 emit ] when ; + data-alignment get (align-here) ; : emit-fixnum ( n -- ) tag-fixnum emit ; @@ -293,7 +297,7 @@ M: fake-bignum ' n>> tag-fixnum ; M: float ' [ float [ - align-here double>bits emit-64 + 8 (align-here) double>bits emit-64 ] emit-object ] cache-eql-object ; @@ -411,6 +415,7 @@ M: byte-array ' [ byte-array [ dup length emit-fixnum + bootstrap-cell 4 = [ 0 emit 0 emit ] when pad-bytes emit-bytes ] emit-object ] cache-eq-object ; diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index a22d522809..ab607d2178 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -17,7 +17,7 @@ CONSTANT: deck-bits 18 : string-offset ( -- n ) 4 string tag-number slot-offset ; inline : string-aux-offset ( -- n ) 2 string tag-number slot-offset ; inline : profile-count-offset ( -- n ) 8 \ word tag-number slot-offset ; inline -: byte-array-offset ( -- n ) 2 byte-array tag-number slot-offset ; inline +: byte-array-offset ( -- n ) 16 byte-array tag-number - ; inline : alien-offset ( -- n ) 3 alien tag-number slot-offset ; inline : underlying-alien-offset ( -- n ) 1 alien tag-number slot-offset ; inline : tuple-class-offset ( -- n ) 1 tuple tag-number slot-offset ; inline diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 517aa7587d..7226145c27 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -374,7 +374,7 @@ M: ppc %set-alien-double -rot STFD ; [ drop load-zone-ptr ] [ swap 0 LWZ ] 2bi ; :: inc-allot-ptr ( nursery-ptr allot-ptr n -- ) - scratch-reg allot-ptr n 8 align ADDI + scratch-reg allot-ptr n data-alignment get align ADDI scratch-reg nursery-ptr 0 STW ; :: store-header ( dst class -- ) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 4576956335..e061ea5d95 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -388,7 +388,7 @@ M: x86 %vm-field-ptr ( dst field -- ) [ drop "nursery" %vm-field-ptr ] [ swap [] MOV ] 2bi ; : inc-allot-ptr ( nursery-ptr n -- ) - [ [] ] dip 8 align ADD ; + [ [] ] dip data-alignment get align ADD ; : store-header ( temp class -- ) [ [] ] [ type-number tag-fixnum ] bi* MOV ; diff --git a/core/bootstrap/layouts/layouts.factor b/core/bootstrap/layouts/layouts.factor index 5ed92b7776..fef7ba2a83 100644 --- a/core/bootstrap/layouts/layouts.factor +++ b/core/bootstrap/layouts/layouts.factor @@ -5,6 +5,8 @@ hashtables vectors strings sbufs arrays quotations assocs layouts classes.tuple.private kernel.private ; +16 data-alignment set + BIN: 111 tag-mask set 8 num-tags set 3 tag-bits set diff --git a/core/layouts/layouts.factor b/core/layouts/layouts.factor index be6276a684..2f0fa12d44 100644 --- a/core/layouts/layouts.factor +++ b/core/layouts/layouts.factor @@ -4,6 +4,8 @@ USING: namespaces math words kernel assocs classes math.order kernel.private ; IN: layouts +SYMBOL: data-alignment + SYMBOL: tag-mask SYMBOL: num-tags diff --git a/vm/arrays.cpp b/vm/arrays.cpp index 09c6998e69..3af8b0600b 100644 --- a/vm/arrays.cpp +++ b/vm/arrays.cpp @@ -7,7 +7,7 @@ namespace factor array *factor_vm::allot_array(cell capacity, cell fill_) { gc_root fill(fill_,this); - gc_root new_array(allot_array_internal(capacity),this); + gc_root new_array(allot_uninitialized_array(capacity),this); if(fill.value() == tag_fixnum(0)) memset(new_array->data(),'\0',capacity * sizeof(cell)); @@ -33,7 +33,7 @@ void factor_vm::primitive_array() cell factor_vm::allot_array_1(cell obj_) { gc_root obj(obj_,this); - gc_root a(allot_array_internal(1),this); + gc_root a(allot_uninitialized_array(1),this); set_array_nth(a.untagged(),0,obj.value()); return a.value(); } @@ -42,7 +42,7 @@ cell factor_vm::allot_array_2(cell v1_, cell v2_) { gc_root v1(v1_,this); gc_root v2(v2_,this); - gc_root a(allot_array_internal(2),this); + gc_root a(allot_uninitialized_array(2),this); set_array_nth(a.untagged(),0,v1.value()); set_array_nth(a.untagged(),1,v2.value()); return a.value(); @@ -54,7 +54,7 @@ cell factor_vm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_) gc_root v2(v2_,this); gc_root v3(v3_,this); gc_root v4(v4_,this); - gc_root a(allot_array_internal(4),this); + gc_root a(allot_uninitialized_array(4),this); set_array_nth(a.untagged(),0,v1.value()); set_array_nth(a.untagged(),1,v2.value()); set_array_nth(a.untagged(),2,v3.value()); diff --git a/vm/bignum.cpp b/vm/bignum.cpp index d8c5452b08..5a391e7625 100755 --- a/vm/bignum.cpp +++ b/vm/bignum.cpp @@ -1299,7 +1299,7 @@ bignum *factor_vm::bignum_digit_to_bignum(bignum_digit_type digit, int negative_ bignum *factor_vm::allot_bignum(bignum_length_type length, int negative_p) { BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX)); - bignum * result = allot_array_internal(length + 1); + bignum * result = allot_uninitialized_array(length + 1); BIGNUM_SET_NEGATIVE_P (result, negative_p); return (result); } diff --git a/vm/byte_arrays.cpp b/vm/byte_arrays.cpp index 56b5db7ad8..fa02ede6c3 100644 --- a/vm/byte_arrays.cpp +++ b/vm/byte_arrays.cpp @@ -5,7 +5,7 @@ namespace factor byte_array *factor_vm::allot_byte_array(cell size) { - byte_array *array = allot_array_internal(size); + byte_array *array = allot_uninitialized_array(size); memset(array + 1,0,size); return array; } @@ -19,7 +19,7 @@ void factor_vm::primitive_byte_array() void factor_vm::primitive_uninitialized_byte_array() { cell size = unbox_array_size(); - dpush(tag(allot_array_internal(size))); + dpush(tag(allot_uninitialized_array(size))); } void factor_vm::primitive_resize_byte_array() diff --git a/vm/callbacks.cpp b/vm/callbacks.cpp index dca0eb6c24..599271555b 100644 --- a/vm/callbacks.cpp +++ b/vm/callbacks.cpp @@ -39,14 +39,14 @@ callback *callback_heap::add(code_block *compiled) tagged insns(array_nth(code_template.untagged(),0)); cell size = array_capacity(insns.untagged()); - cell bump = align8(size) + sizeof(callback); + cell bump = align(size,sizeof(cell)) + sizeof(callback); if(here + bump > seg->end) fatal_error("Out of callback space",0); callback *stub = (callback *)here; stub->compiled = compiled; memcpy(stub + 1,insns->data(),size); - stub->size = align8(size); + stub->size = align(size,sizeof(cell)); here += bump; update(stub); diff --git a/vm/contexts.cpp b/vm/contexts.cpp index cc7029e7f1..ce52555a21 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -133,7 +133,7 @@ bool factor_vm::stack_to_array(cell bottom, cell top) return false; else { - array *a = allot_array_internal(depth / sizeof(cell)); + array *a = allot_uninitialized_array(depth / sizeof(cell)); memcpy(a + 1,(void*)bottom,depth); dpush(tag(a)); return true; diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 335938acab..05ce026973 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -119,7 +119,7 @@ cell factor_vm::object_size(cell tagged) /* Size of the object pointed to by an untagged pointer */ cell factor_vm::untagged_object_size(object *pointer) { - return align8(unaligned_object_size(pointer)); + return align(unaligned_object_size(pointer),data_alignment); } /* Size of the data area of an object pointed to by an untagged pointer */ diff --git a/vm/generic_arrays.hpp b/vm/generic_arrays.hpp index 0ba6d11da2..e1d2c4dc0b 100755 --- a/vm/generic_arrays.hpp +++ b/vm/generic_arrays.hpp @@ -19,7 +19,7 @@ template cell array_size(Array *array) return array_size(array_capacity(array)); } -template Array *factor_vm::allot_array_internal(cell capacity) +template Array *factor_vm::allot_uninitialized_array(cell capacity) { Array *array = allot(array_size(capacity)); array->capacity = tag_fixnum(capacity); @@ -46,7 +46,7 @@ template Array *factor_vm::reallot_array(Array *array_, cell cap if(capacity < to_copy) to_copy = capacity; - Array *new_array = allot_array_internal(capacity); + Array *new_array = allot_uninitialized_array(capacity); memcpy(new_array + 1,array.untagged() + 1,to_copy * Array::element_size); memset((char *)(new_array + 1) + to_copy * Array::element_size, diff --git a/vm/io.cpp b/vm/io.cpp index d5cfc1745c..a75f41c5bf 100755 --- a/vm/io.cpp +++ b/vm/io.cpp @@ -88,7 +88,7 @@ void factor_vm::primitive_fread() return; } - gc_root buf(allot_array_internal(size),this); + gc_root buf(allot_uninitialized_array(size),this); for(;;) { diff --git a/vm/layouts.hpp b/vm/layouts.hpp index 6e8c89ceb3..c25c2c0fc1 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -23,10 +23,7 @@ inline static cell align(cell a, cell b) return (a + (b-1)) & ~(b-1); } -inline static cell align8(cell a) -{ - return align(a,8); -} +static const cell data_alignment = 16; #define WORD_SIZE (signed)(sizeof(cell)*8) @@ -186,6 +183,11 @@ struct byte_array : public object { /* tagged */ cell capacity; +#ifndef FACTOR_64 + cell padding0; + cell padding1; +#endif + template Scalar *data() { return (Scalar *)(this + 1); } }; @@ -249,9 +251,9 @@ struct code_block : public heap_block return (void *)(this + 1); } - cell type() + code_block_type type() { - return (header >> 1) & 0x3; + return (code_block_type)((header >> 1) & 0x3); } void set_type(code_block_type type) diff --git a/vm/strings.cpp b/vm/strings.cpp index d7434fe660..23fa75acca 100644 --- a/vm/strings.cpp +++ b/vm/strings.cpp @@ -45,7 +45,7 @@ void factor_vm::set_string_nth_slow(string *str_, cell index, cell ch) if the most significant bit of a character is set. Initially all of the bits are clear. */ - aux = allot_array_internal(untag_fixnum(str->length) * sizeof(u16)); + aux = allot_uninitialized_array(untag_fixnum(str->length) * sizeof(u16)); str->aux = tag(aux); write_barrier(&str->aux); diff --git a/vm/vm.hpp b/vm/vm.hpp index a2f979e400..87697d5a0f 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -298,7 +298,7 @@ struct factor_vm } // generic arrays - template Array *allot_array_internal(cell capacity); + template Array *allot_uninitialized_array(cell capacity); template bool reallot_array_in_place_p(Array *array, cell capacity); template Array *reallot_array(Array *array_, cell capacity); diff --git a/vm/zone.hpp b/vm/zone.hpp index 4fe4ae9b6b..2c28922fbc 100644 --- a/vm/zone.hpp +++ b/vm/zone.hpp @@ -18,7 +18,7 @@ struct zone { inline object *allot(cell size) { cell h = here; - here = h + align8(size); + here = h + align(size,data_alignment); return (object *)h; } }; From d22d5466fcbb6164b913d8e263cc8f3d9200a59a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 13:13:39 -0500 Subject: [PATCH 035/109] vm: move factor_vm::untagged_object_size() to object::size() --- vm/aging_collector.cpp | 2 +- vm/collector.hpp | 2 +- vm/copying_collector.hpp | 8 ++-- vm/data_heap.cpp | 73 +++++++++++-------------------------- vm/data_heap.hpp | 28 ++++++++++++++ vm/full_collector.cpp | 6 +-- vm/image.cpp | 4 +- vm/layouts.hpp | 16 +++++--- vm/old_space.cpp | 4 +- vm/old_space.hpp | 2 +- vm/to_tenured_collector.cpp | 2 +- vm/vm.hpp | 5 --- 12 files changed, 76 insertions(+), 76 deletions(-) diff --git a/vm/aging_collector.cpp b/vm/aging_collector.cpp index 5e284be587..49b1c520ec 100644 --- a/vm/aging_collector.cpp +++ b/vm/aging_collector.cpp @@ -32,7 +32,7 @@ void factor_vm::collect_aging() current_gc->op = collect_aging_op; std::swap(data->aging,data->aging_semispace); - reset_generation(data->aging); + data->reset_generation(data->aging); aging_collector collector(this); diff --git a/vm/collector.hpp b/vm/collector.hpp index bbaad1d570..9200d95399 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -68,7 +68,7 @@ template struct collector { object *promote_object(object *untagged) { - cell size = parent->untagged_object_size(untagged); + cell size = untagged->size(); object *newpointer = target->allot(size); /* XXX not exception-safe */ if(!newpointer) longjmp(current_gc->gc_unwind,1); diff --git a/vm/copying_collector.hpp b/vm/copying_collector.hpp index 640d355bf4..dd36b680a6 100644 --- a/vm/copying_collector.hpp +++ b/vm/copying_collector.hpp @@ -97,7 +97,7 @@ struct copying_collector : collector { { start = gen->find_object_containing_card(card_index - gen_start_card); binary_start = start + this->parent->binary_payload_start((object *)start); - end = start + this->parent->untagged_object_size((object *)start); + end = start + ((object *)start)->size(); } #ifdef FACTOR_DEBUG @@ -113,11 +113,11 @@ scan_next_object: { card_end_address(card_index)); if(end < card_end_address(card_index)) { - start = gen->next_object_after(this->parent,start); + start = gen->next_object_after(start); if(start) { binary_start = start + this->parent->binary_payload_start((object *)start); - end = start + this->parent->untagged_object_size((object *)start); + end = start + ((object *)start)->size(); goto scan_next_object; } } @@ -158,7 +158,7 @@ end: this->parent->gc_stats.card_scan_time += (current_micros() - start_time); while(scan && scan < this->target->here) { this->trace_slots((object *)scan); - scan = this->target->next_object_after(this->parent,scan); + scan = this->target->next_object_after(scan); } } }; diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 05ce026973..05f8f3a044 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -65,40 +65,14 @@ data_heap *data_heap::grow(cell requested_bytes) return new data_heap(young_size,aging_size,new_tenured_size); } -void factor_vm::clear_cards(old_space *gen) -{ - cell first_card = addr_to_card(gen->start - data->start); - cell last_card = addr_to_card(gen->end - data->start); - memset(&data->cards[first_card],0,last_card - first_card); -} - -void factor_vm::clear_decks(old_space *gen) -{ - cell first_deck = addr_to_deck(gen->start - data->start); - cell last_deck = addr_to_deck(gen->end - data->start); - memset(&data->decks[first_deck],0,last_deck - first_deck); -} - -/* After garbage collection, any generations which are now empty need to have -their allocation pointers and cards reset. */ -void factor_vm::reset_generation(old_space *gen) -{ - gen->here = gen->start; - if(secure_gc) memset((void*)gen->start,69,gen->size); - - clear_cards(gen); - clear_decks(gen); - gen->clear_object_start_offsets(); -} - void factor_vm::set_data_heap(data_heap *data_) { data = data_; nursery = *data->nursery; nursery.here = nursery.start; init_card_decks(); - reset_generation(data->aging); - reset_generation(data->tenured); + data->reset_generation(data->aging); + data->reset_generation(data->tenured); } void factor_vm::init_data_heap(cell young_size, cell aging_size, cell tenured_size, bool secure_gc_) @@ -113,46 +87,43 @@ cell factor_vm::object_size(cell tagged) if(immediate_p(tagged)) return 0; else - return untagged_object_size(untag(tagged)); + return untag(tagged)->size(); } /* Size of the object pointed to by an untagged pointer */ -cell factor_vm::untagged_object_size(object *pointer) +cell object::size() { - return align(unaligned_object_size(pointer),data_alignment); -} - -/* Size of the data area of an object pointed to by an untagged pointer */ -cell factor_vm::unaligned_object_size(object *pointer) -{ - switch(pointer->h.hi_tag()) + switch(h.hi_tag()) { case ARRAY_TYPE: - return array_size((array*)pointer); + return align(array_size((array*)this),data_alignment); case BIGNUM_TYPE: - return array_size((bignum*)pointer); + return align(array_size((bignum*)this),data_alignment); case BYTE_ARRAY_TYPE: - return array_size((byte_array*)pointer); + return align(array_size((byte_array*)this),data_alignment); case STRING_TYPE: - return string_size(string_capacity((string*)pointer)); + return align(string_size(string_capacity((string*)this)),data_alignment); case TUPLE_TYPE: - return tuple_size(untag(((tuple *)pointer)->layout)); + { + tuple_layout *layout = (tuple_layout *)UNTAG(((tuple *)this)->layout); + return align(tuple_size(layout),data_alignment); + } case QUOTATION_TYPE: - return sizeof(quotation); + return align(sizeof(quotation),data_alignment); case WORD_TYPE: - return sizeof(word); + return align(sizeof(word),data_alignment); case FLOAT_TYPE: - return sizeof(boxed_float); + return align(sizeof(boxed_float),data_alignment); case DLL_TYPE: - return sizeof(dll); + return align(sizeof(dll),data_alignment); case ALIEN_TYPE: - return sizeof(alien); + return align(sizeof(alien),data_alignment); case WRAPPER_TYPE: - return sizeof(wrapper); + return align(sizeof(wrapper),data_alignment); case CALLSTACK_TYPE: - return callstack_size(untag_fixnum(((callstack *)pointer)->length)); + return align(callstack_size(untag_fixnum(((callstack *)this)->length)),data_alignment); default: - critical_error("Invalid header",(cell)pointer); + critical_error("Invalid header",(cell)this); return 0; /* can't happen */ } } @@ -246,7 +217,7 @@ cell factor_vm::next_object() return false_object; object *obj = (object *)heap_scan_ptr; - heap_scan_ptr += untagged_object_size(obj); + heap_scan_ptr += obj->size(); return tag_dynamic(obj); } diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp index 10f3698e74..c882262732 100755 --- a/vm/data_heap.hpp +++ b/vm/data_heap.hpp @@ -25,6 +25,34 @@ struct data_heap { explicit data_heap(cell young_size, cell aging_size, cell tenured_size); ~data_heap(); data_heap *grow(cell requested_size); + template void clear_cards(Generation *gen); + template void clear_decks(Generation *gen); + template void reset_generation(Generation *gen); }; +template void data_heap::clear_cards(Generation *gen) +{ + cell first_card = addr_to_card(gen->start - start); + cell last_card = addr_to_card(gen->end - start); + memset(&cards[first_card],0,last_card - first_card); +} + +template void data_heap::clear_decks(Generation *gen) +{ + cell first_deck = addr_to_deck(gen->start - start); + cell last_deck = addr_to_deck(gen->end - start); + memset(&decks[first_deck],0,last_deck - first_deck); +} + +/* After garbage collection, any generations which are now empty need to have +their allocation pointers and cards reset. */ +template void data_heap::reset_generation(Generation *gen) +{ + gen->here = gen->start; + + clear_cards(gen); + clear_decks(gen); + gen->clear_object_start_offsets(); +} + } diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 61827fba41..1bb03d08e7 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -100,7 +100,7 @@ void full_collector::cheneys_algorithm() object *obj = (object *)scan; this->trace_slots(obj); this->mark_object_code_block(obj); - scan = target->next_object_after(this->parent,scan); + scan = target->next_object_after(scan); } } @@ -120,7 +120,7 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) collector.cheneys_algorithm(); - reset_generation(data->aging); + data->reset_generation(data->aging); nursery.here = nursery.start; } @@ -146,7 +146,7 @@ void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p) { /* Copy all live objects to the tenured semispace. */ std::swap(data->tenured,data->tenured_semispace); - reset_generation(data->tenured); + data->reset_generation(data->tenured); collect_full_impl(trace_contexts_p); if(compact_code_heap_p) diff --git a/vm/image.cpp b/vm/image.cpp index c96da6b703..f41ae555a3 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -155,7 +155,7 @@ void factor_vm::relocate_object(object *object, data_fixup(&t->layout,data_relocation_base); cell *scan = t->data(); - cell *end = (cell *)((cell)object + untagged_object_size(object)); + cell *end = (cell *)((cell)object + object->size()); for(; scan < end; scan++) data_fixup(scan,data_relocation_base); @@ -204,7 +204,7 @@ void factor_vm::relocate_data(cell data_relocation_base, cell code_relocation_ba { relocate_object((object *)obj,data_relocation_base,code_relocation_base); data->tenured->record_object_start_offset((object *)obj); - obj = data->tenured->next_object_after(this,obj); + obj = data->tenured->next_object_after(obj); } } diff --git a/vm/layouts.hpp b/vm/layouts.hpp index c25c2c0fc1..f0dbff6c30 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -114,26 +114,31 @@ struct header { explicit header(cell value_) : value(value_ << TAG_BITS) {} - void check_header() { + void check_header() + { #ifdef FACTOR_DEBUG assert(TAG(value) == FIXNUM_TYPE && untag_fixnum(value) < TYPE_COUNT); #endif } - cell hi_tag() { + cell hi_tag() + { check_header(); return value >> TAG_BITS; } - bool forwarding_pointer_p() { + bool forwarding_pointer_p() + { return TAG(value) == GC_COLLECTED; } - object *forwarding_pointer() { + object *forwarding_pointer() + { return (object *)UNTAG(value); } - void forward_to(object *pointer) { + void forward_to(object *pointer) + { value = RETAG(pointer,GC_COLLECTED); } }; @@ -144,6 +149,7 @@ struct object { NO_TYPE_CHECK; header h; cell *slots() { return (cell *)this; } + cell size(); }; /* Assembly code makes assumptions about the layout of this struct */ diff --git a/vm/old_space.cpp b/vm/old_space.cpp index 5fd78a7cf4..9440749e52 100644 --- a/vm/old_space.cpp +++ b/vm/old_space.cpp @@ -62,9 +62,9 @@ void old_space::clear_object_start_offsets() memset(object_start_offsets,card_starts_inside_object,addr_to_card(size)); } -cell old_space::next_object_after(factor_vm *parent, cell scan) +cell old_space::next_object_after(cell scan) { - cell size = parent->untagged_object_size((object *)scan); + cell size = ((object *)scan)->size(); if(scan + size < here) return scan + size; else diff --git a/vm/old_space.hpp b/vm/old_space.hpp index d037a039ae..e59537cffb 100644 --- a/vm/old_space.hpp +++ b/vm/old_space.hpp @@ -15,7 +15,7 @@ struct old_space : zone { void record_object_start_offset(object *obj); object *allot(cell size); void clear_object_start_offsets(); - cell next_object_after(factor_vm *parent, cell scan); + cell next_object_after(cell scan); }; } diff --git a/vm/to_tenured_collector.cpp b/vm/to_tenured_collector.cpp index b5d4793ceb..3676324ce2 100644 --- a/vm/to_tenured_collector.cpp +++ b/vm/to_tenured_collector.cpp @@ -25,7 +25,7 @@ void factor_vm::collect_to_tenured() update_code_heap_for_minor_gc(&code->points_to_aging); nursery.here = nursery.start; - reset_generation(data->aging); + data->reset_generation(data->aging); code->points_to_nursery.clear(); code->points_to_aging.clear(); } diff --git a/vm/vm.hpp b/vm/vm.hpp index 87697d5a0f..2df66e97b3 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -220,13 +220,8 @@ struct factor_vm //data heap void init_card_decks(); - void clear_cards(old_space *gen); - void clear_decks(old_space *gen); - void reset_generation(old_space *gen); void set_data_heap(data_heap *data_); void init_data_heap(cell young_size, cell aging_size, cell tenured_size, bool secure_gc_); - cell untagged_object_size(object *pointer); - cell unaligned_object_size(object *pointer); void primitive_size(); cell binary_payload_start(object *pointer); void primitive_data_room(); From e482940dca57bc2f701168928ed5e527541efe2f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 13:47:04 -0500 Subject: [PATCH 036/109] vm: object start recording in cards is now independent of allocation strategy --- vm/aging_space.hpp | 16 ++++++++++++++-- vm/code_heap.hpp | 5 ----- vm/copying_collector.hpp | 2 +- vm/data_heap.hpp | 2 +- vm/heap.hpp | 13 +++++++++---- vm/image.cpp | 2 +- vm/layouts.hpp | 11 ++++++++++- vm/mark_bits.hpp | 7 ++++++- vm/old_space.cpp | 35 +++++++++-------------------------- vm/old_space.hpp | 9 ++++----- vm/tenured_space.hpp | 29 +++++++++++++++++++++++++++-- vm/zone.hpp | 9 +++++++++ 12 files changed, 91 insertions(+), 49 deletions(-) diff --git a/vm/aging_space.hpp b/vm/aging_space.hpp index c2ec2a645e..1fac4605d2 100644 --- a/vm/aging_space.hpp +++ b/vm/aging_space.hpp @@ -1,8 +1,20 @@ namespace factor { -struct aging_space : old_space { - aging_space(cell size, cell start) : old_space(size,start) {} +struct aging_space : zone { + object_start_map starts; + + aging_space(cell size, cell start) : + zone(size,start), starts(size,start) {} + + object *allot(cell size) + { + if(here + size > end) return NULL; + + object *obj = zone::allot(size); + starts.record_object_start_offset(obj); + return obj; + } }; } diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp index e98d966afe..b29e33ca64 100755 --- a/vm/code_heap.hpp +++ b/vm/code_heap.hpp @@ -6,11 +6,6 @@ struct code_heap_layout { { return block->size(); } - - heap_block *next_block_after(heap_block *block) - { - return (heap_block *)((cell)block + block_size(block)); - } }; struct code_heap : heap { diff --git a/vm/copying_collector.hpp b/vm/copying_collector.hpp index dd36b680a6..4bb56945a1 100644 --- a/vm/copying_collector.hpp +++ b/vm/copying_collector.hpp @@ -95,7 +95,7 @@ struct copying_collector : collector { if(end < card_start_address(card_index)) { - start = gen->find_object_containing_card(card_index - gen_start_card); + start = gen->starts.find_object_containing_card(card_index - gen_start_card); binary_start = start + this->parent->binary_payload_start((object *)start); end = start + ((object *)start)->size(); } diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp index c882262732..3a0af1f36a 100755 --- a/vm/data_heap.hpp +++ b/vm/data_heap.hpp @@ -52,7 +52,7 @@ template void data_heap::reset_generation(Generation *gen) clear_cards(gen); clear_decks(gen); - gen->clear_object_start_offsets(); + gen->starts.clear_object_start_offsets(); } } diff --git a/vm/heap.hpp b/vm/heap.hpp index 653ac2d93d..c82b88ee2f 100644 --- a/vm/heap.hpp +++ b/vm/heap.hpp @@ -28,6 +28,11 @@ template struct heap { return (Block *)seg->end; } + Block *next_block_after(heap_block *block) + { + return (Block *)((cell)block + layout.block_size(block)); + } + void clear_free_list(); void add_to_free_list(free_heap_block *block); void build_free_list(cell size); @@ -50,7 +55,7 @@ template struct heap { while(scan != end) { - Block *next = layout.next_block_after(scan); + Block *next = next_block_after(scan); if(!scan->free_p()) iter(scan,layout.block_size(scan)); scan = next; } @@ -229,7 +234,7 @@ void heap::heap_usage(cell *used, cell *total_free, cell *max_ else *used += size; - scan = layout.next_block_after(scan); + scan = next_block_after(scan); } } @@ -243,7 +248,7 @@ cell heap::heap_size() while(scan != end) { if(scan->free_p()) break; - else scan = layout.next_block_after(scan); + else scan = next_block_after(scan); } if(scan != end) @@ -308,7 +313,7 @@ void heap::sweep_heap(Iterator &iter) } } - scan = layout.next_block_after(scan); + scan = next_block_after(scan); } if(prev && prev->free_p()) diff --git a/vm/image.cpp b/vm/image.cpp index f41ae555a3..7d8c4a2d32 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -203,7 +203,7 @@ void factor_vm::relocate_data(cell data_relocation_base, cell code_relocation_ba while(obj) { relocate_object((object *)obj,data_relocation_base,code_relocation_base); - data->tenured->record_object_start_offset((object *)obj); + data->tenured->starts.record_object_start_offset((object *)obj); obj = data->tenured->next_object_after(obj); } } diff --git a/vm/layouts.hpp b/vm/layouts.hpp index f0dbff6c30..ca51fd6dca 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -148,8 +148,17 @@ struct header { struct object { NO_TYPE_CHECK; header h; - cell *slots() { return (cell *)this; } + cell size(); + + cell *slots() { return (cell *)this; } + + /* Only valid for objects in tenured space; must fast to free_heap_block + to do anything with it if its free */ + bool free_p() + { + return h.value & 1 == 1; + } }; /* Assembly code makes assumptions about the layout of this struct */ diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index d9c9534edb..bc318524b4 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -70,10 +70,15 @@ template struct mark_bits { return (bits[pair.first] & ((u64)1 << pair.second)) != 0; } + Block *next_block_after(Block *block) + { + return (Block *)((cell)block + layout.block_size(block)); + } + void set_bitmap_range(u64 *bits, Block *address) { std::pair start = bitmap_deref(address); - std::pair end = bitmap_deref(layout.next_block_after(address)); + std::pair end = bitmap_deref(next_block_after(address)); u64 start_mask = ((u64)1 << start.second) - 1; u64 end_mask = ((u64)1 << end.second) - 1; diff --git a/vm/old_space.cpp b/vm/old_space.cpp index 9440749e52..5f992e783e 100644 --- a/vm/old_space.cpp +++ b/vm/old_space.cpp @@ -3,23 +3,24 @@ namespace factor { -old_space::old_space(cell size_, cell start_) : zone(size_,start_) +object_start_map::object_start_map(cell size_, cell start_) : + size(size_), start(start_) { object_start_offsets = new card[addr_to_card(size_)]; object_start_offsets_end = object_start_offsets + addr_to_card(size_); } -old_space::~old_space() +object_start_map::~object_start_map() { delete[] object_start_offsets; } -cell old_space::first_object_in_card(cell card_index) +cell object_start_map::first_object_in_card(cell card_index) { return object_start_offsets[card_index]; } -cell old_space::find_object_containing_card(cell card_index) +cell object_start_map::find_object_containing_card(cell card_index) { if(card_index == 0) return start; @@ -41,34 +42,16 @@ cell old_space::find_object_containing_card(cell card_index) } /* we need to remember the first object allocated in the card */ -void old_space::record_object_start_offset(object *obj) +void object_start_map::record_object_start_offset(object *obj) { cell idx = addr_to_card((cell)obj - start); - if(object_start_offsets[idx] == card_starts_inside_object) - object_start_offsets[idx] = ((cell)obj & addr_card_mask); + card obj_start = ((cell)obj & addr_card_mask); + object_start_offsets[idx] = std::min(object_start_offsets[idx],obj_start); } -object *old_space::allot(cell size) -{ - if(here + size > end) return NULL; - - object *obj = zone::allot(size); - record_object_start_offset(obj); - return obj; -} - -void old_space::clear_object_start_offsets() +void object_start_map::clear_object_start_offsets() { memset(object_start_offsets,card_starts_inside_object,addr_to_card(size)); } -cell old_space::next_object_after(cell scan) -{ - cell size = ((object *)scan)->size(); - if(scan + size < here) - return scan + size; - else - return 0; -} - } diff --git a/vm/old_space.hpp b/vm/old_space.hpp index e59537cffb..640e205852 100644 --- a/vm/old_space.hpp +++ b/vm/old_space.hpp @@ -3,19 +3,18 @@ namespace factor static const cell card_starts_inside_object = 0xff; -struct old_space : zone { +struct object_start_map { + cell size, start; card *object_start_offsets; card *object_start_offsets_end; - old_space(cell size_, cell start_); - ~old_space(); + object_start_map(cell size_, cell start_); + ~object_start_map(); cell first_object_in_card(cell card_index); cell find_object_containing_card(cell card_index); void record_object_start_offset(object *obj); - object *allot(cell size); void clear_object_start_offsets(); - cell next_object_after(cell scan); }; } diff --git a/vm/tenured_space.hpp b/vm/tenured_space.hpp index f9f584b200..a700b58bfd 100644 --- a/vm/tenured_space.hpp +++ b/vm/tenured_space.hpp @@ -1,8 +1,33 @@ namespace factor { -struct tenured_space : old_space { - tenured_space(cell size, cell start) : old_space(size,start) {} +struct tenured_space_layout { + cell block_size(object *block) + { + if(block->free_p()) + { + free_heap_block *free_block = (free_heap_block *)block; + return free_block->size(); + } + else + return block->size(); + } +}; + +struct tenured_space : zone { + object_start_map starts; + + tenured_space(cell size, cell start) : + zone(size,start), starts(size,start) {} + + object *allot(cell size) + { + if(here + size > end) return NULL; + + object *obj = zone::allot(size); + starts.record_object_start_offset(obj); + return obj; + } }; } diff --git a/vm/zone.hpp b/vm/zone.hpp index 2c28922fbc..42196f315b 100644 --- a/vm/zone.hpp +++ b/vm/zone.hpp @@ -21,6 +21,15 @@ struct zone { here = h + align(size,data_alignment); return (object *)h; } + + cell next_object_after(cell scan) + { + cell size = ((object *)scan)->size(); + if(scan + size < here) + return scan + size; + else + return 0; + } }; } From a9dbbd1efb5c8b3cbda11f6511457b4f4a5bcca7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 14:01:46 -0500 Subject: [PATCH 037/109] vm: simplify code heap by eliminating HeapLayout template parameter --- vm/code_heap.cpp | 3 +- vm/code_heap.hpp | 9 +---- vm/copying_collector.hpp | 4 +- vm/data_heap.cpp | 2 + vm/full_collector.cpp | 2 +- vm/heap.hpp | 82 ++++++++++++++++------------------------ vm/image.cpp | 2 +- vm/mark_bits.hpp | 11 +++--- vm/tenured_space.hpp | 13 ------- vm/zone.hpp | 2 +- 10 files changed, 47 insertions(+), 83 deletions(-) diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index df557074af..c65dec9a69 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -3,8 +3,7 @@ namespace factor { -code_heap::code_heap(bool secure_gc, cell size) : - heap(secure_gc,size,true) {} +code_heap::code_heap(bool secure_gc, cell size) : heap(secure_gc,size,true) {} void code_heap::write_barrier(code_block *compiled) { diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp index b29e33ca64..d4c5d4e40b 100755 --- a/vm/code_heap.hpp +++ b/vm/code_heap.hpp @@ -1,14 +1,7 @@ namespace factor { -struct code_heap_layout { - cell block_size(heap_block *block) - { - return block->size(); - } -}; - -struct code_heap : heap { +struct code_heap : heap { /* Set of blocks which need full relocation. */ std::set needs_fixup; diff --git a/vm/copying_collector.hpp b/vm/copying_collector.hpp index 4bb56945a1..ea7faf2423 100644 --- a/vm/copying_collector.hpp +++ b/vm/copying_collector.hpp @@ -113,7 +113,7 @@ scan_next_object: { card_end_address(card_index)); if(end < card_end_address(card_index)) { - start = gen->next_object_after(start); + start = gen->next_allocated_block_after(start); if(start) { binary_start = start + this->parent->binary_payload_start((object *)start); @@ -158,7 +158,7 @@ end: this->parent->gc_stats.card_scan_time += (current_micros() - start_time); while(scan && scan < this->target->here) { this->trace_slots((object *)scan); - scan = this->target->next_object_after(scan); + scan = this->target->next_allocated_block_after(scan); } } }; diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 05f8f3a044..d3951b2b27 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -93,6 +93,8 @@ cell factor_vm::object_size(cell tagged) /* Size of the object pointed to by an untagged pointer */ cell object::size() { + if(free_p()) return ((free_heap_block *)this)->size(); + switch(h.hi_tag()) { case ARRAY_TYPE: diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 1bb03d08e7..9c8a825c1f 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -100,7 +100,7 @@ void full_collector::cheneys_algorithm() object *obj = (object *)scan; this->trace_slots(obj); this->mark_object_code_block(obj); - scan = target->next_object_after(scan); + scan = target->next_allocated_block_after(scan); } } diff --git a/vm/heap.hpp b/vm/heap.hpp index c82b88ee2f..c06eab8dc7 100644 --- a/vm/heap.hpp +++ b/vm/heap.hpp @@ -8,12 +8,11 @@ struct heap_free_list { free_heap_block *large_blocks; }; -template struct heap { +template struct heap { bool secure_gc; segment *seg; heap_free_list free; - mark_bits *state; - HeapLayout layout; + mark_bits *state; explicit heap(bool secure_gc_, cell size, bool executable_p); ~heap(); @@ -30,7 +29,7 @@ template struct heap { Block *next_block_after(heap_block *block) { - return (Block *)((cell)block + layout.block_size(block)); + return (Block *)((cell)block + block->size()); } void clear_free_list(); @@ -55,31 +54,29 @@ template struct heap { while(scan != end) { - Block *next = next_block_after(scan); - if(!scan->free_p()) iter(scan,layout.block_size(scan)); + cell size = scan->size(); + Block *next = (Block *)((cell)scan + size); + if(!scan->free_p()) iter(scan,size); scan = next; } } }; -template -void heap::clear_free_list() +template void heap::clear_free_list() { memset(&free,0,sizeof(heap_free_list)); } -template -heap::heap(bool secure_gc_, cell size, bool executable_p) : secure_gc(secure_gc_) +template heap::heap(bool secure_gc_, cell size, bool executable_p) : secure_gc(secure_gc_) { if(size > (1L << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size); seg = new segment(align_page(size),executable_p); if(!seg) fatal_error("Out of memory in heap allocator",size); - state = new mark_bits(seg->start,size); + state = new mark_bits(seg->start,size); clear_free_list(); } -template -heap::~heap() +template heap::~heap() { delete seg; seg = NULL; @@ -87,8 +84,7 @@ heap::~heap() state = NULL; } -template -void heap::add_to_free_list(free_heap_block *block) +template void heap::add_to_free_list(free_heap_block *block) { if(block->size() < free_list_count * block_granularity) { @@ -105,8 +101,7 @@ void heap::add_to_free_list(free_heap_block *block) /* Called after reading the code heap from the image file, and after code heap compaction. Makes a free list consisting of one free block, at the very end. */ -template -void heap::build_free_list(cell size) +template void heap::build_free_list(cell size) { clear_free_list(); free_heap_block *end = (free_heap_block *)(seg->start + size); @@ -115,16 +110,14 @@ void heap::build_free_list(cell size) add_to_free_list(end); } -template -void heap::assert_free_block(free_heap_block *block) +template void heap::assert_free_block(free_heap_block *block) { #ifdef FACTOR_DEBUG assert(block->free_p()); #endif } -template -free_heap_block *heap::find_free_block(cell size) +template free_heap_block *heap::find_free_block(cell size) { cell attempt = size; @@ -164,8 +157,7 @@ free_heap_block *heap::find_free_block(cell size) return NULL; } -template -free_heap_block *heap::split_free_block(free_heap_block *block, cell size) +template free_heap_block *heap::split_free_block(free_heap_block *block, cell size) { if(block->size() != size) { @@ -181,8 +173,7 @@ free_heap_block *heap::split_free_block(free_heap_block *block return block; } -template -Block *heap::heap_allot(cell size) +template Block *heap::heap_allot(cell size) { size = align(size,block_granularity); @@ -196,23 +187,20 @@ Block *heap::heap_allot(cell size) return NULL; } -template -void heap::heap_free(Block *block) +template void heap::heap_free(Block *block) { free_heap_block *free_block = (free_heap_block *)block; free_block->set_free(); add_to_free_list(free_block); } -template -void heap::mark_block(Block *block) +template void heap::mark_block(Block *block) { state->set_marked_p(block); } /* Compute total sum of sizes of free blocks, and size of largest free block */ -template -void heap::heap_usage(cell *used, cell *total_free, cell *max_free) +template void heap::heap_usage(cell *used, cell *total_free, cell *max_free) { *used = 0; *total_free = 0; @@ -223,7 +211,7 @@ void heap::heap_usage(cell *used, cell *total_free, cell *max_ while(scan != end) { - cell size = layout.block_size(scan); + cell size = scan->size(); if(scan->free_p()) { @@ -239,8 +227,7 @@ void heap::heap_usage(cell *used, cell *total_free, cell *max_ } /* The size of the heap after compaction */ -template -cell heap::heap_size() +template cell heap::heap_size() { Block *scan = first_block(); Block *end = last_block(); @@ -255,7 +242,7 @@ cell heap::heap_size() { free_heap_block *free_block = (free_heap_block *)scan; assert(free_block->free_p()); - assert((cell)scan + scan->size() == seg->end); + assert((cell)scan + free_block->size() == seg->end); return (cell)scan - (cell)first_block(); } @@ -265,9 +252,9 @@ cell heap::heap_size() /* After code GC, all live code blocks are marked, so any which are not marked can be reclaimed. */ -template +template template -void heap::sweep_heap(Iterator &iter) +void heap::sweep_heap(Iterator &iter) { this->clear_free_list(); @@ -277,14 +264,14 @@ void heap::sweep_heap(Iterator &iter) while(scan != end) { + cell size = scan->size(); + if(scan->free_p()) { - free_heap_block *free_scan = (free_heap_block *)scan; - if(prev && prev->free_p()) { free_heap_block *free_prev = (free_heap_block *)prev; - free_prev->set_size(free_prev->size() + free_scan->size()); + free_prev->set_size(free_prev->size() + size); } else prev = scan; @@ -294,17 +281,14 @@ void heap::sweep_heap(Iterator &iter) if(prev && prev->free_p()) this->add_to_free_list((free_heap_block *)prev); prev = scan; - iter(scan,layout.block_size(scan)); + iter(scan,size); } else { - if(secure_gc) - memset(scan + 1,0,layout.block_size(scan) - sizeof(heap_block)); - if(prev && prev->free_p()) { free_heap_block *free_prev = (free_heap_block *)prev; - free_prev->set_size(free_prev->size() + layout.block_size(scan)); + free_prev->set_size(free_prev->size() + size); } else { @@ -313,7 +297,7 @@ void heap::sweep_heap(Iterator &iter) } } - scan = next_block_after(scan); + scan = (Block *)((cell)scan + size); } if(prev && prev->free_p()) @@ -322,11 +306,11 @@ void heap::sweep_heap(Iterator &iter) /* The forwarding map must be computed first by calling state->compute_forwarding(). */ -template +template template -void heap::compact_heap(Iterator &iter) +void heap::compact_heap(Iterator &iter) { - heap_compactor compactor(state,first_block(),iter); + heap_compactor compactor(state,first_block(),iter); this->iterate_heap(compactor); /* Now update the free list; there will be a single free block at diff --git a/vm/image.cpp b/vm/image.cpp index 7d8c4a2d32..d45e09a600 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -204,7 +204,7 @@ void factor_vm::relocate_data(cell data_relocation_base, cell code_relocation_ba { relocate_object((object *)obj,data_relocation_base,code_relocation_base); data->tenured->starts.record_object_start_offset((object *)obj); - obj = data->tenured->next_object_after(obj); + obj = data->tenured->next_allocated_block_after(obj); } } diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index bc318524b4..0f14622fcf 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -4,8 +4,7 @@ namespace factor const int block_granularity = 16; const int forwarding_granularity = 64; -template struct mark_bits { - HeapLayout layout; +template struct mark_bits { cell start; cell size; cell bits_size; @@ -72,7 +71,7 @@ template struct mark_bits { Block *next_block_after(Block *block) { - return (Block *)((cell)block + layout.block_size(block)); + return (Block *)((cell)block + block->size()); } void set_bitmap_range(u64 *bits, Block *address) @@ -146,12 +145,12 @@ template struct mark_bits { } }; -template struct heap_compactor { - mark_bits *state; +template struct heap_compactor { + mark_bits *state; char *address; Iterator &iter; - explicit heap_compactor(mark_bits *state_, Block *address_, Iterator &iter_) : + explicit heap_compactor(mark_bits *state_, Block *address_, Iterator &iter_) : state(state_), address((char *)address_), iter(iter_) {} void operator()(Block *block, cell size) diff --git a/vm/tenured_space.hpp b/vm/tenured_space.hpp index a700b58bfd..b36d96c4aa 100644 --- a/vm/tenured_space.hpp +++ b/vm/tenured_space.hpp @@ -1,19 +1,6 @@ namespace factor { -struct tenured_space_layout { - cell block_size(object *block) - { - if(block->free_p()) - { - free_heap_block *free_block = (free_heap_block *)block; - return free_block->size(); - } - else - return block->size(); - } -}; - struct tenured_space : zone { object_start_map starts; diff --git a/vm/zone.hpp b/vm/zone.hpp index 42196f315b..55f34fe67e 100644 --- a/vm/zone.hpp +++ b/vm/zone.hpp @@ -22,7 +22,7 @@ struct zone { return (object *)h; } - cell next_object_after(cell scan) + cell next_allocated_block_after(cell scan) { cell size = ((object *)scan)->size(); if(scan + size < here) From 32adb5df27e8557d9157d990f537fdbeae077f2c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 14:28:34 -0500 Subject: [PATCH 038/109] classes.builtin: fix help lint --- core/classes/builtin/builtin-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/classes/builtin/builtin-docs.factor b/core/classes/builtin/builtin-docs.factor index 9d41239206..ecc484df11 100644 --- a/core/classes/builtin/builtin-docs.factor +++ b/core/classes/builtin/builtin-docs.factor @@ -9,7 +9,7 @@ $nl builtin-class builtin-class? } -"See " { $link "type-index" } " for a list of built-in classes." ; +"See " { $link "class-index" } " for a list of built-in classes." ; HELP: builtin-class { $class-description "The class of built-in classes." } From f0816d72f1748d6a6dff470d4bf7f45a18d9f6ac Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 15:15:05 -0500 Subject: [PATCH 039/109] vm: split off free_list_allocator from heap class, rename zone to bump_allocator --- Makefile | 2 +- vm/aging_collector.hpp | 3 +- vm/aging_space.hpp | 6 +- vm/{zone.hpp => bump_allocator.hpp} | 5 +- vm/code_block.cpp | 6 +- vm/code_heap.cpp | 47 ++++++-- vm/code_heap.hpp | 14 ++- vm/data_heap.cpp | 5 +- vm/data_heap.hpp | 2 +- vm/debug.cpp | 6 +- vm/factor.cpp | 2 - vm/{heap.hpp => free_list_allocator.hpp} | 130 +++++++++------------ vm/full_collector.cpp | 4 +- vm/full_collector.hpp | 2 +- vm/image.cpp | 11 +- vm/image.hpp | 1 - vm/mark_bits.hpp | 4 +- vm/master.hpp | 8 +- vm/{old_space.cpp => object_start_map.cpp} | 0 vm/{old_space.hpp => object_start_map.hpp} | 0 vm/tenured_space.hpp | 6 +- vm/to_tenured_collector.hpp | 2 +- vm/vm.cpp | 1 - vm/vm.hpp | 11 +- 24 files changed, 147 insertions(+), 131 deletions(-) rename vm/{zone.hpp => bump_allocator.hpp} (79%) rename vm/{heap.hpp => free_list_allocator.hpp} (56%) rename vm/{old_space.cpp => object_start_map.cpp} (100%) rename vm/{old_space.hpp => object_start_map.hpp} (100%) diff --git a/Makefile b/Makefile index 5a44333d42..78f59a38bb 100755 --- a/Makefile +++ b/Makefile @@ -55,7 +55,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ vm/jit.o \ vm/math.o \ vm/nursery_collector.o \ - vm/old_space.o \ + vm/object_start_map.o \ vm/primitives.o \ vm/profiler.o \ vm/quotations.o \ diff --git a/vm/aging_collector.hpp b/vm/aging_collector.hpp index 1fa82972ff..8f2677c8b6 100644 --- a/vm/aging_collector.hpp +++ b/vm/aging_collector.hpp @@ -3,7 +3,8 @@ namespace factor struct aging_policy { factor_vm *parent; - zone *aging, *tenured; + aging_space *aging; + tenured_space *tenured; aging_policy(factor_vm *parent_) : parent(parent_), diff --git a/vm/aging_space.hpp b/vm/aging_space.hpp index 1fac4605d2..20e2506539 100644 --- a/vm/aging_space.hpp +++ b/vm/aging_space.hpp @@ -1,17 +1,17 @@ namespace factor { -struct aging_space : zone { +struct aging_space : bump_allocator { object_start_map starts; aging_space(cell size, cell start) : - zone(size,start), starts(size,start) {} + bump_allocator(size,start), starts(size,start) {} object *allot(cell size) { if(here + size > end) return NULL; - object *obj = zone::allot(size); + object *obj = bump_allocator::allot(size); starts.record_object_start_offset(obj); return obj; } diff --git a/vm/zone.hpp b/vm/bump_allocator.hpp similarity index 79% rename from vm/zone.hpp rename to vm/bump_allocator.hpp index 55f34fe67e..64011e0bb6 100644 --- a/vm/zone.hpp +++ b/vm/bump_allocator.hpp @@ -1,14 +1,15 @@ namespace factor { -struct zone { +struct bump_allocator { /* offset of 'here' and 'end' is hardcoded in compiler backends */ cell here; cell start; cell end; cell size; - zone(cell size_, cell start_) : here(0), start(start_), end(start_ + size_), size(size_) {} + bump_allocator(cell size_, cell start_) : + here(0), start(start_), end(start_ + size_), size(size_) {} inline bool contains_p(object *pointer) { diff --git a/vm/code_block.cpp b/vm/code_block.cpp index e29d708c25..1c15f23382 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -439,7 +439,7 @@ void factor_vm::fixup_labels(array *labels, code_block *compiled) /* Might GC */ code_block *factor_vm::allot_code_block(cell size, code_block_type type) { - heap_block *block = code->heap_allot(size + sizeof(code_block)); + heap_block *block = code->allocator->allot(size + sizeof(code_block)); /* If allocation failed, do a full GC and compact the code heap. A full GC that occurs as a result of the data heap filling up does not @@ -449,13 +449,13 @@ code_block *factor_vm::allot_code_block(cell size, code_block_type type) if(block == NULL) { primitive_compact_gc(); - block = code->heap_allot(size + sizeof(code_block)); + block = code->allocator->allot(size + sizeof(code_block)); /* Insufficient room even after code GC, give up */ if(block == NULL) { cell used, total_free, max_free; - code->heap_usage(&used,&total_free,&max_free); + code->allocator->usage(&used,&total_free,&max_free); print_string("Code heap stats:\n"); print_string("Used: "); print_cell(used); nl(); diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index c65dec9a69..2a466857f9 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -3,7 +3,21 @@ namespace factor { -code_heap::code_heap(bool secure_gc, cell size) : heap(secure_gc,size,true) {} +code_heap::code_heap(cell size) +{ + if(size > (1L << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size); + seg = new segment(align_page(size),true); + if(!seg) fatal_error("Out of memory in heap allocator",size); + allocator = new free_list_allocator(seg->start,size); +} + +code_heap::~code_heap() +{ + delete allocator; + allocator = NULL; + delete seg; + seg = NULL; +} void code_heap::write_barrier(code_block *compiled) { @@ -22,18 +36,33 @@ bool code_heap::needs_fixup_p(code_block *compiled) return needs_fixup.count(compiled) > 0; } +bool code_heap::marked_p(heap_block *compiled) +{ + return allocator->state.marked_p(compiled); +} + +void code_heap::set_marked_p(code_block *compiled) +{ + allocator->state.set_marked_p(compiled); +} + +void code_heap::clear_mark_bits() +{ + allocator->state.clear_mark_bits(); +} + void code_heap::code_heap_free(code_block *compiled) { points_to_nursery.erase(compiled); points_to_aging.erase(compiled); needs_fixup.erase(compiled); - heap_free(compiled); + allocator->free(compiled); } /* Allocate a code heap during startup */ void factor_vm::init_code_heap(cell size) { - code = new code_heap(secure_gc,size); + code = new code_heap(size); } bool factor_vm::in_code_heap_p(cell ptr) @@ -89,7 +118,7 @@ struct word_and_literal_code_heap_updater { void factor_vm::update_code_heap_words_and_literals() { word_and_literal_code_heap_updater updater(this); - code->sweep_heap(updater); + code->allocator->sweep(updater); } /* After growing the heap, we have to perform a full relocation to update @@ -109,7 +138,7 @@ void factor_vm::relocate_code_heap() { code_heap_relocator relocator(this); code_heap_iterator iter(relocator); - code->sweep_heap(iter); + code->allocator->sweep(iter); } void factor_vm::primitive_modify_code_heap() @@ -169,7 +198,7 @@ void factor_vm::primitive_modify_code_heap() void factor_vm::primitive_code_room() { cell used, total_free, max_free; - code->heap_usage(&used,&total_free,&max_free); + code->allocator->usage(&used,&total_free,&max_free); dpush(tag_fixnum(code->seg->size / 1024)); dpush(tag_fixnum(used / 1024)); dpush(tag_fixnum(total_free / 1024)); @@ -178,7 +207,7 @@ void factor_vm::primitive_code_room() code_block *code_heap::forward_code_block(code_block *compiled) { - return (code_block *)state->forward_block(compiled); + return (code_block *)allocator->state.forward_block(compiled); } struct callframe_forwarder { @@ -277,7 +306,7 @@ function returns. */ void factor_vm::compact_code_heap(bool trace_contexts_p) { /* Figure out where blocks are going to go */ - code->state->compute_forwarding(); + code->allocator->state.compute_forwarding(); /* Update references to the code heap from the data heap */ forward_object_xts(); @@ -291,7 +320,7 @@ void factor_vm::compact_code_heap(bool trace_contexts_p) that the data heap is up to date since relocation looks up object XTs) */ code_heap_relocator relocator(this); code_heap_iterator iter(relocator); - code->compact_heap(iter); + code->allocator->compact(iter); } struct stack_trace_stripper { diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp index d4c5d4e40b..2d9961c03a 100755 --- a/vm/code_heap.hpp +++ b/vm/code_heap.hpp @@ -1,7 +1,13 @@ namespace factor { -struct code_heap : heap { +struct code_heap { + /* The actual memory area */ + segment *seg; + + /* Memory allocator */ + free_list_allocator *allocator; + /* Set of blocks which need full relocation. */ std::set needs_fixup; @@ -11,10 +17,14 @@ struct code_heap : heap { /* Code blocks which may reference objects in aging space or the nursery */ std::set points_to_aging; - explicit code_heap(bool secure_gc, cell size); + explicit code_heap(cell size); + ~code_heap(); void write_barrier(code_block *compiled); void clear_remembered_set(); bool needs_fixup_p(code_block *compiled); + bool marked_p(heap_block *compiled); + void set_marked_p(code_block *compiled); + void clear_mark_bits(); void code_heap_free(code_block *compiled); code_block *forward_code_block(code_block *compiled); }; diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index d3951b2b27..5a8f4d6b36 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -42,7 +42,7 @@ data_heap::data_heap(cell young_size_, cell aging_size_, cell tenured_size_) aging = new aging_space(aging_size,tenured_semispace->end); aging_semispace = new aging_space(aging_size,aging->end); - nursery = new zone(young_size,aging_semispace->end); + nursery = new bump_allocator(young_size,aging_semispace->end); assert(seg->end - nursery->end <= deck_size); } @@ -75,10 +75,9 @@ void factor_vm::set_data_heap(data_heap *data_) data->reset_generation(data->tenured); } -void factor_vm::init_data_heap(cell young_size, cell aging_size, cell tenured_size, bool secure_gc_) +void factor_vm::init_data_heap(cell young_size, cell aging_size, cell tenured_size) { set_data_heap(new data_heap(young_size,aging_size,tenured_size)); - secure_gc = secure_gc_; } /* Size of the object pointed to by a tagged pointer */ diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp index 3a0af1f36a..526a5eb9ae 100755 --- a/vm/data_heap.hpp +++ b/vm/data_heap.hpp @@ -10,7 +10,7 @@ struct data_heap { segment *seg; - zone *nursery; + bump_allocator *nursery; aging_space *aging; aging_space *aging_semispace; tenured_space *tenured; diff --git a/vm/debug.cpp b/vm/debug.cpp index ddf4877eab..31164e972b 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -209,7 +209,7 @@ void factor_vm::dump_memory(cell from, cell to) dump_cell(from); } -void factor_vm::dump_zone(const char *name, zone *z) +void factor_vm::dump_zone(const char *name, bump_allocator *z) { print_string(name); print_string(": "); print_string("Start="); print_cell(z->start); @@ -296,7 +296,7 @@ struct code_block_printer { const char *status; if(scan->free_p()) status = "free"; - else if(parent->code->state->is_marked_p(scan)) + else if(parent->code->marked_p(scan)) { reloc_size += parent->object_size(((code_block *)scan)->relocation); literal_size += parent->object_size(((code_block *)scan)->literals); @@ -319,7 +319,7 @@ struct code_block_printer { void factor_vm::dump_code_heap() { code_block_printer printer(this); - code->iterate_heap(printer); + code->allocator->iterate(printer); print_cell(printer.reloc_size); print_string(" bytes of relocation data\n"); print_cell(printer.literal_size); print_string(" bytes of literal data\n"); } diff --git a/vm/factor.cpp b/vm/factor.cpp index f2b0d4c92a..9c87c0a9a7 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -37,7 +37,6 @@ void factor_vm::default_parameters(vm_parameters *p) p->max_pic_size = 3; - p->secure_gc = false; p->fep = false; p->signals = true; @@ -85,7 +84,6 @@ void factor_vm::init_parameters_from_args(vm_parameters *p, int argc, vm_char ** else if(factor_arg(arg,STRING_LITERAL("-codeheap=%d"),&p->code_size)); else if(factor_arg(arg,STRING_LITERAL("-pic=%d"),&p->max_pic_size)); else if(factor_arg(arg,STRING_LITERAL("-callbacks=%d"),&p->callback_size)); - else if(STRCMP(arg,STRING_LITERAL("-securegc")) == 0) p->secure_gc = true; else if(STRCMP(arg,STRING_LITERAL("-fep")) == 0) p->fep = true; else if(STRCMP(arg,STRING_LITERAL("-nosignals")) == 0) p->signals = false; else if(STRNCMP(arg,STRING_LITERAL("-i="),3) == 0) p->image_path = arg + 3; diff --git a/vm/heap.hpp b/vm/free_list_allocator.hpp similarity index 56% rename from vm/heap.hpp rename to vm/free_list_allocator.hpp index c06eab8dc7..da2622bb0b 100644 --- a/vm/heap.hpp +++ b/vm/free_list_allocator.hpp @@ -3,28 +3,28 @@ namespace factor static const cell free_list_count = 32; -struct heap_free_list { +struct free_list { free_heap_block *small_blocks[free_list_count]; free_heap_block *large_blocks; }; -template struct heap { - bool secure_gc; - segment *seg; - heap_free_list free; - mark_bits *state; +template struct free_list_allocator { + cell start; + cell size; + cell end; + free_list free_blocks; + mark_bits state; - explicit heap(bool secure_gc_, cell size, bool executable_p); - ~heap(); + explicit free_list_allocator(cell start, cell size); inline Block *first_block() { - return (Block *)seg->start; + return (Block *)start; } inline Block *last_block() { - return (Block *)seg->end; + return (Block *)end; } Block *next_block_after(heap_block *block) @@ -38,16 +38,15 @@ template struct heap { void assert_free_block(free_heap_block *block); free_heap_block *find_free_block(cell size); free_heap_block *split_free_block(free_heap_block *block, cell size); - Block *heap_allot(cell size); - void heap_free(Block *block); - void mark_block(Block *block); - void heap_usage(cell *used, cell *total_free, cell *max_free); - cell heap_size(); + Block *allot(cell size); + void free(Block *block); + void usage(cell *used, cell *total_free, cell *max_free); + cell occupied(); - template void sweep_heap(Iterator &iter); - template void compact_heap(Iterator &iter); + template void sweep(Iterator &iter); + template void compact(Iterator &iter); - template void iterate_heap(Iterator &iter) + template void iterate(Iterator &iter) { Block *scan = first_block(); Block *end = last_block(); @@ -62,73 +61,63 @@ template struct heap { } }; -template void heap::clear_free_list() +template void free_list_allocator::clear_free_list() { - memset(&free,0,sizeof(heap_free_list)); + memset(&free_blocks,0,sizeof(free_list)); } -template heap::heap(bool secure_gc_, cell size, bool executable_p) : secure_gc(secure_gc_) +template +free_list_allocator::free_list_allocator(cell start_, cell size_) : + start(start_), size(size_), end(start_ + size_), state(mark_bits(start_,size_)) { - if(size > (1L << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size); - seg = new segment(align_page(size),executable_p); - if(!seg) fatal_error("Out of memory in heap allocator",size); - state = new mark_bits(seg->start,size); clear_free_list(); } -template heap::~heap() -{ - delete seg; - seg = NULL; - delete state; - state = NULL; -} - -template void heap::add_to_free_list(free_heap_block *block) +template void free_list_allocator::add_to_free_list(free_heap_block *block) { if(block->size() < free_list_count * block_granularity) { int index = block->size() / block_granularity; - block->next_free = free.small_blocks[index]; - free.small_blocks[index] = block; + block->next_free = free_blocks.small_blocks[index]; + free_blocks.small_blocks[index] = block; } else { - block->next_free = free.large_blocks; - free.large_blocks = block; + block->next_free = free_blocks.large_blocks; + free_blocks.large_blocks = block; } } -/* Called after reading the code heap from the image file, and after code heap -compaction. Makes a free list consisting of one free block, at the very end. */ -template void heap::build_free_list(cell size) +/* Called after reading the heap from the image file, and after heap compaction. +Makes a free list consisting of one free block, at the very end. */ +template void free_list_allocator::build_free_list(cell size) { clear_free_list(); - free_heap_block *end = (free_heap_block *)(seg->start + size); - end->set_free(); - end->set_size(seg->end - (cell)end); - add_to_free_list(end); + free_heap_block *last_block = (free_heap_block *)(start + size); + last_block->set_free(); + last_block->set_size(end - (cell)last_block); + add_to_free_list(last_block); } -template void heap::assert_free_block(free_heap_block *block) +template void free_list_allocator::assert_free_block(free_heap_block *block) { #ifdef FACTOR_DEBUG assert(block->free_p()); #endif } -template free_heap_block *heap::find_free_block(cell size) +template free_heap_block *free_list_allocator::find_free_block(cell size) { cell attempt = size; while(attempt < free_list_count * block_granularity) { int index = attempt / block_granularity; - free_heap_block *block = free.small_blocks[index]; + free_heap_block *block = free_blocks.small_blocks[index]; if(block) { assert_free_block(block); - free.small_blocks[index] = block->next_free; + free_blocks.small_blocks[index] = block->next_free; return block; } @@ -136,7 +125,7 @@ template free_heap_block *heap::find_free_block(cell size } free_heap_block *prev = NULL; - free_heap_block *block = free.large_blocks; + free_heap_block *block = free_blocks.large_blocks; while(block) { @@ -146,7 +135,7 @@ template free_heap_block *heap::find_free_block(cell size if(prev) prev->next_free = block->next_free; else - free.large_blocks = block->next_free; + free_blocks.large_blocks = block->next_free; return block; } @@ -157,7 +146,7 @@ template free_heap_block *heap::find_free_block(cell size return NULL; } -template free_heap_block *heap::split_free_block(free_heap_block *block, cell size) +template free_heap_block *free_list_allocator::split_free_block(free_heap_block *block, cell size) { if(block->size() != size) { @@ -173,7 +162,7 @@ template free_heap_block *heap::split_free_block(free_hea return block; } -template Block *heap::heap_allot(cell size) +template Block *free_list_allocator::allot(cell size) { size = align(size,block_granularity); @@ -187,20 +176,15 @@ template Block *heap::heap_allot(cell size) return NULL; } -template void heap::heap_free(Block *block) +template void free_list_allocator::free(Block *block) { free_heap_block *free_block = (free_heap_block *)block; free_block->set_free(); add_to_free_list(free_block); } -template void heap::mark_block(Block *block) -{ - state->set_marked_p(block); -} - /* Compute total sum of sizes of free blocks, and size of largest free block */ -template void heap::heap_usage(cell *used, cell *total_free, cell *max_free) +template void free_list_allocator::usage(cell *used, cell *total_free, cell *max_free) { *used = 0; *total_free = 0; @@ -227,34 +211,34 @@ template void heap::heap_usage(cell *used, cell *total_fr } /* The size of the heap after compaction */ -template cell heap::heap_size() +template cell free_list_allocator::occupied() { Block *scan = first_block(); - Block *end = last_block(); + Block *last = last_block(); - while(scan != end) + while(scan != last) { if(scan->free_p()) break; else scan = next_block_after(scan); } - if(scan != end) + if(scan != last) { free_heap_block *free_block = (free_heap_block *)scan; assert(free_block->free_p()); - assert((cell)scan + free_block->size() == seg->end); + assert((cell)scan + free_block->size() == end); return (cell)scan - (cell)first_block(); } else - return seg->size; + return size; } /* After code GC, all live code blocks are marked, so any which are not marked can be reclaimed. */ template template -void heap::sweep_heap(Iterator &iter) +void free_list_allocator::sweep(Iterator &iter) { this->clear_free_list(); @@ -276,7 +260,7 @@ void heap::sweep_heap(Iterator &iter) else prev = scan; } - else if(this->state->is_marked_p(scan)) + else if(this->state.marked_p(scan)) { if(prev && prev->free_p()) this->add_to_free_list((free_heap_block *)prev); @@ -305,17 +289,17 @@ void heap::sweep_heap(Iterator &iter) } /* The forwarding map must be computed first by calling -state->compute_forwarding(). */ +state.compute_forwarding(). */ template template -void heap::compact_heap(Iterator &iter) +void free_list_allocator::compact(Iterator &iter) { - heap_compactor compactor(state,first_block(),iter); - this->iterate_heap(compactor); + heap_compactor compactor(&state,first_block(),iter); + this->iterate(compactor); /* Now update the free list; there will be a single free block at the end */ - this->build_free_list((cell)compactor.address - this->seg->start); + this->build_free_list((cell)compactor.address - this->start); } } diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 9c8a825c1f..924cad6777 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -89,7 +89,7 @@ void full_collector::trace_literal_references(code_block *compiled) collections */ void full_collector::mark_code_block(code_block *compiled) { - this->code->mark_block(compiled); + this->code->set_marked_p(compiled); trace_literal_references(compiled); } @@ -108,7 +108,7 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) { full_collector collector(this); - code->state->clear_mark_bits(); + code->clear_mark_bits(); collector.trace_roots(); if(trace_contexts_p) diff --git a/vm/full_collector.hpp b/vm/full_collector.hpp index 8cc37f782d..5298f56637 100644 --- a/vm/full_collector.hpp +++ b/vm/full_collector.hpp @@ -3,7 +3,7 @@ namespace factor struct full_policy { factor_vm *parent; - zone *tenured; + tenured_space *tenured; full_policy(factor_vm *parent_) : parent(parent_), tenured(parent->data->tenured) {} diff --git a/vm/image.cpp b/vm/image.cpp index d45e09a600..b47fe4e86a 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -23,8 +23,7 @@ void factor_vm::load_data_heap(FILE *file, image_header *h, vm_parameters *p) init_data_heap(p->young_size, p->aging_size, - p->tenured_size, - p->secure_gc); + p->tenured_size); clear_gc_stats(); @@ -52,7 +51,7 @@ void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p) if(h->code_size != 0) { - size_t bytes_read = fread(code->first_block(),1,h->code_size,file); + size_t bytes_read = fread(code->allocator->first_block(),1,h->code_size,file); if(bytes_read != h->code_size) { print_string("truncated image: "); @@ -64,7 +63,7 @@ void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p) } } - code->build_free_list(h->code_size); + code->allocator->build_free_list(h->code_size); } void factor_vm::data_fixup(cell *handle, cell data_relocation_base) @@ -292,7 +291,7 @@ bool factor_vm::save_image(const vm_char *filename) h.data_relocation_base = data->tenured->start; h.data_size = data->tenured->here - data->tenured->start; h.code_relocation_base = code->seg->start; - h.code_size = code->heap_size(); + h.code_size = code->allocator->occupied(); h.true_object = true_object; h.bignum_zero = bignum_zero; @@ -306,7 +305,7 @@ bool factor_vm::save_image(const vm_char *filename) if(fwrite(&h,sizeof(image_header),1,file) != 1) ok = false; if(fwrite((void*)data->tenured->start,h.data_size,1,file) != 1) ok = false; - if(fwrite(code->first_block(),h.code_size,1,file) != 1) ok = false; + if(fwrite(code->allocator->first_block(),h.code_size,1,file) != 1) ok = false; if(fclose(file)) ok = false; if(!ok) diff --git a/vm/image.hpp b/vm/image.hpp index 8a7080110c..62ab7e8392 100755 --- a/vm/image.hpp +++ b/vm/image.hpp @@ -34,7 +34,6 @@ struct vm_parameters { cell ds_size, rs_size; cell young_size, aging_size, tenured_size; cell code_size; - bool secure_gc; bool fep; bool console; bool signals; diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index 0f14622fcf..44f8b17e35 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -95,7 +95,7 @@ template struct mark_bits { } } - bool is_marked_p(Block *address) + bool marked_p(Block *address) { return bitmap_elt(marked,address); } @@ -155,7 +155,7 @@ template struct heap_compactor { void operator()(Block *block, cell size) { - if(this->state->is_marked_p(block)) + if(this->state->marked_p(block)) { memmove(address,block,size); iter((Block *)address,size); diff --git a/vm/master.hpp b/vm/master.hpp index b0e73a4b29..293923ca7b 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -48,9 +48,11 @@ namespace factor #include "bignumint.hpp" #include "bignum.hpp" #include "code_block.hpp" -#include "zone.hpp" +#include "bump_allocator.hpp" +#include "mark_bits.hpp" +#include "free_list_allocator.hpp" #include "write_barrier.hpp" -#include "old_space.hpp" +#include "object_start_map.hpp" #include "aging_space.hpp" #include "tenured_space.hpp" #include "data_heap.hpp" @@ -61,8 +63,6 @@ namespace factor #include "words.hpp" #include "float_bits.hpp" #include "io.hpp" -#include "mark_bits.hpp" -#include "heap.hpp" #include "image.hpp" #include "alien.hpp" #include "code_heap.hpp" diff --git a/vm/old_space.cpp b/vm/object_start_map.cpp similarity index 100% rename from vm/old_space.cpp rename to vm/object_start_map.cpp diff --git a/vm/old_space.hpp b/vm/object_start_map.hpp similarity index 100% rename from vm/old_space.hpp rename to vm/object_start_map.hpp diff --git a/vm/tenured_space.hpp b/vm/tenured_space.hpp index b36d96c4aa..1162bb5fd3 100644 --- a/vm/tenured_space.hpp +++ b/vm/tenured_space.hpp @@ -1,17 +1,17 @@ namespace factor { -struct tenured_space : zone { +struct tenured_space : bump_allocator { object_start_map starts; tenured_space(cell size, cell start) : - zone(size,start), starts(size,start) {} + bump_allocator(size,start), starts(size,start) {} object *allot(cell size) { if(here + size > end) return NULL; - object *obj = zone::allot(size); + object *obj = bump_allocator::allot(size); starts.record_object_start_offset(obj); return obj; } diff --git a/vm/to_tenured_collector.hpp b/vm/to_tenured_collector.hpp index 64bd9aa04d..9a4cf3764b 100644 --- a/vm/to_tenured_collector.hpp +++ b/vm/to_tenured_collector.hpp @@ -3,7 +3,7 @@ namespace factor struct to_tenured_policy { factor_vm *myvm; - zone *tenured; + tenured_space *tenured; to_tenured_policy(factor_vm *myvm_) : myvm(myvm_), tenured(myvm->data->tenured) {} diff --git a/vm/vm.cpp b/vm/vm.cpp index 50dc441086..bcdead7da5 100755 --- a/vm/vm.cpp +++ b/vm/vm.cpp @@ -6,7 +6,6 @@ namespace factor factor_vm::factor_vm() : nursery(0,0), profiling_p(false), - secure_gc(false), gc_off(false), current_gc(NULL), fep_disabled(false), diff --git a/vm/vm.hpp b/vm/vm.hpp index 2df66e97b3..0509127918 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -11,7 +11,7 @@ struct factor_vm context *ctx; /* New objects are allocated here */ - zone nursery; + bump_allocator nursery; /* Add this to a shifted address to compute write barrier offsets */ cell cards_offset; @@ -39,9 +39,6 @@ struct factor_vm unsigned int signal_fpu_status; stack_frame *signal_callstack_top; - /* Zeroes out deallocated memory; set by the -securegc command line argument */ - bool secure_gc; - /* A heap walk allows useful things to be done, like finding all references to an object for debugging purposes. */ cell heap_scan_ptr; @@ -221,7 +218,7 @@ struct factor_vm //data heap void init_card_decks(); void set_data_heap(data_heap *data_); - void init_data_heap(cell young_size, cell aging_size, cell tenured_size, bool secure_gc_); + void init_data_heap(cell young_size, cell aging_size, cell tenured_size); void primitive_size(); cell binary_payload_start(object *pointer); void primitive_data_room(); @@ -311,7 +308,7 @@ struct factor_vm void print_callstack(); void dump_cell(cell x); void dump_memory(cell from, cell to); - void dump_zone(const char *name, zone *z); + void dump_zone(const char *name, bump_allocator *z); void dump_generations(); void dump_objects(cell type); void find_data_references_step(cell *scan); @@ -531,7 +528,7 @@ struct factor_vm template void iterate_code_heap(Iterator &iter_) { code_heap_iterator iter(iter_); - code->iterate_heap(iter); + code->allocator->iterate(iter); } //callbacks From 34344be636b053ad948fdbcd1a5c6bc1e8c06048 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 20 Oct 2009 14:36:36 -0500 Subject: [PATCH 040/109] clean up vector lerp functions to be better vectorizable --- basis/math/vectors/vectors.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index ee417de12b..6bf396479e 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -167,20 +167,20 @@ PRIVATE> : bilerp ( aa ba ab bb {t,u} -- a_tu ) [ first lerp ] [ second lerp ] bi-curry - [ 2bi@ ] [ call ] bi* ; + [ 2bi@ ] [ call ] bi* ; inline : vlerp ( a b t -- a_t ) - [ lerp ] 3map ; + [ over v- ] dip v* v+ ; inline : vnlerp ( a b t -- a_t ) - [ lerp ] curry 2map ; + [ over v- ] dip v*n v+ ; inline : vbilerp ( aa ba ab bb {t,u} -- a_tu ) [ first vnlerp ] [ second vnlerp ] bi-curry - [ 2bi@ ] [ call ] bi* ; + [ 2bi@ ] [ call ] bi* ; inline : v~ ( a b epsilon -- ? ) - [ ~ ] curry 2all? ; + [ ~ ] curry 2all? ; inline HINTS: vneg { array } ; HINTS: norm-sq { array } ; From 764e08500477c7072b5daa36c0b7ef6ddbbaebfc Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 20 Oct 2009 17:29:01 -0500 Subject: [PATCH 041/109] value numbering rewrite rules for vector ops to convert "not and" to "andn" and "not andn" to "and" --- .../value-numbering/rewrite/rewrite.factor | 45 +++++++ .../value-numbering-tests.factor | 122 ++++++++++++++++++ 2 files changed, 167 insertions(+) diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index bc228cb3b4..28c6741bc1 100755 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -515,3 +515,48 @@ M: ##scalar>vector rewrite M: ##xor-vector rewrite dup [ src1>> vreg>vn ] [ src2>> vreg>vn ] bi eq? [ [ dst>> ] [ rep>> ] bi \ ##zero-vector new-insn ] [ drop f ] if ; + +: vector-not? ( expr -- ? ) + { + [ not-vector-expr? ] + [ { + [ xor-vector-expr? ] + [ [ src1>> ] [ src2>> ] bi [ vn>expr fill-vector-expr? ] either? ] + } 1&& ] + } 1|| ; + +GENERIC: vector-not-src ( expr -- vreg ) +M: not-vector-expr vector-not-src src>> vn>vreg ; +M: xor-vector-expr vector-not-src + dup src1>> vn>expr fill-vector-expr? [ src2>> ] [ src1>> ] if vn>vreg ; + +M: ##and-vector rewrite + { + { [ dup src1>> vreg>expr vector-not? ] [ + { + [ dst>> ] + [ src1>> vreg>expr vector-not-src ] + [ src2>> ] + [ rep>> ] + } cleave \ ##andn-vector new-insn + ] } + { [ dup src2>> vreg>expr vector-not? ] [ + { + [ dst>> ] + [ src2>> vreg>expr vector-not-src ] + [ src1>> ] + [ rep>> ] + } cleave \ ##andn-vector new-insn + ] } + [ drop f ] + } cond ; + +M: ##andn-vector rewrite + dup src1>> vreg>expr vector-not? [ + { + [ dst>> ] + [ src1>> vreg>expr vector-not-src ] + [ src2>> ] + [ rep>> ] + } cleave \ ##and-vector new-insn + ] [ drop f ] if ; diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor index 733b8cc22a..55ff39e9d2 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor @@ -1281,6 +1281,128 @@ cell 8 = [ } value-numbering-step ] unit-test +! NOT x AND y => x ANDN y + +[ + { + T{ ##fill-vector f 3 float-4-rep } + T{ ##xor-vector f 4 0 3 float-4-rep } + T{ ##andn-vector f 5 0 1 float-4-rep } + } +] [ + { + T{ ##fill-vector f 3 float-4-rep } + T{ ##xor-vector f 4 0 3 float-4-rep } + T{ ##and-vector f 5 4 1 float-4-rep } + } value-numbering-step +] unit-test + +[ + { + T{ ##not-vector f 4 0 float-4-rep } + T{ ##andn-vector f 5 0 1 float-4-rep } + } +] [ + { + T{ ##not-vector f 4 0 float-4-rep } + T{ ##and-vector f 5 4 1 float-4-rep } + } value-numbering-step +] unit-test + +! x AND NOT y => y ANDN x + +[ + { + T{ ##fill-vector f 3 float-4-rep } + T{ ##xor-vector f 4 0 3 float-4-rep } + T{ ##andn-vector f 5 0 1 float-4-rep } + } +] [ + { + T{ ##fill-vector f 3 float-4-rep } + T{ ##xor-vector f 4 0 3 float-4-rep } + T{ ##and-vector f 5 1 4 float-4-rep } + } value-numbering-step +] unit-test + +[ + { + T{ ##not-vector f 4 0 float-4-rep } + T{ ##andn-vector f 5 0 1 float-4-rep } + } +] [ + { + T{ ##not-vector f 4 0 float-4-rep } + T{ ##and-vector f 5 1 4 float-4-rep } + } value-numbering-step +] unit-test + +! NOT x ANDN y => x AND y + +[ + { + T{ ##fill-vector f 3 float-4-rep } + T{ ##xor-vector f 4 0 3 float-4-rep } + T{ ##and-vector f 5 0 1 float-4-rep } + } +] [ + { + T{ ##fill-vector f 3 float-4-rep } + T{ ##xor-vector f 4 0 3 float-4-rep } + T{ ##andn-vector f 5 4 1 float-4-rep } + } value-numbering-step +] unit-test + +[ + { + T{ ##not-vector f 4 0 float-4-rep } + T{ ##and-vector f 5 0 1 float-4-rep } + } +] [ + { + T{ ##not-vector f 4 0 float-4-rep } + T{ ##andn-vector f 5 4 1 float-4-rep } + } value-numbering-step +] unit-test + +! AND <=> ANDN + +[ + { + T{ ##fill-vector f 3 float-4-rep } + T{ ##xor-vector f 4 0 3 float-4-rep } + T{ ##andn-vector f 5 0 1 float-4-rep } + T{ ##and-vector f 6 0 2 float-4-rep } + T{ ##or-vector f 7 5 6 float-4-rep } + } +] [ + { + T{ ##fill-vector f 3 float-4-rep } + T{ ##xor-vector f 4 0 3 float-4-rep } + T{ ##and-vector f 5 4 1 float-4-rep } + T{ ##andn-vector f 6 4 2 float-4-rep } + T{ ##or-vector f 7 5 6 float-4-rep } + } value-numbering-step +] unit-test + +[ + { + T{ ##not-vector f 4 0 float-4-rep } + T{ ##andn-vector f 5 0 1 float-4-rep } + T{ ##and-vector f 6 0 2 float-4-rep } + T{ ##or-vector f 7 5 6 float-4-rep } + } +] [ + { + T{ ##not-vector f 4 0 float-4-rep } + T{ ##and-vector f 5 4 1 float-4-rep } + T{ ##andn-vector f 6 4 2 float-4-rep } + T{ ##or-vector f 7 5 6 float-4-rep } + } value-numbering-step +] unit-test + +! branch folding + : test-branch-folding ( insns -- insns' n ) [ V{ 0 1 } clone >>successors basic-block set value-numbering-step ] keep From cb36111a3cbb5262cafac3c5c9a75db4e5e5cd4b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 20 Oct 2009 18:45:35 -0500 Subject: [PATCH 042/109] generate better fallback code for vmin/vmax intrinsics --- basis/compiler/cfg/intrinsics/intrinsics.factor | 4 ++-- basis/compiler/cfg/intrinsics/simd/simd.factor | 13 +++++++++++++ .../math/vectors/simd/intrinsics/intrinsics.factor | 4 ++-- 3 files changed, 17 insertions(+), 4 deletions(-) diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 3b6674efee..2af810ba49 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -163,8 +163,8 @@ IN: compiler.cfg.intrinsics { math.vectors.simd.intrinsics:(simd-v*) [ [ ^^mul-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vs*) [ [ ^^saturated-mul-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-v/) [ [ ^^div-vector ] emit-binary-vector-op ] } - { math.vectors.simd.intrinsics:(simd-vmin) [ [ ^^min-vector ] emit-binary-vector-op ] } - { math.vectors.simd.intrinsics:(simd-vmax) [ [ ^^max-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vmin) [ [ generate-min-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vmax) [ [ generate-max-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-v.) [ [ ^^dot-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vabs) [ [ generate-abs-vector ] emit-unary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vsqrt) [ [ ^^sqrt-vector ] emit-unary-vector-op ] } diff --git a/basis/compiler/cfg/intrinsics/simd/simd.factor b/basis/compiler/cfg/intrinsics/simd/simd.factor index 73f880a102..0e1beae5e0 100644 --- a/basis/compiler/cfg/intrinsics/simd/simd.factor +++ b/basis/compiler/cfg/intrinsics/simd/simd.factor @@ -265,3 +265,16 @@ MACRO: if-literals-match ( quots -- ) ] } cond ; +: generate-min-vector ( src1 src2 rep -- dst ) + dup %min-vector-reps member? + [ ^^min-vector ] [ + [ cc< generate-compare-vector ] + [ generate-blend-vector ] 3bi + ] if ; + +: generate-max-vector ( src1 src2 rep -- dst ) + dup %max-vector-reps member? + [ ^^max-vector ] [ + [ cc> generate-compare-vector ] + [ generate-blend-vector ] 3bi + ] if ; diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index 1bd5834f2c..761ca30375 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -163,8 +163,8 @@ M: vector-rep supported-simd-op? { \ (simd-v*) [ %mul-vector-reps ] } { \ (simd-vs*) [ %saturated-mul-vector-reps ] } { \ (simd-v/) [ %div-vector-reps ] } - { \ (simd-vmin) [ %min-vector-reps ] } - { \ (simd-vmax) [ %max-vector-reps ] } + { \ (simd-vmin) [ %min-vector-reps cc< %compare-vector-reps union ] } + { \ (simd-vmax) [ %max-vector-reps cc> %compare-vector-reps union ] } { \ (simd-v.) [ %dot-vector-reps ] } { \ (simd-vsqrt) [ %sqrt-vector-reps ] } { \ (simd-sum) [ %horizontal-add-vector-reps ] } From 814f6371d6278a01a36c1c8737db5eea3fd81765 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 Oct 2009 22:20:49 -0500 Subject: [PATCH 043/109] vm: mark sweep gc for tenured space work in progress --- vm/aging_collector.cpp | 2 +- vm/aging_collector.hpp | 4 + vm/aging_space.hpp | 15 +++- vm/bump_allocator.hpp | 21 ++---- vm/code_heap.cpp | 2 +- vm/collector.hpp | 143 ++++++++++++++++++++++++++++++++++++ vm/copying_collector.hpp | 137 +--------------------------------- vm/data_heap.cpp | 33 +++++---- vm/data_heap.hpp | 4 +- vm/debug.cpp | 16 ++-- vm/free_list_allocator.hpp | 137 ++++++++++++++++++++++++---------- vm/full_collector.cpp | 25 ++++--- vm/full_collector.hpp | 15 +++- vm/gc.cpp | 6 +- vm/image.cpp | 6 +- vm/master.hpp | 1 + vm/nursery_collector.hpp | 8 +- vm/nursery_space.hpp | 9 +++ vm/tenured_space.hpp | 58 +++++++++++++-- vm/to_tenured_collector.cpp | 15 +++- vm/to_tenured_collector.hpp | 10 ++- vm/vm.hpp | 4 +- 22 files changed, 420 insertions(+), 251 deletions(-) create mode 100644 vm/nursery_space.hpp diff --git a/vm/aging_collector.cpp b/vm/aging_collector.cpp index 49b1c520ec..2972528cb3 100644 --- a/vm/aging_collector.cpp +++ b/vm/aging_collector.cpp @@ -25,7 +25,7 @@ void factor_vm::collect_aging() collector.trace_cards(data->tenured, card_points_to_aging, simple_unmarker(card_mark_mask)); - collector.cheneys_algorithm(); + collector.tenure_reachable_objects(); } { /* If collection fails here, do a to_tenured collection. */ diff --git a/vm/aging_collector.hpp b/vm/aging_collector.hpp index 8f2677c8b6..a04261d826 100644 --- a/vm/aging_collector.hpp +++ b/vm/aging_collector.hpp @@ -15,6 +15,10 @@ struct aging_policy { { return !(aging->contains_p(untagged) || tenured->contains_p(untagged)); } + + void promoted_object(object *obj) {} + + void visited_object(object *obj) {} }; struct aging_collector : copying_collector { diff --git a/vm/aging_space.hpp b/vm/aging_space.hpp index 20e2506539..99efd44de5 100644 --- a/vm/aging_space.hpp +++ b/vm/aging_space.hpp @@ -1,20 +1,29 @@ namespace factor { -struct aging_space : bump_allocator { +struct aging_space : bump_allocator { object_start_map starts; aging_space(cell size, cell start) : - bump_allocator(size,start), starts(size,start) {} + bump_allocator(size,start), starts(size,start) {} object *allot(cell size) { if(here + size > end) return NULL; - object *obj = bump_allocator::allot(size); + object *obj = bump_allocator::allot(size); starts.record_object_start_offset(obj); return obj; } + + cell next_object_after(cell scan) + { + cell size = ((object *)scan)->size(); + if(scan + size < here) + return scan + size; + else + return 0; + } }; } diff --git a/vm/bump_allocator.hpp b/vm/bump_allocator.hpp index 64011e0bb6..b41613b540 100644 --- a/vm/bump_allocator.hpp +++ b/vm/bump_allocator.hpp @@ -1,7 +1,7 @@ namespace factor { -struct bump_allocator { +template struct bump_allocator { /* offset of 'here' and 'end' is hardcoded in compiler backends */ cell here; cell start; @@ -9,27 +9,18 @@ struct bump_allocator { cell size; bump_allocator(cell size_, cell start_) : - here(0), start(start_), end(start_ + size_), size(size_) {} + here(start_), start(start_), end(start_ + size_), size(size_) {} - inline bool contains_p(object *pointer) + inline bool contains_p(Block *block) { - return ((cell)pointer - start) < size; + return ((cell)block - start) < size; } - inline object *allot(cell size) + inline Block *allot(cell size) { cell h = here; here = h + align(size,data_alignment); - return (object *)h; - } - - cell next_allocated_block_after(cell scan) - { - cell size = ((object *)scan)->size(); - if(scan + size < here) - return scan + size; - else - return 0; + return (Block *)h; } }; diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 2a466857f9..5ae55cb760 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -8,7 +8,7 @@ code_heap::code_heap(cell size) if(size > (1L << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size); seg = new segment(align_page(size),true); if(!seg) fatal_error("Out of memory in heap allocator",size); - allocator = new free_list_allocator(seg->start,size); + allocator = new free_list_allocator(size,seg->start); } code_heap::~code_heap() diff --git a/vm/collector.hpp b/vm/collector.hpp index 9200d95399..bc04ee4de7 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -40,7 +40,10 @@ template struct collector { object *untagged = parent->untag(pointer); if(!policy.should_copy_p(untagged)) + { + policy.visited_object(untagged); return; + } object *forwarding = resolve_forwarding(untagged); @@ -49,7 +52,10 @@ template struct collector { else if(policy.should_copy_p(forwarding)) untagged = promote_object(forwarding); else + { untagged = forwarding; + policy.visited_object(untagged); + } *handle = RETAG(untagged,TAG(pointer)); } @@ -79,6 +85,8 @@ template struct collector { stats->object_count++; stats->bytes_copied += size; + policy.promoted_object(newpointer); + return newpointer; } @@ -145,6 +153,141 @@ template struct collector { ctx = ctx->next; } } + + inline cell first_card_in_deck(cell deck) + { + return deck << (deck_bits - card_bits); + } + + inline cell last_card_in_deck(cell deck) + { + return first_card_in_deck(deck + 1); + } + + inline cell card_deck_for_address(cell a) + { + return addr_to_deck(a - this->data->start); + } + + inline cell card_start_address(cell card) + { + return (card << card_bits) + this->data->start; + } + + inline cell card_end_address(cell card) + { + return ((card + 1) << card_bits) + this->data->start; + } + + void trace_partial_objects(cell start, cell end, cell card_start, cell card_end) + { + if(card_start < end) + { + start += sizeof(cell); + + if(start < card_start) start = card_start; + if(end > card_end) end = card_end; + + cell *slot_ptr = (cell *)start; + cell *end_ptr = (cell *)end; + + if(slot_ptr != end_ptr) + { + for(; slot_ptr < end_ptr; slot_ptr++) + this->trace_handle(slot_ptr); + } + } + } + + template + void trace_cards(SourceGeneration *gen, card mask, Unmarker unmarker) + { + u64 start_time = current_micros(); + + card_deck *decks = this->data->decks; + card_deck *cards = this->data->cards; + + cell gen_start_card = addr_to_card(gen->start - this->data->start); + + cell first_deck = card_deck_for_address(gen->start); + cell last_deck = card_deck_for_address(gen->end); + + cell start = 0, binary_start = 0, end = 0; + + for(cell deck_index = first_deck; deck_index < last_deck; deck_index++) + { + if(decks[deck_index] & mask) + { + this->parent->gc_stats.decks_scanned++; + + cell first_card = first_card_in_deck(deck_index); + cell last_card = last_card_in_deck(deck_index); + + for(cell card_index = first_card; card_index < last_card; card_index++) + { + if(cards[card_index] & mask) + { + this->parent->gc_stats.cards_scanned++; + + if(end < card_start_address(card_index)) + { + start = gen->starts.find_object_containing_card(card_index - gen_start_card); + binary_start = start + this->parent->binary_payload_start((object *)start); + end = start + ((object *)start)->size(); + } + +#ifdef FACTOR_DEBUG + assert(addr_to_card(start - this->data->start) <= card_index); + assert(start < card_end_address(card_index)); +#endif + +scan_next_object: { + trace_partial_objects( + start, + binary_start, + card_start_address(card_index), + card_end_address(card_index)); + if(end < card_end_address(card_index)) + { + start = gen->next_object_after(start); + if(start) + { + binary_start = start + this->parent->binary_payload_start((object *)start); + end = start + ((object *)start)->size(); + goto scan_next_object; + } + } + } + + unmarker(&cards[card_index]); + + if(!start) goto end; + } + } + + unmarker(&decks[deck_index]); + } + } + +end: this->parent->gc_stats.card_scan_time += (current_micros() - start_time); + } + + /* Trace all literals referenced from a code block. Only for aging and nursery collections */ + void trace_literal_references(code_block *compiled) + { + this->trace_handle(&compiled->owner); + this->trace_handle(&compiled->literals); + this->trace_handle(&compiled->relocation); + this->parent->gc_stats.code_blocks_scanned++; + } + + void trace_code_heap_roots(std::set *remembered_set) + { + std::set::const_iterator iter = remembered_set->begin(); + std::set::const_iterator end = remembered_set->end(); + + for(; iter != end; iter++) trace_literal_references(*iter); + } }; } diff --git a/vm/copying_collector.hpp b/vm/copying_collector.hpp index ea7faf2423..012aa4ec10 100644 --- a/vm/copying_collector.hpp +++ b/vm/copying_collector.hpp @@ -18,147 +18,12 @@ struct copying_collector : collector { explicit copying_collector(factor_vm *parent_, generation_statistics *stats_, TargetGeneration *target_, Policy policy_) : collector(parent_,stats_,target_,policy_), scan(target_->here) {} - inline cell first_card_in_deck(cell deck) - { - return deck << (deck_bits - card_bits); - } - - inline cell last_card_in_deck(cell deck) - { - return first_card_in_deck(deck + 1); - } - - inline cell card_deck_for_address(cell a) - { - return addr_to_deck(a - this->data->start); - } - - inline cell card_start_address(cell card) - { - return (card << card_bits) + this->data->start; - } - - inline cell card_end_address(cell card) - { - return ((card + 1) << card_bits) + this->data->start; - } - - void trace_partial_objects(cell start, cell end, cell card_start, cell card_end) - { - if(card_start < end) - { - start += sizeof(cell); - - if(start < card_start) start = card_start; - if(end > card_end) end = card_end; - - cell *slot_ptr = (cell *)start; - cell *end_ptr = (cell *)end; - - if(slot_ptr != end_ptr) - { - for(; slot_ptr < end_ptr; slot_ptr++) - this->trace_handle(slot_ptr); - } - } - } - - template - void trace_cards(SourceGeneration *gen, card mask, Unmarker unmarker) - { - u64 start_time = current_micros(); - - card_deck *decks = this->data->decks; - card_deck *cards = this->data->cards; - - cell gen_start_card = addr_to_card(gen->start - this->data->start); - - cell first_deck = card_deck_for_address(gen->start); - cell last_deck = card_deck_for_address(gen->end); - - cell start = 0, binary_start = 0, end = 0; - - for(cell deck_index = first_deck; deck_index < last_deck; deck_index++) - { - if(decks[deck_index] & mask) - { - this->parent->gc_stats.decks_scanned++; - - cell first_card = first_card_in_deck(deck_index); - cell last_card = last_card_in_deck(deck_index); - - for(cell card_index = first_card; card_index < last_card; card_index++) - { - if(cards[card_index] & mask) - { - this->parent->gc_stats.cards_scanned++; - - if(end < card_start_address(card_index)) - { - start = gen->starts.find_object_containing_card(card_index - gen_start_card); - binary_start = start + this->parent->binary_payload_start((object *)start); - end = start + ((object *)start)->size(); - } - -#ifdef FACTOR_DEBUG - assert(addr_to_card(start - this->data->start) <= card_index); - assert(start < card_end_address(card_index)); -#endif - -scan_next_object: { - trace_partial_objects( - start, - binary_start, - card_start_address(card_index), - card_end_address(card_index)); - if(end < card_end_address(card_index)) - { - start = gen->next_allocated_block_after(start); - if(start) - { - binary_start = start + this->parent->binary_payload_start((object *)start); - end = start + ((object *)start)->size(); - goto scan_next_object; - } - } - } - - unmarker(&cards[card_index]); - - if(!start) goto end; - } - } - - unmarker(&decks[deck_index]); - } - } - -end: this->parent->gc_stats.card_scan_time += (current_micros() - start_time); - } - - /* Trace all literals referenced from a code block. Only for aging and nursery collections */ - void trace_literal_references(code_block *compiled) - { - this->trace_handle(&compiled->owner); - this->trace_handle(&compiled->literals); - this->trace_handle(&compiled->relocation); - this->parent->gc_stats.code_blocks_scanned++; - } - - void trace_code_heap_roots(std::set *remembered_set) - { - std::set::const_iterator iter = remembered_set->begin(); - std::set::const_iterator end = remembered_set->end(); - - for(; iter != end; iter++) trace_literal_references(*iter); - } - void cheneys_algorithm() { while(scan && scan < this->target->here) { this->trace_slots((object *)scan); - scan = this->target->next_allocated_block_after(scan); + scan = this->target->next_object_after(scan); } } }; diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 5a8f4d6b36..7c887c7419 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -19,7 +19,7 @@ data_heap::data_heap(cell young_size_, cell aging_size_, cell tenured_size_) aging_size = aging_size_; tenured_size = tenured_size_; - cell total_size = young_size + 2 * aging_size + 2 * tenured_size; + cell total_size = young_size + 2 * aging_size + tenured_size; total_size += deck_size; @@ -29,20 +29,21 @@ data_heap::data_heap(cell young_size_, cell aging_size_, cell tenured_size_) cards = new card[cards_size]; cards_end = cards + cards_size; + memset(cards,0,cards_size); cell decks_size = addr_to_deck(total_size); decks = new card_deck[decks_size]; decks_end = decks + decks_size; + memset(decks,0,decks_size); start = align(seg->start,deck_size); tenured = new tenured_space(tenured_size,start); - tenured_semispace = new tenured_space(tenured_size,tenured->end); - aging = new aging_space(aging_size,tenured_semispace->end); + aging = new aging_space(aging_size,tenured->end); aging_semispace = new aging_space(aging_size,aging->end); - nursery = new bump_allocator(young_size,aging_semispace->end); + nursery = new nursery_space(young_size,aging_semispace->end); assert(seg->end - nursery->end <= deck_size); } @@ -54,7 +55,6 @@ data_heap::~data_heap() delete aging; delete aging_semispace; delete tenured; - delete tenured_semispace; delete[] cards; delete[] decks; } @@ -71,8 +71,6 @@ void factor_vm::set_data_heap(data_heap *data_) nursery = *data->nursery; nursery.here = nursery.start; init_card_decks(); - data->reset_generation(data->aging); - data->reset_generation(data->tenured); } void factor_vm::init_data_heap(cell young_size, cell aging_size, cell tenured_size) @@ -185,8 +183,11 @@ void factor_vm::primitive_data_room() a.add(tag_fixnum((data->aging->end - data->aging->here) >> 10)); a.add(tag_fixnum((data->aging->size) >> 10)); - a.add(tag_fixnum((data->tenured->end - data->tenured->here) >> 10)); - a.add(tag_fixnum((data->tenured->size) >> 10)); + //XXX + cell used, total_free, max_free; + data->tenured->usage(&used,&total_free,&max_free); + a.add(tag_fixnum(total_free >> 10)); + a.add(tag_fixnum(used >> 10)); a.trim(); dpush(a.elements.value()); @@ -195,7 +196,7 @@ void factor_vm::primitive_data_room() /* Disables GC and activates next-object ( -- obj ) primitive */ void factor_vm::begin_scan() { - heap_scan_ptr = data->tenured->start; + heap_scan_ptr = data->tenured->first_object(); gc_off = true; } @@ -214,12 +215,14 @@ cell factor_vm::next_object() if(!gc_off) general_error(ERROR_HEAP_SCAN,false_object,false_object,NULL); - if(heap_scan_ptr >= data->tenured->here) + if(heap_scan_ptr) + { + cell current = heap_scan_ptr; + heap_scan_ptr = data->tenured->next_object_after(heap_scan_ptr); + return tag_dynamic((object *)current); + } + else return false_object; - - object *obj = (object *)heap_scan_ptr; - heap_scan_ptr += obj->size(); - return tag_dynamic(obj); } /* Push object at heap scan cursor and advance; pushes f when done */ diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp index 526a5eb9ae..fe714b91b0 100755 --- a/vm/data_heap.hpp +++ b/vm/data_heap.hpp @@ -10,11 +10,10 @@ struct data_heap { segment *seg; - bump_allocator *nursery; + nursery_space *nursery; aging_space *aging; aging_space *aging_semispace; tenured_space *tenured; - tenured_space *tenured_semispace; card *cards; card *cards_end; @@ -49,7 +48,6 @@ their allocation pointers and cards reset. */ template void data_heap::reset_generation(Generation *gen) { gen->here = gen->start; - clear_cards(gen); clear_decks(gen); gen->starts.clear_object_start_offsets(); diff --git a/vm/debug.cpp b/vm/debug.cpp index 31164e972b..afc0b43f7a 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -209,19 +209,21 @@ void factor_vm::dump_memory(cell from, cell to) dump_cell(from); } -void factor_vm::dump_zone(const char *name, bump_allocator *z) +template +void factor_vm::dump_generation(const char *name, Generation *gen) { print_string(name); print_string(": "); - print_string("Start="); print_cell(z->start); - print_string(", size="); print_cell(z->size); - print_string(", here="); print_cell(z->here - z->start); nl(); + print_string("Start="); print_cell(gen->start); + print_string(", size="); print_cell(gen->size); + print_string(", end="); print_cell(gen->end); + nl(); } void factor_vm::dump_generations() { - dump_zone("Nursery",&nursery); - dump_zone("Aging",data->aging); - dump_zone("Tenured",data->tenured); + dump_generation("Nursery",&nursery); + dump_generation("Aging",data->aging); + dump_generation("Tenured",data->tenured); print_string("Cards: base="); print_cell((cell)data->cards); diff --git a/vm/free_list_allocator.hpp b/vm/free_list_allocator.hpp index da2622bb0b..c8f3bd6f47 100644 --- a/vm/free_list_allocator.hpp +++ b/vm/free_list_allocator.hpp @@ -9,29 +9,17 @@ struct free_list { }; template struct free_list_allocator { - cell start; cell size; + cell start; cell end; free_list free_blocks; mark_bits state; - explicit free_list_allocator(cell start, cell size); - - inline Block *first_block() - { - return (Block *)start; - } - - inline Block *last_block() - { - return (Block *)end; - } - - Block *next_block_after(heap_block *block) - { - return (Block *)((cell)block + block->size()); - } - + explicit free_list_allocator(cell size, cell start); + bool contains_p(Block *block); + Block *first_block(); + Block *last_block(); + Block *next_block_after(Block *block); void clear_free_list(); void add_to_free_list(free_heap_block *block); void build_free_list(cell size); @@ -42,35 +30,42 @@ template struct free_list_allocator { void free(Block *block); void usage(cell *used, cell *total_free, cell *max_free); cell occupied(); - + void sweep(); template void sweep(Iterator &iter); template void compact(Iterator &iter); - - template void iterate(Iterator &iter) - { - Block *scan = first_block(); - Block *end = last_block(); - - while(scan != end) - { - cell size = scan->size(); - Block *next = (Block *)((cell)scan + size); - if(!scan->free_p()) iter(scan,size); - scan = next; - } - } + template void iterate(Iterator &iter); }; +template +free_list_allocator::free_list_allocator(cell size_, cell start_) : + size(size_), start(start_), end(start_ + size_), state(mark_bits(size_,start_)) +{ + clear_free_list(); +} + template void free_list_allocator::clear_free_list() { memset(&free_blocks,0,sizeof(free_list)); } -template -free_list_allocator::free_list_allocator(cell start_, cell size_) : - start(start_), size(size_), end(start_ + size_), state(mark_bits(start_,size_)) +template bool free_list_allocator::contains_p(Block *block) { - clear_free_list(); + return ((cell)block - start) < size; +} + +template Block *free_list_allocator::first_block() +{ + return (Block *)start; +} + +template Block *free_list_allocator::last_block() +{ + return (Block *)end; +} + +template Block *free_list_allocator::next_block_after(Block *block) +{ + return (Block *)((cell)block + block->size()); } template void free_list_allocator::add_to_free_list(free_heap_block *block) @@ -234,8 +229,56 @@ template cell free_list_allocator::occupied() return size; } -/* After code GC, all live code blocks are marked, so any -which are not marked can be reclaimed. */ +template +void free_list_allocator::sweep() +{ + this->clear_free_list(); + + Block *prev = NULL; + Block *scan = this->first_block(); + Block *end = this->last_block(); + + while(scan != end) + { + cell size = scan->size(); + + if(scan->free_p()) + { + if(prev && prev->free_p()) + { + free_heap_block *free_prev = (free_heap_block *)prev; + free_prev->set_size(free_prev->size() + size); + } + else + prev = scan; + } + else if(this->state.marked_p(scan)) + { + if(prev && prev->free_p()) + this->add_to_free_list((free_heap_block *)prev); + prev = scan; + } + else + { + if(prev && prev->free_p()) + { + free_heap_block *free_prev = (free_heap_block *)prev; + free_prev->set_size(free_prev->size() + size); + } + else + { + ((free_heap_block *)scan)->set_free(); + prev = scan; + } + } + + scan = (Block *)((cell)scan + size); + } + + if(prev && prev->free_p()) + this->add_to_free_list((free_heap_block *)prev); +} + template template void free_list_allocator::sweep(Iterator &iter) @@ -302,4 +345,20 @@ void free_list_allocator::compact(Iterator &iter) this->build_free_list((cell)compactor.address - this->start); } +template +template +void free_list_allocator::iterate(Iterator &iter) +{ + Block *scan = first_block(); + Block *end = last_block(); + + while(scan != end) + { + cell size = scan->size(); + Block *next = (Block *)((cell)scan + size); + if(!scan->free_p()) iter(scan,size); + scan = next; + } +} + } diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 924cad6777..9191823d75 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -4,7 +4,7 @@ namespace factor { full_collector::full_collector(factor_vm *parent_) : - copying_collector( + collector( parent_, &parent_->gc_stats.full_stats, parent_->data->tenured, @@ -89,18 +89,22 @@ void full_collector::trace_literal_references(code_block *compiled) collections */ void full_collector::mark_code_block(code_block *compiled) { - this->code->set_marked_p(compiled); - trace_literal_references(compiled); + if(!this->code->marked_p(compiled)) + { + this->code->set_marked_p(compiled); + trace_literal_references(compiled); + } } -void full_collector::cheneys_algorithm() +void full_collector::mark_reachable_objects() { - while(scan && scan < target->here) + std::vector *mark_stack = &this->target->mark_stack; + while(!mark_stack->empty()) { - object *obj = (object *)scan; + object *obj = mark_stack->back(); + mark_stack->pop_back(); this->trace_slots(obj); this->mark_object_code_block(obj); - scan = target->next_allocated_block_after(scan); } } @@ -109,6 +113,7 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) full_collector collector(this); code->clear_mark_bits(); + data->tenured->clear_mark_bits(); collector.trace_roots(); if(trace_contexts_p) @@ -118,8 +123,9 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) collector.trace_callbacks(); } - collector.cheneys_algorithm(); + collector.mark_reachable_objects(); + data->tenured->sweep(); data->reset_generation(data->aging); nursery.here = nursery.start; } @@ -144,9 +150,6 @@ void factor_vm::collect_growing_heap(cell requested_bytes, void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p) { - /* Copy all live objects to the tenured semispace. */ - std::swap(data->tenured,data->tenured_semispace); - data->reset_generation(data->tenured); collect_full_impl(trace_contexts_p); if(compact_code_heap_p) diff --git a/vm/full_collector.hpp b/vm/full_collector.hpp index 5298f56637..9aef352b4b 100644 --- a/vm/full_collector.hpp +++ b/vm/full_collector.hpp @@ -11,9 +11,20 @@ struct full_policy { { return !tenured->contains_p(untagged); } + + void promoted_object(object *obj) + { + tenured->mark_and_push(obj); + } + + void visited_object(object *obj) + { + if(!tenured->marked_p(obj)) + tenured->mark_and_push(obj); + } }; -struct full_collector : copying_collector { +struct full_collector : collector { bool trace_contexts_p; full_collector(factor_vm *parent_); @@ -22,7 +33,7 @@ struct full_collector : copying_collector { void trace_callbacks(); void trace_literal_references(code_block *compiled); void mark_code_block(code_block *compiled); - void cheneys_algorithm(); + void mark_reachable_objects(); }; } diff --git a/vm/gc.cpp b/vm/gc.cpp index c8ba57b7f2..6cb99b6da0 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -235,11 +235,13 @@ object *factor_vm::allot_object(header header, cell size) else { /* If tenured space does not have enough room, collect */ - if(data->tenured->here + size > data->tenured->end) + //XXX + //if(data->tenured->here + size > data->tenured->end) primitive_full_gc(); /* If it still won't fit, grow the heap */ - if(data->tenured->here + size > data->tenured->end) + //XXX + //if(data->tenured->here + size > data->tenured->end) { gc(collect_growing_heap_op, size, /* requested size */ diff --git a/vm/image.cpp b/vm/image.cpp index b47fe4e86a..ee0a1064ed 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -39,7 +39,7 @@ void factor_vm::load_data_heap(FILE *file, image_header *h, vm_parameters *p) fatal_error("load_data_heap failed",0); } - data->tenured->here = data->tenured->start + h->data_size; + data->tenured->build_free_list(h->data_size); } void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p) @@ -203,7 +203,7 @@ void factor_vm::relocate_data(cell data_relocation_base, cell code_relocation_ba { relocate_object((object *)obj,data_relocation_base,code_relocation_base); data->tenured->starts.record_object_start_offset((object *)obj); - obj = data->tenured->next_allocated_block_after(obj); + obj = data->tenured->next_object_after(obj); } } @@ -289,7 +289,7 @@ bool factor_vm::save_image(const vm_char *filename) h.magic = image_magic; h.version = image_version; h.data_relocation_base = data->tenured->start; - h.data_size = data->tenured->here - data->tenured->start; + h.data_size = data->tenured->occupied(); h.code_relocation_base = code->seg->start; h.code_size = code->allocator->occupied(); diff --git a/vm/master.hpp b/vm/master.hpp index 293923ca7b..0282a0597d 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -53,6 +53,7 @@ namespace factor #include "free_list_allocator.hpp" #include "write_barrier.hpp" #include "object_start_map.hpp" +#include "nursery_space.hpp" #include "aging_space.hpp" #include "tenured_space.hpp" #include "data_heap.hpp" diff --git a/vm/nursery_collector.hpp b/vm/nursery_collector.hpp index f9d2172929..778efab138 100644 --- a/vm/nursery_collector.hpp +++ b/vm/nursery_collector.hpp @@ -6,10 +6,14 @@ struct nursery_policy { nursery_policy(factor_vm *parent_) : parent(parent_) {} - bool should_copy_p(object *untagged) + bool should_copy_p(object *obj) { - return parent->nursery.contains_p(untagged); + return parent->nursery.contains_p(obj); } + + void promoted_object(object *obj) {} + + void visited_object(object *obj) {} }; struct nursery_collector : copying_collector { diff --git a/vm/nursery_space.hpp b/vm/nursery_space.hpp new file mode 100644 index 0000000000..4425c1612b --- /dev/null +++ b/vm/nursery_space.hpp @@ -0,0 +1,9 @@ +namespace factor +{ + +struct nursery_space : bump_allocator +{ + nursery_space(cell size, cell start) : bump_allocator(size,start) {} +}; + +} diff --git a/vm/tenured_space.hpp b/vm/tenured_space.hpp index 1162bb5fd3..c0c12d3f58 100644 --- a/vm/tenured_space.hpp +++ b/vm/tenured_space.hpp @@ -1,19 +1,65 @@ namespace factor { -struct tenured_space : bump_allocator { +struct tenured_space : free_list_allocator { object_start_map starts; + std::vector mark_stack; tenured_space(cell size, cell start) : - bump_allocator(size,start), starts(size,start) {} + free_list_allocator(size,start), starts(size,start) {} object *allot(cell size) { - if(here + size > end) return NULL; + object *obj = free_list_allocator::allot(size); + if(obj) + { + starts.record_object_start_offset(obj); + return obj; + } + else + return NULL; + } - object *obj = bump_allocator::allot(size); - starts.record_object_start_offset(obj); - return obj; + object *first_allocated_block_after(object *block) + { + while(block != this->last_block() && block->free_p()) + { + free_heap_block *free_block = (free_heap_block *)block; + block = (object *)((cell)free_block + free_block->size()); + } + + if(block == this->last_block()) + return NULL; + else + return block; + } + + cell first_object() + { + return (cell)first_allocated_block_after(this->first_block()); + } + + cell next_object_after(cell scan) + { + cell size = ((object *)scan)->size(); + object *next = (object *)(scan + size); + return (cell)first_allocated_block_after(next); + } + + void clear_mark_bits() + { + state.clear_mark_bits(); + } + + bool marked_p(object *obj) + { + return this->state.marked_p(obj); + } + + void mark_and_push(object *obj) + { + this->state.set_marked_p(obj); + this->mark_stack.push_back(obj); } }; diff --git a/vm/to_tenured_collector.cpp b/vm/to_tenured_collector.cpp index 3676324ce2..3150647cd2 100644 --- a/vm/to_tenured_collector.cpp +++ b/vm/to_tenured_collector.cpp @@ -4,12 +4,23 @@ namespace factor { to_tenured_collector::to_tenured_collector(factor_vm *myvm_) : - copying_collector( + collector( myvm_, &myvm_->gc_stats.aging_stats, myvm_->data->tenured, to_tenured_policy(myvm_)) {} +void to_tenured_collector::tenure_reachable_objects() +{ + std::vector *mark_stack = &this->target->mark_stack; + while(!mark_stack->empty()) + { + object *obj = mark_stack->back(); + mark_stack->pop_back(); + this->trace_slots(obj); + } +} + void factor_vm::collect_to_tenured() { /* Copy live objects from aging space to tenured space. */ @@ -21,7 +32,7 @@ void factor_vm::collect_to_tenured() card_points_to_aging, dummy_unmarker()); collector.trace_code_heap_roots(&code->points_to_aging); - collector.cheneys_algorithm(); + collector.tenure_reachable_objects(); update_code_heap_for_minor_gc(&code->points_to_aging); nursery.here = nursery.start; diff --git a/vm/to_tenured_collector.hpp b/vm/to_tenured_collector.hpp index 9a4cf3764b..e87ba5ee29 100644 --- a/vm/to_tenured_collector.hpp +++ b/vm/to_tenured_collector.hpp @@ -11,10 +11,18 @@ struct to_tenured_policy { { return !tenured->contains_p(untagged); } + + void promoted_object(object *obj) + { + tenured->mark_stack.push_back(obj); + } + + void visited_object(object *obj) {} }; -struct to_tenured_collector : copying_collector { +struct to_tenured_collector : collector { to_tenured_collector(factor_vm *myvm_); + void tenure_reachable_objects(); }; } diff --git a/vm/vm.hpp b/vm/vm.hpp index 0509127918..615efe35ed 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -11,7 +11,7 @@ struct factor_vm context *ctx; /* New objects are allocated here */ - bump_allocator nursery; + nursery_space nursery; /* Add this to a shifted address to compute write barrier offsets */ cell cards_offset; @@ -308,7 +308,7 @@ struct factor_vm void print_callstack(); void dump_cell(cell x); void dump_memory(cell from, cell to); - void dump_zone(const char *name, bump_allocator *z); + template void dump_generation(const char *name, Generation *gen); void dump_generations(); void dump_objects(cell type); void find_data_references_step(cell *scan); From 8a6b0a14539111de13824e7c03452f8910fef4c2 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 20 Oct 2009 22:30:57 -0500 Subject: [PATCH 044/109] generate unsigned vector comparison fallbacks using min/max or xor/signed compare --- .../compiler/cfg/intrinsics/simd/simd.factor | 64 +++++++++++++++++-- basis/cpu/x86/x86.factor | 6 +- .../vectors/simd/intrinsics/intrinsics.factor | 12 ++-- 3 files changed, 67 insertions(+), 15 deletions(-) diff --git a/basis/compiler/cfg/intrinsics/simd/simd.factor b/basis/compiler/cfg/intrinsics/simd/simd.factor index 0e1beae5e0..9d17ddd0f8 100644 --- a/basis/compiler/cfg/intrinsics/simd/simd.factor +++ b/basis/compiler/cfg/intrinsics/simd/simd.factor @@ -10,8 +10,8 @@ compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.hats compiler.cfg.instructions compiler.cfg.registers compiler.cfg.intrinsics.alien specialized-arrays ; -FROM: alien.c-types => heap-size char uchar float double ; -SPECIALIZED-ARRAYS: float double ; +FROM: alien.c-types => heap-size uchar ushort uint ulonglong float double ; +SPECIALIZED-ARRAYS: uchar ushort uint ulonglong float double ; IN: compiler.cfg.intrinsics.simd MACRO: check-elements ( quots -- ) @@ -155,28 +155,79 @@ MACRO: if-literals-match ( quots -- ) [ ^^not-vector ] [ [ ^^fill-vector ] [ ^^xor-vector ] bi ] if ; -:: (generate-compare-vector) ( src1 src2 rep {cc,swap} -- dst ) +:: ((generate-compare-vector)) ( src1 src2 rep {cc,swap} -- dst ) {cc,swap} first2 :> swap? :> cc swap? [ src2 src1 rep cc ^^compare-vector ] [ src1 src2 rep cc ^^compare-vector ] if ; -:: generate-compare-vector ( src1 src2 rep orig-cc -- dst ) +:: (generate-compare-vector) ( src1 src2 rep orig-cc -- dst ) rep orig-cc %compare-vector-ccs :> not? :> ccs ccs empty? [ rep not? [ ^^fill-vector ] [ ^^zero-vector ] if ] [ ccs unclip :> first-cc :> rest-ccs - src1 src2 rep first-cc (generate-compare-vector) :> first-dst + src1 src2 rep first-cc ((generate-compare-vector)) :> first-dst rest-ccs first-dst - [ [ src1 src2 rep ] dip (generate-compare-vector) rep ^^or-vector ] + [ [ src1 src2 rep ] dip ((generate-compare-vector)) rep ^^or-vector ] reduce not? [ rep generate-not-vector ] when ] if ; +: sign-bit-mask ( rep -- byte-array ) + unsign-rep { + { char-16-rep [ uchar-array{ + HEX: 80 HEX: 80 HEX: 80 HEX: 80 + HEX: 80 HEX: 80 HEX: 80 HEX: 80 + HEX: 80 HEX: 80 HEX: 80 HEX: 80 + HEX: 80 HEX: 80 HEX: 80 HEX: 80 + } underlying>> ] } + { short-8-rep [ ushort-array{ + HEX: 8000 HEX: 8000 HEX: 8000 HEX: 8000 + HEX: 8000 HEX: 8000 HEX: 8000 HEX: 8000 + } underlying>> ] } + { int-4-rep [ uint-array{ + HEX: 8000,0000 HEX: 8000,0000 + HEX: 8000,0000 HEX: 8000,0000 + } underlying>> ] } + { longlong-2-rep [ ulonglong-array{ + HEX: 8000,0000,0000,0000 + HEX: 8000,0000,0000,0000 + } underlying>> ] } + } case ; + +:: (generate-minmax-compare-vector) ( src1 src2 rep orig-cc -- dst ) + orig-cc order-cc { + { cc< [ src1 src2 rep ^^max-vector src1 rep cc/= (generate-compare-vector) ] } + { cc<= [ src1 src2 rep ^^min-vector src1 rep cc= (generate-compare-vector) ] } + { cc> [ src1 src2 rep ^^min-vector src1 rep cc/= (generate-compare-vector) ] } + { cc>= [ src1 src2 rep ^^max-vector src1 rep cc= (generate-compare-vector) ] } + } case ; + +:: generate-compare-vector ( src1 src2 rep orig-cc -- dst ) + { + { + [ rep orig-cc %compare-vector-reps member? ] + [ src1 src2 rep orig-cc (generate-compare-vector) ] + } + { + [ rep %min-vector-reps member? ] + [ src1 src2 rep orig-cc (generate-minmax-compare-vector) ] + } + { + [ rep unsign-rep orig-cc %compare-vector-reps member? ] + [ + rep sign-bit-mask ^^load-constant :> sign-bits + src1 sign-bits rep ^^xor-vector + src2 sign-bits rep ^^xor-vector + rep unsign-rep orig-cc (generate-compare-vector) + ] + } + } cond ; + :: generate-unpack-vector-head ( src rep -- dst ) { { @@ -278,3 +329,4 @@ MACRO: if-literals-match ( quots -- ) [ cc> generate-compare-vector ] [ generate-blend-vector ] 3bi ] if ; + diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 4576956335..d99512f0f7 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -893,7 +893,7 @@ M: x86 %compare-vector ( dst src1 src2 rep cc -- ) M: x86 %compare-vector-reps { - { [ dup { cc= cc/= } memq? ] [ drop %compare-vector-eq-reps ] } + { [ dup { cc= cc/= cc/<>= cc<>= } memq? ] [ drop %compare-vector-eq-reps ] } [ drop %compare-vector-ord-reps ] } cond ; @@ -1098,7 +1098,7 @@ M: x86 %min-vector ( dst src1 src2 rep -- ) M: x86 %min-vector-reps { { sse? { float-4-rep } } - { sse2? { uchar-16-rep short-8-rep double-2-rep short-8-rep uchar-16-rep } } + { sse2? { uchar-16-rep short-8-rep double-2-rep } } { sse4.1? { char-16-rep ushort-8-rep int-4-rep uint-4-rep } } } available-reps ; @@ -1118,7 +1118,7 @@ M: x86 %max-vector ( dst src1 src2 rep -- ) M: x86 %max-vector-reps { { sse? { float-4-rep } } - { sse2? { uchar-16-rep short-8-rep double-2-rep short-8-rep uchar-16-rep } } + { sse2? { uchar-16-rep short-8-rep double-2-rep } } { sse4.1? { char-16-rep ushort-8-rep int-4-rep uint-4-rep } } } available-reps ; diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index 761ca30375..649e444915 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -193,12 +193,12 @@ M: vector-rep supported-simd-op? { \ (simd-(vpack-unsigned)) [ %unsigned-pack-vector-reps ] } { \ (simd-(vunpack-head)) [ (%unpack-reps) ] } { \ (simd-(vunpack-tail)) [ (%unpack-reps) ] } - { \ (simd-v<=) [ cc<= %compare-vector-reps ] } - { \ (simd-v<) [ cc< %compare-vector-reps ] } - { \ (simd-v=) [ cc= %compare-vector-reps ] } - { \ (simd-v>) [ cc> %compare-vector-reps ] } - { \ (simd-v>=) [ cc>= %compare-vector-reps ] } - { \ (simd-vunordered?) [ cc/<>= %compare-vector-reps ] } + { \ (simd-v<=) [ unsign-rep cc<= %compare-vector-reps ] } + { \ (simd-v<) [ unsign-rep cc< %compare-vector-reps ] } + { \ (simd-v=) [ unsign-rep cc= %compare-vector-reps ] } + { \ (simd-v>) [ unsign-rep cc> %compare-vector-reps ] } + { \ (simd-v>=) [ unsign-rep cc>= %compare-vector-reps ] } + { \ (simd-vunordered?) [ unsign-rep cc/<>= %compare-vector-reps ] } { \ (simd-gather-2) [ %gather-vector-2-reps ] } { \ (simd-gather-4) [ %gather-vector-4-reps ] } { \ (simd-vany?) [ %test-vector-reps ] } From c681039c77bdeef4367208647ffc834b4f89ef7c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 20 Oct 2009 22:37:44 -0500 Subject: [PATCH 045/109] fix a normalization bug in decimals --- extra/decimals/decimals-tests.factor | 1 + extra/decimals/decimals.factor | 6 ++++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/extra/decimals/decimals-tests.factor b/extra/decimals/decimals-tests.factor index bb9e60cfc1..29b9d98b38 100644 --- a/extra/decimals/decimals-tests.factor +++ b/extra/decimals/decimals-tests.factor @@ -49,3 +49,4 @@ ERROR: decimal-test-failure D1 D2 quot ; [ f ] [ D: -1 D: -2 before? ] unit-test [ f ] [ D: -2 D: -2 before? ] unit-test [ t ] [ D: -3 D: -2 before? ] unit-test +[ t ] [ D: .5 D: 0 D: 1.0 between? ] unit-test diff --git a/extra/decimals/decimals.factor b/extra/decimals/decimals.factor index d9bafd43d0..ae1fb2f9a3 100644 --- a/extra/decimals/decimals.factor +++ b/extra/decimals/decimals.factor @@ -37,8 +37,7 @@ SYNTAX: D: parse-decimal parsed ; ] 2bi ; : scale-decimals ( D1 D2 -- D1' D2' ) - [ drop ] - [ scale-mantissas nip ] 2bi ; + scale-mantissas tuck [ ] 2dip ; ERROR: decimal-types-expected d1 d2 ; @@ -83,3 +82,6 @@ M: decimal before? e1 e2 a + - ; + +M: decimal <=> + 2dup before? [ 2drop +lt+ ] [ equal? +eq+ +gt+ ? ] if ; inline From 9781e5180c0b7a398b00160e6a0593bc318c0ec9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 20 Oct 2009 22:43:11 -0500 Subject: [PATCH 046/109] fix doc formatting for io.mmap --- basis/io/mmap/mmap-docs.factor | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/basis/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor index fe16e08467..caa2f95dae 100644 --- a/basis/io/mmap/mmap-docs.factor +++ b/basis/io/mmap/mmap-docs.factor @@ -68,8 +68,7 @@ ARTICLE: "io.mmap.arrays" "Working with memory-mapped data" "The " { $link } " word returns an instance of " { $link mapped-file } ", which doesn't directly support the sequence protocol. Instead, it needs to be wrapped in a specialized array of the appropriate C type:" { $subsections } "Additionally, files may be opened with two combinators which take a c-type as input:" -{ $subsections with-mapped-array } -{ $subsections with-mapped-array-reader } +{ $subsections with-mapped-array with-mapped-array-reader } "The appropriate specialized array type must first be generated with " { $link POSTPONE: SPECIALIZED-ARRAY: } "." $nl "Data can also be read and written from the " { $link mapped-file } " by applying low-level alien words to the " { $slot "address" } " slot. This approach is not recommended, though, since in most cases the compiler will generate efficient code for specialized array usage. See " { $link "reading-writing-memory" } " for a description of low-level memory access primitives." ; @@ -101,10 +100,10 @@ ARTICLE: "io.mmap" "Memory-mapped files" { $subsections } "Memory-mapped files are disposable and can be closed with " { $link dispose } " or " { $link with-disposal } "." $nl "Utility combinators which wrap the above:" -{ $subsections with-mapped-file } -{ $subsections with-mapped-file-reader } -{ $subsections with-mapped-array } -{ $subsections with-mapped-array-reader } +{ $subsections with-mapped-file + with-mapped-file-reader + with-mapped-array + with-mapped-array-reader } "Instances of " { $link mapped-file } " don't support any interesting operations in themselves. There are two facilities for accessing their contents:" { $subsections "io.mmap.arrays" From bedfc8f13c743e29d70a4d4ef9f157f748a8c1cc Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 20 Oct 2009 22:49:20 -0500 Subject: [PATCH 047/109] vif combinator --- basis/math/vectors/vectors-docs.factor | 12 +++++++++++- basis/math/vectors/vectors.factor | 9 ++++++++- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor index 71e86417f5..b831ac7dbe 100644 --- a/basis/math/vectors/vectors-docs.factor +++ b/basis/math/vectors/vectors-docs.factor @@ -101,6 +101,7 @@ $nl vxor vnot v? + vif } "Entire vector tests:" { $subsections @@ -534,10 +535,19 @@ HELP: vnot { $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs and results when using SIMD types." } ; HELP: v? -{ $values { "mask" "a sequence of booleans" } { "true" "a sequence of numbers" } { "false" "a sequence of numbers" } { "w" "a sequence of numbers" } } +{ $values { "mask" "a sequence of booleans" } { "true" "a sequence of numbers" } { "false" "a sequence of numbers" } { "result" "a sequence of numbers" } } { $description "Creates a new sequence by selecting elements from the " { $snippet "true" } " and " { $snippet "false" } " sequences based on whether the corresponding bits of the " { $snippet "mask" } " sequence are set or not." } { $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs and results when using SIMD types." } ; +HELP: vif +{ $values { "mask" "a sequence of booleans" } { "true-quot" { $quotation "( -- vector )" } } { "false-quot" { $quotation "( -- vector )" } } { "result" "a sequence" } } +{ $description "If all of the elements of " { $snippet "mask" } " are true, " { $snippet "true-quot" } " is called and its output value returned. If all of the elements of " { $snippet "mask" } " are false, " { $snippet "false-quot" } " is called and its output value returned. Otherwise, both quotations are called and " { $snippet "mask" } " is used to select elements from each output as with " { $link v? } "." } +{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs and results when using SIMD types." +$nl +"For most conditional SIMD code, unless a case is exceptionally expensive to compute, it is usually most efficient to just compute all cases and blend them with " { $link v? } " instead of using " { $snippet "vif" } "." } ; + +{ v? vif } related-words + HELP: vany? { $values { "v" "a sequence of booleans" } { "?" "a boolean" } } { $description "Returns true if any element of " { $snippet "v" } " is true." } diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 49ee6c3873..81af5c12d2 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -142,9 +142,16 @@ M: simd-128 vshuffle ( u perm -- v ) : vunordered? ( u v -- w ) [ unordered? ] 2map ; : v= ( u v -- w ) [ = ] 2map ; -: v? ( mask true false -- w ) +: v? ( mask true false -- result ) [ vand ] [ vandn ] bi-curry* bi vor ; inline +:: vif ( mask true-quot false-quot -- result ) + { + { [ mask vall? ] [ true-quot call ] } + { [ mask vnone? ] [ false-quot call ] } + [ mask true-quot call false-quot call v? ] + } cond ; inline + : vfloor ( u -- v ) [ floor ] map ; : vceiling ( u -- v ) [ ceiling ] map ; : vtruncate ( u -- v ) [ truncate ] map ; From 83a442c30fadd952750d6a30e3ad566e76e76168 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 21 Oct 2009 17:39:53 -0500 Subject: [PATCH 048/109] don't natural-sort the stack effects or $values in help-lint -- catches a lot more documentation errors --- basis/help/lint/checks/checks.factor | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index 56f104a1a1..dac3900cc9 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -33,14 +33,13 @@ SYMBOL: vocab-articles : extract-values ( element -- seq ) \ $values swap elements dup empty? [ - first rest [ first ] map prune natural-sort + first rest [ first ] map prune ] unless ; : effect-values ( word -- seq ) stack-effect [ in>> ] [ out>> ] bi append - [ dup pair? [ first ] when effect>string ] map - prune natural-sort ; + [ dup pair? [ first ] when effect>string ] map prune ; : contains-funky-elements? ( element -- ? ) { From 0d4b9132d73bb4d9089b87d52e1498f6d1b97a25 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 21 Oct 2009 17:40:43 -0500 Subject: [PATCH 049/109] fix a bunch of typos in docs --- basis/cocoa/messages/messages-docs.factor | 4 ++-- basis/cocoa/subclassing/subclassing-docs.factor | 2 +- basis/concurrency/mailboxes/mailboxes-docs.factor | 3 ++- basis/delegate/delegate-docs.factor | 2 +- basis/documents/documents-docs.factor | 4 ++-- basis/heaps/heaps-docs.factor | 8 ++++---- basis/lists/lists-docs.factor | 2 +- basis/logging/logging-docs.factor | 8 ++++---- basis/math/functions/functions-docs.factor | 2 +- basis/tools/walker/walker-docs.factor | 2 +- basis/ui/gadgets/menus/menus-docs.factor | 2 +- basis/ui/gadgets/scrollers/scrollers-docs.factor | 2 +- basis/ui/gadgets/tracks/tracks-docs.factor | 2 +- basis/ui/pens/pens-docs.factor | 6 +++--- core/combinators/combinators-docs.factor | 2 +- core/continuations/continuations-docs.factor | 4 ++-- core/generic/generic-docs.factor | 2 +- core/io/streams/byte-array/byte-array-docs.factor | 5 +++-- core/kernel/kernel-docs.factor | 12 ++++++------ core/kernel/kernel.factor | 2 +- core/parser/parser-docs.factor | 2 +- core/sequences/sequences-docs.factor | 12 ++++++------ core/source-files/source-files-docs.factor | 2 +- 23 files changed, 47 insertions(+), 45 deletions(-) diff --git a/basis/cocoa/messages/messages-docs.factor b/basis/cocoa/messages/messages-docs.factor index 400599383f..7dee15d2e2 100644 --- a/basis/cocoa/messages/messages-docs.factor +++ b/basis/cocoa/messages/messages-docs.factor @@ -2,13 +2,13 @@ USING: help.markup help.syntax strings alien ; IN: cocoa.messages HELP: send -{ $values { "args..." "method arguments" } { "receiver" alien } { "selector" string } { "return..." "value returned by method, if any" } } +{ $values { "receiver" alien } { "args..." "method arguments" } { "selector" string } { "return..." "value returned by method, if any" } } { $description "Sends an Objective C message named by " { $snippet "selector" } " to " { $snippet "receiver" } ". The arguments must be on the stack in left-to-right order." } { $errors "Throws an error if the receiver does not recognize the message, or if the arguments have inappropriate types." } { $notes "This word uses a special fast code path if " { $snippet "selector" } " is a literal and the word containing the call to " { $link send } " is compiled." } ; HELP: super-send -{ $values { "args..." "method arguments" } { "receiver" alien } { "selector" string } { "return..." "value returned by method, if any" } } +{ $values { "receiver" alien } { "args..." "method arguments" } { "selector" string } { "return..." "value returned by method, if any" } } { $description "Sends an Objective C message named by " { $snippet "selector" } " to the super class of " { $snippet "receiver" } ". Otherwise behaves identically to " { $link send } "." } ; HELP: objc-class diff --git a/basis/cocoa/subclassing/subclassing-docs.factor b/basis/cocoa/subclassing/subclassing-docs.factor index 181912b0f0..0944727e46 100644 --- a/basis/cocoa/subclassing/subclassing-docs.factor +++ b/basis/cocoa/subclassing/subclassing-docs.factor @@ -2,7 +2,7 @@ USING: help.markup help.syntax strings alien hashtables ; IN: cocoa.subclassing HELP: define-objc-class -{ $values { "hash" hashtable } { "imeth" "a sequence of instance method definitions" } } +{ $values { "imeth" "a sequence of instance method definitions" } { "hash" hashtable } } { $description "Defines a new Objective C class. The hashtable can contain the following keys:" { $list { { $link +name+ } " - a string naming the new class. Required." } diff --git a/basis/concurrency/mailboxes/mailboxes-docs.factor b/basis/concurrency/mailboxes/mailboxes-docs.factor index a58a1a4cc6..727efd45d0 100644 --- a/basis/concurrency/mailboxes/mailboxes-docs.factor +++ b/basis/concurrency/mailboxes/mailboxes-docs.factor @@ -18,9 +18,10 @@ HELP: mailbox-put { $description "Put the object into the mailbox. Any threads that have a blocking get on the mailbox are resumed. Only one of those threads will successfully get the object, the rest will immediately block waiting for the next item in the mailbox." } ; HELP: block-unless-pred -{ $values { "pred" { $quotation "( obj -- ? )" } } +{ $values { "mailbox" mailbox } { "timeout" "a " { $link duration } " or " { $link f } } + { "pred" { $quotation "( obj -- ? )" } } } { $description "Block the thread if there are no items in the mailbox that return true when the predicate is called with the item on the stack." } ; diff --git a/basis/delegate/delegate-docs.factor b/basis/delegate/delegate-docs.factor index 4ce3776277..d4867714d3 100644 --- a/basis/delegate/delegate-docs.factor +++ b/basis/delegate/delegate-docs.factor @@ -2,7 +2,7 @@ USING: help.syntax help.markup delegate.private ; IN: delegate HELP: define-protocol -{ $values { "wordlist" "a sequence of words" } { "protocol" "a word for the new protocol" } } +{ $values { "protocol" "a word for the new protocol" } { "wordlist" "a sequence of words" } } { $description "Defines a symbol as a protocol." } { $notes "Usually, " { $link POSTPONE: PROTOCOL: } " should be used instead. This is only for runtime use." } ; diff --git a/basis/documents/documents-docs.factor b/basis/documents/documents-docs.factor index 850c68fd9d..a4e02009df 100644 --- a/basis/documents/documents-docs.factor +++ b/basis/documents/documents-docs.factor @@ -12,11 +12,11 @@ HELP: +line { $description "Adds an integer to the line number of a line/column pair." } ; HELP: =col -{ $values { "loc" "a pair of integers" } { "n" integer } { "newloc" "a pair of integers" } } +{ $values { "n" integer } { "loc" "a pair of integers" } { "newloc" "a pair of integers" } } { $description "Sets the column number of a line/column pair." } ; HELP: =line -{ $values { "loc" "a pair of integers" } { "n" integer } { "newloc" "a pair of integers" } } +{ $values { "n" integer } { "loc" "a pair of integers" } { "newloc" "a pair of integers" } } { $description "Sets the line number of a line/column pair." } ; HELP: lines-equal? diff --git a/basis/heaps/heaps-docs.factor b/basis/heaps/heaps-docs.factor index 32b6ffe7ed..8ceb7bb78f 100644 --- a/basis/heaps/heaps-docs.factor +++ b/basis/heaps/heaps-docs.factor @@ -53,12 +53,12 @@ HELP: { $description "Create a new " { $link max-heap } "." } ; HELP: heap-push -{ $values { "key" "a comparable object" } { "value" object } { "heap" "a heap" } } +{ $values { "value" object } { "key" "a comparable object" } { "heap" "a heap" } } { $description "Push a pair onto a heap. The key must be comparable with all other keys by the " { $link <=> } " generic word." } { $side-effects "heap" } ; HELP: heap-push* -{ $values { "key" "a comparable object" } { "value" object } { "heap" "a heap" } { "entry" entry } } +{ $values { "value" object } { "key" "a comparable object" } { "heap" "a heap" } { "entry" entry } } { $description "Push a pair onto a heap, and output an entry which may later be passed to " { $link heap-delete } "." } { $side-effects "heap" } ; @@ -68,7 +68,7 @@ HELP: heap-push-all { $side-effects "heap" } ; HELP: heap-peek -{ $values { "heap" "a heap" } { "key" object } { "value" object } } +{ $values { "heap" "a heap" } { "value" object } { "key" object } } { $description "Output the first element in the heap, leaving it in the heap." } ; HELP: heap-pop* @@ -77,7 +77,7 @@ HELP: heap-pop* { $side-effects "heap" } ; HELP: heap-pop -{ $values { "heap" "a heap" } { "key" object } { "value" object } } +{ $values { "heap" "a heap" } { "value" object } { "key" object } } { $description "Output and remove the first element in the heap." } { $side-effects "heap" } ; diff --git a/basis/lists/lists-docs.factor b/basis/lists/lists-docs.factor index f70b6ff4a1..7fba57a4bb 100644 --- a/basis/lists/lists-docs.factor +++ b/basis/lists/lists-docs.factor @@ -122,7 +122,7 @@ HELP: uncons { $description "Put the head and tail of the list on the stack." } ; HELP: unswons -{ $values { "cons" list } { "car" "the head of the list" } { "cdr" "the tail of the list" } } +{ $values { "cons" list } { "cdr" "the tail of the list" } { "car" "the head of the list" } } { $description "Put the head and tail of the list on the stack." } ; { leach foldl lmap>array } related-words diff --git a/basis/logging/logging-docs.factor b/basis/logging/logging-docs.factor index 2dc5918bda..4af3f01ef7 100644 --- a/basis/logging/logging-docs.factor +++ b/basis/logging/logging-docs.factor @@ -47,19 +47,19 @@ HELP: log-message { $description "Sends a message to the current log if the level is more urgent than " { $link log-level } ". Does nothing if not executing in a dynamic scope established by " { $link with-logging } "." } ; HELP: add-logging -{ $values { "level" "a log level" } { "word" word } } +{ $values { "word" word } { "level" "a log level" } } { $description "Causes the word to log a message every time it is called." } ; HELP: add-input-logging -{ $values { "level" "a log level" } { "word" word } } +{ $values { "word" word } { "level" "a log level" } } { $description "Causes the word to log its input values every time it is called. The word must have a stack effect declaration." } ; HELP: add-output-logging -{ $values { "level" "a log level" } { "word" word } } +{ $values { "word" word } { "level" "a log level" } } { $description "Causes the word to log its output values every time it is called. The word must have a stack effect declaration." } ; HELP: add-error-logging -{ $values { "level" "a log level" } { "word" word } } +{ $values { "word" word } { "level" "a log level" } } { $description "Causes the word to log its input values and any errors it throws." $nl "If the word is not executed in a dynamic scope established by " { $link with-logging } ", its behavior is unchanged, and any errors it throws are passed to the caller." diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index 5b1920f572..1939de4f97 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -239,7 +239,7 @@ HELP: cis { cis exp } related-words HELP: polar> -{ $values { "z" number } { "abs" "a non-negative real number" } { "arg" real } } +{ $values { "abs" "a non-negative real number" } { "arg" real } { "z" number } } { $description "Converts an absolute value and argument (polar form) to a complex number." } ; HELP: [-1,1]? diff --git a/basis/tools/walker/walker-docs.factor b/basis/tools/walker/walker-docs.factor index bbfb9cbd9f..318f7e065c 100644 --- a/basis/tools/walker/walker-docs.factor +++ b/basis/tools/walker/walker-docs.factor @@ -6,7 +6,7 @@ HELP: breakpoint { $description "Annotates a word definition to enter the single stepper when executed." } ; HELP: breakpoint-if -{ $values { "quot" { $quotation "( -- ? )" } } { "word" word } } +{ $values { "word" word } { "quot" { $quotation "( -- ? )" } } } { $description "Annotates a word definition to enter the single stepper if the quotation yields true." } ; HELP: B diff --git a/basis/ui/gadgets/menus/menus-docs.factor b/basis/ui/gadgets/menus/menus-docs.factor index bebfaf13fe..b1ae421f52 100644 --- a/basis/ui/gadgets/menus/menus-docs.factor +++ b/basis/ui/gadgets/menus/menus-docs.factor @@ -3,7 +3,7 @@ kernel ; IN: ui.gadgets.menus HELP: -{ $values { "target" object } { "commands" "a sequence of commands" } { "hook" { $quotation "( button -- )" } } { "menu" "a new " { $link gadget } } } +{ $values { "target" object } { "hook" { $quotation "( button -- )" } } { "commands" "a sequence of commands" } { "menu" "a new " { $link gadget } } } { $description "Creates a popup menu of commands which are to be invoked on " { $snippet "target" } ". The " { $snippet "hook" } " quotation is run before a command is invoked." } ; HELP: show-menu diff --git a/basis/ui/gadgets/scrollers/scrollers-docs.factor b/basis/ui/gadgets/scrollers/scrollers-docs.factor index 1e4b875f28..17adb2bd64 100644 --- a/basis/ui/gadgets/scrollers/scrollers-docs.factor +++ b/basis/ui/gadgets/scrollers/scrollers-docs.factor @@ -24,7 +24,7 @@ HELP: { } related-words HELP: set-scroll-position -{ $values { "scroller" scroller } { "value" "a pair of integers" } } +{ $values { "value" "a pair of integers" } { "scroller" scroller } } { $description "Sets the offset of the top-left corner of the scroller's " { $link viewport } "'s child." } ; HELP: relative-scroll-rect diff --git a/basis/ui/gadgets/tracks/tracks-docs.factor b/basis/ui/gadgets/tracks/tracks-docs.factor index 0bbedc8d0d..cf5c94aa6b 100644 --- a/basis/ui/gadgets/tracks/tracks-docs.factor +++ b/basis/ui/gadgets/tracks/tracks-docs.factor @@ -18,7 +18,7 @@ HELP: { $description "Creates a new track which lays out children along the given orientation, either " { $link horizontal } " or " { $link vertical } "." } ; HELP: track-add -{ $values { "gadget" gadget } { "track" track } { "constraint" "a number between 0 and 1, or " { $link f } } } +{ $values { "track" track } { "gadget" gadget } { "constraint" "a number between 0 and 1, or " { $link f } } } { $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ; ABOUT: "ui-track-layout" diff --git a/basis/ui/pens/pens-docs.factor b/basis/ui/pens/pens-docs.factor index 4aa0e50945..4a5ec277f0 100644 --- a/basis/ui/pens/pens-docs.factor +++ b/basis/ui/pens/pens-docs.factor @@ -2,11 +2,11 @@ IN: ui.pens USING: help.markup help.syntax kernel ui.gadgets ; HELP: draw-interior -{ $values { "pen" object } { "gadget" gadget } } +{ $values { "gadget" gadget } { "pen" object } } { $contract "Draws the interior of a gadget by making OpenGL calls. The " { $snippet "interior" } " slot may be set to objects implementing this generic word." } ; HELP: draw-boundary -{ $values { "pen" object } { "gadget" gadget } } +{ $values { "gadget" gadget } { "pen" object } } { $contract "Draws the boundary of a gadget by making OpenGL calls. The " { $snippet "boundary" } " slot may be set to objects implementing this generic word." } ; ARTICLE: "ui-pen-protocol" "UI pen protocol" @@ -23,4 +23,4 @@ $nl { $vocab-subsection "Polygon pens" "ui.pens.polygon" } { $vocab-subsection "Solid pens" "ui.pens.solid" } { $vocab-subsection "Tile pens" "ui.pens.tile" } -"Custom implementations must follow the guidelines set forth in " { $link "ui-paint-custom" } "." ; \ No newline at end of file +"Custom implementations must follow the guidelines set forth in " { $link "ui-paint-custom" } "." ; diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor index 4701476d2a..1717359fa8 100755 --- a/core/combinators/combinators-docs.factor +++ b/core/combinators/combinators-docs.factor @@ -438,7 +438,7 @@ $nl { $notes "This word is used behind the scenes to compile " { $link cond } " forms efficiently; it can also be called directly, which is useful for meta-programming." } ; HELP: case>quot -{ $values { "assoc" "a sequence of pairs of quotations" } { "default" quotation } { "quot" quotation } } +{ $values { "default" quotation } { "assoc" "a sequence of pairs of quotations" } { "quot" quotation } } { $description "Creates a quotation that when called, has the same effect as applying " { $link case } " to " { $snippet "assoc" } "." $nl "This word uses three strategies:" diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index 5fb5a38af2..84da26a082 100644 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -122,7 +122,7 @@ HELP: continuation { $description "Reifies the current continuation from the point immediately after which the caller returns." } ; HELP: >continuation< -{ $values { "continuation" continuation } { "data" vector } { "retain" vector } { "call" vector } { "name" vector } { "catch" vector } } +{ $values { "continuation" continuation } { "data" vector } { "call" vector } { "retain" vector } { "name" vector } { "catch" vector } } { $description "Takes a continuation apart into its constituents." } ; HELP: ifcc @@ -271,4 +271,4 @@ HELP: with-return HELP: restart { $values { "restart" restart } } { $description "Invokes a restart." } -{ $class-description "The class of restarts." } ; \ No newline at end of file +{ $class-description "The class of restarts." } ; diff --git a/core/generic/generic-docs.factor b/core/generic/generic-docs.factor index 0f80aac2f3..dea523538e 100644 --- a/core/generic/generic-docs.factor +++ b/core/generic/generic-docs.factor @@ -124,7 +124,7 @@ HELP: make-generic $low-level-note ; HELP: define-generic -{ $values { "word" word } { "effect" effect } { "combination" "a method combination" } } +{ $values { "word" word } { "combination" "a method combination" } { "effect" effect } } { $description "Defines a generic word. A method combination is an object which responds to the " { $link perform-combination } " generic word." } { $contract "The method combination quotation is called each time the generic word has to be updated (for example, when a method is added), and thus must be side-effect free." } ; diff --git a/core/io/streams/byte-array/byte-array-docs.factor b/core/io/streams/byte-array/byte-array-docs.factor index 1bc09429dc..eeada8d0c9 100644 --- a/core/io/streams/byte-array/byte-array-docs.factor +++ b/core/io/streams/byte-array/byte-array-docs.factor @@ -27,8 +27,9 @@ HELP: { $description "Creates an output stream writing data to a byte array using an encoding." } ; HELP: with-byte-reader -{ $values { "encoding" "an encoding descriptor" } - { "quot" quotation } { "byte-array" byte-array } } +{ $values { "byte-array" byte-array } + { "encoding" "an encoding descriptor" } + { "quot" quotation } } { $description "Calls the quotation in a new dynamic scope with " { $link input-stream } " rebound to an input stream for reading from a byte array using an encoding." } ; HELP: with-byte-writer diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 3f1e715448..d4f8f3c28c 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -168,7 +168,7 @@ HELP: xor { $notes "This word implements boolean exclusive or, so applying it to integers will not yield useful results (all integers have a true value). Bitwise exclusive or is the " { $link bitxor } " word." } ; HELP: both? -{ $values { "quot" { $quotation "( obj -- ? )" } } { "x" object } { "y" object } { "?" "a boolean" } } +{ $values { "x" object } { "y" object } { "quot" { $quotation "( obj -- ? )" } } { "?" "a boolean" } } { $description "Tests if the quotation yields a true value when applied to both " { $snippet "x" } " and " { $snippet "y" } "." } { $examples { $example "USING: kernel math prettyprint ;" "3 5 [ odd? ] both? ." "t" } @@ -176,7 +176,7 @@ HELP: both? } ; HELP: either? -{ $values { "quot" { $quotation "( obj -- ? )" } } { "x" object } { "y" object } { "?" "a boolean" } } +{ $values { "x" object } { "y" object } { "quot" { $quotation "( obj -- ? )" } } { "?" "a boolean" } } { $description "Tests if the quotation yields a true value when applied to either " { $snippet "x" } " or " { $snippet "y" } "." } { $examples { $example "USING: kernel math prettyprint ;" "3 6 [ odd? ] either? ." "t" } @@ -213,18 +213,18 @@ HELP: call-clear ( quot -- ) { $notes "Used to implement " { $link "threads" } "." } ; HELP: keep -{ $values { "quot" { $quotation "( x -- ... )" } } { "x" object } } +{ $values { "x" object } { "quot" { $quotation "( x -- ... )" } } } { $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." } { $examples { $example "USING: arrays kernel prettyprint ;" "2 \"greetings\" [ ] keep 2array ." "{ { \"greetings\" \"greetings\" } \"greetings\" }" } } ; HELP: 2keep -{ $values { "quot" { $quotation "( x y -- ... )" } } { "x" object } { "y" object } } +{ $values { "x" object } { "y" object } { "quot" { $quotation "( x y -- ... )" } } } { $description "Call a quotation with two values on the stack, restoring the values when the quotation returns." } ; HELP: 3keep -{ $values { "quot" { $quotation "( x y z -- ... )" } } { "x" object } { "y" object } { "z" object } } +{ $values { "x" object } { "y" object } { "z" object } { "quot" { $quotation "( x y z -- ... )" } } } { $description "Call a quotation with three values on the stack, restoring the values when the quotation returns." } ; HELP: bi @@ -664,7 +664,7 @@ HELP: getenv ( n -- obj ) { $description "Reads an object from the Factor VM's environment table. User code never has to read the environment table directly; instead, use one of the callers of this word." } ; HELP: setenv ( obj n -- ) -{ $values { "n" "a non-negative integer" } { "obj" object } } +{ $values { "obj" object } { "n" "a non-negative integer" } } { $description "Writes an object to the Factor VM's environment table. User code never has to write to the environment table directly; instead, use one of the callers of this word." } ; HELP: object diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 838d877a40..6538109687 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -122,7 +122,7 @@ DEFER: if : 2bi@ ( w x y z quot -- ) dup 2bi* ; inline -: 2tri@ ( u v w y x z quot -- ) +: 2tri@ ( u v w x y z quot -- ) dup dup 2tri* ; inline ! Quotation building diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 7e94d71c29..888f9f3b4c 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -188,7 +188,7 @@ HELP: parse-lines { $errors "Throws a " { $link lexer-error } " if the input is malformed." } ; HELP: parse-base -{ $values { "base" "an integer between 2 and 36" } { "parsed" integer } } +{ $values { "parsed" integer } { "base" "an integer between 2 and 36" } { "parsed" integer } } { $description "Reads an integer in a specific numerical base from the parser input." } $parsing-note ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index ef02754a60..9fd48796d6 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -218,7 +218,7 @@ HELP: 3sequence { $description "Creates a three-element sequence of the same type as " { $snippet "exemplar" } "." } ; HELP: 4sequence -{ $values { "obj1" object } { "obj2" object } { "exemplar" sequence } { "obj3" object } { "obj4" object } { "seq" sequence } } +{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "obj4" object } { "exemplar" sequence } { "seq" sequence } } { $description "Creates a four-element sequence of the same type as " { $snippet "exemplar" } "." } ; HELP: first2 @@ -277,7 +277,7 @@ HELP: reduce-index } } ; HELP: accumulate-as -{ $values { "identity" object } { "seq" sequence } { "quot" { $quotation "( prev elt -- next )" } } { "exemplar" sequence } { "final" "the final result" } { "newseq" "a new sequence" } } +{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation "( prev elt -- next )" } } { "exemplar" sequence } { "final" "the final result" } { "newseq" "a new sequence" } } { $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of the same type as " { $snippet "exemplar" } " containing intermediate results, together with the final result." $nl "The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence." @@ -285,7 +285,7 @@ $nl "When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." } ; HELP: accumulate -{ $values { "identity" object } { "seq" sequence } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } { "newseq" "a new array" } } +{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } { "newseq" "a new array" } } { $description "Combines successive elements of the sequence using a binary operation, and outputs an array of intermediate results, together with the final result." $nl "The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence." @@ -300,7 +300,7 @@ HELP: map { $description "Applies the quotation to each element of the sequence in order. The new elements are collected into a sequence of the same class as the input sequence." } ; HELP: map-as -{ $values { "seq" sequence } { "quot" { $quotation "( old -- new )" } } { "newseq" "a new sequence" } { "exemplar" sequence } } +{ $values { "seq" sequence } { "quot" { $quotation "( old -- new )" } } { "exemplar" sequence } { "newseq" "a new sequence" } } { $description "Applies the quotation to each element of the sequence in order. The new elements are collected into a sequence of the same class as " { $snippet "exemplar" } "." } { $examples "The following example converts a string into an array of one-element strings:" @@ -483,7 +483,7 @@ HELP: remove-nth } } ; HELP: move -{ $values { "from" "an index in " { $snippet "seq" } } { "to" "an index in " { $snippet "seq" } } { "seq" "a mutable sequence" } } +{ $values { "to" "an index in " { $snippet "seq" } } { "from" "an index in " { $snippet "seq" } } { "seq" "a mutable sequence" } } { $description "Sets the element with index " { $snippet "m" } " to the element with index " { $snippet "n" } "." } { $side-effects "seq" } ; @@ -510,7 +510,7 @@ HELP: delete-slice { $side-effects "seq" } ; HELP: replace-slice -{ $values { "new" sequence } { "seq" sequence } { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq'" sequence } } +{ $values { "new" sequence } { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "seq'" sequence } } { $description "Replaces a range of elements beginning at index " { $snippet "from" } " and ending before index " { $snippet "to" } " with a new sequence." } { $errors "Throws an error if " { $snippet "new" } " contains elements whose types are not permissible in " { $snippet "seq" } "." } ; diff --git a/core/source-files/source-files-docs.factor b/core/source-files/source-files-docs.factor index ef19d16351..cb1e5e6017 100644 --- a/core/source-files/source-files-docs.factor +++ b/core/source-files/source-files-docs.factor @@ -38,7 +38,7 @@ HELP: source-file } ; HELP: record-checksum -{ $values { "source-file" source-file } { "lines" "a sequence of strings" } } +{ $values { "lines" "a sequence of strings" } { "source-file" source-file } } { $description "Records the CRC32 checksm of the source file's contents." } $low-level-note ; From 1b4e3cb7a6735200104fe1fec57b30e4a01b2b97 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 21 Oct 2009 18:11:24 -0500 Subject: [PATCH 050/109] fix more docs typos --- basis/furnace/auth/auth-docs.factor | 2 +- basis/math/primes/primes-docs.factor | 3 ++- basis/persistent/heaps/heaps-docs.factor | 2 +- extra/models/combinators/combinators-docs.factor | 4 ++-- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/basis/furnace/auth/auth-docs.factor b/basis/furnace/auth/auth-docs.factor index c7fc0d5f0b..5aab808763 100644 --- a/basis/furnace/auth/auth-docs.factor +++ b/basis/furnace/auth/auth-docs.factor @@ -63,7 +63,7 @@ HELP: realm { $class-description "The class of authentication realms. See " { $link "furnace.auth.realms" } " for details." } ; HELP: uchange -{ $values { "key" symbol } { "quot" { $quotation "( old -- new )" } } } +{ $values { "quot" { $quotation "( old -- new )" } } { "key" symbol } } { $description "Applies the quotation to the old value of the user profile variable, and assigns the resulting value back to the variable." } ; HELP: uget diff --git a/basis/math/primes/primes-docs.factor b/basis/math/primes/primes-docs.factor index 7f525debfe..74aa2ebca3 100644 --- a/basis/math/primes/primes-docs.factor +++ b/basis/math/primes/primes-docs.factor @@ -44,7 +44,8 @@ HELP: random-prime HELP: unique-primes { $values - { "numbits" integer } { "n" integer } + { "n" integer } + { "numbits" integer } { "seq" sequence } } { $description "Generates a sequence of " { $snippet "n" } " unique prime numbers with exactly " { $snippet "numbits" } " bits." } ; diff --git a/basis/persistent/heaps/heaps-docs.factor b/basis/persistent/heaps/heaps-docs.factor index 49852bac4d..31422f23b9 100644 --- a/basis/persistent/heaps/heaps-docs.factor +++ b/basis/persistent/heaps/heaps-docs.factor @@ -18,7 +18,7 @@ HELP: pheap-peek { $description "Gets the object in the heap with minumum priority." } ; HELP: pheap-push -{ $values { "heap" "a persistent heap" } { "value" object } { "prio" "a priority" } { "newheap" "a new persistent heap" } } +{ $values { "value" object } { "prio" "a priority" } { "heap" "a persistent heap" } { "newheap" "a new persistent heap" } } { $description "Creates a new persistent heap also containing the given object of the given priority." } ; HELP: pheap-pop* diff --git a/extra/models/combinators/combinators-docs.factor b/extra/models/combinators/combinators-docs.factor index 5ccfe1f758..8ac3657105 100644 --- a/extra/models/combinators/combinators-docs.factor +++ b/extra/models/combinators/combinators-docs.factor @@ -10,7 +10,7 @@ HELP: filter-model { $description "Creates a model that uses the updates of another model only when they satisfy a given predicate" } ; HELP: fold -{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "model" model } } +{ $values { "model" model } { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } } { $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ; HELP: switch-models @@ -38,4 +38,4 @@ ARTICLE: "models.combinators" "Extending models" "Also, it provides methods of manipulating and combining models, expecially useful when programming user interfaces: " "The output models of some gadgets (see " { $vocab-link "ui.gadgets.controls" } " ) can be manipulated and used as the input models of others. " ; -ABOUT: "models.combinators" \ No newline at end of file +ABOUT: "models.combinators" From cc5f9ff98afae646ef25fe463cd51e0edf46053a Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 21 Oct 2009 18:17:29 -0500 Subject: [PATCH 051/109] update cocoa bridge to use c-type words --- basis/cocoa/callbacks/callbacks.factor | 4 +- basis/cocoa/cocoa-tests.factor | 16 +-- basis/cocoa/messages/messages.factor | 117 +++++++++++---------- basis/tools/deploy/test/14/14.factor | 4 +- basis/ui/backend/cocoa/cocoa.factor | 2 +- basis/ui/backend/cocoa/tools/tools.factor | 39 +++---- basis/ui/backend/cocoa/views/views.factor | 120 +++++++++++----------- 7 files changed, 157 insertions(+), 145 deletions(-) diff --git a/basis/cocoa/callbacks/callbacks.factor b/basis/cocoa/callbacks/callbacks.factor index a798eb15ba..e1ec43f1dc 100644 --- a/basis/cocoa/callbacks/callbacks.factor +++ b/basis/cocoa/callbacks/callbacks.factor @@ -16,11 +16,11 @@ CLASS: { { +superclass+ "NSObject" } } -{ "perform:" "void" { "id" "SEL" "id" } +{ "perform:" void { id SEL id } [ 2drop callbacks get at try ] } -{ "dealloc" "void" { "id" "SEL" } +{ "dealloc" void { id SEL } [ drop dup callbacks get delete-at diff --git a/basis/cocoa/cocoa-tests.factor b/basis/cocoa/cocoa-tests.factor index c657a5e6e8..47e9cd8d55 100644 --- a/basis/cocoa/cocoa-tests.factor +++ b/basis/cocoa/cocoa-tests.factor @@ -8,8 +8,8 @@ CLASS: { { +name+ "Foo" } } { "foo:" - "void" - { "id" "SEL" "NSRect" } + void + { id SEL NSRect } [ gc "x" set 2drop ] } ; @@ -30,8 +30,8 @@ CLASS: { { +name+ "Bar" } } { "bar" - "NSRect" - { "id" "SEL" } + NSRect + { id SEL } [ 2drop test-foo "x" get ] } ; @@ -52,13 +52,13 @@ CLASS: { { +name+ "Bar" } } { "bar" - "NSRect" - { "id" "SEL" } + NSRect + { id SEL } [ 2drop test-foo "x" get ] } { "babb" - "int" - { "id" "SEL" "int" } + int + { id SEL int } [ 2nip sq ] } ; diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index c0d8939a7a..fce7adc04a 100755 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -2,10 +2,12 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types alien.strings arrays assocs classes.struct continuations combinators compiler compiler.alien -stack-checker kernel math namespaces make quotations sequences -strings words cocoa.runtime io macros memoize io.encodings.utf8 -effects libc libc.private lexer init core-foundation fry -generalizations specialized-arrays ; +core-graphics.types stack-checker kernel math namespaces make +quotations sequences strings words cocoa.runtime cocoa.types io +macros memoize io.encodings.utf8 effects layouts libc +libc.private lexer init core-foundation fry generalizations +specialized-arrays ; +QUALIFIED-WITH: alien.c-types c IN: cocoa.messages SPECIALIZED-ARRAY: void* @@ -98,75 +100,84 @@ class-init-hooks [ H{ } clone ] initialize SYMBOL: objc>alien-types H{ - { "c" "char" } - { "i" "int" } - { "s" "short" } - { "C" "uchar" } - { "I" "uint" } - { "S" "ushort" } - { "f" "float" } - { "d" "double" } - { "B" "bool" } - { "v" "void" } - { "*" "char*" } - { "?" "unknown_type" } - { "@" "id" } - { "#" "Class" } - { ":" "SEL" } + { "c" c:char } + { "i" c:int } + { "s" c:short } + { "C" c:uchar } + { "I" c:uint } + { "S" c:ushort } + { "f" c:float } + { "d" c:double } + { "B" c:bool } + { "v" c:void } + { "*" c:char* } + { "?" unknown_type } + { "@" id } + { "#" Class } + { ":" SEL } } -"ptrdiff_t" heap-size { +cell { { 4 [ H{ - { "l" "long" } - { "q" "longlong" } - { "L" "ulong" } - { "Q" "ulonglong" } + { "l" c:long } + { "q" c:longlong } + { "L" c:ulong } + { "Q" c:ulonglong } } ] } { 8 [ H{ - { "l" "long32" } - { "q" "long" } - { "L" "ulong32" } - { "Q" "ulong" } + { "l" long32 } + { "q" long } + { "L" ulong32 } + { "Q" ulong } } ] } } case assoc-union objc>alien-types set-global +SYMBOL: objc>struct-types + +H{ + { "_NSPoint" NSPoint } + { "NSPoint" NSPoint } + { "CGPoint" NSPoint } + { "_NSRect" NSRect } + { "NSRect" NSRect } + { "CGRect" NSRect } + { "_NSSize" NSSize } + { "NSSize" NSSize } + { "CGSize" NSSize } + { "_NSRange" NSRange } + { "NSRange" NSRange } +} objc>struct-types set-global + ! The transpose of the above map SYMBOL: alien>objc-types objc>alien-types get [ swap ] assoc-map ! A hack... -"ptrdiff_t" heap-size { +cell { { 4 [ H{ - { "NSPoint" "{_NSPoint=ff}" } - { "NSRect" "{_NSRect={_NSPoint=ff}{_NSSize=ff}}" } - { "NSSize" "{_NSSize=ff}" } - { "NSRange" "{_NSRange=II}" } - { "NSInteger" "i" } - { "NSUInteger" "I" } - { "CGFloat" "f" } + { NSPoint "{_NSPoint=ff}" } + { NSRect "{_NSRect={_NSPoint=ff}{_NSSize=ff}}" } + { NSSize "{_NSSize=ff}" } + { NSRange "{_NSRange=II}" } + { NSInteger "i" } + { NSUInteger "I" } + { CGFloat "f" } } ] } { 8 [ H{ - { "NSPoint" "{CGPoint=dd}" } - { "NSRect" "{CGRect={CGPoint=dd}{CGSize=dd}}" } - { "NSSize" "{CGSize=dd}" } - { "NSRange" "{_NSRange=QQ}" } - { "NSInteger" "q" } - { "NSUInteger" "Q" } - { "CGFloat" "d" } + { NSPoint "{CGPoint=dd}" } + { NSRect "{CGRect={CGPoint=dd}{CGSize=dd}}" } + { NSSize "{CGSize=dd}" } + { NSRange "{_NSRange=QQ}" } + { NSInteger "q" } + { NSUInteger "Q" } + { CGFloat "d" } } ] } } case assoc-union alien>objc-types set-global -: internal-cocoa-type? ( c-type -- ? ) - [ "?" = ] [ first CHAR: _ = ] bi or ; - -: warn-c-type ( c-type -- ) - dup internal-cocoa-type? - [ drop ] [ "Warning: no such C type: " write print ] if ; - : objc-struct-type ( i string -- ctype ) [ CHAR: = ] 2keep index-from swap subseq - dup c-types get key? [ warn-c-type "void*" ] unless ; + objc>struct-types get at* [ drop void* ] unless ; ERROR: no-objc-type name ; @@ -177,9 +188,9 @@ ERROR: no-objc-type name ; : (parse-objc-type) ( i string -- ctype ) [ [ 1 + ] dip ] [ nth ] 2bi { { [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] } - { [ dup CHAR: ^ = ] [ 3drop "void*" ] } + { [ dup CHAR: ^ = ] [ 3drop void* ] } { [ dup CHAR: { = ] [ drop objc-struct-type ] } - { [ dup CHAR: [ = ] [ 3drop "void*" ] } + { [ dup CHAR: [ = ] [ 3drop void* ] } [ 2nip decode-type ] } cond ; diff --git a/basis/tools/deploy/test/14/14.factor b/basis/tools/deploy/test/14/14.factor index d6caa0e68b..c1079ccb93 100644 --- a/basis/tools/deploy/test/14/14.factor +++ b/basis/tools/deploy/test/14/14.factor @@ -9,8 +9,8 @@ CLASS: { { +name+ "Bar" } } { "bar:" - "float" - { "id" "SEL" "NSRect" } + float + { id SEL NSRect } [ [ origin>> [ x>> ] [ y>> ] bi + ] [ size>> [ w>> ] [ h>> ] bi + ] diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index 0213b8433c..a262b549f2 100755 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -218,7 +218,7 @@ CLASS: { { +name+ "FactorApplicationDelegate" } } -{ "applicationDidUpdate:" "void" { "id" "SEL" "id" } +{ "applicationDidUpdate:" void { id SEL id } [ 3drop reset-run-loop ] } ; diff --git a/basis/ui/backend/cocoa/tools/tools.factor b/basis/ui/backend/cocoa/tools/tools.factor index b8c01f0bd9..d04bcededa 100644 --- a/basis/ui/backend/cocoa/tools/tools.factor +++ b/basis/ui/backend/cocoa/tools/tools.factor @@ -1,11 +1,12 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax cocoa cocoa.nibs cocoa.application -cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.subclassing -core-foundation core-foundation.strings help.topics kernel -memory namespaces parser system ui ui.tools.browser -ui.tools.listener ui.backend.cocoa eval locals -vocabs.refresh ; +cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.runtime +cocoa.subclassing core-foundation core-foundation.strings +help.topics kernel memory namespaces parser system ui +ui.tools.browser ui.tools.listener ui.backend.cocoa eval +locals vocabs.refresh ; +FROM: alien.c-types => int void ; IN: ui.backend.cocoa.tools : finder-run-files ( alien -- ) @@ -25,43 +26,43 @@ CLASS: { { +name+ "FactorWorkspaceApplicationDelegate" } } -{ "application:openFiles:" "void" { "id" "SEL" "id" "id" } +{ "application:openFiles:" void { id SEL id id } [ [ 3drop ] dip finder-run-files ] } -{ "applicationShouldHandleReopen:hasVisibleWindows:" "int" { "id" "SEL" "id" "int" } +{ "applicationShouldHandleReopen:hasVisibleWindows:" int { id SEL id int } [ [ 3drop ] dip 0 = [ show-listener ] when 1 ] } -{ "factorListener:" "id" { "id" "SEL" "id" } +{ "factorListener:" id { id SEL id } [ 3drop show-listener f ] } -{ "factorBrowser:" "id" { "id" "SEL" "id" } +{ "factorBrowser:" id { id SEL id } [ 3drop show-browser f ] } -{ "newFactorListener:" "id" { "id" "SEL" "id" } +{ "newFactorListener:" id { id SEL id } [ 3drop listener-window f ] } -{ "newFactorBrowser:" "id" { "id" "SEL" "id" } +{ "newFactorBrowser:" id { id SEL id } [ 3drop browser-window f ] } -{ "runFactorFile:" "id" { "id" "SEL" "id" } +{ "runFactorFile:" id { id SEL id } [ 3drop menu-run-files f ] } -{ "saveFactorImage:" "id" { "id" "SEL" "id" } +{ "saveFactorImage:" id { id SEL id } [ 3drop save f ] } -{ "saveFactorImageAs:" "id" { "id" "SEL" "id" } +{ "saveFactorImageAs:" id { id SEL id } [ 3drop menu-save-image f ] } -{ "refreshAll:" "id" { "id" "SEL" "id" } +{ "refreshAll:" id { id SEL id } [ 3drop [ refresh-all ] \ refresh-all call-listener f ] } ; @@ -79,13 +80,13 @@ CLASS: { { +name+ "FactorServiceProvider" } } { "evalInListener:userData:error:" - "void" - { "id" "SEL" "id" "id" "id" } + void + { id SEL id id id } [ nip [ eval-listener f ] do-service 2drop ] } { "evalToString:userData:error:" - "void" - { "id" "SEL" "id" "id" "id" } + void + { id SEL id id id } [ nip [ eval>string ] do-service 2drop ] } ; diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 9577696314..88e5f243ad 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -3,8 +3,8 @@ USING: accessors alien alien.c-types alien.data alien.strings arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes cocoa.views cocoa.application cocoa.pasteboard -cocoa.types cocoa.windows sequences io.encodings.utf8 ui ui.private -ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures +cocoa.runtime cocoa.types cocoa.windows sequences io.encodings.utf8 +ui ui.private ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures core-foundation.strings core-graphics core-graphics.types threads combinators math.rectangles ; IN: ui.backend.cocoa.views @@ -148,76 +148,76 @@ CLASS: { } ! Rendering -{ "drawRect:" "void" { "id" "SEL" "NSRect" } +{ "drawRect:" void { id SEL NSRect } [ 2drop window relayout-1 yield ] } ! Events -{ "acceptsFirstMouse:" "char" { "id" "SEL" "id" } +{ "acceptsFirstMouse:" char { id SEL id } [ 3drop 1 ] } -{ "mouseEntered:" "void" { "id" "SEL" "id" } +{ "mouseEntered:" void { id SEL id } [ nip send-mouse-moved ] } -{ "mouseExited:" "void" { "id" "SEL" "id" } +{ "mouseExited:" void { id SEL id } [ 3drop forget-rollover ] } -{ "mouseMoved:" "void" { "id" "SEL" "id" } +{ "mouseMoved:" void { id SEL id } [ nip send-mouse-moved ] } -{ "mouseDragged:" "void" { "id" "SEL" "id" } +{ "mouseDragged:" void { id SEL id } [ nip send-mouse-moved ] } -{ "rightMouseDragged:" "void" { "id" "SEL" "id" } +{ "rightMouseDragged:" void { id SEL id } [ nip send-mouse-moved ] } -{ "otherMouseDragged:" "void" { "id" "SEL" "id" } +{ "otherMouseDragged:" void { id SEL id } [ nip send-mouse-moved ] } -{ "mouseDown:" "void" { "id" "SEL" "id" } +{ "mouseDown:" void { id SEL id } [ nip send-button-down$ ] } -{ "mouseUp:" "void" { "id" "SEL" "id" } +{ "mouseUp:" void { id SEL id } [ nip send-button-up$ ] } -{ "rightMouseDown:" "void" { "id" "SEL" "id" } +{ "rightMouseDown:" void { id SEL id } [ nip send-button-down$ ] } -{ "rightMouseUp:" "void" { "id" "SEL" "id" } +{ "rightMouseUp:" void { id SEL id } [ nip send-button-up$ ] } -{ "otherMouseDown:" "void" { "id" "SEL" "id" } +{ "otherMouseDown:" void { id SEL id } [ nip send-button-down$ ] } -{ "otherMouseUp:" "void" { "id" "SEL" "id" } +{ "otherMouseUp:" void { id SEL id } [ nip send-button-up$ ] } -{ "scrollWheel:" "void" { "id" "SEL" "id" } +{ "scrollWheel:" void { id SEL id } [ nip send-wheel$ ] } -{ "keyDown:" "void" { "id" "SEL" "id" } +{ "keyDown:" void { id SEL id } [ nip send-key-down-event ] } -{ "keyUp:" "void" { "id" "SEL" "id" } +{ "keyUp:" void { id SEL id } [ nip send-key-up-event ] } -{ "validateUserInterfaceItem:" "char" { "id" "SEL" "id" } +{ "validateUserInterfaceItem:" char { id SEL id } [ nip -> action 2dup [ window ] [ utf8 alien>string ] bi* validate-action @@ -225,57 +225,57 @@ CLASS: { ] } -{ "undo:" "id" { "id" "SEL" "id" } +{ "undo:" id { id SEL id } [ nip undo-action send-action$ ] } -{ "redo:" "id" { "id" "SEL" "id" } +{ "redo:" id { id SEL id } [ nip redo-action send-action$ ] } -{ "cut:" "id" { "id" "SEL" "id" } +{ "cut:" id { id SEL id } [ nip cut-action send-action$ ] } -{ "copy:" "id" { "id" "SEL" "id" } +{ "copy:" id { id SEL id } [ nip copy-action send-action$ ] } -{ "paste:" "id" { "id" "SEL" "id" } +{ "paste:" id { id SEL id } [ nip paste-action send-action$ ] } -{ "delete:" "id" { "id" "SEL" "id" } +{ "delete:" id { id SEL id } [ nip delete-action send-action$ ] } -{ "selectAll:" "id" { "id" "SEL" "id" } +{ "selectAll:" id { id SEL id } [ nip select-all-action send-action$ ] } -{ "newDocument:" "id" { "id" "SEL" "id" } +{ "newDocument:" id { id SEL id } [ nip new-action send-action$ ] } -{ "openDocument:" "id" { "id" "SEL" "id" } +{ "openDocument:" id { id SEL id } [ nip open-action send-action$ ] } -{ "saveDocument:" "id" { "id" "SEL" "id" } +{ "saveDocument:" id { id SEL id } [ nip save-action send-action$ ] } -{ "saveDocumentAs:" "id" { "id" "SEL" "id" } +{ "saveDocumentAs:" id { id SEL id } [ nip save-as-action send-action$ ] } -{ "revertDocumentToSaved:" "id" { "id" "SEL" "id" } +{ "revertDocumentToSaved:" id { id SEL id } [ nip revert-action send-action$ ] } ! Multi-touch gestures: this is undocumented. ! http://cocoadex.com/2008/02/nsevent-modifications-swipe-ro.html -{ "magnifyWithEvent:" "void" { "id" "SEL" "id" } +{ "magnifyWithEvent:" void { id SEL id } [ nip dup -> deltaZ sgn { @@ -286,7 +286,7 @@ CLASS: { ] } -{ "swipeWithEvent:" "void" { "id" "SEL" "id" } +{ "swipeWithEvent:" void { id SEL id } [ nip dup -> deltaX sgn { @@ -305,14 +305,14 @@ CLASS: { ] } -! "rotateWithEvent:" "void" { "id" "SEL" "id" }} +! "rotateWithEvent:" void { id SEL id }} -{ "acceptsFirstResponder" "char" { "id" "SEL" } +{ "acceptsFirstResponder" char { id SEL } [ 2drop 1 ] } ! Services -{ "validRequestorForSendType:returnType:" "id" { "id" "SEL" "id" "id" } +{ "validRequestorForSendType:returnType:" id { id SEL id id } [ ! We return either self or nil [ over window-focus ] 2dip @@ -320,7 +320,7 @@ CLASS: { ] } -{ "writeSelectionToPasteboard:types:" "char" { "id" "SEL" "id" "id" } +{ "writeSelectionToPasteboard:types:" char { id SEL id id } [ CF>string-array NSStringPboardType swap member? [ [ drop window-focus gadget-selection ] dip over @@ -329,7 +329,7 @@ CLASS: { ] } -{ "readSelectionFromPasteboard:" "char" { "id" "SEL" "id" } +{ "readSelectionFromPasteboard:" char { id SEL id } [ pasteboard-string dup [ [ drop window ] dip swap user-input 1 @@ -338,60 +338,60 @@ CLASS: { } ! Text input -{ "insertText:" "void" { "id" "SEL" "id" } +{ "insertText:" void { id SEL id } [ nip CF>string swap window user-input ] } -{ "hasMarkedText" "char" { "id" "SEL" } +{ "hasMarkedText" char { id SEL } [ 2drop 0 ] } -{ "markedRange" "NSRange" { "id" "SEL" } +{ "markedRange" NSRange { id SEL } [ 2drop 0 0 ] } -{ "selectedRange" "NSRange" { "id" "SEL" } +{ "selectedRange" NSRange { id SEL } [ 2drop 0 0 ] } -{ "setMarkedText:selectedRange:" "void" { "id" "SEL" "id" "NSRange" } +{ "setMarkedText:selectedRange:" void { id SEL id NSRange } [ 2drop 2drop ] } -{ "unmarkText" "void" { "id" "SEL" } +{ "unmarkText" void { id SEL } [ 2drop ] } -{ "validAttributesForMarkedText" "id" { "id" "SEL" } +{ "validAttributesForMarkedText" id { id SEL } [ 2drop NSArray -> array ] } -{ "attributedSubstringFromRange:" "id" { "id" "SEL" "NSRange" } +{ "attributedSubstringFromRange:" id { id SEL NSRange } [ 3drop f ] } -{ "characterIndexForPoint:" "NSUInteger" { "id" "SEL" "NSPoint" } +{ "characterIndexForPoint:" NSUInteger { id SEL NSPoint } [ 3drop 0 ] } -{ "firstRectForCharacterRange:" "NSRect" { "id" "SEL" "NSRange" } +{ "firstRectForCharacterRange:" NSRect { id SEL NSRange } [ 3drop 0 0 0 0 ] } -{ "conversationIdentifier" "NSInteger" { "id" "SEL" } +{ "conversationIdentifier" NSInteger { id SEL } [ drop alien-address ] } ! Initialization -{ "updateFactorGadgetSize:" "void" { "id" "SEL" "id" } +{ "updateFactorGadgetSize:" void { id SEL id } [ 2drop [ window ] [ view-dim ] bi >>dim drop yield ] } -{ "doCommandBySelector:" "void" { "id" "SEL" "SEL" } +{ "doCommandBySelector:" void { id SEL SEL } [ 3drop ] } -{ "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" } +{ "initWithFrame:pixelFormat:" id { id SEL NSRect id } [ [ drop ] 2dip SUPER-> initWithFrame:pixelFormat: @@ -399,13 +399,13 @@ CLASS: { ] } -{ "isOpaque" "char" { "id" "SEL" } +{ "isOpaque" char { id SEL } [ 2drop 0 ] } -{ "dealloc" "void" { "id" "SEL" } +{ "dealloc" void { id SEL } [ drop [ unregister-window ] @@ -430,19 +430,19 @@ CLASS: { { +name+ "FactorWindowDelegate" } } -{ "windowDidMove:" "void" { "id" "SEL" "id" } +{ "windowDidMove:" void { id SEL id } [ 2nip -> object [ -> contentView window ] keep save-position ] } -{ "windowDidBecomeKey:" "void" { "id" "SEL" "id" } +{ "windowDidBecomeKey:" void { id SEL id } [ 2nip -> object -> contentView window focus-world ] } -{ "windowDidResignKey:" "void" { "id" "SEL" "id" } +{ "windowDidResignKey:" void { id SEL id } [ forget-rollover 2nip -> object -> contentView @@ -452,13 +452,13 @@ CLASS: { ] } -{ "windowShouldClose:" "char" { "id" "SEL" "id" } +{ "windowShouldClose:" char { id SEL id } [ 3drop 1 ] } -{ "windowWillClose:" "void" { "id" "SEL" "id" } +{ "windowWillClose:" void { id SEL id } [ 2nip -> object -> contentView window ungraft ] From f9320e229fcaaec0878a60c793882b95fe2a8a70 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 21 Oct 2009 18:19:35 -0500 Subject: [PATCH 052/109] update cocoa tests --- basis/cocoa/cocoa-tests.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/cocoa/cocoa-tests.factor b/basis/cocoa/cocoa-tests.factor index 47e9cd8d55..892d5ea38d 100644 --- a/basis/cocoa/cocoa-tests.factor +++ b/basis/cocoa/cocoa-tests.factor @@ -1,6 +1,7 @@ USING: cocoa cocoa.messages cocoa.subclassing cocoa.types -compiler kernel namespaces cocoa.classes tools.test memory -compiler.units math core-graphics.types ; +compiler kernel namespaces cocoa.classes cocoa.runtime +tools.test memory compiler.units math core-graphics.types ; +FROM: alien.c-types => int void ; IN: cocoa.tests CLASS: { From 7fac3682a64fbe6397c0604ecb1bd663f31533bf Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 21 Oct 2009 18:44:00 -0500 Subject: [PATCH 053/109] update some naked alien-invokes to use c-type words --- basis/compiler/cfg/builder/builder-tests.factor | 5 +++-- basis/compiler/tests/alien.factor | 12 ++++++------ basis/compiler/tests/codegen.factor | 6 +++--- basis/db/sqlite/ffi/ffi.factor | 8 ++++---- basis/system-info/linux/linux.factor | 2 +- 5 files changed, 17 insertions(+), 16 deletions(-) diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index d303cc597f..e3ad8e6074 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -6,6 +6,7 @@ compiler.cfg arrays locals byte-arrays kernel.private math slots.private vectors sbufs strings math.partial-dispatch hashtables assocs combinators.short-circuit strings.private accessors compiler.cfg.instructions ; +FROM: alien.c-types => int ; IN: compiler.cfg.builder.tests ! Just ensure that various CFGs build correctly. @@ -66,7 +67,7 @@ IN: compiler.cfg.builder.tests [ [ t ] loop ] [ [ dup ] loop ] [ [ 2 ] [ 3 throw ] if 4 ] - [ "int" f "malloc" { "int" } alien-invoke ] + [ int f "malloc" { int } alien-invoke ] [ "int" { "int" } "cdecl" alien-indirect ] [ "int" { "int" } "cdecl" [ ] alien-callback ] [ swap - + * ] @@ -213,4 +214,4 @@ IN: compiler.cfg.builder.tests ] when ! Regression. Make sure everything is inlined correctly -[ f ] [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test \ No newline at end of file +[ f ] [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index 1bf7a00c75..cc835a8a8f 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -122,13 +122,13 @@ unit-test [ "stdcall" ] [ "f-stdcall" library abi>> ] unit-test : ffi_test_18 ( w x y z -- int ) - "int" "f-stdcall" "ffi_test_18" { "int" "int" "int" "int" } + int "f-stdcall" "ffi_test_18" { int int int int } alien-invoke gc ; [ 25 ] [ 2 3 4 5 ffi_test_18 ] unit-test : ffi_test_19 ( x y z -- BAR ) - "BAR" "f-stdcall" "ffi_test_19" { "long" "long" "long" } + BAR "f-stdcall" "ffi_test_19" { long long long } alien-invoke gc ; [ 11 6 -7 ] [ @@ -157,17 +157,17 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3, ! Make sure XT doesn't get clobbered in stack frame : ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y ) - "int" + int "f-cdecl" "ffi_test_31" - { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" } + { int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int } alien-invoke gc 3 ; [ 861 3 ] [ 42 [ ] each ffi_test_31 ] unit-test : ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result ) - "float" + float "f-cdecl" "ffi_test_31_point_5" - { "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" } + { float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float } alien-invoke ; [ 861.0 ] [ 42 [ >float ] each ffi_test_31_point_5 ] unit-test diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index 141fc24309..18f3a618f6 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -270,8 +270,8 @@ TUPLE: id obj ; { float } declare dup 0 = [ drop 1 ] [ dup 0 >= - [ 2 "double" "libm" "pow" { "double" "double" } alien-invoke ] - [ -0.5 "double" "libm" "pow" { "double" "double" } alien-invoke ] + [ 2 double "libm" "pow" { double double } alien-invoke ] + [ -0.5 double "libm" "pow" { double double } alien-invoke ] if ] if ; @@ -475,4 +475,4 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read- [ 2 0 ] [ 1 1 [ [ HEX: f bitand ] bi@ [ shift ] [ drop -3 shift ] 2bi ] compile-call -] unit-test \ No newline at end of file +] unit-test diff --git a/basis/db/sqlite/ffi/ffi.factor b/basis/db/sqlite/ffi/ffi.factor index 61394391a0..2f7bec1b54 100644 --- a/basis/db/sqlite/ffi/ffi.factor +++ b/basis/db/sqlite/ffi/ffi.factor @@ -120,8 +120,8 @@ FUNCTION: int sqlite3_bind_int ( sqlite3_stmt* pStmt, int index, int n ) ; FUNCTION: int sqlite3_bind_int64 ( sqlite3_stmt* pStmt, int index, sqlite3_int64 n ) ; ! Bind the same function as above, but for unsigned 64bit integers : sqlite3-bind-uint64 ( pStmt index in64 -- int ) - "int" "sqlite" "sqlite3_bind_int64" - { "sqlite3_stmt*" "int" "sqlite3_uint64" } alien-invoke ; + int "sqlite" "sqlite3_bind_int64" + { sqlite3_stmt* int sqlite3_uint64 } alien-invoke ; FUNCTION: int sqlite3_bind_null ( sqlite3_stmt* pStmt, int n ) ; FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, char* text, int len, int destructor ) ; FUNCTION: int sqlite3_bind_parameter_index ( sqlite3_stmt* pStmt, char* name ) ; @@ -134,8 +134,8 @@ FUNCTION: int sqlite3_column_int ( sqlite3_stmt* pStmt, int col ) ; FUNCTION: sqlite3_int64 sqlite3_column_int64 ( sqlite3_stmt* pStmt, int col ) ; ! Bind the same function as above, but for unsigned 64bit integers : sqlite3-column-uint64 ( pStmt col -- uint64 ) - "sqlite3_uint64" "sqlite" "sqlite3_column_int64" - { "sqlite3_stmt*" "int" } alien-invoke ; + sqlite3_uint64 "sqlite" "sqlite3_column_int64" + { sqlite3_stmt* int } alien-invoke ; FUNCTION: double sqlite3_column_double ( sqlite3_stmt* pStmt, int col ) ; FUNCTION: char* sqlite3_column_name ( sqlite3_stmt* pStmt, int col ) ; FUNCTION: char* sqlite3_column_text ( sqlite3_stmt* pStmt, int col ) ; diff --git a/basis/system-info/linux/linux.factor b/basis/system-info/linux/linux.factor index 5f83eb268b..0c21597a2f 100644 --- a/basis/system-info/linux/linux.factor +++ b/basis/system-info/linux/linux.factor @@ -7,7 +7,7 @@ SPECIALIZED-ARRAY: char IN: system-info.linux : (uname) ( buf -- int ) - "int" f "uname" { "char*" } alien-invoke ; + int f "uname" { char* } alien-invoke ; : uname ( -- seq ) 65536 [ (uname) io-error ] keep From af855b7fa9ec681ae056395047cc4929de80b06c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Oct 2009 19:41:54 -0500 Subject: [PATCH 054/109] vm: debugging mark-sweep --- vm/aging_collector.cpp | 3 ++- vm/data_heap.cpp | 34 +++++++++++++++++++++++++++++++++- vm/data_heap.hpp | 28 +++------------------------- vm/free_list_allocator.hpp | 23 +++++++++++++---------- vm/full_collector.cpp | 25 +++++++++++++++++++------ vm/layouts.hpp | 25 +++++++++++-------------- vm/mark_bits.hpp | 5 ----- vm/nursery_collector.cpp | 2 +- vm/tenured_space.hpp | 5 +++++ vm/to_tenured_collector.cpp | 9 +++++---- 10 files changed, 92 insertions(+), 67 deletions(-) diff --git a/vm/aging_collector.cpp b/vm/aging_collector.cpp index 2972528cb3..d33823b624 100644 --- a/vm/aging_collector.cpp +++ b/vm/aging_collector.cpp @@ -40,9 +40,10 @@ void factor_vm::collect_aging() collector.trace_contexts(); collector.trace_code_heap_roots(&code->points_to_aging); collector.cheneys_algorithm(); + update_code_heap_for_minor_gc(&code->points_to_aging); - nursery.here = nursery.start; + data->reset_generation(&nursery); code->points_to_nursery.clear(); } } diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 7c887c7419..915ed8e32a 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -65,11 +65,43 @@ data_heap *data_heap::grow(cell requested_bytes) return new data_heap(young_size,aging_size,new_tenured_size); } +template void data_heap::clear_cards(Generation *gen) +{ + cell first_card = addr_to_card(gen->start - start); + cell last_card = addr_to_card(gen->end - start); + memset(&cards[first_card],0,last_card - first_card); +} + +template void data_heap::clear_decks(Generation *gen) +{ + cell first_deck = addr_to_deck(gen->start - start); + cell last_deck = addr_to_deck(gen->end - start); + memset(&decks[first_deck],0,last_deck - first_deck); +} + +void data_heap::reset_generation(nursery_space *gen) +{ + gen->here = gen->start; +} + +void data_heap::reset_generation(aging_space *gen) +{ + gen->here = gen->start; + clear_cards(gen); + clear_decks(gen); + gen->starts.clear_object_start_offsets(); +} + +void data_heap::reset_generation(tenured_space *gen) +{ + clear_cards(gen); + clear_decks(gen); +} + void factor_vm::set_data_heap(data_heap *data_) { data = data_; nursery = *data->nursery; - nursery.here = nursery.start; init_card_decks(); } diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp index fe714b91b0..c8d6ce0b70 100755 --- a/vm/data_heap.hpp +++ b/vm/data_heap.hpp @@ -26,31 +26,9 @@ struct data_heap { data_heap *grow(cell requested_size); template void clear_cards(Generation *gen); template void clear_decks(Generation *gen); - template void reset_generation(Generation *gen); + void reset_generation(nursery_space *gen); + void reset_generation(aging_space *gen); + void reset_generation(tenured_space *gen); }; -template void data_heap::clear_cards(Generation *gen) -{ - cell first_card = addr_to_card(gen->start - start); - cell last_card = addr_to_card(gen->end - start); - memset(&cards[first_card],0,last_card - first_card); -} - -template void data_heap::clear_decks(Generation *gen) -{ - cell first_deck = addr_to_deck(gen->start - start); - cell last_deck = addr_to_deck(gen->end - start); - memset(&decks[first_deck],0,last_deck - first_deck); -} - -/* After garbage collection, any generations which are now empty need to have -their allocation pointers and cards reset. */ -template void data_heap::reset_generation(Generation *gen) -{ - gen->here = gen->start; - clear_cards(gen); - clear_decks(gen); - gen->starts.clear_object_start_offsets(); -} - } diff --git a/vm/free_list_allocator.hpp b/vm/free_list_allocator.hpp index c8f3bd6f47..efdad508cb 100644 --- a/vm/free_list_allocator.hpp +++ b/vm/free_list_allocator.hpp @@ -88,10 +88,12 @@ Makes a free list consisting of one free block, at the very end. */ template void free_list_allocator::build_free_list(cell size) { clear_free_list(); - free_heap_block *last_block = (free_heap_block *)(start + size); - last_block->set_free(); - last_block->set_size(end - (cell)last_block); - add_to_free_list(last_block); + if(size != this->size) + { + free_heap_block *last_block = (free_heap_block *)(start + size); + last_block->make_free(end - (cell)last_block); + add_to_free_list(last_block); + } } template void free_list_allocator::assert_free_block(free_heap_block *block) @@ -147,10 +149,9 @@ template free_heap_block *free_list_allocator::split_free { /* split the block in two */ free_heap_block *split = (free_heap_block *)((cell)block + size); - split->set_free(); - split->set_size(block->size() - size); + split->make_free(block->size() - size); split->next_free = block->next_free; - block->set_size(size); + block->make_free(size); add_to_free_list(split); } @@ -174,7 +175,7 @@ template Block *free_list_allocator::allot(cell size) template void free_list_allocator::free(Block *block) { free_heap_block *free_block = (free_heap_block *)block; - free_block->set_free(); + free_block->make_free(block->size()); add_to_free_list(free_block); } @@ -267,7 +268,8 @@ void free_list_allocator::sweep() } else { - ((free_heap_block *)scan)->set_free(); + free_heap_block *free_block = (free_heap_block *)scan; + free_block->make_free(size); prev = scan; } } @@ -319,7 +321,8 @@ void free_list_allocator::sweep(Iterator &iter) } else { - scan->set_free(); + free_heap_block *free_block = (free_heap_block *)scan; + free_block->make_free(size); prev = scan; } } diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 9191823d75..817908ece5 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -108,12 +108,24 @@ void full_collector::mark_reachable_objects() } } +struct object_start_map_updater { + object_start_map *starts; + + object_start_map_updater(object_start_map *starts_) : starts(starts_) {} + + void operator()(object *obj, cell size) + { + starts->record_object_start_offset(obj); + } +}; + void factor_vm::collect_full_impl(bool trace_contexts_p) { full_collector collector(this); code->clear_mark_bits(); data->tenured->clear_mark_bits(); + data->tenured->clear_mark_stack(); collector.trace_roots(); if(trace_contexts_p) @@ -125,9 +137,14 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) collector.mark_reachable_objects(); - data->tenured->sweep(); + data->tenured->starts.clear_object_start_offsets(); + object_start_map_updater updater(&data->tenured->starts); + data->tenured->sweep(updater); + + data->reset_generation(data->tenured); data->reset_generation(data->aging); - nursery.here = nursery.start; + data->reset_generation(&nursery); + code->clear_remembered_set(); } void factor_vm::collect_growing_heap(cell requested_bytes, @@ -144,8 +161,6 @@ void factor_vm::collect_growing_heap(cell requested_bytes, compact_code_heap(trace_contexts_p); else relocate_code_heap(); - - code->clear_remembered_set(); } void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p) @@ -156,8 +171,6 @@ void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p) compact_code_heap(trace_contexts_p); else update_code_heap_words_and_literals(); - - code->clear_remembered_set(); } } diff --git a/vm/layouts.hpp b/vm/layouts.hpp index ca51fd6dca..76581621ca 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -58,8 +58,6 @@ static const cell data_alignment = 16; #define TYPE_COUNT 15 -/* Not real types, but code_block's type can be set to this */ - enum code_block_type { code_block_unoptimized, @@ -229,30 +227,29 @@ struct heap_block return header & 1 == 1; } - void set_free() - { - header |= 1; - } - - void clear_free() - { - header &= ~1; - } - cell size() { - return header >> 3; + cell bytes = header >> 3; +#ifdef FACTOR_DEBUG + assert(bytes > 0); +#endif + return bytes; } void set_size(cell size) { - header = (header & 0x7) | (size << 3); + header = ((header & 0x7) | (size << 3)); } }; struct free_heap_block : public heap_block { free_heap_block *next_free; + + void make_free(cell size) + { + header = (size << 3) | 1; + } }; struct code_block : public heap_block diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index 44f8b17e35..161a7fd755 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -55,11 +55,6 @@ template struct mark_bits { cell line_number = block_line(address); cell word_index = (line_number >> 6); cell word_shift = (line_number & 63); - -#ifdef FACTOR_DEBUG - assert(word_index < bits_size); -#endif - return std::make_pair(word_index,word_shift); } diff --git a/vm/nursery_collector.cpp b/vm/nursery_collector.cpp index 909cde02f8..07f9666f37 100644 --- a/vm/nursery_collector.cpp +++ b/vm/nursery_collector.cpp @@ -28,7 +28,7 @@ void factor_vm::collect_nursery() collector.cheneys_algorithm(); update_code_heap_for_minor_gc(&code->points_to_nursery); - nursery.here = nursery.start; + data->reset_generation(&nursery); code->points_to_nursery.clear(); } diff --git a/vm/tenured_space.hpp b/vm/tenured_space.hpp index c0c12d3f58..7cc4131fa0 100644 --- a/vm/tenured_space.hpp +++ b/vm/tenured_space.hpp @@ -51,6 +51,11 @@ struct tenured_space : free_list_allocator { state.clear_mark_bits(); } + void clear_mark_stack() + { + mark_stack.clear(); + } + bool marked_p(object *obj) { return this->state.marked_p(obj); diff --git a/vm/to_tenured_collector.cpp b/vm/to_tenured_collector.cpp index 3150647cd2..ea7cb8ed72 100644 --- a/vm/to_tenured_collector.cpp +++ b/vm/to_tenured_collector.cpp @@ -26,19 +26,20 @@ void factor_vm::collect_to_tenured() /* Copy live objects from aging space to tenured space. */ to_tenured_collector collector(this); + data->tenured->clear_mark_stack(); + collector.trace_roots(); collector.trace_contexts(); collector.trace_cards(data->tenured, card_points_to_aging, - dummy_unmarker()); + simple_unmarker(card_mark_mask)); collector.trace_code_heap_roots(&code->points_to_aging); collector.tenure_reachable_objects(); update_code_heap_for_minor_gc(&code->points_to_aging); - nursery.here = nursery.start; + data->reset_generation(&nursery); data->reset_generation(data->aging); - code->points_to_nursery.clear(); - code->points_to_aging.clear(); + code->clear_remembered_set(); } } From 40351d40be3d880a62003e3a7b3075ca2b1edc4c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Oct 2009 20:12:57 -0500 Subject: [PATCH 055/109] vm: use iostreams instead of printf for debug messages, clean up a few things --- vm/code_block.cpp | 10 +-- vm/collector.hpp | 2 +- vm/data_heap.cpp | 2 +- vm/debug.cpp | 208 ++++++++++++++++++++++---------------------- vm/errors.cpp | 20 +++-- vm/factor.cpp | 9 +- vm/gc.cpp | 11 ++- vm/image.cpp | 26 ++---- vm/image.hpp | 1 + vm/inline_cache.cpp | 8 +- vm/jit.hpp | 2 +- vm/layouts.hpp | 44 +++++----- vm/master.hpp | 1 + vm/os-windows.hpp | 2 - vm/quotations.cpp | 4 +- vm/strings.cpp | 8 +- vm/strings.hpp | 2 +- vm/tagged.hpp | 2 +- vm/utilities.cpp | 32 ------- vm/utilities.hpp | 5 -- vm/vm.hpp | 8 +- 21 files changed, 191 insertions(+), 216 deletions(-) diff --git a/vm/code_block.cpp b/vm/code_block.cpp index 1c15f23382..687bbcf500 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -286,7 +286,7 @@ struct literal_references_updater { if(parent->relocation_type_of(rel) == RT_IMMEDIATE) { cell offset = parent->relocation_offset_of(rel) + (cell)(compiled + 1); - array *literals = parent->untag(compiled->literals); + array *literals = untag(compiled->literals); fixnum absolute_value = array_nth(literals,index); parent->store_address_in_code_block(parent->relocation_class_of(rel),offset,absolute_value); } @@ -457,10 +457,10 @@ code_block *factor_vm::allot_code_block(cell size, code_block_type type) cell used, total_free, max_free; code->allocator->usage(&used,&total_free,&max_free); - print_string("Code heap stats:\n"); - print_string("Used: "); print_cell(used); nl(); - print_string("Total free space: "); print_cell(total_free); nl(); - print_string("Largest free block: "); print_cell(max_free); nl(); + std::cout << "Code heap stats:\n"; + std::cout << "Used: " << used << "\n"; + std::cout << "Total free space: " << total_free << "\n"; + std::cout << "Largest free block: " << max_free << "\n"; fatal_error("Out of memory in add-compiled-block",0); } } diff --git a/vm/collector.hpp b/vm/collector.hpp index bc04ee4de7..4479fc7b45 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -38,7 +38,7 @@ template struct collector { if(immediate_p(pointer)) return; - object *untagged = parent->untag(pointer); + object *untagged = untag(pointer); if(!policy.should_copy_p(untagged)) { policy.visited_object(untagged); diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 915ed8e32a..6178dc8861 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -120,7 +120,7 @@ cell factor_vm::object_size(cell tagged) } /* Size of the object pointed to by an untagged pointer */ -cell object::size() +cell object::size() const { if(free_p()) return ((free_heap_block *)this)->size(); diff --git a/vm/debug.cpp b/vm/debug.cpp index afc0b43f7a..b37a7e6f82 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -3,36 +3,31 @@ namespace factor { -void factor_vm::print_chars(string* str) +std::ostream &operator<<(std::ostream &out, const string *str) { - cell i; - for(i = 0; i < string_capacity(str); i++) - putchar(string_nth(str,i)); + for(cell i = 0; i < string_capacity(str); i++) + out << (char)str->nth(i); + return out; } void factor_vm::print_word(word* word, cell nesting) { if(tagged(word->vocabulary).type_p(STRING_TYPE)) - { - print_chars(untag(word->vocabulary)); - print_string(":"); - } + std::cout << untag(word->vocabulary) << ":"; if(tagged(word->name).type_p(STRING_TYPE)) - print_chars(untag(word->name)); + std::cout << untag(word->name); else { - print_string("#name,nesting); - print_string(">"); + std::cout << ">"; } } -void factor_vm::print_factor_string(string* str) +void factor_vm::print_factor_string(string *str) { - putchar('"'); - print_chars(str); - putchar('"'); + std::cout << '"' << str << '"'; } void factor_vm::print_array(array* array, cell nesting) @@ -51,12 +46,12 @@ void factor_vm::print_array(array* array, cell nesting) for(i = 0; i < length; i++) { - print_string(" "); + std::cout << " "; print_nested_obj(array_nth(array,i),nesting); } if(trimmed) - print_string("..."); + std::cout << "..."; } void factor_vm::print_tuple(tuple *tuple, cell nesting) @@ -64,12 +59,10 @@ void factor_vm::print_tuple(tuple *tuple, cell nesting) tuple_layout *layout = untag(tuple->layout); cell length = to_fixnum(layout->size); - print_string(" "); + std::cout << " "; print_nested_obj(layout->klass,nesting); - cell i; bool trimmed; - if(length > 10 && !full_output) { trimmed = true; @@ -78,21 +71,21 @@ void factor_vm::print_tuple(tuple *tuple, cell nesting) else trimmed = false; - for(i = 0; i < length; i++) + for(cell i = 0; i < length; i++) { - print_string(" "); + std::cout << " "; print_nested_obj(tuple->data()[i],nesting); } if(trimmed) - print_string("..."); + std::cout << "..."; } void factor_vm::print_nested_obj(cell obj, fixnum nesting) { if(nesting <= 0 && !full_output) { - print_string(" ... "); + std::cout << " ... "; return; } @@ -101,7 +94,7 @@ void factor_vm::print_nested_obj(cell obj, fixnum nesting) switch(tagged(obj).type()) { case FIXNUM_TYPE: - print_fixnum(untag_fixnum(obj)); + std::cout << untag_fixnum(obj); break; case WORD_TYPE: print_word(untag(obj),nesting - 1); @@ -110,30 +103,27 @@ void factor_vm::print_nested_obj(cell obj, fixnum nesting) print_factor_string(untag(obj)); break; case F_TYPE: - print_string("f"); + std::cout << "f"; break; case TUPLE_TYPE: - print_string("T{"); + std::cout << "T{"; print_tuple(untag(obj),nesting - 1); - print_string(" }"); + std::cout << " }"; break; case ARRAY_TYPE: - print_string("{"); + std::cout << "{"; print_array(untag(obj),nesting - 1); - print_string(" }"); + std::cout << " }"; break; case QUOTATION_TYPE: - print_string("["); + std::cout << "["; quot = untag(obj); print_array(untag(quot->array),nesting - 1); - print_string(" ]"); + std::cout << " ]"; break; default: - print_string("#(obj).type()); - print_string(" @ "); - print_cell_hex(obj); - print_string(">"); + std::cout << "#(obj).type() << " @ "; + std::cout << std::hex << obj << std::dec << ">"; break; } } @@ -148,19 +138,19 @@ void factor_vm::print_objects(cell *start, cell *end) for(; start <= end; start++) { print_obj(*start); - nl(); + std::cout << std::endl; } } void factor_vm::print_datastack() { - print_string("==== DATA STACK:\n"); + std::cout << "==== DATA STACK:\n"; print_objects((cell *)ds_bot,(cell *)ds); } void factor_vm::print_retainstack() { - print_string("==== RETAIN STACK:\n"); + std::cout << "==== RETAIN STACK:\n"; print_objects((cell *)rs_bot,(cell *)rs); } @@ -171,34 +161,48 @@ struct stack_frame_printer { void operator()(stack_frame *frame) { parent->print_obj(parent->frame_executing(frame)); - print_string("\n"); + std::cout << std::endl; parent->print_obj(parent->frame_scan(frame)); - print_string("\n"); - print_string("word/quot addr: "); - print_cell_hex((cell)parent->frame_executing(frame)); - print_string("\n"); - print_string("word/quot xt: "); - print_cell_hex((cell)frame->xt); - print_string("\n"); - print_string("return address: "); - print_cell_hex((cell)FRAME_RETURN_ADDRESS(frame,parent)); - print_string("\n"); + std::cout << std::endl; + std::cout << "word/quot addr: "; + std::cout << std::hex << (cell)parent->frame_executing(frame) << std::dec; + std::cout << std::endl; + std::cout << "word/quot xt: "; + std::cout << std::hex << (cell)frame->xt << std::dec; + std::cout << std::endl; + std::cout << "return address: "; + std::cout << std::hex << (cell)FRAME_RETURN_ADDRESS(frame,parent) << std::dec; + std::cout << std::endl; } }; void factor_vm::print_callstack() { - print_string("==== CALL STACK:\n"); + std::cout << "==== CALL STACK:\n"; stack_frame_printer printer(this); iterate_callstack(ctx,printer); } +struct padded_address { + cell value; + + explicit padded_address(cell value_) : value(value_) {} +}; + +std::ostream &operator<<(std::ostream &out, const padded_address &value) +{ + char prev = out.fill('0'); + out.width(sizeof(cell) * 2); + out << std::hex << value.value << std::dec; + out.fill(prev); + return out; +} + void factor_vm::dump_cell(cell x) { - print_cell_hex_pad(x); print_string(": "); + std::cout << padded_address(x) << ": "; x = *(cell *)x; - print_cell_hex_pad(x); print_string(" tag "); print_cell(TAG(x)); - nl(); + std::cout << padded_address(x) << " tag " << TAG(x) << std::endl; } void factor_vm::dump_memory(cell from, cell to) @@ -212,11 +216,11 @@ void factor_vm::dump_memory(cell from, cell to) template void factor_vm::dump_generation(const char *name, Generation *gen) { - print_string(name); print_string(": "); - print_string("Start="); print_cell(gen->start); - print_string(", size="); print_cell(gen->size); - print_string(", end="); print_cell(gen->end); - nl(); + std::cout << name << ": "; + std::cout << "Start=" << gen->start; + std::cout << ", size=" << gen->size; + std::cout << ", end=" << gen->end; + std::cout << std::endl; } void factor_vm::dump_generations() @@ -225,11 +229,9 @@ void factor_vm::dump_generations() dump_generation("Aging",data->aging); dump_generation("Tenured",data->tenured); - print_string("Cards: base="); - print_cell((cell)data->cards); - print_string(", size="); - print_cell((cell)(data->cards_end - data->cards)); - nl(); + std::cout << "Cards:"; + std::cout << "base=" << (cell)data->cards << ", "; + std::cout << "size=" << (cell)(data->cards_end - data->cards) << std::endl; } void factor_vm::dump_objects(cell type) @@ -242,10 +244,9 @@ void factor_vm::dump_objects(cell type) { if(type == TYPE_COUNT || tagged(obj).type_p(type)) { - print_cell_hex_pad(obj); - print_string(" "); + std::cout << padded_address(obj) << " "; print_nested_obj(obj,2); - nl(); + std::cout << std::endl; } } @@ -263,10 +264,9 @@ struct data_references_finder { { if(look_for == *scan) { - print_cell_hex_pad(obj); - print_string(" "); + std::cout << padded_address(obj) << " "; parent->print_nested_obj(obj,2); - nl(); + std::cout << std::endl; } } }; @@ -311,9 +311,9 @@ struct code_block_printer { status = "allocated"; } - print_cell_hex((cell)scan); print_string(" "); - print_cell_hex(size); print_string(" "); - print_string(status); print_string("\n"); + std::cout << std::hex << (cell)scan << std::dec << " "; + std::cout << std::hex << size << std::dec << " "; + std::cout << status << std::endl; } }; @@ -322,40 +322,40 @@ void factor_vm::dump_code_heap() { code_block_printer printer(this); code->allocator->iterate(printer); - print_cell(printer.reloc_size); print_string(" bytes of relocation data\n"); - print_cell(printer.literal_size); print_string(" bytes of literal data\n"); + std::cout << printer.reloc_size << " bytes of relocation data\n"; + std::cout << printer.literal_size << " bytes of literal data\n"; } void factor_vm::factorbug() { if(fep_disabled) { - print_string("Low level debugger disabled\n"); + std::cout << "Low level debugger disabled\n"; exit(1); } /* open_console(); */ - print_string("Starting low level debugger...\n"); - print_string(" Basic commands:\n"); - print_string("q -- continue executing Factor - NOT SAFE\n"); - print_string("im -- save image to fep.image\n"); - print_string("x -- exit Factor\n"); - print_string(" Advanced commands:\n"); - print_string("d -- dump memory\n"); - print_string("u -- dump object at tagged \n"); - print_string(". -- print object at tagged \n"); - print_string("t -- toggle output trimming\n"); - print_string("s r -- dump data, retain stacks\n"); - print_string(".s .r .c -- print data, retain, call stacks\n"); - print_string("e -- dump environment\n"); - print_string("g -- dump generations\n"); - print_string("data -- data heap dump\n"); - print_string("words -- words dump\n"); - print_string("tuples -- tuples dump\n"); - print_string("refs -- find data heap references to object\n"); - print_string("push -- push object on data stack - NOT SAFE\n"); - print_string("code -- code heap dump\n"); + std::cout << "Starting low level debugger...\n"; + std::cout << " Basic commands:\n"; + std::cout << "q -- continue executing Factor - NOT SAFE\n"; + std::cout << "im -- save image to fep.image\n"; + std::cout << "x -- exit Factor\n"; + std::cout << " Advanced commands:\n"; + std::cout << "d -- dump memory\n"; + std::cout << "u -- dump object at tagged \n"; + std::cout << ". -- print object at tagged \n"; + std::cout << "t -- toggle output trimming\n"; + std::cout << "s r -- dump data, retain stacks\n"; + std::cout << ".s .r .c -- print data, retain, call stacks\n"; + std::cout << "e -- dump environment\n"; + std::cout << "g -- dump generations\n"; + std::cout << "data -- data heap dump\n"; + std::cout << "words -- words dump\n"; + std::cout << "tuples -- tuples dump\n"; + std::cout << "refs -- find data heap references to object\n"; + std::cout << "push -- push object on data stack - NOT SAFE\n"; + std::cout << "code -- code heap dump\n"; bool seen_command = false; @@ -363,7 +363,7 @@ void factor_vm::factorbug() { char cmd[1024]; - print_string("READY\n"); + std::cout << "READY\n"; fflush(stdout); if(scanf("%1000s",cmd) <= 0) @@ -403,7 +403,7 @@ void factor_vm::factorbug() { cell addr = read_cell_hex(); print_obj(addr); - print_string("\n"); + std::cout << std::endl; } else if(strcmp(cmd,"t") == 0) full_output = !full_output; @@ -436,9 +436,9 @@ void factor_vm::factorbug() else if(strcmp(cmd,"refs") == 0) { cell addr = read_cell_hex(); - print_string("Data heap references:\n"); + std::cout << "Data heap references:\n"; find_data_references(addr); - nl(); + std::cout << std::endl; } else if(strcmp(cmd,"words") == 0) dump_objects(WORD_TYPE); @@ -452,14 +452,14 @@ void factor_vm::factorbug() else if(strcmp(cmd,"code") == 0) dump_code_heap(); else - print_string("unknown command\n"); + std::cout << "unknown command\n"; } } void factor_vm::primitive_die() { - print_string("The die word was called by the library. Unless you called it yourself,\n"); - print_string("you have triggered a bug in Factor. Please report.\n"); + std::cout << "The die word was called by the library. Unless you called it yourself,\n"; + std::cout << "you have triggered a bug in Factor. Please report.\n"; factorbug(); } diff --git a/vm/errors.cpp b/vm/errors.cpp index a1fc71ffbc..6268ca695d 100755 --- a/vm/errors.cpp +++ b/vm/errors.cpp @@ -5,22 +5,24 @@ namespace factor void fatal_error(const char *msg, cell tagged) { - print_string("fatal_error: "); print_string(msg); - print_string(": "); print_cell_hex(tagged); nl(); + std::cout << "fatal_error: " << msg; + std::cout << ": " << std::hex << tagged << std::dec; + std::cout << std::endl; exit(1); } void critical_error(const char *msg, cell tagged) { - print_string("You have triggered a bug in Factor. Please report.\n"); - print_string("critical_error: "); print_string(msg); - print_string(": "); print_cell_hex(tagged); nl(); + std::cout << "You have triggered a bug in Factor. Please report.\n"; + std::cout << "critical_error: " << msg; + std::cout << ": " << std::hex << tagged << std::dec; + std::cout << std::endl; tls_vm()->factorbug(); } void out_of_memory() { - print_string("Out of memory\n\n"); + std::cout << "Out of memory\n\n"; tls_vm()->dump_generations(); exit(1); } @@ -59,10 +61,10 @@ void factor_vm::throw_error(cell error, stack_frame *callstack_top) crash. */ else { - print_string("You have triggered a bug in Factor. Please report.\n"); - print_string("early_error: "); + std::cout << "You have triggered a bug in Factor. Please report.\n"; + std::cout << "early_error: "; print_obj(error); - nl(); + std::cout << std::endl; factorbug(); } } diff --git a/vm/factor.cpp b/vm/factor.cpp index 9c87c0a9a7..f3eb351d94 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -38,6 +38,7 @@ void factor_vm::default_parameters(vm_parameters *p) p->max_pic_size = 3; p->fep = false; + p->verbosegc = false; p->signals = true; #ifdef WINDOWS @@ -86,6 +87,7 @@ void factor_vm::init_parameters_from_args(vm_parameters *p, int argc, vm_char ** else if(factor_arg(arg,STRING_LITERAL("-callbacks=%d"),&p->callback_size)); else if(STRCMP(arg,STRING_LITERAL("-fep")) == 0) p->fep = true; else if(STRCMP(arg,STRING_LITERAL("-nosignals")) == 0) p->signals = false; + else if(STRCMP(arg,STRING_LITERAL("-verbosegc")) == 0) p->verbosegc = true; else if(STRNCMP(arg,STRING_LITERAL("-i="),3) == 0) p->image_path = arg + 3; else if(STRCMP(arg,STRING_LITERAL("-console")) == 0) p->console = true; } @@ -94,14 +96,13 @@ void factor_vm::init_parameters_from_args(vm_parameters *p, int argc, vm_char ** /* Do some initialization that we do once only */ void factor_vm::do_stage1_init() { - print_string("*** Stage 2 early init... "); + std::cout << "*** Stage 2 early init... "; fflush(stdout); compile_all_words(); userenv[STAGE2_ENV] = true_object; - print_string("done\n"); - fflush(stdout); + std::cout << "done\n"; } void factor_vm::init_factor(vm_parameters *p) @@ -141,6 +142,8 @@ void factor_vm::init_factor(vm_parameters *p) if(p->signals) init_signals(); + verbosegc = p->verbosegc; + if(p->console) open_console(); diff --git a/vm/gc.cpp b/vm/gc.cpp index 6cb99b6da0..706831136b 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -37,6 +37,9 @@ void factor_vm::gc(gc_op op, current_gc = new gc_state(op); + if(verbosegc) + std::cout << "GC requested, op=" << op << std::endl; + /* Keep trying to GC higher and higher generations until we don't run out of space */ if(setjmp(current_gc->gc_unwind)) @@ -60,6 +63,9 @@ void factor_vm::gc(gc_op op, critical_error("Bad GC op\n",op); break; } + + if(verbosegc) + std::cout << "GC rewind, op=" << op << std::endl; } switch(current_gc->op) @@ -91,11 +97,14 @@ void factor_vm::gc(gc_op op, delete current_gc; current_gc = NULL; + + if(verbosegc) + std::cout << "GC done, op=" << op << std::endl; } void factor_vm::primitive_minor_gc() { - gc(collect_nursery_op, + gc(collect_full_op, 0, /* requested size */ true, /* trace contexts? */ false /* compact code heap? */); diff --git a/vm/image.cpp b/vm/image.cpp index ee0a1064ed..845ca6c1bc 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -31,11 +31,8 @@ void factor_vm::load_data_heap(FILE *file, image_header *h, vm_parameters *p) if((cell)bytes_read != h->data_size) { - print_string("truncated image: "); - print_fixnum(bytes_read); - print_string(" bytes read, "); - print_cell(h->data_size); - print_string(" bytes expected\n"); + std::cout << "truncated image: " << bytes_read << " bytes read, "; + std::cout << h->data_size << " bytes expected\n"; fatal_error("load_data_heap failed",0); } @@ -54,11 +51,8 @@ void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p) size_t bytes_read = fread(code->allocator->first_block(),1,h->code_size,file); if(bytes_read != h->code_size) { - print_string("truncated image: "); - print_fixnum(bytes_read); - print_string(" bytes read, "); - print_cell(h->code_size); - print_string(" bytes expected\n"); + std::cout << "truncated image: " << bytes_read << " bytes read, "; + std::cout << h->code_size << " bytes expected\n"; fatal_error("load_code_heap failed",0); } } @@ -243,8 +237,8 @@ void factor_vm::load_image(vm_parameters *p) FILE *file = OPEN_READ(p->image_path); if(file == NULL) { - print_string("Cannot open image file: "); print_native_string(p->image_path); nl(); - print_string(strerror(errno)); nl(); + std::cout << "Cannot open image file: " << p->image_path << std::endl; + std::cout << strerror(errno) << std::endl; exit(1); } @@ -281,8 +275,8 @@ bool factor_vm::save_image(const vm_char *filename) file = OPEN_WRITE(filename); if(file == NULL) { - print_string("Cannot open image file: "); print_native_string(filename); nl(); - print_string(strerror(errno)); nl(); + std::cout << "Cannot open image file: " << filename << std::endl; + std::cout << strerror(errno) << std::endl; return false; } @@ -309,9 +303,7 @@ bool factor_vm::save_image(const vm_char *filename) if(fclose(file)) ok = false; if(!ok) - { - print_string("save-image failed: "); print_string(strerror(errno)); nl(); - } + std::cout << "save-image failed: " << strerror(errno) << std::endl; return ok; } diff --git a/vm/image.hpp b/vm/image.hpp index 62ab7e8392..127709ffb7 100755 --- a/vm/image.hpp +++ b/vm/image.hpp @@ -35,6 +35,7 @@ struct vm_parameters { cell young_size, aging_size, tenured_size; cell code_size; bool fep; + bool verbosegc; bool console; bool signals; cell max_pic_size; diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index 772631d1ce..8d8709fdea 100755 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -233,10 +233,10 @@ void *factor_vm::inline_cache_miss(cell return_address) set_call_target(return_address,xt); #ifdef PIC_DEBUG - printf("Updated %s call site 0x%lx with 0x%lx\n", - tail_call_site_p(return_address) ? "tail" : "non-tail", - return_address, - (cell)xt); + std::cout << "Updated " + << (tail_call_site_p(return_address) ? "tail" : "non-tail") + << " call site 0x" << std::hex << return_address << std::dec + << " with " << std::hex << (cell)xt << std::dec; #endif return xt; diff --git a/vm/jit.hpp b/vm/jit.hpp index 4928962fc6..1940da9c7c 100644 --- a/vm/jit.hpp +++ b/vm/jit.hpp @@ -43,7 +43,7 @@ struct jit { void emit_subprimitive(cell word_) { gc_root word(word_,parent); gc_root code_pair(word->subprimitive,parent); - literals.append(parent->untag(array_nth(code_pair.untagged(),0))); + literals.append(untag(array_nth(code_pair.untagged(),0))); emit(array_nth(code_pair.untagged(),1)); } diff --git a/vm/layouts.hpp b/vm/layouts.hpp index 76581621ca..c90be1b2dd 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -112,25 +112,25 @@ struct header { explicit header(cell value_) : value(value_ << TAG_BITS) {} - void check_header() + void check_header() const { #ifdef FACTOR_DEBUG assert(TAG(value) == FIXNUM_TYPE && untag_fixnum(value) < TYPE_COUNT); #endif } - cell hi_tag() + cell hi_tag() const { check_header(); return value >> TAG_BITS; } - bool forwarding_pointer_p() + bool forwarding_pointer_p() const { return TAG(value) == GC_COLLECTED; } - object *forwarding_pointer() + object *forwarding_pointer() const { return (object *)UNTAG(value); } @@ -147,13 +147,13 @@ struct object { NO_TYPE_CHECK; header h; - cell size(); + cell size() const; - cell *slots() { return (cell *)this; } + cell *slots() const { return (cell *)this; } /* Only valid for objects in tenured space; must fast to free_heap_block to do anything with it if its free */ - bool free_p() + bool free_p() const { return h.value & 1 == 1; } @@ -166,7 +166,7 @@ struct array : public object { /* tagged */ cell capacity; - cell *data() { return (cell *)(this + 1); } + cell *data() const { return (cell *)(this + 1); } }; /* These are really just arrays, but certain elements have special @@ -187,7 +187,7 @@ struct bignum : public object { /* tagged */ cell capacity; - cell *data() { return (cell *)(this + 1); } + cell *data() const { return (cell *)(this + 1); } }; struct byte_array : public object { @@ -201,7 +201,7 @@ struct byte_array : public object { cell padding1; #endif - template Scalar *data() { return (Scalar *)(this + 1); } + template Scalar *data() const { return (Scalar *)(this + 1); } }; /* Assembly code makes assumptions about the layout of this struct */ @@ -214,7 +214,9 @@ struct string : public object { /* tagged */ cell hashcode; - u8 *data() { return (u8 *)(this + 1); } + u8 *data() const { return (u8 *)(this + 1); } + + cell nth(cell i) const; }; /* The compiled code heap is structured into blocks. */ @@ -222,12 +224,12 @@ struct heap_block { cell header; - bool free_p() + bool free_p() const { return header & 1 == 1; } - cell size() + cell size() const { cell bytes = header >> 3; #ifdef FACTOR_DEBUG @@ -258,12 +260,12 @@ struct code_block : public heap_block cell literals; /* tagged pointer to array or f */ cell relocation; /* tagged pointer to byte-array or f */ - void *xt() + void *xt() const { return (void *)(this + 1); } - code_block_type type() + code_block_type type() const { return (code_block_type)((header >> 1) & 0x3); } @@ -273,12 +275,12 @@ struct code_block : public heap_block header = ((header & ~0x7) | (type << 1)); } - bool pic_p() + bool pic_p() const { return type() == code_block_pic; } - bool optimized_p() + bool optimized_p() const { return type() == code_block_optimized; } @@ -376,13 +378,13 @@ struct callstack : public object { /* tagged */ cell length; - stack_frame *frame_at(cell offset) + stack_frame *frame_at(cell offset) const { return (stack_frame *)((char *)(this + 1) + offset); } - stack_frame *top() { return (stack_frame *)(this + 1); } - stack_frame *bottom() { return (stack_frame *)((cell)(this + 1) + untag_fixnum(length)); } + stack_frame *top() const { return (stack_frame *)(this + 1); } + stack_frame *bottom() const { return (stack_frame *)((cell)(this + 1) + untag_fixnum(length)); } }; struct tuple : public object { @@ -390,7 +392,7 @@ struct tuple : public object { /* tagged layout */ cell layout; - cell *data() { return (cell *)(this + 1); } + cell *data() const { return (cell *)(this + 1); } }; } diff --git a/vm/master.hpp b/vm/master.hpp index 0282a0597d..9168cecce4 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -28,6 +28,7 @@ #include #include #include +#include /* Forward-declare this since it comes up in function prototypes */ namespace factor diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp index b12ebd0610..403842b2cb 100644 --- a/vm/os-windows.hpp +++ b/vm/os-windows.hpp @@ -37,8 +37,6 @@ typedef wchar_t vm_char; #define OPEN_READ(path) _wfopen(path,L"rb") #define OPEN_WRITE(path) _wfopen(path,L"wb") -#define print_native_string(string) wprintf(L"%s",string) - /* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */ #define EPOCH_OFFSET 0x019db1ded53e8000LL diff --git a/vm/quotations.cpp b/vm/quotations.cpp index e06b5c23d5..46087abeab 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -88,7 +88,7 @@ bool quotation_jit::stack_frame_p() switch(tagged(obj).type()) { case WORD_TYPE: - if(!parent->to_boolean(parent->untag(obj)->subprimitive)) + if(!parent->to_boolean(untag(obj)->subprimitive)) return true; break; case QUOTATION_TYPE: @@ -112,7 +112,7 @@ void quotation_jit::emit_quot(cell quot_) { gc_root quot(quot_,parent); - array *elements = parent->untag(quot->array); + array *elements = untag(quot->array); /* If the quotation consists of a single word, compile a direct call to the word. */ diff --git a/vm/strings.cpp b/vm/strings.cpp index 23fa75acca..3022611319 100644 --- a/vm/strings.cpp +++ b/vm/strings.cpp @@ -3,20 +3,20 @@ namespace factor { -cell factor_vm::string_nth(string* str, cell index) +cell string::nth(cell index) const { /* If high bit is set, the most significant 16 bits of the char come from the aux vector. The least significant bit of the corresponding aux vector entry is negated, so that we can XOR the two components together and get the original code point back. */ - cell lo_bits = str->data()[index]; + cell lo_bits = data()[index]; if((lo_bits & 0x80) == 0) return lo_bits; else { - byte_array *aux = untag(str->aux); + byte_array *aux = untag(this->aux); cell hi_bits = aux->data()[index]; return (hi_bits << 7) ^ lo_bits; } @@ -166,7 +166,7 @@ void factor_vm::primitive_string_nth() { string *str = untag(dpop()); cell index = untag_fixnum(dpop()); - dpush(tag_fixnum(string_nth(str,index))); + dpush(tag_fixnum(str->nth(index))); } void factor_vm::primitive_set_string_nth_fast() diff --git a/vm/strings.hpp b/vm/strings.hpp index 727ca8516e..54ff981d99 100644 --- a/vm/strings.hpp +++ b/vm/strings.hpp @@ -1,7 +1,7 @@ namespace factor { -inline static cell string_capacity(string *str) +inline static cell string_capacity(const string *str) { return untag_fixnum(str->length); } diff --git a/vm/tagged.hpp b/vm/tagged.hpp index 02fcdee26c..c5325542cb 100755 --- a/vm/tagged.hpp +++ b/vm/tagged.hpp @@ -75,7 +75,7 @@ template Type *factor_vm::untag_check(cell value) return tagged(value).untag_check(this); } -template Type *factor_vm::untag(cell value) +template Type *untag(cell value) { return tagged(value).untagged(); } diff --git a/vm/utilities.cpp b/vm/utilities.cpp index 0595430283..8f063a9ad4 100755 --- a/vm/utilities.cpp +++ b/vm/utilities.cpp @@ -11,38 +11,6 @@ vm_char *safe_strdup(const vm_char *str) return ptr; } -/* We don't use printf directly, because format directives are not portable. -Instead we define the common cases here. */ -void nl() -{ - fputs("\n",stdout); -} - -void print_string(const char *str) -{ - fputs(str,stdout); -} - -void print_cell(cell x) -{ - printf(CELL_FORMAT,x); -} - -void print_cell_hex(cell x) -{ - printf(CELL_HEX_FORMAT,x); -} - -void print_cell_hex_pad(cell x) -{ - printf(CELL_HEX_PAD_FORMAT,x); -} - -void print_fixnum(fixnum x) -{ - printf(FIXNUM_FORMAT,x); -} - cell read_cell_hex() { cell cell; diff --git a/vm/utilities.hpp b/vm/utilities.hpp index f93fe13f78..497e1a3bfb 100755 --- a/vm/utilities.hpp +++ b/vm/utilities.hpp @@ -1,11 +1,6 @@ namespace factor { vm_char *safe_strdup(const vm_char *str); - void print_string(const char *str); - void nl(); - void print_cell(cell x); - void print_cell_hex(cell x); void print_cell_hex_pad(cell x); - void print_fixnum(fixnum x); cell read_cell_hex(); } diff --git a/vm/vm.hpp b/vm/vm.hpp index 615efe35ed..86ed092ff7 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -46,6 +46,9 @@ struct factor_vm /* GC is off during heap walking */ bool gc_off; + /* GC logging */ + bool verbosegc; + /* Data heap */ data_heap *data; @@ -327,7 +330,7 @@ struct factor_vm inline void set_array_nth(array *array, cell slot, cell value); //strings - cell string_nth(string* str, cell index); + cell string_nth(const string *str, cell index); void set_string_nth_fast(string *str, cell index, cell ch); void set_string_nth_slow(string *str_, cell index, cell ch); void set_string_nth(string *str, cell index, cell ch); @@ -450,8 +453,9 @@ struct factor_vm inline double untag_float_check(cell tagged); inline fixnum float_to_fixnum(cell tagged); inline double fixnum_to_float(cell tagged); + + // tagged template Type *untag_check(cell value); - template Type *untag(cell value); //io void init_c_io(); From c3b8847936fc4002097a01548290f2dd303d2d3c Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 21 Oct 2009 21:10:11 -0500 Subject: [PATCH 056/109] update a bunch of alien-callbacks and alien-indirects to use c-type words --- .../compiler/cfg/builder/builder-tests.factor | 4 +- basis/compiler/tests/alien.factor | 50 +++++++++---------- .../core-foundation/fsevents/fsevents.factor | 4 +- .../core-foundation/run-loop/run-loop.factor | 2 +- basis/db/sqlite/ffi/ffi.factor | 4 +- .../multiplexers/run-loop/run-loop.factor | 5 +- basis/tools/deploy/test/9/9.factor | 6 +-- basis/tools/profiler/profiler-tests.factor | 4 +- basis/ui/backend/windows/windows.factor | 2 +- core/alien/alien-docs.factor | 4 +- extra/benchmark/fib6/fib6.factor | 6 +-- extra/noise/noise.factor | 2 +- 12 files changed, 47 insertions(+), 46 deletions(-) diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index e3ad8e6074..a4651b87b5 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -68,8 +68,8 @@ IN: compiler.cfg.builder.tests [ [ dup ] loop ] [ [ 2 ] [ 3 throw ] if 4 ] [ int f "malloc" { int } alien-invoke ] - [ "int" { "int" } "cdecl" alien-indirect ] - [ "int" { "int" } "cdecl" [ ] alien-callback ] + [ int { int } "cdecl" alien-indirect ] + [ int { int } "cdecl" [ ] alien-callback ] [ swap - + * ] [ swap slot ] [ blahblah ] diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index cc835a8a8f..ef8cb5f0a4 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -90,14 +90,14 @@ FUNCTION: TINY ffi_test_17 int x ; [ [ alien-indirect ] infer ] [ inference-error? ] must-fail-with : indirect-test-1 ( ptr -- result ) - "int" { } "cdecl" alien-indirect ; + int { } "cdecl" alien-indirect ; { 1 1 } [ indirect-test-1 ] must-infer-as [ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test : indirect-test-1' ( ptr -- ) - "int" { } "cdecl" alien-indirect drop ; + int { } "cdecl" alien-indirect drop ; { 1 0 } [ indirect-test-1' ] must-infer-as @@ -106,7 +106,7 @@ FUNCTION: TINY ffi_test_17 int x ; [ -1 indirect-test-1 ] must-fail : indirect-test-2 ( x y ptr -- result ) - "int" { "int" "int" } "cdecl" alien-indirect gc ; + int { int int } "cdecl" alien-indirect gc ; { 3 1 } [ indirect-test-2 ] must-infer-as @@ -115,7 +115,7 @@ FUNCTION: TINY ffi_test_17 int x ; unit-test : indirect-test-3 ( a b c d ptr -- result ) - "int" { "int" "int" "int" "int" } "stdcall" alien-indirect + int { int int int int } "stdcall" alien-indirect gc ; [ f ] [ "f-stdcall" load-library f = ] unit-test @@ -312,21 +312,21 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ; ! Test callbacks -: callback-1 ( -- callback ) "void" { } "cdecl" [ ] alien-callback ; +: callback-1 ( -- callback ) void { } "cdecl" [ ] alien-callback ; [ 0 1 ] [ [ callback-1 ] infer [ in>> ] [ out>> ] bi ] unit-test [ t ] [ callback-1 alien? ] unit-test -: callback_test_1 ( ptr -- ) "void" { } "cdecl" alien-indirect ; +: callback_test_1 ( ptr -- ) void { } "cdecl" alien-indirect ; [ ] [ callback-1 callback_test_1 ] unit-test -: callback-2 ( -- callback ) "void" { } "cdecl" [ [ 5 throw ] ignore-errors ] alien-callback ; +: callback-2 ( -- callback ) void { } "cdecl" [ [ 5 throw ] ignore-errors ] alien-callback ; [ ] [ callback-2 callback_test_1 ] unit-test -: callback-3 ( -- callback ) "void" { } "cdecl" [ 5 "x" set ] alien-callback ; +: callback-3 ( -- callback ) void { } "cdecl" [ 5 "x" set ] alien-callback ; [ t ] [ namestack* @@ -341,7 +341,7 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ; ] unit-test : callback-4 ( -- callback ) - "void" { } "cdecl" [ "Hello world" write ] alien-callback + void { } "cdecl" [ "Hello world" write ] alien-callback gc ; [ "Hello world" ] [ @@ -349,40 +349,40 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ; ] unit-test : callback-5 ( -- callback ) - "void" { } "cdecl" [ gc ] alien-callback ; + void { } "cdecl" [ gc ] alien-callback ; [ "testing" ] [ "testing" callback-5 callback_test_1 ] unit-test : callback-5b ( -- callback ) - "void" { } "cdecl" [ compact-gc ] alien-callback ; + void { } "cdecl" [ compact-gc ] alien-callback ; [ "testing" ] [ "testing" callback-5b callback_test_1 ] unit-test : callback-6 ( -- callback ) - "void" { } "cdecl" [ [ continue ] callcc0 ] alien-callback ; + void { } "cdecl" [ [ continue ] callcc0 ] alien-callback ; [ 1 2 3 ] [ callback-6 callback_test_1 1 2 3 ] unit-test : callback-7 ( -- callback ) - "void" { } "cdecl" [ 1000000 sleep ] alien-callback ; + void { } "cdecl" [ 1000000 sleep ] alien-callback ; [ 1 2 3 ] [ callback-7 callback_test_1 1 2 3 ] unit-test [ f ] [ namespace global eq? ] unit-test : callback-8 ( -- callback ) - "void" { } "cdecl" [ + void { } "cdecl" [ [ continue ] callcc0 ] alien-callback ; [ ] [ callback-8 callback_test_1 ] unit-test : callback-9 ( -- callback ) - "int" { "int" "int" "int" } "cdecl" [ + int { int int int } "cdecl" [ + + 1 + ] alien-callback ; @@ -440,13 +440,13 @@ STRUCT: double-rect } cleave ; : double-rect-callback ( -- alien ) - "void" { "void*" "void*" "double-rect" } "cdecl" + void { void* void* double-rect } "cdecl" [ "example" set-global 2drop ] alien-callback ; : double-rect-test ( arg -- arg' ) f f rot double-rect-callback - "void" { "void*" "void*" "double-rect" } "cdecl" alien-indirect + void { void* void* double-rect } "cdecl" alien-indirect "example" get-global ; [ 1.0 2.0 3.0 4.0 ] @@ -463,7 +463,7 @@ FUNCTION: test_struct_14 ffi_test_40 ( double x1, double x2 ) ; ] unit-test : callback-10 ( -- callback ) - "test_struct_14" { "double" "double" } "cdecl" + test_struct_14 { double double } "cdecl" [ test_struct_14 swap >>x2 @@ -471,7 +471,7 @@ FUNCTION: test_struct_14 ffi_test_40 ( double x1, double x2 ) ; ] alien-callback ; : callback-10-test ( x1 x2 callback -- result ) - "test_struct_14" { "double" "double" } "cdecl" alien-indirect ; + test_struct_14 { double double } "cdecl" alien-indirect ; [ 1.0 2.0 ] [ 1.0 2.0 callback-10 callback-10-test @@ -486,7 +486,7 @@ FUNCTION: test-struct-12 ffi_test_41 ( int a, double x ) ; ] unit-test : callback-11 ( -- callback ) - "test-struct-12" { "int" "double" } "cdecl" + test-struct-12 { int double } "cdecl" [ test-struct-12 swap >>x @@ -494,7 +494,7 @@ FUNCTION: test-struct-12 ffi_test_41 ( int a, double x ) ; ] alien-callback ; : callback-11-test ( x1 x2 callback -- result ) - "test-struct-12" { "int" "double" } "cdecl" alien-indirect ; + test-struct-12 { int double } "cdecl" alien-indirect ; [ 1 2.0 ] [ 1 2.0 callback-11 callback-11-test @@ -510,7 +510,7 @@ FUNCTION: test_struct_15 ffi_test_42 ( float x, float y ) ; [ 1.0 2.0 ] [ 1.0 2.0 ffi_test_42 [ x>> ] [ y>> ] bi ] unit-test : callback-12 ( -- callback ) - "test_struct_15" { "float" "float" } "cdecl" + test_struct_15 { float float } "cdecl" [ test_struct_15 swap >>y @@ -518,7 +518,7 @@ FUNCTION: test_struct_15 ffi_test_42 ( float x, float y ) ; ] alien-callback ; : callback-12-test ( x1 x2 callback -- result ) - "test_struct_15" { "float" "float" } "cdecl" alien-indirect ; + test_struct_15 { float float } "cdecl" alien-indirect ; [ 1.0 2.0 ] [ 1.0 2.0 callback-12 callback-12-test [ x>> ] [ y>> ] bi @@ -533,7 +533,7 @@ FUNCTION: test_struct_16 ffi_test_43 ( float x, int a ) ; [ 1.0 2 ] [ 1.0 2 ffi_test_43 [ x>> ] [ a>> ] bi ] unit-test : callback-13 ( -- callback ) - "test_struct_16" { "float" "int" } "cdecl" + test_struct_16 { float int } "cdecl" [ test_struct_16 swap >>a @@ -541,7 +541,7 @@ FUNCTION: test_struct_16 ffi_test_43 ( float x, int a ) ; ] alien-callback ; : callback-13-test ( x1 x2 callback -- result ) - "test_struct_16" { "float" "int" } "cdecl" alien-indirect ; + test_struct_16 { float int } "cdecl" alien-indirect ; [ 1.0 2 ] [ 1.0 2 callback-13 callback-13-test diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index 6f5484fb77..24ac24bb6a 100755 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -36,8 +36,8 @@ STRUCT: FSEventStreamContext { release void* } { copyDescription void* } ; -! callback(FSEventStreamRef streamRef, void *clientCallBackInfo, size_t numEvents, void *eventPaths, const FSEventStreamEventFlags eventFlags[], const FSEventStreamEventId eventIds[]); -TYPEDEF: void* FSEventStreamCallback +! callback( +CALLBACK: void FSEventStreamCallback ( FSEventStreamRef streamRef, void* clientCallBackInfo, size_t numEvents, void* eventPaths, FSEventStreamEventFlags* eventFlags, FSEventStreamEventId* eventIds ) ; CONSTANT: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor index 7b454266f2..0b61274b22 100644 --- a/basis/core-foundation/run-loop/run-loop.factor +++ b/basis/core-foundation/run-loop/run-loop.factor @@ -115,7 +115,7 @@ PRIVATE> [ fds>> [ enable-all-callbacks ] each ] bi ; : timer-callback ( -- callback ) - "void" { "CFRunLoopTimerRef" "void*" } "cdecl" + void { CFRunLoopTimerRef void* } "cdecl" [ 2drop reset-run-loop yield ] alien-callback ; : init-thread-timer ( -- ) diff --git a/basis/db/sqlite/ffi/ffi.factor b/basis/db/sqlite/ffi/ffi.factor index 2f7bec1b54..c180df9bf5 100644 --- a/basis/db/sqlite/ffi/ffi.factor +++ b/basis/db/sqlite/ffi/ffi.factor @@ -99,8 +99,8 @@ CONSTANT: SQLITE_OPEN_TEMP_JOURNAL HEX: 00001000 CONSTANT: SQLITE_OPEN_SUBJOURNAL HEX: 00002000 CONSTANT: SQLITE_OPEN_MASTER_JOURNAL HEX: 00004000 -TYPEDEF: void sqlite3 -TYPEDEF: void sqlite3_stmt +TYPEDEF: void* sqlite3* +TYPEDEF: void* sqlite3_stmt* TYPEDEF: longlong sqlite3_int64 TYPEDEF: ulonglong sqlite3_uint64 diff --git a/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor b/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor index 84a609643a..276949a99f 100644 --- a/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor +++ b/basis/io/backend/unix/multiplexers/run-loop/run-loop.factor @@ -3,13 +3,14 @@ USING: kernel arrays namespaces math accessors alien locals destructors system threads io.backend.unix.multiplexers io.backend.unix.multiplexers.kqueue core-foundation -core-foundation.run-loop ; +core-foundation.run-loop core-foundation.file-descriptors ; +FROM: alien.c-types => void void* ; IN: io.backend.unix.multiplexers.run-loop TUPLE: run-loop-mx kqueue-mx ; : file-descriptor-callback ( -- callback ) - "void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" } + void { CFFileDescriptorRef CFOptionFlags void* } "cdecl" [ 3drop 0 mx get kqueue-mx>> wait-for-events diff --git a/basis/tools/deploy/test/9/9.factor b/basis/tools/deploy/test/9/9.factor index a1cbd5bc66..642ee48e67 100644 --- a/basis/tools/deploy/test/9/9.factor +++ b/basis/tools/deploy/test/9/9.factor @@ -1,10 +1,10 @@ -USING: alien kernel math ; +USING: alien alien.c-types kernel math ; IN: tools.deploy.test.9 : callback-test ( -- callback ) - "int" { "int" } "cdecl" [ 1 + ] alien-callback ; + int { int } "cdecl" [ 1 + ] alien-callback ; : indirect-test ( -- ) - 10 callback-test "int" { "int" } "cdecl" alien-indirect 11 assert= ; + 10 callback-test int { int } "cdecl" alien-indirect 11 assert= ; MAIN: indirect-test diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor index dda531faee..f7da0d1636 100644 --- a/basis/tools/profiler/profiler-tests.factor +++ b/basis/tools/profiler/profiler-tests.factor @@ -21,9 +21,9 @@ words ; [ ] [ \ + usage-profile. ] unit-test -: callback-test ( -- callback ) "void" { } "cdecl" [ ] alien-callback ; +: callback-test ( -- callback ) void { } "cdecl" [ ] alien-callback ; -: indirect-test ( callback -- ) "void" { } "cdecl" alien-indirect ; +: indirect-test ( callback -- ) void { } "cdecl" alien-indirect ; : foobar ( -- ) ; diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 0e07ff6611..7dbe3a3c48 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -596,7 +596,7 @@ SYMBOL: trace-messages? ! return 0 if you handle the message, else just let DefWindowProc return its val : ui-wndproc ( -- object ) - "uint" { "void*" "uint" "long" "long" } "stdcall" [ + uint { void* uint long long } "stdcall" [ pick trace-messages? get-global [ dup windows-message-name name>> print flush ] when wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 9fb9c042ee..6787d3714b 100644 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -79,7 +79,7 @@ HELP: alien-callback-error HELP: alien-callback { $values { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } { "quot" "a quotation" } { "alien" alien } } { $description - "Defines a callback from C to Factor which accepts the given set of parameters from the C caller, pushes them on the data stack, calls the quotation, and passes a return value back to the C caller. A return type of " { $snippet "\"void\"" } " indicates that no value is to be returned." + "Defines a callback from C to Factor which accepts the given set of parameters from the C caller, pushes them on the data stack, calls the quotation, and passes a return value back to the C caller. A return type of " { $snippet "void" } " indicates that no value is to be returned." $nl "When a compiled reference to this word is called, it pushes the callback's alien address on the data stack. This address can be passed to any C function expecting a C function pointer with the correct signature. The callback is actually generated when the word calling " { $link alien-callback } " is compiled." $nl @@ -90,7 +90,7 @@ HELP: alien-callback "A simple example, showing a C function which returns the difference of two given integers:" { $code ": difference-callback ( -- alien )" - " \"int\" { \"int\" \"int\" } \"cdecl\" [ - ] alien-callback ;" + " int { int int } \"cdecl\" [ - ] alien-callback ;" } } { $errors "Throws an " { $link alien-callback-error } " if the word calling " { $link alien-callback } " is not compiled." } ; diff --git a/extra/benchmark/fib6/fib6.factor b/extra/benchmark/fib6/fib6.factor index 7ddd58468a..561110d941 100755 --- a/extra/benchmark/fib6/fib6.factor +++ b/extra/benchmark/fib6/fib6.factor @@ -1,13 +1,13 @@ -USING: math kernel alien ; +USING: math kernel alien alien.c-types ; IN: benchmark.fib6 : fib ( x -- y ) - "int" { "int" } "cdecl" [ + int { int } "cdecl" [ dup 1 <= [ drop 1 ] [ 1 - dup fib swap 1 - fib + ] if ] alien-callback - "int" { "int" } "cdecl" alien-indirect ; + int { int } "cdecl" alien-indirect ; : fib-main ( -- ) 32 fib drop ; diff --git a/extra/noise/noise.factor b/extra/noise/noise.factor index 1ea5b95157..91e040d35f 100644 --- a/extra/noise/noise.factor +++ b/extra/noise/noise.factor @@ -56,7 +56,7 @@ ERROR: invalid-perlin-noise-table table ; dup { [ byte-array? ] [ length 512 >= ] } 1&& [ invalid-perlin-noise-table ] unless ; -! XXX doesn't work for NaNs or floats > 2^31 +! XXX doesn't work when v is nan or |v| >= 2^31 : floor-vector ( v -- v' ) [ float-4 int-4 vconvert int-4 float-4 vconvert ] [ [ v> -1.0 float-4-with vand ] curry keep v+ ] bi ; inline From b89047b3d3ea09d370dfe6696c0f63a51db649c1 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 21 Oct 2009 22:12:28 -0500 Subject: [PATCH 057/109] fix tools.deploy test --- basis/tools/deploy/test/14/14.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/tools/deploy/test/14/14.factor b/basis/tools/deploy/test/14/14.factor index c1079ccb93..65fd50b5b8 100644 --- a/basis/tools/deploy/test/14/14.factor +++ b/basis/tools/deploy/test/14/14.factor @@ -1,7 +1,9 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors classes.struct cocoa cocoa.classes -cocoa.subclassing core-graphics.types kernel math ; +cocoa.runtime cocoa.subclassing cocoa.types core-graphics.types +kernel math ; +FROM: alien.c-types => float ; IN: tools.deploy.test.14 CLASS: { From 66dc1c6311cdfc24bfc190305a5f07647e4f4a08 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 21 Oct 2009 23:00:02 -0500 Subject: [PATCH 058/109] oops, longlong comparison is sse4.2, not 4.1 --- basis/cpu/x86/x86.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index d99512f0f7..d19a9b0c8c 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -888,7 +888,7 @@ M: x86 %compare-vector ( dst src1 src2 rep cc -- ) { { sse? { float-4-rep } } { sse2? { double-2-rep char-16-rep short-8-rep int-4-rep } } - { sse4.1? { longlong-2-rep } } + { sse4.2? { longlong-2-rep } } } available-reps ; M: x86 %compare-vector-reps From 606a805d7d94b1a44a01c15c17bafdfc728e57d4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Oct 2009 23:24:35 -0500 Subject: [PATCH 059/109] vm: debugging mark and sweep --- vm/arrays.hpp | 1 - vm/free_list_allocator.hpp | 8 ++++---- vm/gc.cpp | 14 +++++++------- vm/image.cpp | 4 ++-- vm/local_roots.hpp | 2 +- vm/mark_bits.hpp | 11 ++++++++++- vm/vm.hpp | 12 ------------ 7 files changed, 24 insertions(+), 28 deletions(-) diff --git a/vm/arrays.hpp b/vm/arrays.hpp index 48be881230..6063269e7f 100755 --- a/vm/arrays.hpp +++ b/vm/arrays.hpp @@ -15,7 +15,6 @@ inline void factor_vm::set_array_nth(array *array, cell slot, cell value) #ifdef FACTOR_DEBUG assert(slot < array_capacity(array)); assert(array->h.hi_tag() == ARRAY_TYPE); - check_tagged_pointer(value); #endif cell *slot_ptr = &array->data()[slot]; *slot_ptr = value; diff --git a/vm/free_list_allocator.hpp b/vm/free_list_allocator.hpp index efdad508cb..8332399279 100644 --- a/vm/free_list_allocator.hpp +++ b/vm/free_list_allocator.hpp @@ -22,7 +22,7 @@ template struct free_list_allocator { Block *next_block_after(Block *block); void clear_free_list(); void add_to_free_list(free_heap_block *block); - void build_free_list(cell size); + void initial_free_list(cell size); void assert_free_block(free_heap_block *block); free_heap_block *find_free_block(cell size); free_heap_block *split_free_block(free_heap_block *block, cell size); @@ -40,7 +40,7 @@ template free_list_allocator::free_list_allocator(cell size_, cell start_) : size(size_), start(start_), end(start_ + size_), state(mark_bits(size_,start_)) { - clear_free_list(); + initial_free_list(0); } template void free_list_allocator::clear_free_list() @@ -85,7 +85,7 @@ template void free_list_allocator::add_to_free_list(free_ /* Called after reading the heap from the image file, and after heap compaction. Makes a free list consisting of one free block, at the very end. */ -template void free_list_allocator::build_free_list(cell size) +template void free_list_allocator::initial_free_list(cell size) { clear_free_list(); if(size != this->size) @@ -345,7 +345,7 @@ void free_list_allocator::compact(Iterator &iter) /* Now update the free list; there will be a single free block at the end */ - this->build_free_list((cell)compactor.address - this->start); + this->initial_free_list((cell)compactor.address - this->start); } template diff --git a/vm/gc.cpp b/vm/gc.cpp index 706831136b..6b3ec80481 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -60,12 +60,12 @@ void factor_vm::gc(gc_op op, current_gc->op = collect_growing_heap_op; break; default: - critical_error("Bad GC op\n",op); + critical_error("Bad GC op",current_gc->op); break; } if(verbosegc) - std::cout << "GC rewind, op=" << op << std::endl; + std::cout << "GC rewind, op=" << current_gc->op << std::endl; } switch(current_gc->op) @@ -91,20 +91,20 @@ void factor_vm::gc(gc_op op, record_gc_stats(&gc_stats.full_stats); break; default: - critical_error("Bad GC op\n",op); + critical_error("Bad GC op\n",current_gc->op); break; } + if(verbosegc) + std::cout << "GC done, op=" << current_gc->op << std::endl; + delete current_gc; current_gc = NULL; - - if(verbosegc) - std::cout << "GC done, op=" << op << std::endl; } void factor_vm::primitive_minor_gc() { - gc(collect_full_op, + gc(collect_nursery_op, 0, /* requested size */ true, /* trace contexts? */ false /* compact code heap? */); diff --git a/vm/image.cpp b/vm/image.cpp index 845ca6c1bc..f5879e7a32 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -36,7 +36,7 @@ void factor_vm::load_data_heap(FILE *file, image_header *h, vm_parameters *p) fatal_error("load_data_heap failed",0); } - data->tenured->build_free_list(h->data_size); + data->tenured->initial_free_list(h->data_size); } void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p) @@ -57,7 +57,7 @@ void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p) } } - code->allocator->build_free_list(h->code_size); + code->allocator->initial_free_list(h->code_size); } void factor_vm::data_fixup(cell *handle, cell data_relocation_base) diff --git a/vm/local_roots.hpp b/vm/local_roots.hpp index 6ae059f4c4..58142be8f2 100644 --- a/vm/local_roots.hpp +++ b/vm/local_roots.hpp @@ -6,7 +6,7 @@ struct gc_root : public tagged { factor_vm *parent; - void push() { parent->check_tagged_pointer(tagged::value()); parent->gc_locals.push_back((cell)this); } + void push() { parent->gc_locals.push_back((cell)this); } explicit gc_root(cell value_,factor_vm *vm) : tagged(value_),parent(vm) { push(); } explicit gc_root(Type *value_, factor_vm *vm) : tagged(value_),parent(vm) { push(); } diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index 161a7fd755..279c04a23a 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -81,12 +81,21 @@ template struct mark_bits { bits[start.first] |= start_mask ^ end_mask; else { +#ifdef FACTOR_DEBUG + assert(start.first < bits_size); +#endif bits[start.first] |= ~start_mask; for(cell index = start.first + 1; index < end.first; index++) bits[index] = (u64)-1; - bits[end.first] |= end_mask; + if(end_mask != 0) + { +#ifdef FACTOR_DEBUG + assert(end.first < bits_size); +#endif + bits[end.first] |= end_mask; + } } } diff --git a/vm/vm.hpp b/vm/vm.hpp index 86ed092ff7..40dcb4f3bc 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -280,18 +280,6 @@ struct factor_vm #endif } - inline void check_tagged_pointer(cell tagged) - { - #ifdef FACTOR_DEBUG - if(!immediate_p(tagged)) - { - object *obj = untag(tagged); - check_data_pointer(obj); - obj->h.hi_tag(); - } - #endif - } - // generic arrays template Array *allot_uninitialized_array(cell capacity); template bool reallot_array_in_place_p(Array *array, cell capacity); From 432d4f79e9eeba9bffcb43d53ab01f68bd64f040 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 21 Oct 2009 23:37:51 -0500 Subject: [PATCH 060/109] give better error message for windows exceptions, and don't lop off the top end of the exception code when the vm throws the error --- basis/debugger/windows/windows.factor | 38 ++++++++++++++++++++++++-- basis/windows/kernel32/kernel32.factor | 26 ++++++++++++++++++ vm/errors.cpp | 2 +- 3 files changed, 63 insertions(+), 3 deletions(-) diff --git a/basis/debugger/windows/windows.factor b/basis/debugger/windows/windows.factor index 1f4b8fb0ac..3485d96447 100644 --- a/basis/debugger/windows/windows.factor +++ b/basis/debugger/windows/windows.factor @@ -1,6 +1,40 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: debugger io prettyprint sequences system ; +USING: assocs debugger io kernel literals namespaces prettyprint +sequences system windows.kernel32 ; IN: debugger.windows -M: windows signal-error. "Windows exception #" write third .h ; \ No newline at end of file +CONSTANT: seh-names + H{ + { $ STATUS_GUARD_PAGE_VIOLATION "STATUS_GUARD_PAGE_VIOLATION" } + { $ STATUS_DATATYPE_MISALIGNMENT "STATUS_DATATYPE_MISALIGNMENT" } + { $ STATUS_BREAKPOINT "STATUS_BREAKPOINT" } + { $ STATUS_SINGLE_STEP "STATUS_SINGLE_STEP" } + { $ STATUS_ACCESS_VIOLATION "STATUS_ACCESS_VIOLATION" } + { $ STATUS_IN_PAGE_ERROR "STATUS_IN_PAGE_ERROR" } + { $ STATUS_INVALID_HANDLE "STATUS_INVALID_HANDLE" } + { $ STATUS_NO_MEMORY "STATUS_NO_MEMORY" } + { $ STATUS_ILLEGAL_INSTRUCTION "STATUS_ILLEGAL_INSTRUCTION" } + { $ STATUS_NONCONTINUABLE_EXCEPTION "STATUS_NONCONTINUABLE_EXCEPTION" } + { $ STATUS_INVALID_DISPOSITION "STATUS_INVALID_DISPOSITION" } + { $ STATUS_ARRAY_BOUNDS_EXCEEDED "STATUS_ARRAY_BOUNDS_EXCEEDED" } + { $ STATUS_FLOAT_DENORMAL_OPERAND "STATUS_FLOAT_DENORMAL_OPERAND" } + { $ STATUS_FLOAT_DIVIDE_BY_ZERO "STATUS_FLOAT_DIVIDE_BY_ZERO" } + { $ STATUS_FLOAT_INEXACT_RESULT "STATUS_FLOAT_INEXACT_RESULT" } + { $ STATUS_FLOAT_INVALID_OPERATION "STATUS_FLOAT_INVALID_OPERATION" } + { $ STATUS_FLOAT_OVERFLOW "STATUS_FLOAT_OVERFLOW" } + { $ STATUS_FLOAT_STACK_CHECK "STATUS_FLOAT_STACK_CHECK" } + { $ STATUS_FLOAT_UNDERFLOW "STATUS_FLOAT_UNDERFLOW" } + { $ STATUS_INTEGER_DIVIDE_BY_ZERO "STATUS_INTEGER_DIVIDE_BY_ZERO" } + { $ STATUS_INTEGER_OVERFLOW "STATUS_INTEGER_OVERFLOW" } + { $ STATUS_PRIVILEGED_INSTRUCTION "STATUS_PRIVILEGED_INSTRUCTION" } + { $ STATUS_STACK_OVERFLOW "STATUS_STACK_OVERFLOW" } + { $ STATUS_CONTROL_C_EXIT "STATUS_CONTROL_C_EXIT" } + } + +: seh-name. ( n -- ) + seh-names get at [ " (" ")" surround write ] when* ; + +M: windows signal-error. + "Windows exception 0x" write + third [ .h ] [ seh-name. ] bi nl ; diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 70c104e2df..4cf93f7836 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -759,6 +759,32 @@ CONSTANT: PIPE_NOWAIT 1 CONSTANT: PIPE_UNLIMITED_INSTANCES 255 +CONSTANT: EXCEPTION_NONCONTINUABLE HEX: 1 +CONSTANT: STATUS_GUARD_PAGE_VIOLATION HEX: 80000001 +CONSTANT: STATUS_DATATYPE_MISALIGNMENT HEX: 80000002 +CONSTANT: STATUS_BREAKPOINT HEX: 80000003 +CONSTANT: STATUS_SINGLE_STEP HEX: 80000004 +CONSTANT: STATUS_ACCESS_VIOLATION HEX: C0000005 +CONSTANT: STATUS_IN_PAGE_ERROR HEX: C0000006 +CONSTANT: STATUS_INVALID_HANDLE HEX: C0000008 +CONSTANT: STATUS_NO_MEMORY HEX: C0000017 +CONSTANT: STATUS_ILLEGAL_INSTRUCTION HEX: C000001D +CONSTANT: STATUS_NONCONTINUABLE_EXCEPTION HEX: C0000025 +CONSTANT: STATUS_INVALID_DISPOSITION HEX: C0000026 +CONSTANT: STATUS_ARRAY_BOUNDS_EXCEEDED HEX: C000008C +CONSTANT: STATUS_FLOAT_DENORMAL_OPERAND HEX: C000008D +CONSTANT: STATUS_FLOAT_DIVIDE_BY_ZERO HEX: C000008E +CONSTANT: STATUS_FLOAT_INEXACT_RESULT HEX: C000008F +CONSTANT: STATUS_FLOAT_INVALID_OPERATION HEX: C0000090 +CONSTANT: STATUS_FLOAT_OVERFLOW HEX: C0000091 +CONSTANT: STATUS_FLOAT_STACK_CHECK HEX: C0000092 +CONSTANT: STATUS_FLOAT_UNDERFLOW HEX: C0000093 +CONSTANT: STATUS_INTEGER_DIVIDE_BY_ZERO HEX: C0000094 +CONSTANT: STATUS_INTEGER_OVERFLOW HEX: C0000095 +CONSTANT: STATUS_PRIVILEGED_INSTRUCTION HEX: C0000096 +CONSTANT: STATUS_STACK_OVERFLOW HEX: C00000FD +CONSTANT: STATUS_CONTROL_C_EXIT HEX: C000013A + LIBRARY: kernel32 ! FUNCTION: _hread ! FUNCTION: _hwrite diff --git a/vm/errors.cpp b/vm/errors.cpp index a1fc71ffbc..c587fa723a 100755 --- a/vm/errors.cpp +++ b/vm/errors.cpp @@ -112,7 +112,7 @@ void factor_vm::memory_protection_error(cell addr, stack_frame *native_stack) void factor_vm::signal_error(int signal, stack_frame *native_stack) { - general_error(ERROR_SIGNAL,tag_fixnum(signal),false_object,native_stack); + general_error(ERROR_SIGNAL,allot_cell(signal),false_object,native_stack); } void factor_vm::divide_by_zero_error() From c4fe86fa7d13d035e9936f0adba2a7763b03e440 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 21 Oct 2009 23:59:37 -0500 Subject: [PATCH 061/109] tweak windows exception error printing --- basis/debugger/windows/windows.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) mode change 100644 => 100755 basis/debugger/windows/windows.factor diff --git a/basis/debugger/windows/windows.factor b/basis/debugger/windows/windows.factor old mode 100644 new mode 100755 index 3485d96447..0de5c38283 --- a/basis/debugger/windows/windows.factor +++ b/basis/debugger/windows/windows.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs debugger io kernel literals namespaces prettyprint -sequences system windows.kernel32 ; +USING: assocs debugger io kernel literals math.parser namespaces +prettyprint sequences system windows.kernel32 ; IN: debugger.windows CONSTANT: seh-names @@ -33,8 +33,8 @@ CONSTANT: seh-names } : seh-name. ( n -- ) - seh-names get at [ " (" ")" surround write ] when* ; + seh-names at [ " (" ")" surround write ] when* ; M: windows signal-error. "Windows exception 0x" write - third [ .h ] [ seh-name. ] bi nl ; + third [ >hex write ] [ seh-name. ] bi nl ; From 9a91abe8a873e392e3e4f9b0395e732e4f4dfab5 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 00:18:01 -0500 Subject: [PATCH 062/109] also print undocumented windows SSE exception codes --- basis/debugger/windows/windows.factor | 2 ++ basis/windows/kernel32/kernel32.factor | 2 ++ 2 files changed, 4 insertions(+) diff --git a/basis/debugger/windows/windows.factor b/basis/debugger/windows/windows.factor index 3485d96447..188b820788 100644 --- a/basis/debugger/windows/windows.factor +++ b/basis/debugger/windows/windows.factor @@ -30,6 +30,8 @@ CONSTANT: seh-names { $ STATUS_PRIVILEGED_INSTRUCTION "STATUS_PRIVILEGED_INSTRUCTION" } { $ STATUS_STACK_OVERFLOW "STATUS_STACK_OVERFLOW" } { $ STATUS_CONTROL_C_EXIT "STATUS_CONTROL_C_EXIT" } + { $ STATUS_FLOAT_MULTIPLE_FAULTS "STATUS_FLOAT_MULTIPLE_FAULTS" } + { $ STATUS_FLOAT_MULTIPLE_TRAPS "STATUS_FLOAT_MULTIPLE_TRAPS" } } : seh-name. ( n -- ) diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 4cf93f7836..54d3fe6f4d 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -784,6 +784,8 @@ CONSTANT: STATUS_INTEGER_OVERFLOW HEX: C0000095 CONSTANT: STATUS_PRIVILEGED_INSTRUCTION HEX: C0000096 CONSTANT: STATUS_STACK_OVERFLOW HEX: C00000FD CONSTANT: STATUS_CONTROL_C_EXIT HEX: C000013A +CONSTANT: STATUS_FLOAT_MULTIPLE_FAULTS HEX: C00002B4 +CONSTANT: STATUS_FLOAT_MULTIPLE_TRAPS HEX: C00002B5 LIBRARY: kernel32 ! FUNCTION: _hread From f24942e06312c07de036185373d5f28c2128b6c3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 22 Oct 2009 05:22:59 -0500 Subject: [PATCH 063/109] vm: clean up signal handling and add EXC_BAD_INSTRUCTION Mach exception handler for OS X, since signal handlers cannot change the stack pointer --- vm/mach_signal.cpp | 12 ++++++-- vm/os-freebsd-x86.32.hpp | 10 ++----- vm/os-freebsd-x86.64.hpp | 10 ++----- vm/os-genunix.hpp | 5 ++++ vm/os-linux-arm.hpp | 12 ++------ vm/os-linux-ppc.hpp | 11 ++----- vm/os-linux-x86.32.hpp | 11 ++----- vm/os-linux-x86.64.hpp | 10 ++----- vm/os-macosx-ppc.hpp | 2 +- vm/os-macosx-x86.32.hpp | 2 +- vm/os-macosx-x86.64.hpp | 2 +- vm/os-macosx.hpp | 8 ++---- vm/os-netbsd-x86.32.hpp | 6 ++-- vm/os-netbsd-x86.64.hpp | 7 ++--- vm/os-openbsd-x86.32.hpp | 14 +++------ vm/os-openbsd-x86.64.hpp | 14 +++------ vm/os-solaris-x86.32.hpp | 10 ++----- vm/os-solaris-x86.64.hpp | 10 ++----- vm/os-unix.cpp | 62 +++++++++++++++------------------------- vm/vm.hpp | 11 ++----- 20 files changed, 79 insertions(+), 150 deletions(-) diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp index 2d76b12c38..d05942ff7e 100644 --- a/vm/mach_signal.cpp +++ b/vm/mach_signal.cpp @@ -47,7 +47,7 @@ void factor_vm::call_fault_handler( else signal_callstack_top = NULL; - MACH_STACK_POINTER(thread_state) = fix_stack_pointer(MACH_STACK_POINTER(thread_state)); + MACH_STACK_POINTER(thread_state) = align_stack_pointer(MACH_STACK_POINTER(thread_state)); /* Now we point the program counter at the right handler function. */ if(exception == EXC_BAD_ACCESS) @@ -63,7 +63,13 @@ void factor_vm::call_fault_handler( } else { - signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT); + switch(exception) + { + case EXC_ARITHMETIC: signal_number = SIGFPE; break; + case EXC_BAD_INSTRUCTION: signal_number = SIGILL; break; + default: signal_number = SIGABRT; break; + } + MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::misc_signal_handler_impl; } } @@ -226,7 +232,7 @@ void mach_initialize () fatal_error("mach_port_insert_right() failed",0); /* The exceptions we want to catch. */ - mask = EXC_MASK_BAD_ACCESS | EXC_MASK_ARITHMETIC; + mask = EXC_MASK_BAD_ACCESS | EXC_MASK_BAD_INSTRUCTION | EXC_MASK_ARITHMETIC; /* Create the thread listening on the exception port. */ start_thread(mach_exception_thread,NULL); diff --git a/vm/os-freebsd-x86.32.hpp b/vm/os-freebsd-x86.32.hpp index e682fec13c..5ed5cf0e81 100644 --- a/vm/os-freebsd-x86.32.hpp +++ b/vm/os-freebsd-x86.32.hpp @@ -4,12 +4,6 @@ namespace factor { -inline static void *ucontext_stack_pointer(void *uap) -{ - ucontext_t *ucontext = (ucontext_t *)uap; - return (void *)ucontext->uc_mcontext.mc_esp; -} - inline static unsigned int uap_fpu_status(void *uap) { ucontext_t *ucontext = (ucontext_t *)uap; @@ -43,6 +37,8 @@ inline static void uap_clear_fpu_status(void *uap) } } -#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)(ucontext))->uc_mcontext.mc_eip) + +#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.mc_esp) +#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.mc_eip) } diff --git a/vm/os-freebsd-x86.64.hpp b/vm/os-freebsd-x86.64.hpp index 8f8d218a10..02f7fb3ad2 100644 --- a/vm/os-freebsd-x86.64.hpp +++ b/vm/os-freebsd-x86.64.hpp @@ -4,12 +4,6 @@ namespace factor { -inline static void *ucontext_stack_pointer(void *uap) -{ - ucontext_t *ucontext = (ucontext_t *)uap; - return (void *)ucontext->uc_mcontext.mc_rsp; -} - inline static unsigned int uap_fpu_status(void *uap) { ucontext_t *ucontext = (ucontext_t *)uap; @@ -33,6 +27,8 @@ inline static void uap_clear_fpu_status(void *uap) } } -#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)(ucontext))->uc_mcontext.mc_rip) + +#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.mc_rsp) +#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.mc_rip) } diff --git a/vm/os-genunix.hpp b/vm/os-genunix.hpp index 1972a728e6..626d399a27 100644 --- a/vm/os-genunix.hpp +++ b/vm/os-genunix.hpp @@ -10,4 +10,9 @@ void early_init(); const char *vm_executable_path(); const char *default_image_path(); +inline static cell align_stack_pointer(cell sp) +{ + return sp; +} + } diff --git a/vm/os-linux-arm.hpp b/vm/os-linux-arm.hpp index 70c3eb3ff6..3af92fda99 100644 --- a/vm/os-linux-arm.hpp +++ b/vm/os-linux-arm.hpp @@ -5,15 +5,9 @@ namespace factor { -inline static void *ucontext_stack_pointer(void *uap) -{ - ucontext_t *ucontext = (ucontext_t *)uap; - return (void *)ucontext->uc_mcontext.arm_sp; -} - -#define UAP_PROGRAM_COUNTER(ucontext) \ - (((ucontext_t *)(ucontext))->uc_mcontext.arm_pc) - void flush_icache(cell start, cell len); +#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.arm_sp) +#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.arm_pc) + } diff --git a/vm/os-linux-ppc.hpp b/vm/os-linux-ppc.hpp index 62671e5ded..51e017bdad 100644 --- a/vm/os-linux-ppc.hpp +++ b/vm/os-linux-ppc.hpp @@ -4,14 +4,7 @@ namespace factor { #define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 1) - -inline static void *ucontext_stack_pointer(void *uap) -{ - ucontext_t *ucontext = (ucontext_t *)uap; - return (void *)ucontext->uc_mcontext.uc_regs->gregs[PT_R1]; -} - -#define UAP_PROGRAM_COUNTER(ucontext) \ - (((ucontext_t *)(ucontext))->uc_mcontext.uc_regs->gregs[PT_NIP]) +#define UAP_STACK_POINTER(ucontext) ((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[PT_R1] +#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.uc_regs->gregs[PT_NIP]) } diff --git a/vm/os-linux-x86.32.hpp b/vm/os-linux-x86.32.hpp index bd2315ccef..53a93d17de 100644 --- a/vm/os-linux-x86.32.hpp +++ b/vm/os-linux-x86.32.hpp @@ -29,12 +29,6 @@ struct _fpstate { #define X86_FXSR_MAGIC 0x0000 -inline static void *ucontext_stack_pointer(void *uap) -{ - ucontext_t *ucontext = (ucontext_t *)uap; - return (void *)ucontext->uc_mcontext.gregs[7]; -} - inline static unsigned int uap_fpu_status(void *uap) { ucontext_t *ucontext = (ucontext_t *)uap; @@ -54,7 +48,8 @@ inline static void uap_clear_fpu_status(void *uap) fpregs->mxcsr &= 0xffffffc0; } -#define UAP_PROGRAM_COUNTER(ucontext) \ - (((ucontext_t *)(ucontext))->uc_mcontext.gregs[14]) + +#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[7]) +#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[14]) } diff --git a/vm/os-linux-x86.64.hpp b/vm/os-linux-x86.64.hpp index 42adb3c6b8..14ba9fb002 100644 --- a/vm/os-linux-x86.64.hpp +++ b/vm/os-linux-x86.64.hpp @@ -3,12 +3,6 @@ namespace factor { -inline static void *ucontext_stack_pointer(void *uap) -{ - ucontext_t *ucontext = (ucontext_t *)uap; - return (void *)ucontext->uc_mcontext.gregs[15]; -} - inline static unsigned int uap_fpu_status(void *uap) { ucontext_t *ucontext = (ucontext_t *)uap; @@ -23,7 +17,7 @@ inline static void uap_clear_fpu_status(void *uap) ucontext->uc_mcontext.fpregs->mxcsr &= 0xffffffc0; } -#define UAP_PROGRAM_COUNTER(ucontext) \ - (((ucontext_t *)(ucontext))->uc_mcontext.gregs[16]) +#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[15]) +#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[16]) } diff --git a/vm/os-macosx-ppc.hpp b/vm/os-macosx-ppc.hpp index 2bea926890..70fa18142a 100644 --- a/vm/os-macosx-ppc.hpp +++ b/vm/os-macosx-ppc.hpp @@ -62,7 +62,7 @@ inline static unsigned int uap_fpu_status(void *uap) return mach_fpu_status(UAP_FS(uap)); } -inline static cell fix_stack_pointer(cell sp) +inline static cell align_stack_pointer(cell sp) { return sp; } diff --git a/vm/os-macosx-x86.32.hpp b/vm/os-macosx-x86.32.hpp index 89906cd9a4..4bdc68ff72 100644 --- a/vm/os-macosx-x86.32.hpp +++ b/vm/os-macosx-x86.32.hpp @@ -64,7 +64,7 @@ inline static unsigned int uap_fpu_status(void *uap) return mach_fpu_status(UAP_FS(uap)); } -inline static cell fix_stack_pointer(cell sp) +inline static cell align_stack_pointer(cell sp) { return ((sp + 4) & ~15) - 4; } diff --git a/vm/os-macosx-x86.64.hpp b/vm/os-macosx-x86.64.hpp index fd6db4d68c..b923674cd1 100644 --- a/vm/os-macosx-x86.64.hpp +++ b/vm/os-macosx-x86.64.hpp @@ -62,7 +62,7 @@ inline static unsigned int uap_fpu_status(void *uap) return mach_fpu_status(UAP_FS(uap)); } -inline static cell fix_stack_pointer(cell sp) +inline static cell align_stack_pointer(cell sp) { return ((sp + 8) & ~15) - 8; } diff --git a/vm/os-macosx.hpp b/vm/os-macosx.hpp index cdc0ff7b42..0d230f48e3 100644 --- a/vm/os-macosx.hpp +++ b/vm/os-macosx.hpp @@ -11,12 +11,8 @@ void early_init(); const char *vm_executable_path(); const char *default_image_path(); -inline static void *ucontext_stack_pointer(void *uap) -{ - ucontext_t *ucontext = (ucontext_t *)uap; - return ucontext->uc_stack.ss_sp; -} - void c_to_factor_toplevel(cell quot); +#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_stack.ss_sp) + } diff --git a/vm/os-netbsd-x86.32.hpp b/vm/os-netbsd-x86.32.hpp index f2f47ecf6c..21b3557239 100644 --- a/vm/os-netbsd-x86.32.hpp +++ b/vm/os-netbsd-x86.32.hpp @@ -3,9 +3,9 @@ namespace factor { -#define ucontext_stack_pointer(uap) ((void *)_UC_MACHINE_SP((ucontext_t *)uap)) - static inline unsigned int uap_fpu_status(void *uap) { return 0; } -static inline void uap_clear_fpu_status(void *uap) { } +static inline void uap_clear_fpu_status(void *uap) {} + +#define UAP_STACK_POINTER(ucontext) (_UC_MACHINE_SP((ucontext_t *)ucontext)) } diff --git a/vm/os-netbsd-x86.64.hpp b/vm/os-netbsd-x86.64.hpp index a9d52a6c2b..3e94998993 100644 --- a/vm/os-netbsd-x86.64.hpp +++ b/vm/os-netbsd-x86.64.hpp @@ -3,10 +3,9 @@ namespace factor { -#define ucontext_stack_pointer(uap) \ - ((void *)(((ucontext_t *)(uap))->uc_mcontext.__gregs[_REG_URSP])) - static inline unsigned int uap_fpu_status(void *uap) { return 0; } -static inline void uap_clear_fpu_status(void *uap) { } +static inline void uap_clear_fpu_status(void *uap) {} + +#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.__gregs[_REG_URSP]) } diff --git a/vm/os-openbsd-x86.32.hpp b/vm/os-openbsd-x86.32.hpp index 0abd019219..34a641c235 100644 --- a/vm/os-openbsd-x86.32.hpp +++ b/vm/os-openbsd-x86.32.hpp @@ -3,16 +3,10 @@ namespace factor { -inline static void *openbsd_stack_pointer(void *uap) -{ - struct sigcontext *sc = (struct sigcontext*) uap; - return (void *)sc->sc_esp; -} - -#define ucontext_stack_pointer openbsd_stack_pointer -#define UAP_PROGRAM_COUNTER(uap) (((struct sigcontext*)(uap))->sc_eip) - static inline unsigned int uap_fpu_status(void *uap) { return 0; } -static inline void uap_clear_fpu_status(void *uap) { } +static inline void uap_clear_fpu_status(void *uap) {} + +#define UAP_STACK_POINTER(ucontext) (((struct sigcontext *)ucontext)->sc_esp) +#define UAP_PROGRAM_COUNTER(ucontext) (((struct sigcontext *)ucontext)->sc_eip) } diff --git a/vm/os-openbsd-x86.64.hpp b/vm/os-openbsd-x86.64.hpp index 9dce48ee91..032e77b154 100644 --- a/vm/os-openbsd-x86.64.hpp +++ b/vm/os-openbsd-x86.64.hpp @@ -3,16 +3,10 @@ namespace factor { -inline static void *openbsd_stack_pointer(void *uap) -{ - struct sigcontext *sc = (struct sigcontext*) uap; - return (void *)sc->sc_rsp; -} - -#define ucontext_stack_pointer openbsd_stack_pointer -#define UAP_PROGRAM_COUNTER(uap) (((struct sigcontext*)(uap))->sc_rip) - static inline unsigned int uap_fpu_status(void *uap) { return 0; } -static inline void uap_clear_fpu_status(void *uap) { } +static inline void uap_clear_fpu_status(void *uap) {} + +#define UAP_STACK_POINTER(ucontext) (((struct sigcontext *)ucontext)->sc_rsp) +#define UAP_PROGRAM_COUNTER(ucontext) (((struct sigcontext *)ucontext)->sc_rip) } diff --git a/vm/os-solaris-x86.32.hpp b/vm/os-solaris-x86.32.hpp index b89b8d541b..2ec8bc138f 100644 --- a/vm/os-solaris-x86.32.hpp +++ b/vm/os-solaris-x86.32.hpp @@ -3,13 +3,7 @@ namespace factor { -inline static void *ucontext_stack_pointer(void *uap) -{ - ucontext_t *ucontext = (ucontext_t *)uap; - return (void *)ucontext->uc_mcontext.gregs[ESP]; -} - -#define UAP_PROGRAM_COUNTER(ucontext) \ - (((ucontext_t *)(ucontext))->uc_mcontext.gregs[EIP]) +#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[ESP]) +#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[EIP]) } diff --git a/vm/os-solaris-x86.64.hpp b/vm/os-solaris-x86.64.hpp index 0d3a74e11d..72a7b5c2fd 100644 --- a/vm/os-solaris-x86.64.hpp +++ b/vm/os-solaris-x86.64.hpp @@ -3,13 +3,7 @@ namespace factor { -inline static void *ucontext_stack_pointer(void *uap) -{ - ucontext_t *ucontext = (ucontext_t *)uap; - return (void *)ucontext->uc_mcontext.gregs[RSP]; -} - -#define UAP_PROGRAM_COUNTER(ucontext) \ - (((ucontext_t *)(ucontext))->uc_mcontext.gregs[RIP]) +#define UAP_STACK_POINTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[RSP]) +#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)ucontext)->uc_mcontext.gregs[RIP]) } diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp index 2f9d5a3c89..0f2570b183 100644 --- a/vm/os-unix.cpp +++ b/vm/os-unix.cpp @@ -115,63 +115,47 @@ segment::~segment() if(retval) fatal_error("Segment deallocation failed",0); } - -stack_frame *factor_vm::uap_stack_pointer(void *uap) + +void factor_vm::dispatch_signal(void *uap, void (handler)()) { - /* There is a race condition here, but in practice a signal - delivered during stack frame setup/teardown or while transitioning - from Factor to C is a sign of things seriously gone wrong, not just - a divide by zero or stack underflow in the listener */ if(in_code_heap_p(UAP_PROGRAM_COUNTER(uap))) { - stack_frame *ptr = (stack_frame *)ucontext_stack_pointer(uap); - if(!ptr) - critical_error("Invalid uap",(cell)uap); - return ptr; + stack_frame *ptr = (stack_frame *)UAP_STACK_POINTER(uap); + assert(ptr); + signal_callstack_top = ptr; } else - return NULL; -} + signal_callstack_top = NULL; -void factor_vm::memory_signal_handler(int signal, siginfo_t *siginfo, void *uap) -{ - signal_fault_addr = (cell)siginfo->si_addr; - signal_callstack_top = uap_stack_pointer(uap); - UAP_PROGRAM_COUNTER(uap) = (cell)factor::memory_signal_handler_impl; + UAP_STACK_POINTER(uap) = (void *)align_stack_pointer((cell)UAP_STACK_POINTER(uap)); + UAP_PROGRAM_COUNTER(uap) = (cell)handler; } void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap) { - tls_vm()->memory_signal_handler(signal,siginfo,uap); -} - -void factor_vm::misc_signal_handler(int signal, siginfo_t *siginfo, void *uap) -{ - signal_number = signal; - signal_callstack_top = uap_stack_pointer(uap); - UAP_PROGRAM_COUNTER(uap) = (cell)factor::misc_signal_handler_impl; + factor_vm *vm = tls_vm(); + vm->signal_fault_addr = (cell)siginfo->si_addr; + vm->dispatch_signal(uap,factor::memory_signal_handler_impl); } void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap) { - tls_vm()->misc_signal_handler(signal,siginfo,uap); -} - -void factor_vm::fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap) -{ - signal_number = signal; - signal_callstack_top = uap_stack_pointer(uap); - signal_fpu_status = fpu_status(uap_fpu_status(uap)); - uap_clear_fpu_status(uap); - UAP_PROGRAM_COUNTER(uap) = - (siginfo->si_code == FPE_INTDIV || siginfo->si_code == FPE_INTOVF) - ? (cell)factor::misc_signal_handler_impl - : (cell)factor::fp_signal_handler_impl; + factor_vm *vm = tls_vm(); + vm->signal_number = signal; + vm->dispatch_signal(uap,factor::misc_signal_handler_impl); } void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap) { - tls_vm()->fpe_signal_handler(signal, siginfo, uap); + factor_vm *vm = tls_vm(); + vm->signal_number = signal; + vm->signal_fpu_status = fpu_status(uap_fpu_status(uap)); + uap_clear_fpu_status(uap); + + vm->dispatch_signal(uap, + (siginfo->si_code == FPE_INTDIV || siginfo->si_code == FPE_INTOVF) + ? factor::misc_signal_handler_impl + : factor::fp_signal_handler_impl); } static void sigaction_safe(int signum, const struct sigaction *act, struct sigaction *oldact) diff --git a/vm/vm.hpp b/vm/vm.hpp index 202996ce26..4b115ecd3f 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -689,17 +689,12 @@ struct factor_vm void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length); bool windows_stat(vm_char *path); - #if defined(WINNT) + #if defined(WINNT) void open_console(); LONG exception_handler(PEXCEPTION_POINTERS pe); - // next method here: - #endif + #endif #else // UNIX - void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap); - void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap); - void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap); - stack_frame *uap_stack_pointer(void *uap); - + void factor_vm::dispatch_signal(void *uap, void (handler)()); #endif #ifdef __APPLE__ From 3d5c3935ad8b31c8052e381ac84d9e19f582dac9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 22 Oct 2009 06:38:02 -0400 Subject: [PATCH 064/109] vm: fix compilation --- vm/os-genunix.hpp | 2 +- vm/os-macosx-ppc.hpp | 2 +- vm/os-macosx-x86.32.hpp | 4 ++-- vm/os-macosx-x86.64.hpp | 4 ++-- vm/os-unix.cpp | 2 +- vm/vm.hpp | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) diff --git a/vm/os-genunix.hpp b/vm/os-genunix.hpp index 626d399a27..ff5d29ecd7 100644 --- a/vm/os-genunix.hpp +++ b/vm/os-genunix.hpp @@ -10,7 +10,7 @@ void early_init(); const char *vm_executable_path(); const char *default_image_path(); -inline static cell align_stack_pointer(cell sp) +template Type align_stack_pointer(Type sp) { return sp; } diff --git a/vm/os-macosx-ppc.hpp b/vm/os-macosx-ppc.hpp index 70fa18142a..30fd4b2081 100644 --- a/vm/os-macosx-ppc.hpp +++ b/vm/os-macosx-ppc.hpp @@ -62,7 +62,7 @@ inline static unsigned int uap_fpu_status(void *uap) return mach_fpu_status(UAP_FS(uap)); } -inline static cell align_stack_pointer(cell sp) +template Type align_stack_pointer(Type sp) { return sp; } diff --git a/vm/os-macosx-x86.32.hpp b/vm/os-macosx-x86.32.hpp index 4bdc68ff72..a6fe8e2703 100644 --- a/vm/os-macosx-x86.32.hpp +++ b/vm/os-macosx-x86.32.hpp @@ -64,9 +64,9 @@ inline static unsigned int uap_fpu_status(void *uap) return mach_fpu_status(UAP_FS(uap)); } -inline static cell align_stack_pointer(cell sp) +template Type align_stack_pointer(Type sp) { - return ((sp + 4) & ~15) - 4; + return (Type)((((cell)sp + 4) & ~15) - 4); } inline static void mach_clear_fpu_status(i386_float_state_t *float_state) diff --git a/vm/os-macosx-x86.64.hpp b/vm/os-macosx-x86.64.hpp index b923674cd1..cb1980ddbf 100644 --- a/vm/os-macosx-x86.64.hpp +++ b/vm/os-macosx-x86.64.hpp @@ -62,9 +62,9 @@ inline static unsigned int uap_fpu_status(void *uap) return mach_fpu_status(UAP_FS(uap)); } -inline static cell align_stack_pointer(cell sp) +template Type align_stack_pointer(Type sp) { - return ((sp + 8) & ~15) - 8; + return (Type)((((cell)sp + 8) & ~15) - 8); } inline static void mach_clear_fpu_status(x86_float_state64_t *float_state) diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp index 0f2570b183..cd88541136 100644 --- a/vm/os-unix.cpp +++ b/vm/os-unix.cpp @@ -127,7 +127,7 @@ void factor_vm::dispatch_signal(void *uap, void (handler)()) else signal_callstack_top = NULL; - UAP_STACK_POINTER(uap) = (void *)align_stack_pointer((cell)UAP_STACK_POINTER(uap)); + UAP_STACK_POINTER(uap) = align_stack_pointer(UAP_STACK_POINTER(uap)); UAP_PROGRAM_COUNTER(uap) = (cell)handler; } diff --git a/vm/vm.hpp b/vm/vm.hpp index 4b115ecd3f..2c85b8ec49 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -694,7 +694,7 @@ struct factor_vm LONG exception_handler(PEXCEPTION_POINTERS pe); #endif #else // UNIX - void factor_vm::dispatch_signal(void *uap, void (handler)()); + void dispatch_signal(void *uap, void (handler)()); #endif #ifdef __APPLE__ From 0c40eb51ae9bdb6c48ca1cb7d597474a569c782d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 22 Oct 2009 05:40:31 -0500 Subject: [PATCH 065/109] tools.profiler: fix tests --- basis/tools/profiler/profiler-tests.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor index f7da0d1636..7f44a6138c 100644 --- a/basis/tools/profiler/profiler-tests.factor +++ b/basis/tools/profiler/profiler-tests.factor @@ -1,7 +1,7 @@ -IN: tools.profiler.tests USING: accessors tools.profiler tools.test kernel memory math -threads alien tools.profiler.private sequences compiler compiler.units -words ; +threads alien alien.c-types tools.profiler.private sequences +compiler compiler.units words ; +IN: tools.profiler.tests [ t ] [ \ length counter>> From 3f1b664b74b57f1ef1f845f28419171f514fea74 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 13:31:03 -0500 Subject: [PATCH 066/109] break off a "sequences.generalizations" vocab for neach, nmap, and mnmap --- .../generalizations-docs.factor | 28 +---- .../generalizations-tests.factor | 102 ----------------- basis/generalizations/generalizations.factor | 54 --------- .../generalizations-docs.factor | 36 ++++++ .../generalizations-tests.factor | 107 ++++++++++++++++++ .../generalizations/generalizations.factor | 59 ++++++++++ extra/alien/data/map/map.factor | 3 +- 7 files changed, 206 insertions(+), 183 deletions(-) create mode 100644 basis/sequences/generalizations/generalizations-docs.factor create mode 100644 basis/sequences/generalizations/generalizations-tests.factor create mode 100644 basis/sequences/generalizations/generalizations.factor diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index f5c0de2ea2..e9a709030e 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -266,26 +266,6 @@ HELP: spread-curry { $description "Curries the " { $snippet "n" } " quotations on the top of the datastack with the " { $snippet "n" } " values just below them. A generalization of " { $link bi-curry* } " and " { $link tri-curry* } "." } { $notes "This word can be used with " { $link cleave* } " and " { $link spread* } " to generalize dataflow patterns such as " { $snippet "bi-curry* bi" } ", " { $snippet "tri-curry* tri" } ", " { $snippet "bi-curry* bi*" } ", and " { $snippet "tri-curry* tri*" } "." } ; -HELP: neach -{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- )" } } { "n" integer } } -{ $description "A generalization of " { $link each } ", " { $link 2each } ", and " { $link 3each } " that can iterate over any number of sequences in parallel." } ; - -HELP: nmap -{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- result )" } } { "n" integer } { "result" "a sequence of the same type as the first " { $snippet "seq" } } } -{ $description "A generalization of " { $link map } ", " { $link 2map } ", and " { $link 3map } " that can map over any number of sequences in parallel." } ; - -HELP: nmap-as -{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- result )" } } { "exemplar" sequence } { "n" integer } { "result" "a sequence of the same type as " { $snippet "exemplar" } } } -{ $description "A generalization of " { $link map-as } ", " { $link 2map-as } ", and " { $link 3map-as } " that can map over any number of sequences in parallel." } ; - -HELP: mnmap -{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences of the same type as the first " { $snippet "seq" } } } -{ $description "A generalization of " { $link map } ", " { $link 2map } ", and " { $link 3map } " that can map over any number of sequences in parallel and provide any number of output sequences." } ; - -HELP: mnmap-as -{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "n*exemplar" { $snippet "n" } " sequences on the datastack" } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences of the same type as the " { $snippet "exemplar" } "s" } } -{ $description "A generalization of " { $link map-as } ", " { $link 2map-as } ", and " { $link 3map-as } " that can map over any number of sequences in parallel and provide any number of output sequences of distinct types." } ; - HELP: mnswap { $values { "m" integer } { "n" integer } } { $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." } @@ -401,11 +381,6 @@ ARTICLE: "combinator-generalizations" "Generalized combinators" apply-curry cleave-curry spread-curry - neach - nmap - nmap-as - mnmap - mnmap-as } ; ARTICLE: "other-generalizations" "Additional generalizations" @@ -424,6 +399,7 @@ ARTICLE: "generalizations" "Generalized shuffle words and combinators" "shuffle-generalizations" "combinator-generalizations" "other-generalizations" -} ; +} +"Also see the " { $vocab-link "sequences.generalizations" } " vocabulary for generalized sequence iteration combinators." ; ABOUT: "generalizations" diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index cb2c40ca0a..c54e35002f 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -82,108 +82,6 @@ IN: generalizations.tests [ '[ number>string _ append ] 4 napply ] must-infer -: neach-test ( a b c d -- ) - [ 4 nappend print ] 4 neach ; -: nmap-test ( a b c d -- e ) - [ 4 nappend ] 4 nmap ; -: nmap-as-test ( a b c d -- e ) - [ 4 nappend ] [ ] 4 nmap-as ; -: mnmap-3-test ( a b c d -- e f g ) - [ append ] 4 3 mnmap ; -: mnmap-2-test ( a b c d -- e f ) - [ [ append ] 2bi@ ] 4 2 mnmap ; -: mnmap-as-test ( a b c d -- e f ) - [ [ append ] 2bi@ ] { } [ ] 4 2 mnmap-as ; -: mnmap-1-test ( a b c d -- e ) - [ 4 nappend ] 4 1 mnmap ; -: mnmap-0-test ( a b c d -- ) - [ 4 nappend print ] 4 0 mnmap ; - -[ """A1a! -B2b@ -C3c# -D4d$ -""" ] [ - { "A" "B" "C" "D" } - { "1" "2" "3" "4" } - { "a" "b" "c" "d" } - { "!" "@" "#" "$" } - [ neach-test ] with-string-writer -] unit-test - -[ { "A1a!" "B2b@" "C3c#" "D4d$" } ] -[ - { "A" "B" "C" "D" } - { "1" "2" "3" "4" } - { "a" "b" "c" "d" } - { "!" "@" "#" "$" } - nmap-test -] unit-test - -[ [ "A1a!" "B2b@" "C3c#" "D4d$" ] ] -[ - { "A" "B" "C" "D" } - { "1" "2" "3" "4" } - { "a" "b" "c" "d" } - { "!" "@" "#" "$" } - nmap-as-test -] unit-test - -[ - { "A" "B" "C" "D" } - { "1" "2" "3" "4" } - { "a!" "b@" "c#" "d$" } -] [ - { "A" "B" "C" "D" } - { "1" "2" "3" "4" } - { "a" "b" "c" "d" } - { "!" "@" "#" "$" } - mnmap-3-test -] unit-test - -[ - { "A1" "B2" "C3" "D4" } - { "a!" "b@" "c#" "d$" } -] [ - { "A" "B" "C" "D" } - { "1" "2" "3" "4" } - { "a" "b" "c" "d" } - { "!" "@" "#" "$" } - mnmap-2-test -] unit-test - -[ - { "A1" "B2" "C3" "D4" } - [ "a!" "b@" "c#" "d$" ] -] [ - { "A" "B" "C" "D" } - { "1" "2" "3" "4" } - { "a" "b" "c" "d" } - { "!" "@" "#" "$" } - mnmap-as-test -] unit-test - -[ { "A1a!" "B2b@" "C3c#" "D4d$" } ] -[ - { "A" "B" "C" "D" } - { "1" "2" "3" "4" } - { "a" "b" "c" "d" } - { "!" "@" "#" "$" } - mnmap-1-test -] unit-test - -[ """A1a! -B2b@ -C3c# -D4d$ -""" ] [ - { "A" "B" "C" "D" } - { "1" "2" "3" "4" } - { "a" "b" "c" "d" } - { "!" "@" "#" "$" } - [ mnmap-0-test ] with-string-writer -] unit-test - [ 6 8 10 12 ] [ 1 2 3 4 5 6 7 8 [ + ] 4 apply-curry 4 spread* diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 2ae076655e..8d6d6f2ac0 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -142,57 +142,3 @@ MACRO: nbi-curry ( n -- ) MACRO: nspin ( n -- ) [ [ ] ] swap [ swap [ ] curry compose ] n*quot [ call ] 3append ; -MACRO: nmin-length ( n -- ) - dup 1 - [ min ] n*quot - '[ [ length ] _ napply @ ] ; - -: nnth-unsafe ( n ...seq n -- ) - [ nth-unsafe ] swap [ apply-curry ] [ cleave* ] bi ; inline -MACRO: nset-nth-unsafe ( n -- ) - [ [ drop ] ] - [ '[ [ set-nth-unsafe ] _ [ apply-curry ] [ cleave-curry ] [ spread* ] tri ] ] - if-zero ; - -: (neach) ( ...seq quot n -- len quot' ) - dup dup dup - '[ [ _ nmin-length ] _ nkeep [ _ nnth-unsafe ] _ ncurry ] dip compose ; inline - -: neach ( ...seq quot n -- ) - (neach) each-integer ; inline - -: nmap-as ( ...seq quot exemplar n -- result ) - '[ _ (neach) ] dip map-integers ; inline - -: nmap ( ...seq quot n -- result ) - dup '[ [ _ npick ] dip swap ] dip nmap-as ; inline - -MACRO: nnew-sequence ( n -- ) - [ [ drop ] ] - [ dup '[ [ new-sequence ] _ apply-curry _ cleave* ] ] if-zero ; - -: nnew-like ( len ...exemplar quot n -- result... ) - dup dup dup dup '[ - _ nover - [ [ _ nnew-sequence ] dip call ] - _ ndip [ like ] - _ apply-curry - _ spread* - ] call ; inline - -MACRO: (ncollect) ( n -- ) - dup dup 1 + - '[ [ [ keep ] _ ndip _ nset-nth-unsafe ] _ ncurry ] ; - -: ncollect ( len quot ...into n -- ) - (ncollect) each-integer ; inline - -: nmap-integers ( len quot ...exemplar n -- result... ) - dup dup dup - '[ [ over ] _ ndip [ [ _ ncollect ] _ nkeep ] _ nnew-like ] call ; inline - -: mnmap-as ( m*seq quot n*exemplar m n -- result*n ) - dup '[ [ _ (neach) ] _ ndip _ nmap-integers ] call ; inline - -: mnmap ( m*seq quot m n -- result*n ) - 2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline - diff --git a/basis/sequences/generalizations/generalizations-docs.factor b/basis/sequences/generalizations/generalizations-docs.factor new file mode 100644 index 0000000000..d2e8c0c5fc --- /dev/null +++ b/basis/sequences/generalizations/generalizations-docs.factor @@ -0,0 +1,36 @@ +! (c)2009 Joe Groff bsd license +USING: help.syntax help.markup kernel sequences quotations +math arrays combinators ; +IN: sequences.generalizations + +HELP: neach +{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- )" } } { "n" integer } } +{ $description "A generalization of " { $link each } ", " { $link 2each } ", and " { $link 3each } " that can iterate over any number of sequences in parallel." } ; + +HELP: nmap +{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- result )" } } { "n" integer } { "result" "a sequence of the same type as the first " { $snippet "seq" } } } +{ $description "A generalization of " { $link map } ", " { $link 2map } ", and " { $link 3map } " that can map over any number of sequences in parallel." } ; + +HELP: nmap-as +{ $values { "...seq" { $snippet "n" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- result )" } } { "exemplar" sequence } { "n" integer } { "result" "a sequence of the same type as " { $snippet "exemplar" } } } +{ $description "A generalization of " { $link map-as } ", " { $link 2map-as } ", and " { $link 3map-as } " that can map over any number of sequences in parallel." } ; + +HELP: mnmap +{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences of the same type as the first " { $snippet "seq" } } } +{ $description "A generalization of " { $link map } ", " { $link 2map } ", and " { $link 3map } " that can map over any number of sequences in parallel and provide any number of output sequences." } ; + +HELP: mnmap-as +{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "n*exemplar" { $snippet "n" } " sequences on the datastack" } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences of the same type as the " { $snippet "exemplar" } "s" } } +{ $description "A generalization of " { $link map-as } ", " { $link 2map-as } ", and " { $link 3map-as } " that can map over any number of sequences in parallel and provide any number of output sequences of distinct types." } ; + +ARTICLE: "sequences.generalizations" "Generalized sequence iteration combinators" +"The " { $vocab-link "sequences.generalizations" } " vocabulary defines generalized versions of the iteration " { $link "sequences-combinators" } "." +{ $subsections + neach + nmap + nmap-as + mnmap + mnmap-as +} ; + +ABOUT: "sequences.generalizations" diff --git a/basis/sequences/generalizations/generalizations-tests.factor b/basis/sequences/generalizations/generalizations-tests.factor new file mode 100644 index 0000000000..ac1990743e --- /dev/null +++ b/basis/sequences/generalizations/generalizations-tests.factor @@ -0,0 +1,107 @@ +! (c)2009 Joe Groff bsd license +USING: tools.test generalizations kernel math arrays sequences +sequences.generalizations ascii fry math.parser io io.streams.string ; +IN: sequences.generalizations.tests + +: neach-test ( a b c d -- ) + [ 4 nappend print ] 4 neach ; +: nmap-test ( a b c d -- e ) + [ 4 nappend ] 4 nmap ; +: nmap-as-test ( a b c d -- e ) + [ 4 nappend ] [ ] 4 nmap-as ; +: mnmap-3-test ( a b c d -- e f g ) + [ append ] 4 3 mnmap ; +: mnmap-2-test ( a b c d -- e f ) + [ [ append ] 2bi@ ] 4 2 mnmap ; +: mnmap-as-test ( a b c d -- e f ) + [ [ append ] 2bi@ ] { } [ ] 4 2 mnmap-as ; +: mnmap-1-test ( a b c d -- e ) + [ 4 nappend ] 4 1 mnmap ; +: mnmap-0-test ( a b c d -- ) + [ 4 nappend print ] 4 0 mnmap ; + +[ """A1a! +B2b@ +C3c# +D4d$ +""" ] [ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + [ neach-test ] with-string-writer +] unit-test + +[ { "A1a!" "B2b@" "C3c#" "D4d$" } ] +[ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + nmap-test +] unit-test + +[ [ "A1a!" "B2b@" "C3c#" "D4d$" ] ] +[ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + nmap-as-test +] unit-test + +[ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a!" "b@" "c#" "d$" } +] [ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + mnmap-3-test +] unit-test + +[ + { "A1" "B2" "C3" "D4" } + { "a!" "b@" "c#" "d$" } +] [ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + mnmap-2-test +] unit-test + +[ + { "A1" "B2" "C3" "D4" } + [ "a!" "b@" "c#" "d$" ] +] [ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + mnmap-as-test +] unit-test + +[ { "A1a!" "B2b@" "C3c#" "D4d$" } ] +[ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + mnmap-1-test +] unit-test + +[ """A1a! +B2b@ +C3c# +D4d$ +""" ] [ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + [ mnmap-0-test ] with-string-writer +] unit-test + diff --git a/basis/sequences/generalizations/generalizations.factor b/basis/sequences/generalizations/generalizations.factor new file mode 100644 index 0000000000..4365c1494d --- /dev/null +++ b/basis/sequences/generalizations/generalizations.factor @@ -0,0 +1,59 @@ +USING: kernel sequences sequences.private math +combinators macros math.order math.ranges quotations fry effects +memoize.private generalizations ; +IN: sequences.generalizations + +MACRO: nmin-length ( n -- ) + dup 1 - [ min ] n*quot + '[ [ length ] _ napply @ ] ; + +: nnth-unsafe ( n ...seq n -- ) + [ nth-unsafe ] swap [ apply-curry ] [ cleave* ] bi ; inline +MACRO: nset-nth-unsafe ( n -- ) + [ [ drop ] ] + [ '[ [ set-nth-unsafe ] _ [ apply-curry ] [ cleave-curry ] [ spread* ] tri ] ] + if-zero ; + +: (neach) ( ...seq quot n -- len quot' ) + dup dup dup + '[ [ _ nmin-length ] _ nkeep [ _ nnth-unsafe ] _ ncurry ] dip compose ; inline + +: neach ( ...seq quot n -- ) + (neach) each-integer ; inline + +: nmap-as ( ...seq quot exemplar n -- result ) + '[ _ (neach) ] dip map-integers ; inline + +: nmap ( ...seq quot n -- result ) + dup '[ [ _ npick ] dip swap ] dip nmap-as ; inline + +MACRO: nnew-sequence ( n -- ) + [ [ drop ] ] + [ dup '[ [ new-sequence ] _ apply-curry _ cleave* ] ] if-zero ; + +: nnew-like ( len ...exemplar quot n -- result... ) + dup dup dup dup '[ + _ nover + [ [ _ nnew-sequence ] dip call ] + _ ndip [ like ] + _ apply-curry + _ spread* + ] call ; inline + +MACRO: (ncollect) ( n -- ) + dup dup 1 + + '[ [ [ keep ] _ ndip _ nset-nth-unsafe ] _ ncurry ] ; + +: ncollect ( len quot ...into n -- ) + (ncollect) each-integer ; inline + +: nmap-integers ( len quot ...exemplar n -- result... ) + dup dup dup + '[ [ over ] _ ndip [ [ _ ncollect ] _ nkeep ] _ nnew-like ] call ; inline + +: mnmap-as ( m*seq quot n*exemplar m n -- result*n ) + dup '[ [ _ (neach) ] _ ndip _ nmap-integers ] call ; inline + +: mnmap ( m*seq quot m n -- result*n ) + 2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline + diff --git a/extra/alien/data/map/map.factor b/extra/alien/data/map/map.factor index 72f5cb5517..62bd45938b 100644 --- a/extra/alien/data/map/map.factor +++ b/extra/alien/data/map/map.factor @@ -1,7 +1,8 @@ ! (c)Joe Groff bsd license USING: accessors alien alien.c-types alien.data alien.parser arrays byte-arrays combinators effects.parser fry generalizations grouping kernel -lexer locals macros make math math.ranges parser sequences sequences.private ; +lexer locals macros make math math.ranges parser sequences +sequences.generalizations sequences.private ; FROM: alien.arrays => array-length ; IN: alien.data.map From fdea9b09f2aab1553dcafc9f41f81e4eb04f19ce Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 14:35:27 -0500 Subject: [PATCH 067/109] change produce-as so it uses an intermediate vector of a type appropriate to the destination type --- core/sequences/sequences.factor | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index c64095cb73..6e7d8984b2 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -498,11 +498,14 @@ PRIVATE> : partition ( seq quot -- trueseq falseseq ) over [ 2pusher [ each ] 2dip ] dip [ like ] curry bi@ ; inline +: accumulator-for ( quot exemplar -- quot' vec ) + [ length ] keep new-resizable [ [ push ] curry compose ] keep ; inline + : accumulator ( quot -- quot' vec ) - V{ } clone [ [ push ] curry compose ] keep ; inline + V{ } accumulator-for ; inline : produce-as ( pred quot exemplar -- seq ) - [ accumulator [ while ] dip ] dip like ; inline + dup '[ _ accumulator-for [ while ] dip ] dip like ; inline : produce ( pred quot -- seq ) { } produce-as ; inline From ba5429e7720a40e7cd37080163e274ee69518b79 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 14:53:16 -0500 Subject: [PATCH 068/109] fix sequences bootstrap --- core/sequences/sequences.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 6e7d8984b2..b46645d433 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -505,7 +505,7 @@ PRIVATE> V{ } accumulator-for ; inline : produce-as ( pred quot exemplar -- seq ) - dup '[ _ accumulator-for [ while ] dip ] dip like ; inline + dup [ accumulator-for [ while ] dip ] curry dip like ; inline : produce ( pred quot -- seq ) { } produce-as ; inline From e4f108714a3d6b7dfb68e556773385e4c5a367e7 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 15:32:34 -0500 Subject: [PATCH 069/109] add nproduce and nproduce-as combinators to sequences.generalizations --- .../generalizations-docs.factor | 12 ++++++++- .../generalizations-tests.factor | 13 ++++++++++ .../generalizations/generalizations.factor | 26 ++++++++++++++++--- 3 files changed, 47 insertions(+), 4 deletions(-) diff --git a/basis/sequences/generalizations/generalizations-docs.factor b/basis/sequences/generalizations/generalizations-docs.factor index d2e8c0c5fc..7940427e69 100644 --- a/basis/sequences/generalizations/generalizations-docs.factor +++ b/basis/sequences/generalizations/generalizations-docs.factor @@ -20,9 +20,17 @@ HELP: mnmap { $description "A generalization of " { $link map } ", " { $link 2map } ", and " { $link 3map } " that can map over any number of sequences in parallel and provide any number of output sequences." } ; HELP: mnmap-as -{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "n*exemplar" { $snippet "n" } " sequences on the datastack" } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences of the same type as the " { $snippet "exemplar" } "s" } } +{ $values { "m*seq" { $snippet "m" } " sequences on the datastack" } { "quot" "a quotation with stack effect " { $snippet "( m*element -- result*n )" } } { "n*exemplar" { $snippet "n" } " sequences on the datastack" } { "m" integer } { "n" integer } { "result*n" { $snippet "n" } " sequences on the datastack of the same types as the " { $snippet "exemplar" } "s" } } { $description "A generalization of " { $link map-as } ", " { $link 2map-as } ", and " { $link 3map-as } " that can map over any number of sequences in parallel and provide any number of output sequences of distinct types." } ; +HELP: nproduce +{ $values { "pred" { $quotation "( -- ? )" } } { "quot" { $quotation "( -- obj1 obj2 ... objn )" } } { "n" integer } { "seq..." { $snippet "n" } " arrays on the datastack" } } +{ $description "A generalization of " { $link produce } " that generates " { $snippet "n" } " arrays in parallel by calling " { $snippet "quot" } " repeatedly until " { $snippet "pred" } " outputs false." } ; + +HELP: nproduce-as +{ $values { "pred" { $quotation "( -- ? )" } } { "quot" { $quotation "( -- obj1 obj2 ... objn )" } } { "...exemplar" { $snippet "n" } " sequences on the datastack" } { "n" integer } { "seq..." { $snippet "n" } " sequences on the datastack of the same types as the " { $snippet "exemplar" } "s" } } +{ $description "A generalization of " { $link produce-as } " that generates " { $snippet "n" } " sequences in parallel by calling " { $snippet "quot" } " repeatedly until " { $snippet "pred" } " outputs false." } ; + ARTICLE: "sequences.generalizations" "Generalized sequence iteration combinators" "The " { $vocab-link "sequences.generalizations" } " vocabulary defines generalized versions of the iteration " { $link "sequences-combinators" } "." { $subsections @@ -31,6 +39,8 @@ ARTICLE: "sequences.generalizations" "Generalized sequence iteration combinators nmap-as mnmap mnmap-as + nproduce + nproduce-as } ; ABOUT: "sequences.generalizations" diff --git a/basis/sequences/generalizations/generalizations-tests.factor b/basis/sequences/generalizations/generalizations-tests.factor index ac1990743e..d1861b8f9d 100644 --- a/basis/sequences/generalizations/generalizations-tests.factor +++ b/basis/sequences/generalizations/generalizations-tests.factor @@ -19,6 +19,14 @@ IN: sequences.generalizations.tests [ 4 nappend ] 4 1 mnmap ; : mnmap-0-test ( a b c d -- ) [ 4 nappend print ] 4 0 mnmap ; +: nproduce-as-test ( n -- a b ) + [ dup zero? not ] + [ [ 2 - ] [ ] [ 1 - ] tri ] { } B{ } 2 nproduce-as + [ drop ] 2dip ; +: nproduce-test ( n -- a b ) + [ dup zero? not ] + [ [ 2 - ] [ ] [ 1 - ] tri ] 2 nproduce + [ drop ] 2dip ; [ """A1a! B2b@ @@ -105,3 +113,8 @@ D4d$ [ mnmap-0-test ] with-string-writer ] unit-test +[ { 10 8 6 4 2 } B{ 9 7 5 3 1 } ] +[ 10 nproduce-as-test ] unit-test + +[ { 10 8 6 4 2 } { 9 7 5 3 1 } ] +[ 10 nproduce-test ] unit-test diff --git a/basis/sequences/generalizations/generalizations.factor b/basis/sequences/generalizations/generalizations.factor index 4365c1494d..210b27f3f3 100644 --- a/basis/sequences/generalizations/generalizations.factor +++ b/basis/sequences/generalizations/generalizations.factor @@ -1,3 +1,4 @@ +! (c)2009 Joe Groff bsd license USING: kernel sequences sequences.private math combinators macros math.order math.ranges quotations fry effects memoize.private generalizations ; @@ -32,7 +33,7 @@ MACRO: nnew-sequence ( n -- ) [ dup '[ [ new-sequence ] _ apply-curry _ cleave* ] ] if-zero ; : nnew-like ( len ...exemplar quot n -- result... ) - dup dup dup dup '[ + 5 dupn '[ _ nover [ [ _ nnew-sequence ] dip call ] _ ndip [ like ] @@ -41,14 +42,14 @@ MACRO: nnew-sequence ( n -- ) ] call ; inline MACRO: (ncollect) ( n -- ) - dup dup 1 + + 3 dupn 1 + '[ [ [ keep ] _ ndip _ nset-nth-unsafe ] _ ncurry ] ; : ncollect ( len quot ...into n -- ) (ncollect) each-integer ; inline : nmap-integers ( len quot ...exemplar n -- result... ) - dup dup dup + 4 dupn '[ [ over ] _ ndip [ [ _ ncollect ] _ nkeep ] _ nnew-like ] call ; inline : mnmap-as ( m*seq quot n*exemplar m n -- result*n ) @@ -57,3 +58,22 @@ MACRO: (ncollect) ( n -- ) : mnmap ( m*seq quot m n -- result*n ) 2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline +: naccumulator-for ( quot ...exemplar n -- quot' vec... ) + 5 dupn '[ + [ [ length ] keep new-resizable ] _ napply + [ [ [ push ] _ apply-curry _ spread* ] _ ncurry compose ] _ nkeep + ] call ; inline + +: naccumulator ( quot n -- quot' vec... ) + [ V{ } swap dupn ] keep naccumulator-for ; inline + +: nproduce-as ( pred quot ...exemplar n -- seq... ) + 7 dupn '[ + _ ndup + [ _ naccumulator-for [ while ] _ ndip ] + _ ncurry _ ndip + [ like ] _ apply-curry _ spread* + ] call ; inline + +: nproduce ( pred quot n -- seq... ) + [ { } swap dupn ] keep nproduce-as ; inline From 84f203afcc363f81822acb7f46d6df9a8b466eaf Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 16:26:25 -0500 Subject: [PATCH 070/109] math.matrices: vectorizable definition of cross --- basis/math/matrices/matrices.factor | 4 +++- basis/math/vectors/vectors.factor | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor index 4a76a20598..8f75cb9442 100644 --- a/basis/math/matrices/matrices.factor +++ b/basis/math/matrices/matrices.factor @@ -122,7 +122,9 @@ IN: math.matrices PRIVATE> -: cross ( vec1 vec2 -- vec3 ) [ [ i ] [ j ] [ k ] 2tri ] keep 3sequence ; +: cross ( vec1 vec2 -- vec3 ) + [ [ { 1 2 1 } vshuffle ] [ { 2 0 0 } vshuffle ] bi* v* ] + [ [ { 2 0 0 } vshuffle ] [ { 1 2 1 } vshuffle ] bi* v* ] 2bi v- ; inline : proj ( v u -- w ) [ [ v. ] [ norm-sq ] bi / ] keep n*v ; diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 81af5c12d2..63564f064d 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -96,6 +96,7 @@ PRIVATE> :: vbroadcast ( u n -- v ) u length n u nth u like ; : vshuffle-elements ( u perm -- v ) + over length 0 pad-tail swap [ '[ _ nth ] ] keep map-as ; : vshuffle-bytes ( u perm -- v ) From 27100ae094a5b76c01a9495ae7fcdad535ffd90d Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 16:53:40 -0500 Subject: [PATCH 071/109] improve gpu.demos.bunny mesh generation performance --- extra/gpu/demos/bunny/bunny.factor | 47 ++++++++++++++++-------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/extra/gpu/demos/bunny/bunny.factor b/extra/gpu/demos/bunny/bunny.factor index 2e292f0141..0d3226c394 100755 --- a/extra/gpu/demos/bunny/bunny.factor +++ b/extra/gpu/demos/bunny/bunny.factor @@ -3,13 +3,15 @@ USING: accessors alien.c-types arrays classes.struct combinators combinators.short-circuit game.worlds gpu gpu.buffers gpu.util.wasd gpu.framebuffers gpu.render gpu.shaders gpu.state gpu.textures gpu.util grouping http.client images images.loader -io io.encodings.ascii io.files io.files.temp kernel math -math.matrices math.parser math.vectors method-chains sequences -splitting threads ui ui.gadgets ui.gadgets.worlds -ui.pixel-formats specialized-arrays specialized-vectors ; +io io.encodings.ascii io.files io.files.temp kernel locals math +math.matrices math.vectors.simd math.parser math.vectors +method-chains sequences splitting threads ui ui.gadgets +ui.gadgets.worlds ui.pixel-formats specialized-arrays +specialized-vectors ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float SPECIALIZED-VECTOR: uint +SIMD: float IN: gpu.demos.bunny GLSL-SHADER-FILE: bunny-vertex-shader vertex-shader "bunny.v.glsl" @@ -52,7 +54,10 @@ VERTEX-FORMAT: bunny-vertex { f float-components 1 f } { "normal" float-components 3 f } { f float-components 1 f } ; -VERTEX-STRUCT: bunny-vertex-struct bunny-vertex + +STRUCT: bunny-vertex-struct + { vertex float-4 } + { normal float-4 } ; SPECIALIZED-VECTOR: bunny-vertex-struct @@ -75,42 +80,40 @@ UNIFORM-TUPLE: loading-uniforms { "loading-texture" texture-uniform f } ; : numbers ( str -- seq ) - " " split [ string>number ] map sift ; + " " split [ empty? not ] filter [ string>number ] map ; inline : ( vertex -- struct ) bunny-vertex-struct - swap >float-array >>vertex ; inline + swap first3 0.0 float-4-boa >>vertex ; inline : (parse-bunny-model) ( vs is -- vs is ) - readln [ + [ numbers { { [ dup length 5 = ] [ 3 head pick push ] } { [ dup first 3 = ] [ rest over push-all ] } [ drop ] - } cond (parse-bunny-model) - ] when* ; + } cond + ] each-line ; inline : parse-bunny-model ( -- vertexes indexes ) 100000 100000 - (parse-bunny-model) ; + (parse-bunny-model) ; inline -: normal ( vertexes -- normal ) - [ [ second ] [ first ] bi v- ] - [ [ third ] [ first ] bi v- ] bi cross - vneg normalize ; inline +:: normal ( a b c -- normal ) + c a v- + b a v- cross normalize ; inline -: calc-bunny-normal ( vertexes indexes -- ) - swap - [ [ nth vertex>> ] curry { } map-as normal ] - [ [ nth [ v+ ] change-normal drop ] curry with each ] 2bi ; +:: calc-bunny-normal ( a b c vertexes -- ) + a b c [ vertexes nth vertex>> ] tri@ normal :> n + a b c [ vertexes nth [ n v+ ] change-normal drop ] tri@ ; inline : calc-bunny-normals ( vertexes indexes -- ) - 3 - [ calc-bunny-normal ] with each ; + 3 swap + [ [ first3 ] dip calc-bunny-normal ] curry each ; inline : normalize-bunny-normals ( vertexes -- ) - [ [ normalize ] change-normal drop ] each ; + [ [ normalize ] change-normal drop ] each ; inline : bunny-data ( filename -- vertexes indexes ) ascii [ parse-bunny-model ] with-file-reader From 1a7b4d7c63435ce1da031c5339de2fa6b4cfaf4f Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 17:26:22 -0500 Subject: [PATCH 072/109] inline the trivial words in math.parser --- core/math/parser/parser.factor | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor index a53604ddf9..eaa58ac177 100644 --- a/core/math/parser/parser.factor +++ b/core/math/parser/parser.factor @@ -111,10 +111,10 @@ SYMBOL: negative? { { 16 [ hex>float ] } [ drop dec>float ] - } case ; + } case ; inline : number-char? ( char -- ? ) - "0123456789ABCDEFabcdef." member? ; + "0123456789ABCDEFabcdef." member? ; inline : numeric-looking? ( str -- ? ) "-" ?head drop @@ -127,7 +127,7 @@ SYMBOL: negative? PRIVATE> : string>float ( str -- n/f ) - 10 base>float ; + 10 base>float ; inline : base> ( str radix -- n/f ) over numeric-looking? [ @@ -138,13 +138,13 @@ PRIVATE> } case ] [ 2drop f ] if ; -: string>number ( str -- n/f ) 10 base> ; -: bin> ( str -- n/f ) 2 base> ; -: oct> ( str -- n/f ) 8 base> ; -: hex> ( str -- n/f ) 16 base> ; +: string>number ( str -- n/f ) 10 base> ; inline +: bin> ( str -- n/f ) 2 base> ; inline +: oct> ( str -- n/f ) 8 base> ; inline +: hex> ( str -- n/f ) 16 base> ; inline : >digit ( n -- ch ) - dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] if ; + dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] if ; inline : positive>base ( num radix -- str ) dup 1 <= [ "Invalid radix" throw ] when @@ -234,12 +234,12 @@ M: ratio >base { { 16 [ float>hex ] } [ drop float>decimal ] - } case ; + } case ; inline PRIVATE> : float>string ( n -- str ) - 10 float>base ; + 10 float>base ; inline M: float >base { @@ -251,9 +251,9 @@ M: float >base [ float>base ] } cond ; -: number>string ( n -- str ) 10 >base ; -: >bin ( n -- str ) 2 >base ; -: >oct ( n -- str ) 8 >base ; -: >hex ( n -- str ) 16 >base ; +: number>string ( n -- str ) 10 >base ; inline +: >bin ( n -- str ) 2 >base ; inline +: >oct ( n -- str ) 8 >base ; inline +: >hex ( n -- str ) 16 >base ; inline -: # ( n -- ) number>string % ; +: # ( n -- ) number>string % ; inline From e31ed3eda4785af12b45eabcbfdd0de9cb79527d Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 17:28:01 -0500 Subject: [PATCH 073/109] add filter-as to sequences --- core/sequences/sequences-docs.factor | 5 +++++ core/sequences/sequences.factor | 10 ++++++++-- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 9fd48796d6..2156557fff 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -426,6 +426,10 @@ HELP: filter { $values { "seq" sequence } { "quot" { $quotation "( elt -- ? )" } } { "subseq" "a new sequence" } } { $description "Applies the quotation to each element in turn, and outputs a new sequence containing the elements of the original sequence for which the quotation output a true value." } ; +HELP: filter-as +{ $values { "seq" sequence } { "quot" { $quotation "( elt -- ? )" } } { "exemplar" sequence } { "subseq" "a new sequence" } } +{ $description "Applies the quotation to each element in turn, and outputs a new sequence of the same type as " { $snippet "exemplar" } " containing the elements of the original sequence for which the quotation output a true value." } ; + HELP: filter-here { $values { "seq" "a resizable mutable sequence" } { "quot" { $quotation "( elt -- ? )" } } } { $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." } @@ -1512,6 +1516,7 @@ ARTICLE: "sequences-combinators" "Sequence combinators" "Filtering:" { $subsections filter + filter-as partition } "Testing if a sequence contains elements satisfying a predicate:" diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index b46645d433..93709122c7 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -483,11 +483,17 @@ PRIVATE> : push-if ( elt quot accum -- ) [ keep ] dip rot [ push ] [ 2drop ] if ; inline +: pusher-for ( quot exemplar -- quot accum ) + [ length ] keep new-resizable [ [ push-if ] 2curry ] keep ; inline + : pusher ( quot -- quot accum ) - V{ } clone [ [ push-if ] 2curry ] keep ; inline + V{ } pusher-for ; inline + +: filter-as ( seq quot exemplar -- subseq ) + dup [ pusher-for [ each ] dip ] curry dip like ; inline : filter ( seq quot -- subseq ) - over [ pusher [ each ] dip ] dip like ; inline + over filter-as ; inline : push-either ( elt quot accum1 accum2 -- ) [ keep swap ] 2dip ? push ; inline From cdd0e5774e0ccb4f7cf50f70ea3d7092e85df581 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 18:55:00 -0500 Subject: [PATCH 074/109] make new-resizable on growable sequences return a growable of the same type --- basis/vectors/functor/functor.factor | 2 ++ core/byte-vectors/byte-vectors.factor | 2 ++ core/growable/growable.factor | 2 ++ core/sbufs/sbufs.factor | 4 ++-- 4 files changed, 8 insertions(+), 2 deletions(-) diff --git a/basis/vectors/functor/functor.factor b/basis/vectors/functor/functor.factor index b70c7c5050..a2a67d58bc 100644 --- a/basis/vectors/functor/functor.factor +++ b/basis/vectors/functor/functor.factor @@ -24,6 +24,8 @@ M: V new-sequence drop [ ] [ >fixnum ] bi V boa ; inline M: A new-resizable drop ; inline +M: V new-resizable drop ; inline + M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ; : >V ( seq -- vector ) V new clone-like ; inline diff --git a/core/byte-vectors/byte-vectors.factor b/core/byte-vectors/byte-vectors.factor index 287e972405..4f6ade8580 100644 --- a/core/byte-vectors/byte-vectors.factor +++ b/core/byte-vectors/byte-vectors.factor @@ -43,4 +43,6 @@ M: byte-array like M: byte-array new-resizable drop ; inline +M: byte-vector new-resizable drop ; inline + INSTANCE: byte-vector growable diff --git a/core/growable/growable.factor b/core/growable/growable.factor index 68a8de3d43..2ca11e2e24 100644 --- a/core/growable/growable.factor +++ b/core/growable/growable.factor @@ -66,4 +66,6 @@ M: growable shorten ( n seq -- ) 2dup (>>length) ] when 2drop ; inline +M: growable new-resizable new-sequence 0 over set-length ; inline + INSTANCE: growable sequence diff --git a/core/sbufs/sbufs.factor b/core/sbufs/sbufs.factor index 49b6ec1374..db2649142d 100644 --- a/core/sbufs/sbufs.factor +++ b/core/sbufs/sbufs.factor @@ -23,13 +23,13 @@ M: sbuf like dup string? [ dup length sbuf boa ] [ >sbuf ] if ] unless ; inline -M: sbuf new-resizable drop ; inline - M: sbuf equal? over sbuf? [ sequence= ] [ 2drop f ] if ; M: string new-resizable drop ; inline +M: sbuf new-resizable drop ; inline + M: string like #! If we have a string, we're done. #! If we have an sbuf, and it's at full capacity, we're done. From 943bde59f9f30c7205efd704485ed5670cfbd5f7 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 18:55:32 -0500 Subject: [PATCH 075/109] speed up dec>float a little --- core/math/parser/parser.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor index eaa58ac177..32bacf5f49 100644 --- a/core/math/parser/parser.factor +++ b/core/math/parser/parser.factor @@ -83,8 +83,8 @@ SYMBOL: negative? ] if ; inline : dec>float ( str -- n/f ) - [ CHAR: , eq? not ] filter - >byte-array 0 suffix (string>float) ; + [ CHAR: , eq? not ] BV{ } filter-as + 0 over push B{ } like (string>float) ; : hex>float-parts ( str -- neg? mantissa-str expt ) "-" ?head swap "p" split1 [ 10 base> ] [ 0 ] if* ; From 34027e46b60e71f56b15a9acea55d46031622b8a Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 20:26:43 -0500 Subject: [PATCH 076/109] remove a redundant head from parse-bunny-model --- extra/gpu/demos/bunny/bunny.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/gpu/demos/bunny/bunny.factor b/extra/gpu/demos/bunny/bunny.factor index 0d3226c394..bea137c8a3 100755 --- a/extra/gpu/demos/bunny/bunny.factor +++ b/extra/gpu/demos/bunny/bunny.factor @@ -89,7 +89,7 @@ UNIFORM-TUPLE: loading-uniforms : (parse-bunny-model) ( vs is -- vs is ) [ numbers { - { [ dup length 5 = ] [ 3 head pick push ] } + { [ dup length 5 = ] [ pick push ] } { [ dup first 3 = ] [ rest over push-all ] } [ drop ] } cond From 28f5347e71a3b6754b4f60fbc9615df417ec7250 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 22 Oct 2009 20:28:00 -0500 Subject: [PATCH 077/109] tighten some screws in math.parser --- core/math/parser/parser.factor | 59 ++++++++++++++-------------------- 1 file changed, 24 insertions(+), 35 deletions(-) diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor index 32bacf5f49..60fb5559c5 100644 --- a/core/math/parser/parser.factor +++ b/core/math/parser/parser.factor @@ -5,39 +5,18 @@ strings arrays combinators splitting math assocs byte-arrays make ; IN: math.parser : digit> ( ch -- n ) - H{ - { CHAR: 0 0 } - { CHAR: 1 1 } - { CHAR: 2 2 } - { CHAR: 3 3 } - { CHAR: 4 4 } - { CHAR: 5 5 } - { CHAR: 6 6 } - { CHAR: 7 7 } - { CHAR: 8 8 } - { CHAR: 9 9 } - { CHAR: A 10 } - { CHAR: B 11 } - { CHAR: C 12 } - { CHAR: D 13 } - { CHAR: E 14 } - { CHAR: F 15 } - { CHAR: a 10 } - { CHAR: b 11 } - { CHAR: c 12 } - { CHAR: d 13 } - { CHAR: e 14 } - { CHAR: f 15 } - { CHAR: , f } - } at* [ drop 255 ] unless ; inline + 127 bitand { + { [ dup CHAR: 9 <= ] [ CHAR: 0 - ] } + { [ dup CHAR: a < ] [ CHAR: A 10 - - ] } + [ CHAR: a 10 - - ] + } cond + dup 0 < [ drop 255 ] [ dup 16 >= [ drop 255 ] when ] if ; inline : string>digits ( str -- digits ) [ digit> ] B{ } map-as ; inline : (digits>integer) ( valid? accum digit radix -- valid? accum ) - over [ - 2dup < [ swapd * + ] [ 2drop 2drop f 0 ] if - ] [ 2drop ] if ; inline + 2dup < [ swapd * + ] [ 2drop 2drop f 0 ] if ; inline : each-digit ( seq radix quot -- n/f ) [ t 0 ] 3dip curry each swap [ drop f ] unless ; inline @@ -54,8 +33,8 @@ SYMBOL: negative? : string>natural ( seq radix -- n/f ) over empty? [ 2drop f ] [ - [ [ digit> ] dip (digits>integer) ] each-digit - ] if ; inline + [ over CHAR: , eq? [ 2drop ] [ [ digit> ] dip (digits>integer) ] if ] each-digit + ] if ; : sign ( -- str ) negative? get "-" "+" ? ; @@ -116,13 +95,23 @@ SYMBOL: negative? : number-char? ( char -- ? ) "0123456789ABCDEFabcdef." member? ; inline +: last-unsafe ( seq -- elt ) + [ length 1 - ] [ nth-unsafe ] bi ; inline + : numeric-looking? ( str -- ? ) - "-" ?head drop dup empty? [ drop f ] [ - dup first number-char? [ - last number-char? - ] [ drop f ] if - ] if ; + dup first-unsafe number-char? [ + last-unsafe number-char? + ] [ + dup first-unsafe CHAR: - eq? [ + dup length 1 eq? [ drop f ] [ + 1 over nth-unsafe number-char? [ + last-unsafe number-char? + ] [ drop f ] if + ] if + ] [ drop f ] if + ] if + ] if ; inline PRIVATE> From 6597e0ea3ab445253264595efb108cda462d97f7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 22 Oct 2009 23:41:02 -0500 Subject: [PATCH 078/109] vm/mark_bits.hpp: fix incorrect constructor argument order --- vm/mark_bits.hpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index 279c04a23a..cd739346f0 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -5,8 +5,8 @@ const int block_granularity = 16; const int forwarding_granularity = 64; template struct mark_bits { - cell start; cell size; + cell start; cell bits_size; u64 *marked; cell *forwarding; @@ -21,9 +21,9 @@ template struct mark_bits { memset(forwarding,0,bits_size * sizeof(cell)); } - explicit mark_bits(cell start_, cell size_) : - start(start_), + explicit mark_bits(cell size_, cell start_) : size(size_), + start(start_), bits_size(size / block_granularity / forwarding_granularity), marked(new u64[bits_size]), forwarding(new cell[bits_size]) From d5d89f03a79c18068ae4009e464ca597acd28158 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 23 Oct 2009 00:07:19 -0500 Subject: [PATCH 079/109] swap around io combinators to avoid a bunch of redundant "input-stream get"s in each-line, each-block, contents, etc. --- core/io/io.factor | 43 ++++++++++++++++++++++++++----------------- 1 file changed, 26 insertions(+), 17 deletions(-) diff --git a/core/io/io.factor b/core/io/io.factor index e240467c07..ca36bc3b36 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -87,42 +87,51 @@ SYMBOL: error-stream : bl ( -- ) " " write ; - -: each-line ( quot -- ) - [ readln ] each-morsel ; inline +: each-stream-line ( stream quot -- ) + swap [ stream-readln ] curry each-morsel ; inline -: lines ( -- seq ) - [ ] accumulator [ each-line ] dip { } like ; +: each-line ( quot -- ) + input-stream get swap each-stream-line ; inline : stream-lines ( stream -- seq ) - [ lines ] with-input-stream ; + [ [ ] accumulator [ each-stream-line ] dip { } like ] with-disposal ; -: contents ( -- seq ) - [ 65536 read-partial dup ] [ ] produce nip - element-exemplar concat-as ; +: lines ( -- seq ) + input-stream get stream-lines ; inline : stream-contents ( stream -- seq ) - [ contents ] with-input-stream ; + [ + [ [ 65536 swap stream-read-partial dup ] curry [ ] produce nip ] + [ stream-element-exemplar concat-as ] bi + ] with-disposal ; + +: contents ( -- seq ) + input-stream get stream-contents ; inline + +: each-stream-block ( stream quot: ( block -- ) -- ) + swap [ 8192 swap stream-read-partial ] curry each-morsel ; inline : each-block ( quot: ( block -- ) -- ) - [ 8192 read-partial ] each-morsel ; inline + input-stream get swap each-stream-block ; inline : stream-copy ( in out -- ) [ [ [ write ] each-block ] with-output-stream ] From 15f4196d438ef4730d33369a3619918b3ef4b60f Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 23 Oct 2009 00:08:14 -0500 Subject: [PATCH 080/109] gpu.demos.bunny: tokenize model file as it's read to avoid an extra splitting-and-filtering pass --- extra/gpu/demos/bunny/bunny.factor | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/extra/gpu/demos/bunny/bunny.factor b/extra/gpu/demos/bunny/bunny.factor index bea137c8a3..a741af8002 100755 --- a/extra/gpu/demos/bunny/bunny.factor +++ b/extra/gpu/demos/bunny/bunny.factor @@ -5,7 +5,7 @@ gpu.util.wasd gpu.framebuffers gpu.render gpu.shaders gpu.state gpu.textures gpu.util grouping http.client images images.loader io io.encodings.ascii io.files io.files.temp kernel locals math math.matrices math.vectors.simd math.parser math.vectors -method-chains sequences splitting threads ui ui.gadgets +method-chains namespaces sequences splitting threads ui ui.gadgets ui.gadgets.worlds ui.pixel-formats specialized-arrays specialized-vectors ; FROM: alien.c-types => float ; @@ -79,13 +79,30 @@ UNIFORM-TUPLE: loading-uniforms { "texcoord-scale" vec2-uniform f } { "loading-texture" texture-uniform f } ; -: numbers ( str -- seq ) - " " split [ empty? not ] filter [ string>number ] map ; inline +: numbers ( tokens -- seq ) + [ string>number ] map ; inline : ( vertex -- struct ) bunny-vertex-struct swap first3 0.0 float-4-boa >>vertex ; inline +: (read-line-tokens) ( seq stream -- seq ) + " \n" over stream-read-until + [ [ pick push ] unless-empty ] + [ + { + { CHAR: \s [ (read-line-tokens) ] } + { CHAR: \n [ drop ] } + [ 2drop [ f ] when-empty ] + } case + ] bi* ; inline recursive + +: stream-read-line-tokens ( stream -- seq ) + V{ } clone swap (read-line-tokens) ; + +: each-line-tokens ( quot -- ) + input-stream get [ stream-read-line-tokens ] curry each-morsel ; inline + : (parse-bunny-model) ( vs is -- vs is ) [ numbers { @@ -93,7 +110,7 @@ UNIFORM-TUPLE: loading-uniforms { [ dup first 3 = ] [ rest over push-all ] } [ drop ] } cond - ] each-line ; inline + ] each-line-tokens ; inline : parse-bunny-model ( -- vertexes indexes ) 100000 From 810e309e0cea10a0836cb4c44822b08a1c71c981 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 00:33:53 -0500 Subject: [PATCH 081/109] vm: rename userenv to special_objects --- vm/callbacks.cpp | 4 +-- vm/collector.hpp | 3 ++- vm/contexts.cpp | 12 ++++----- vm/contexts.hpp | 2 +- vm/debug.cpp | 5 ++-- vm/dispatch.cpp | 10 +++---- vm/errors.cpp | 6 ++--- vm/factor.cpp | 26 +++++++++--------- vm/image.cpp | 18 ++++++------- vm/image.hpp | 2 +- vm/inline_cache.cpp | 8 +++--- vm/io.cpp | 6 ++--- vm/jit.cpp | 4 +-- vm/jit.hpp | 29 ++++++++++++-------- vm/os-macosx.mm | 2 +- vm/profiler.cpp | 2 +- vm/quotations.cpp | 46 +++++++++++++++---------------- vm/run.cpp | 4 +-- vm/run.hpp | 66 ++++++++++++++++++++++----------------------- vm/vm.hpp | 2 +- vm/words.cpp | 2 +- 21 files changed, 133 insertions(+), 126 deletions(-) diff --git a/vm/callbacks.cpp b/vm/callbacks.cpp index 599271555b..4fe19c0bc0 100644 --- a/vm/callbacks.cpp +++ b/vm/callbacks.cpp @@ -21,7 +21,7 @@ void factor_vm::init_callbacks(cell size) void callback_heap::update(callback *stub) { - tagged code_template(parent->userenv[CALLBACK_STUB]); + tagged code_template(parent->special_objects[CALLBACK_STUB]); cell rel_class = untag_fixnum(array_nth(code_template.untagged(),1)); cell offset = untag_fixnum(array_nth(code_template.untagged(),3)); @@ -35,7 +35,7 @@ void callback_heap::update(callback *stub) callback *callback_heap::add(code_block *compiled) { - tagged code_template(parent->userenv[CALLBACK_STUB]); + tagged code_template(parent->special_objects[CALLBACK_STUB]); tagged insns(array_nth(code_template.untagged(),0)); cell size = array_capacity(insns.untagged()); diff --git a/vm/collector.hpp b/vm/collector.hpp index 4479fc7b45..a1a7dc5695 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -135,7 +135,8 @@ template struct collector { trace_registered_locals(); trace_registered_bignums(); - for(int i = 0; i < USER_ENV; i++) trace_handle(&parent->userenv[i]); + for(cell i = 0; i < special_object_count; i++) + trace_handle(&parent->special_objects[i]); } void trace_contexts() diff --git a/vm/contexts.cpp b/vm/contexts.cpp index ce52555a21..7af7fdaa57 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -80,9 +80,9 @@ void factor_vm::nest_stacks(stack_frame *magic_frame) new_ctx->magic_frame = magic_frame; - /* save per-callback userenv */ - new_ctx->current_callback_save = userenv[CURRENT_CALLBACK_ENV]; - new_ctx->catchstack_save = userenv[CATCHSTACK_ENV]; + /* save per-callback special_objects */ + new_ctx->current_callback_save = special_objects[OBJ_CURRENT_CALLBACK]; + new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK]; new_ctx->next = ctx; ctx = new_ctx; @@ -102,9 +102,9 @@ void factor_vm::unnest_stacks() ds = ctx->datastack_save; rs = ctx->retainstack_save; - /* restore per-callback userenv */ - userenv[CURRENT_CALLBACK_ENV] = ctx->current_callback_save; - userenv[CATCHSTACK_ENV] = ctx->catchstack_save; + /* restore per-callback special_objects */ + special_objects[OBJ_CURRENT_CALLBACK] = ctx->current_callback_save; + special_objects[OBJ_CATCHSTACK] = ctx->catchstack_save; context *old_ctx = ctx; ctx = old_ctx->next; diff --git a/vm/contexts.hpp b/vm/contexts.hpp index f66b5d0fe2..aa6f9ec8ce 100644 --- a/vm/contexts.hpp +++ b/vm/contexts.hpp @@ -41,7 +41,7 @@ struct context { /* memory region holding current retain stack */ segment *retainstack_region; - /* saved userenv slots on entry to callback */ + /* saved special_objects slots on entry to callback */ cell catchstack_save; cell current_callback_save; diff --git a/vm/debug.cpp b/vm/debug.cpp index b37a7e6f82..91fb1ea1d3 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -419,9 +419,8 @@ void factor_vm::factorbug() print_callstack(); else if(strcmp(cmd,"e") == 0) { - int i; - for(i = 0; i < USER_ENV; i++) - dump_cell((cell)&userenv[i]); + for(cell i = 0; i < special_object_count; i++) + dump_cell((cell)&special_objects[i]); } else if(strcmp(cmd,"g") == 0) dump_generations(); diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp index 0abde2e711..bbe86c0fd6 100755 --- a/vm/dispatch.cpp +++ b/vm/dispatch.cpp @@ -187,21 +187,21 @@ void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cac emit_class_lookup(index,PIC_HI_TAG_TUPLE); /* Do a cache lookup. */ - emit_with(parent->userenv[MEGA_LOOKUP],cache.value()); + emit_with(parent->special_objects[MEGA_LOOKUP],cache.value()); /* If we end up here, the cache missed. */ - emit(parent->userenv[JIT_PROLOG]); + emit(parent->special_objects[JIT_PROLOG]); /* Push index, method table and cache on the stack. */ push(methods.value()); push(tag_fixnum(index)); push(cache.value()); - word_call(parent->userenv[MEGA_MISS_WORD]); + word_call(parent->special_objects[MEGA_MISS_WORD]); /* Now the new method has been stored into the cache, and its on the stack. */ - emit(parent->userenv[JIT_EPILOG]); - emit(parent->userenv[JIT_EXECUTE_JUMP]); + emit(parent->special_objects[JIT_EPILOG]); + emit(parent->special_objects[JIT_EXECUTE_JUMP]); } } diff --git a/vm/errors.cpp b/vm/errors.cpp index 148799446a..3161f625cd 100755 --- a/vm/errors.cpp +++ b/vm/errors.cpp @@ -31,7 +31,7 @@ void factor_vm::throw_error(cell error, stack_frame *callstack_top) { /* If the error handler is set, we rewind any C stack frames and pass the error to user-space. */ - if(!current_gc && to_boolean(userenv[BREAK_ENV])) + if(!current_gc && to_boolean(special_objects[OBJ_BREAK])) { /* If error was thrown during heap scan, we re-enable the GC */ gc_off = false; @@ -55,7 +55,7 @@ void factor_vm::throw_error(cell error, stack_frame *callstack_top) else callstack_top = ctx->callstack_top; - throw_impl(userenv[BREAK_ENV],callstack_top,this); + throw_impl(special_objects[OBJ_BREAK],callstack_top,this); } /* Error was thrown in early startup before error handler is set, just crash. */ @@ -71,7 +71,7 @@ void factor_vm::throw_error(cell error, stack_frame *callstack_top) void factor_vm::general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top) { - throw_error(allot_array_4(userenv[ERROR_ENV], + throw_error(allot_array_4(special_objects[OBJ_ERROR], tag_fixnum(error),arg1,arg2),callstack_top); } diff --git a/vm/factor.cpp b/vm/factor.cpp index f3eb351d94..df27de84fd 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -100,7 +100,7 @@ void factor_vm::do_stage1_init() fflush(stdout); compile_all_words(); - userenv[STAGE2_ENV] = true_object; + special_objects[OBJ_STAGE2] = true_object; std::cout << "done\n"; } @@ -149,17 +149,17 @@ void factor_vm::init_factor(vm_parameters *p) init_profiler(); - userenv[CPU_ENV] = allot_alien(false_object,(cell)FACTOR_CPU_STRING); - userenv[OS_ENV] = allot_alien(false_object,(cell)FACTOR_OS_STRING); - userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(cell)); - userenv[EXECUTABLE_ENV] = allot_alien(false_object,(cell)p->executable_path); - userenv[ARGS_ENV] = false_object; - userenv[EMBEDDED_ENV] = false_object; + special_objects[OBJ_CPU] = allot_alien(false_object,(cell)FACTOR_CPU_STRING); + special_objects[OBJ_OS] = allot_alien(false_object,(cell)FACTOR_OS_STRING); + special_objects[OBJ_CELL_SIZE] = tag_fixnum(sizeof(cell)); + special_objects[OBJ_EXECUTABLE] = allot_alien(false_object,(cell)p->executable_path); + special_objects[OBJ_ARGS] = false_object; + special_objects[OBJ_EMBEDDED] = false_object; /* We can GC now */ gc_off = false; - if(!to_boolean(userenv[STAGE2_ENV])) + if(!to_boolean(special_objects[OBJ_STAGE2])) do_stage1_init(); } @@ -174,7 +174,7 @@ void factor_vm::pass_args_to_factor(int argc, vm_char **argv) } args.trim(); - userenv[ARGS_ENV] = args.elements.value(); + special_objects[OBJ_ARGS] = args.elements.value(); } void factor_vm::start_factor(vm_parameters *p) @@ -182,13 +182,13 @@ void factor_vm::start_factor(vm_parameters *p) if(p->fep) factorbug(); nest_stacks(NULL); - c_to_factor_toplevel(userenv[BOOT_ENV]); + c_to_factor_toplevel(special_objects[OBJ_BOOT]); unnest_stacks(); } char *factor_vm::factor_eval_string(char *string) { - char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]); + char *(*callback)(char *) = (char *(*)(char *))alien_offset(special_objects[OBJ_EVAL_CALLBACK]); return callback(string); } @@ -199,13 +199,13 @@ void factor_vm::factor_eval_free(char *result) void factor_vm::factor_yield() { - void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]); + void (*callback)() = (void (*)())alien_offset(special_objects[OBJ_YIELD_CALLBACK]); callback(); } void factor_vm::factor_sleep(long us) { - void (*callback)(long) = (void (*)(long))alien_offset(userenv[SLEEP_CALLBACK_ENV]); + void (*callback)(long) = (void (*)(long))alien_offset(special_objects[OBJ_SLEEP_CALLBACK]); callback(us); } diff --git a/vm/image.cpp b/vm/image.cpp index f5879e7a32..1b7debc2b2 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -6,7 +6,7 @@ namespace factor /* Certain special objects in the image are known to the runtime */ void factor_vm::init_objects(image_header *h) { - memcpy(userenv,h->userenv,sizeof(userenv)); + memcpy(special_objects,h->special_objects,sizeof(special_objects)); true_object = h->true_object; bignum_zero = h->bignum_zero; @@ -183,8 +183,8 @@ void factor_vm::relocate_object(object *object, where it is loaded, we need to fix up pointers in the image. */ void factor_vm::relocate_data(cell data_relocation_base, cell code_relocation_base) { - for(cell i = 0; i < USER_ENV; i++) - data_fixup(&userenv[i],data_relocation_base); + for(cell i = 0; i < special_object_count; i++) + data_fixup(&special_objects[i],data_relocation_base); data_fixup(&true_object,data_relocation_base); data_fixup(&bignum_zero,data_relocation_base); @@ -263,7 +263,7 @@ void factor_vm::load_image(vm_parameters *p) relocate_code(h.data_relocation_base); /* Store image path name */ - userenv[IMAGE_ENV] = allot_alien(false_object,(cell)p->image_path); + special_objects[OBJ_IMAGE] = allot_alien(false_object,(cell)p->image_path); } /* Save the current image to disk */ @@ -292,8 +292,8 @@ bool factor_vm::save_image(const vm_char *filename) h.bignum_pos_one = bignum_pos_one; h.bignum_neg_one = bignum_neg_one; - for(cell i = 0; i < USER_ENV; i++) - h.userenv[i] = (save_env_p(i) ? userenv[i] : false_object); + for(cell i = 0; i < special_object_count; i++) + h.special_objects[i] = (save_env_p(i) ? special_objects[i] : false_object); bool ok = true; @@ -326,9 +326,9 @@ void factor_vm::primitive_save_image_and_exit() gc_root path(dpop(),this); path.untag_check(this); - /* strip out userenv data which is set on startup anyway */ - for(cell i = 0; i < USER_ENV; i++) - if(!save_env_p(i)) userenv[i] = false_object; + /* strip out special_objects data which is set on startup anyway */ + for(cell i = 0; i < special_object_count; i++) + if(!save_env_p(i)) special_objects[i] = false_object; gc(collect_full_op, 0, /* requested size */ diff --git a/vm/image.hpp b/vm/image.hpp index 127709ffb7..3a5447c63b 100755 --- a/vm/image.hpp +++ b/vm/image.hpp @@ -25,7 +25,7 @@ struct image_header { /* tagged pointer to bignum -1 */ cell bignum_neg_one; /* Initial user environment */ - cell userenv[USER_ENV]; + cell special_objects[special_object_count]; }; struct vm_parameters { diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index 8d8709fdea..ee221c3797 100755 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -86,9 +86,9 @@ void inline_cache_jit::emit_check(cell klass) { cell code_template; if(TAG(klass) == FIXNUM_TYPE && untag_fixnum(klass) < HEADER_TYPE) - code_template = parent->userenv[PIC_CHECK_TAG]; + code_template = parent->special_objects[PIC_CHECK_TAG]; else - code_template = parent->userenv[PIC_CHECK]; + code_template = parent->special_objects[PIC_CHECK]; emit_with(code_template,klass); } @@ -121,7 +121,7 @@ void inline_cache_jit::compile_inline_cache(fixnum index, /* Yes? Jump to method */ cell method = array_nth(cache_entries.untagged(),i + 1); - emit_with(parent->userenv[PIC_HIT],method); + emit_with(parent->special_objects[PIC_HIT],method); } /* Generate machine code to handle a cache miss, which ultimately results in @@ -133,7 +133,7 @@ void inline_cache_jit::compile_inline_cache(fixnum index, push(methods.value()); push(tag_fixnum(index)); push(cache_entries.value()); - word_special(parent->userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]); + word_special(parent->special_objects[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]); } code_block *factor_vm::compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p) diff --git a/vm/io.cpp b/vm/io.cpp index a75f41c5bf..bbcac0b849 100755 --- a/vm/io.cpp +++ b/vm/io.cpp @@ -16,9 +16,9 @@ normal operation. */ void factor_vm::init_c_io() { - userenv[STDIN_ENV] = allot_alien(false_object,(cell)stdin); - userenv[STDOUT_ENV] = allot_alien(false_object,(cell)stdout); - userenv[STDERR_ENV] = allot_alien(false_object,(cell)stderr); + special_objects[OBJ_STDIN] = allot_alien(false_object,(cell)stdin); + special_objects[OBJ_STDOUT] = allot_alien(false_object,(cell)stdout); + special_objects[OBJ_STDERR] = allot_alien(false_object,(cell)stderr); } void factor_vm::io_error() diff --git a/vm/jit.cpp b/vm/jit.cpp index 98212d2efe..2fa948e4d6 100644 --- a/vm/jit.cpp +++ b/vm/jit.cpp @@ -79,8 +79,8 @@ void jit::emit_with(cell code_template_, cell argument_) { void jit::emit_class_lookup(fixnum index, cell type) { - emit_with(parent->userenv[PIC_LOAD],tag_fixnum(-index * sizeof(cell))); - emit(parent->userenv[type]); + emit_with(parent->special_objects[PIC_LOAD],tag_fixnum(-index * sizeof(cell))); + emit(parent->special_objects[type]); } /* Facility to convert compiled code offsets to quotation offsets. diff --git a/vm/jit.hpp b/vm/jit.hpp index 1940da9c7c..9feade4cc1 100644 --- a/vm/jit.hpp +++ b/vm/jit.hpp @@ -21,26 +21,31 @@ struct jit { void literal(cell literal) { literals.add(literal); } void emit_with(cell code_template_, cell literal_); - void push(cell literal) { - emit_with(parent->userenv[JIT_PUSH_IMMEDIATE],literal); + void push(cell literal) + { + emit_with(parent->special_objects[JIT_PUSH_IMMEDIATE],literal); } - void word_jump(cell word_) { + void word_jump(cell word_) + { gc_root word(word_,parent); literal(tag_fixnum(xt_tail_pic_offset)); literal(word.value()); - emit(parent->userenv[JIT_WORD_JUMP]); + emit(parent->special_objects[JIT_WORD_JUMP]); } - void word_call(cell word) { - emit_with(parent->userenv[JIT_WORD_CALL],word); + void word_call(cell word) + { + emit_with(parent->special_objects[JIT_WORD_CALL],word); } - void word_special(cell word) { - emit_with(parent->userenv[JIT_WORD_SPECIAL],word); + void word_special(cell word) + { + emit_with(parent->special_objects[JIT_WORD_SPECIAL],word); } - void emit_subprimitive(cell word_) { + void emit_subprimitive(cell word_) + { gc_root word(word_,parent); gc_root code_pair(word->subprimitive,parent); literals.append(untag(array_nth(code_pair.untagged(),0))); @@ -49,7 +54,8 @@ struct jit { void emit_class_lookup(fixnum index, cell type); - fixnum get_position() { + fixnum get_position() + { if(computing_offset_p) { /* If this is still on, emit() didn't clear it, @@ -60,7 +66,8 @@ struct jit { return position; } - void set_position(fixnum position_) { + void set_position(fixnum position_) + { if(computing_offset_p) position = position_; } diff --git a/vm/os-macosx.mm b/vm/os-macosx.mm index 96f169bbcf..438957bd04 100644 --- a/vm/os-macosx.mm +++ b/vm/os-macosx.mm @@ -14,7 +14,7 @@ NS_DURING NS_VOIDRETURN; NS_HANDLER dpush(allot_alien(false_object,(cell)localException)); - quot = userenv[COCOA_EXCEPTION_ENV]; + quot = special_objects[OBJ_COCOA_EXCEPTION]; if(!tagged(quot).type_p(QUOTATION_TYPE)) { /* No Cocoa exception handler was registered, so diff --git a/vm/profiler.cpp b/vm/profiler.cpp index df9d9ee67b..5113b55cf7 100755 --- a/vm/profiler.cpp +++ b/vm/profiler.cpp @@ -14,7 +14,7 @@ code_block *factor_vm::compile_profiling_stub(cell word_) gc_root word(word_,this); jit jit(code_block_profiling,word.value(),this); - jit.emit_with(userenv[JIT_PROFILING],word.value()); + jit.emit_with(special_objects[JIT_PROFILING],word.value()); return jit.to_code_block(); } diff --git a/vm/quotations.cpp b/vm/quotations.cpp index 46087abeab..c65c0fe909 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -38,29 +38,29 @@ so this results in a big speedup for relatively little effort. */ bool quotation_jit::primitive_call_p(cell i, cell length) { - return (i + 2) == length && array_nth(elements.untagged(),i + 1) == parent->userenv[JIT_PRIMITIVE_WORD]; + return (i + 2) == length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_PRIMITIVE_WORD]; } bool quotation_jit::fast_if_p(cell i, cell length) { return (i + 3) == length && tagged(array_nth(elements.untagged(),i + 1)).type_p(QUOTATION_TYPE) - && array_nth(elements.untagged(),i + 2) == parent->userenv[JIT_IF_WORD]; + && array_nth(elements.untagged(),i + 2) == parent->special_objects[JIT_IF_WORD]; } bool quotation_jit::fast_dip_p(cell i, cell length) { - return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->userenv[JIT_DIP_WORD]; + return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_DIP_WORD]; } bool quotation_jit::fast_2dip_p(cell i, cell length) { - return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->userenv[JIT_2DIP_WORD]; + return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_2DIP_WORD]; } bool quotation_jit::fast_3dip_p(cell i, cell length) { - return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->userenv[JIT_3DIP_WORD]; + return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_3DIP_WORD]; } bool quotation_jit::mega_lookup_p(cell i, cell length) @@ -68,13 +68,13 @@ bool quotation_jit::mega_lookup_p(cell i, cell length) return (i + 4) <= length && tagged(array_nth(elements.untagged(),i + 1)).type_p(FIXNUM_TYPE) && tagged(array_nth(elements.untagged(),i + 2)).type_p(ARRAY_TYPE) - && array_nth(elements.untagged(),i + 3) == parent->userenv[MEGA_LOOKUP_WORD]; + && array_nth(elements.untagged(),i + 3) == parent->special_objects[MEGA_LOOKUP_WORD]; } bool quotation_jit::declare_p(cell i, cell length) { return (i + 2) <= length - && array_nth(elements.untagged(),i + 1) == parent->userenv[JIT_DECLARE_WORD]; + && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_DECLARE_WORD]; } bool quotation_jit::stack_frame_p() @@ -133,7 +133,7 @@ void quotation_jit::iterate_quotation() set_position(0); if(stack_frame) - emit(parent->userenv[JIT_PROLOG]); + emit(parent->special_objects[JIT_PROLOG]); cell i; cell length = array_capacity(elements.untagged()); @@ -152,23 +152,23 @@ void quotation_jit::iterate_quotation() if(parent->to_boolean(obj.as()->subprimitive)) emit_subprimitive(obj.value()); /* The (execute) primitive is special-cased */ - else if(obj.value() == parent->userenv[JIT_EXECUTE_WORD]) + else if(obj.value() == parent->special_objects[JIT_EXECUTE_WORD]) { if(i == length - 1) { - if(stack_frame) emit(parent->userenv[JIT_EPILOG]); + if(stack_frame) emit(parent->special_objects[JIT_EPILOG]); tail_call = true; - emit(parent->userenv[JIT_EXECUTE_JUMP]); + emit(parent->special_objects[JIT_EXECUTE_JUMP]); } else - emit(parent->userenv[JIT_EXECUTE_CALL]); + emit(parent->special_objects[JIT_EXECUTE_CALL]); } /* Everything else */ else { if(i == length - 1) { - if(stack_frame) emit(parent->userenv[JIT_EPILOG]); + if(stack_frame) emit(parent->special_objects[JIT_EPILOG]); tail_call = true; /* Inline cache misses are special-cased. The calling convention for tail @@ -178,8 +178,8 @@ void quotation_jit::iterate_quotation() the inline cache miss primitive, and we don't want to clobber the saved address. */ - if(obj.value() == parent->userenv[PIC_MISS_WORD] - || obj.value() == parent->userenv[PIC_MISS_TAIL_WORD]) + if(obj.value() == parent->special_objects[PIC_MISS_WORD] + || obj.value() == parent->special_objects[PIC_MISS_TAIL_WORD]) { word_special(obj.value()); } @@ -201,7 +201,7 @@ void quotation_jit::iterate_quotation() { literal(tag_fixnum(0)); literal(obj.value()); - emit(parent->userenv[JIT_PRIMITIVE]); + emit(parent->special_objects[JIT_PRIMITIVE]); i++; @@ -215,12 +215,12 @@ void quotation_jit::iterate_quotation() mutually recursive in the library, but both still work) */ if(fast_if_p(i,length)) { - if(stack_frame) emit(parent->userenv[JIT_EPILOG]); + if(stack_frame) emit(parent->special_objects[JIT_EPILOG]); tail_call = true; emit_quot(array_nth(elements.untagged(),i)); emit_quot(array_nth(elements.untagged(),i + 1)); - emit(parent->userenv[JIT_IF]); + emit(parent->special_objects[JIT_IF]); i += 2; } @@ -228,21 +228,21 @@ void quotation_jit::iterate_quotation() else if(fast_dip_p(i,length)) { emit_quot(obj.value()); - emit(parent->userenv[JIT_DIP]); + emit(parent->special_objects[JIT_DIP]); i++; } /* 2dip */ else if(fast_2dip_p(i,length)) { emit_quot(obj.value()); - emit(parent->userenv[JIT_2DIP]); + emit(parent->special_objects[JIT_2DIP]); i++; } /* 3dip */ else if(fast_3dip_p(i,length)) { emit_quot(obj.value()); - emit(parent->userenv[JIT_3DIP]); + emit(parent->special_objects[JIT_3DIP]); i++; } else @@ -276,8 +276,8 @@ void quotation_jit::iterate_quotation() set_position(length); if(stack_frame) - emit(parent->userenv[JIT_EPILOG]); - emit(parent->userenv[JIT_RETURN]); + emit(parent->special_objects[JIT_EPILOG]); + emit(parent->special_objects[JIT_RETURN]); } } diff --git a/vm/run.cpp b/vm/run.cpp index 79aca937ca..b6e3324502 100755 --- a/vm/run.cpp +++ b/vm/run.cpp @@ -6,14 +6,14 @@ namespace factor void factor_vm::primitive_getenv() { fixnum e = untag_fixnum(dpeek()); - drepl(userenv[e]); + drepl(special_objects[e]); } void factor_vm::primitive_setenv() { fixnum e = untag_fixnum(dpop()); cell value = dpop(); - userenv[e] = value; + special_objects[e] = value; } void factor_vm::primitive_exit() diff --git a/vm/run.hpp b/vm/run.hpp index 9a23979066..714ac1f64a 100755 --- a/vm/run.hpp +++ b/vm/run.hpp @@ -1,39 +1,39 @@ namespace factor { -#define USER_ENV 70 +static const cell special_object_count = 70; enum special_object { - NAMESTACK_ENV, /* used by library only */ - CATCHSTACK_ENV, /* used by library only, per-callback */ + OBJ_NAMESTACK, /* used by library only */ + OBJ_CATCHSTACK, /* used by library only, per-callback */ - CURRENT_CALLBACK_ENV = 2, /* used by library only, per-callback */ - WALKER_HOOK_ENV, /* non-local exit hook, used by library only */ - CALLCC_1_ENV, /* used to pass the value in callcc1 */ + OBJ_CURRENT_CALLBACK = 2, /* used by library only, per-callback */ + OBJ_WALKER_HOOK, /* non-local exit hook, used by library only */ + OBJ_CALLCC_1, /* used to pass the value in callcc1 */ - BREAK_ENV = 5, /* quotation called by throw primitive */ - ERROR_ENV, /* a marker consed onto kernel errors */ + OBJ_BREAK = 5, /* quotation called by throw primitive */ + OBJ_ERROR, /* a marker consed onto kernel errors */ - CELL_SIZE_ENV = 7, /* sizeof(cell) */ - CPU_ENV, /* CPU architecture */ - OS_ENV, /* operating system name */ + OBJ_CELL_SIZE = 7, /* sizeof(cell) */ + OBJ_CPU, /* CPU architecture */ + OBJ_OS, /* operating system name */ - ARGS_ENV = 10, /* command line arguments */ - STDIN_ENV, /* stdin FILE* handle */ - STDOUT_ENV, /* stdout FILE* handle */ + OBJ_ARGS = 10, /* command line arguments */ + OBJ_STDIN, /* stdin FILE* handle */ + OBJ_STDOUT, /* stdout FILE* handle */ - IMAGE_ENV = 13, /* image path name */ - EXECUTABLE_ENV, /* runtime executable path name */ + OBJ_IMAGE = 13, /* image path name */ + OBJ_EXECUTABLE, /* runtime executable path name */ - EMBEDDED_ENV = 15, /* are we embedded in another app? */ - EVAL_CALLBACK_ENV, /* used when Factor is embedded in a C app */ - YIELD_CALLBACK_ENV, /* used when Factor is embedded in a C app */ - SLEEP_CALLBACK_ENV, /* used when Factor is embedded in a C app */ + OBJ_EMBEDDED = 15, /* are we embedded in another app? */ + OBJ_EVAL_CALLBACK, /* used when Factor is embedded in a C app */ + OBJ_YIELD_CALLBACK, /* used when Factor is embedded in a C app */ + OBJ_SLEEP_CALLBACK, /* used when Factor is embedded in a C app */ - COCOA_EXCEPTION_ENV = 19, /* Cocoa exception handler quotation */ + OBJ_COCOA_EXCEPTION = 19, /* Cocoa exception handler quotation */ - BOOT_ENV = 20, /* boot quotation */ - GLOBAL_ENV, /* global namespace */ + OBJ_BOOT = 20, /* boot quotation */ + OBJ_GLOBAL, /* global namespace */ /* Quotation compilation in quotations.c */ JIT_PROLOG = 23, @@ -79,25 +79,25 @@ enum special_object { MEGA_LOOKUP_WORD, MEGA_MISS_WORD, - UNDEFINED_ENV = 60, /* default quotation for undefined words */ + OBJ_UNDEFINED = 60, /* default quotation for undefined words */ - STDERR_ENV = 61, /* stderr FILE* handle */ + OBJ_STDERR = 61, /* stderr FILE* handle */ - STAGE2_ENV = 62, /* have we bootstrapped? */ + OBJ_STAGE2 = 62, /* have we bootstrapped? */ - CURRENT_THREAD_ENV = 63, + OBJ_CURRENT_THREAD = 63, - THREADS_ENV = 64, - RUN_QUEUE_ENV = 65, - SLEEP_QUEUE_ENV = 66, + OBJ_THREADS = 64, + OBJ_RUN_QUEUE = 65, + OBJ_SLEEP_QUEUE = 66, }; -#define FIRST_SAVE_ENV BOOT_ENV -#define LAST_SAVE_ENV STAGE2_ENV +#define OBJ_FIRST_SAVE OBJ_BOOT +#define OBJ_LAST_SAVE OBJ_STAGE2 inline static bool save_env_p(cell i) { - return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV); + return (i >= OBJ_FIRST_SAVE && i <= OBJ_LAST_SAVE); } } diff --git a/vm/vm.hpp b/vm/vm.hpp index 78efc915d7..e22e45f22e 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -18,7 +18,7 @@ struct factor_vm cell decks_offset; /* TAGGED user environment data; see getenv/setenv prims */ - cell userenv[USER_ENV]; + cell special_objects[special_object_count]; /* Data stack and retain stack sizes */ cell ds_size, rs_size; diff --git a/vm/words.cpp b/vm/words.cpp index 9d3ccff3c3..37a3821069 100644 --- a/vm/words.cpp +++ b/vm/words.cpp @@ -13,7 +13,7 @@ word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_) new_word->hashcode = hashcode_; new_word->vocabulary = vocab.value(); new_word->name = name.value(); - new_word->def = userenv[UNDEFINED_ENV]; + new_word->def = special_objects[OBJ_UNDEFINED]; new_word->props = false_object; new_word->counter = tag_fixnum(0); new_word->pic_def = false_object; From a36e7ff40a1cbbc343071051a4698f2735a303c4 Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Sun, 27 Sep 2009 17:31:02 +0200 Subject: [PATCH 082/109] added with-local-address to bind the local address of a socket to a specific IP or IP/port combination (sometimes required to get through firewalls) --- basis/io/sockets/sockets.factor | 14 ++++++++++++++ basis/io/sockets/unix/unix.factor | 6 +++++- basis/io/sockets/windows/windows.factor | 6 +++++- 3 files changed, 24 insertions(+), 2 deletions(-) diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index a542575446..e45224fcc2 100755 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -173,6 +173,8 @@ GENERIC: (get-remote-address) ( handle remote -- sockaddr ) [ |dispose ] [ |dispose ] bi ] with-destructors ; +SYMBOL: bind-local-address + GENERIC: establish-connection ( client-out remote -- ) GENERIC: ((client)) ( remote -- handle ) @@ -321,6 +323,18 @@ M: invalid-inet-server summary M: inet (server) invalid-inet-server ; +ERROR: invalid-local-address addrspec ; + +M: invalid-local-address summary + drop "Cannot use with-local-address with ; use or instead" ; + +: with-local-address ( addr quot -- ) + [ + [ ] [ inet4? ] [ inet6? ] tri or + [ bind-local-address ] + [ invalid-local-address ] if + ] dip with-variable ; inline + { { [ os unix? ] [ "io.sockets.unix" require ] } { [ os winnt? ] [ "io.sockets.windows.nt" require ] } diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index fa46a71ca0..3564b32890 100755 --- a/basis/io/sockets/unix/unix.factor +++ b/basis/io/sockets/unix/unix.factor @@ -69,8 +69,12 @@ M: object establish-connection ( client-out remote -- ) [ (io-error) ] } cond ; +: ?bind-client ( socket -- ) + bind-local-address get [ [ fd>> ] dip make-sockaddr/size bind io-error ] [ drop ] if* ; inline + M: object ((client)) ( addrspec -- fd ) - protocol-family SOCK_STREAM socket-fd dup init-client-socket ; + protocol-family SOCK_STREAM socket-fd + [ init-client-socket ] [ ?bind-client ] [ ] tri ; ! Server sockets - TCP and Unix domain : init-server-socket ( fd -- ) diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor index ccf86ca308..fa5e3833bc 100755 --- a/basis/io/sockets/windows/windows.factor +++ b/basis/io/sockets/windows/windows.factor @@ -55,7 +55,11 @@ M: object (get-remote-address) ( socket addrspec -- sockaddr ) M: object ((client)) ( addrspec -- handle ) [ SOCK_STREAM open-socket ] keep - [ unspecific-sockaddr/size bind-socket ] [ drop ] 2bi ; + [ + bind-local-address get + [ nip make-sockaddr/size ] + [ unspecific-sockaddr/size ] if* bind-socket + ] [ drop ] 2bi ; : server-socket ( addrspec type -- fd ) [ open-socket ] [ drop ] 2bi From a5d4f9cf16d62c285855979662724d1e7744c07e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 02:58:15 -0500 Subject: [PATCH 083/109] grouping: clump on empty sequence was trying to make a sequence of length -1 --- basis/grouping/grouping-tests.factor | 11 ++++++++++- basis/grouping/grouping.factor | 2 +- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/basis/grouping/grouping-tests.factor b/basis/grouping/grouping-tests.factor index c91e5a56d6..52b436507e 100644 --- a/basis/grouping/grouping-tests.factor +++ b/basis/grouping/grouping-tests.factor @@ -1,5 +1,5 @@ USING: grouping tools.test kernel sequences arrays -math ; +math accessors ; IN: grouping.tests [ { 1 2 3 } 0 group ] must-fail @@ -12,6 +12,15 @@ IN: grouping.tests >array ] unit-test +[ 0 ] [ { } 2 length ] unit-test +[ 0 ] [ { 1 } 2 length ] unit-test +[ 1 ] [ { 1 2 } 2 length ] unit-test +[ 2 ] [ { 1 2 3 } 2 length ] unit-test + +[ 1 ] [ V{ } 2 0 over set-length seq>> length ] unit-test +[ 2 ] [ V{ } 2 1 over set-length seq>> length ] unit-test +[ 3 ] [ V{ } 2 2 over set-length seq>> length ] unit-test + [ { { 1 2 } { 2 3 } } ] [ { 1 2 3 } 2 [ >array ] map ] unit-test [ f ] [ [ { } { } "Hello" ] all-equal? ] unit-test diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor index 83579d2beb..8a39a5d5cf 100644 --- a/basis/grouping/grouping.factor +++ b/basis/grouping/grouping.factor @@ -46,7 +46,7 @@ M: abstract-groups group@ TUPLE: abstract-clumps < chunking-seq ; M: abstract-clumps length - [ seq>> length ] [ n>> ] bi - 1 + ; inline + [ seq>> length 1 + ] [ n>> ] bi [-] ; inline M: abstract-clumps set-length [ n>> + 1 - ] [ seq>> ] bi set-length ; inline From e8fd85437b45888e3f54b165540b537b7c741dcc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 03:27:25 -0500 Subject: [PATCH 084/109] compiler: fix stack effect inference bug discovered by x6j8x; it was possible to define a word which did not compile but could be called anyway --- basis/compiler/compiler.factor | 24 +++++++++--------------- basis/compiler/tests/simple.factor | 13 ++++++++++++- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 626ab678c0..e58cf0c834 100755 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -55,28 +55,22 @@ SYMBOL: compiled GENERIC: no-compile? ( word -- ? ) -M: word no-compile? "no-compile" word-prop ; - M: method-body no-compile? "method-generic" word-prop no-compile? ; M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ; +M: word no-compile? + { + [ macro? ] + [ inline? ] + [ "special" word-prop ] + [ "no-compile" word-prop ] + } 1|| ; + : ignore-error? ( word error -- ? ) #! Ignore some errors on inline combinators, macros, and special #! words such as 'call'. - [ - { - [ macro? ] - [ inline? ] - [ no-compile? ] - [ "special" word-prop ] - } 1|| - ] [ - { - [ do-not-compile? ] - [ literal-expected? ] - } 1|| - ] bi* and ; + [ no-compile? ] [ { [ do-not-compile? ] [ literal-expected? ] } 1|| ] bi* and ; : finish ( word -- ) #! Recompile callers if the word's stack effect changed, then diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor index da021412fe..a86d5b8c52 100644 --- a/basis/compiler/tests/simple.factor +++ b/basis/compiler/tests/simple.factor @@ -1,6 +1,7 @@ USING: compiler compiler.units tools.test kernel kernel.private sequences.private math.private math combinators strings alien -arrays memory vocabs parser eval ; +arrays memory vocabs parser eval quotations compiler.errors +definitions ; IN: compiler.tests.simple ! Test empty word @@ -238,3 +239,13 @@ M: f single-combination-test-2 single-combination-test-4 ; "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized?" eval( -- obj ) ] unit-test ] times + +! This should not compile +GENERIC: bad-effect-test ( a -- ) +M: quotation bad-effect-test call ; inline +: bad-effect-test* ( -- ) [ 1 2 3 ] bad-effect-test ; + +[ bad-effect-test* ] [ not-compiled? ] must-fail-with + +! Don't want compiler error to stick around +[ ] [ [ M\ quotation bad-effect-test forget ] with-compilation-unit ] unit-test From 9d4df482c8f929db14d5958318ff407767a5c1cf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 03:27:45 -0500 Subject: [PATCH 085/109] help: don't consider children of $markup-examples for cross-referencing --- basis/help/crossref/crossref-tests.factor | 11 ++++++++++- basis/help/markup/markup.factor | 4 ++-- basis/help/vocabs/vocabs-tests.factor | 3 ++- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/basis/help/crossref/crossref-tests.factor b/basis/help/crossref/crossref-tests.factor index 4022d3bd38..6fb4c562cf 100644 --- a/basis/help/crossref/crossref-tests.factor +++ b/basis/help/crossref/crossref-tests.factor @@ -1,6 +1,7 @@ USING: help.crossref help.topics help.markup tools.test words definitions assocs sequences kernel namespaces parser arrays -io.streams.string continuations debugger compiler.units eval ; +io.streams.string continuations debugger compiler.units eval +help.syntax ; IN: help.crossref.tests [ ] [ @@ -54,3 +55,11 @@ IN: help.crossref.tests ] unit-test [ "xxx" ] [ "yyy" article-parent ] unit-test + +ARTICLE: "crossref-test-1" "Crossref test 1" +"Hello world" ; + +ARTICLE: "crossref-test-2" "Crossref test 2" +{ $markup-example { $subsection "crossref-test-1" } } ; + +[ V{ } ] [ "crossref-test-2" >link article-children ] unit-test diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index ea64df3edc..229a025442 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -430,8 +430,8 @@ M: simple-element elements* M: object elements* 2drop ; M: array elements* - [ [ elements* ] with each ] 2keep - [ first eq? ] keep swap [ , ] [ drop ] if ; + [ dup first \ $markup-example eq? [ 2drop ] [ [ elements* ] with each ] if ] + [ [ first eq? ] keep swap [ , ] [ drop ] if ] 2bi ; : elements ( elt-type element -- seq ) [ elements* ] { } make ; diff --git a/basis/help/vocabs/vocabs-tests.factor b/basis/help/vocabs/vocabs-tests.factor index 5637dd92f4..aca1ae43c9 100644 --- a/basis/help/vocabs/vocabs-tests.factor +++ b/basis/help/vocabs/vocabs-tests.factor @@ -1,5 +1,6 @@ -USING: help.vocabs tools.test help.markup help vocabs ; +USING: help.vocabs tools.test help.markup help vocabs io ; IN: help.vocabs.tests [ ] [ { $vocab "scratchpad" } print-content ] unit-test [ ] [ "classes" vocab print-topic ] unit-test +[ ] [ nl ] unit-test From d05127644e12010a1ae9498841707a3f1c3877f6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 03:40:02 -0500 Subject: [PATCH 086/109] io.sockets.windows: fix USING: list --- basis/io/sockets/windows/windows.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor index fa5e3833bc..0f3ac39607 100755 --- a/basis/io/sockets/windows/windows.factor +++ b/basis/io/sockets/windows/windows.factor @@ -1,6 +1,9 @@ +! Copyright (C) 2007, 2009 Slava Pestov, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors io.sockets io.sockets.private io.backend.windows io.backend windows.winsock system destructors alien.c-types classes.struct combinators ; +FROM: namespaces => get ; IN: io.sockets.windows M: windows addrinfo-error ( n -- ) From bbedd03f6b01fad5c51f49bd6afaae62186a60b8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 04:24:20 -0500 Subject: [PATCH 087/109] mirrors: don't depend on specialized-arrays, it pulls in too much --- basis/math/vectors/specialization/specialization.factor | 6 +++--- basis/mirrors/mirrors.factor | 5 +---- basis/specialized-arrays/mirrors/mirrors.factor | 8 ++++++++ basis/specialized-arrays/specialized-arrays.factor | 4 ++++ 4 files changed, 16 insertions(+), 7 deletions(-) create mode 100644 basis/specialized-arrays/mirrors/mirrors.factor diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor index 3ff286d508..602fd9802c 100644 --- a/basis/math/vectors/specialization/specialization.factor +++ b/basis/math/vectors/specialization/specialization.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: words kernel make sequences effects sets kernel.private accessors combinators math math.intervals math.vectors -math.vectors.conversion.backend -namespaces assocs fry splitting classes.algebra generalizations -locals compiler.tree.propagation.info ; +math.vectors.conversion.backend namespaces assocs fry splitting +classes.algebra generalizations locals +compiler.tree.propagation.info ; IN: math.vectors.specialization SYMBOLS: -> +vector+ +any-vector+ +scalar+ +boolean+ +nonnegative+ +literal+ ; diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor index b9f9019245..e1871a35ca 100644 --- a/basis/mirrors/mirrors.factor +++ b/basis/mirrors/mirrors.factor @@ -3,7 +3,7 @@ USING: assocs hashtables kernel sequences generic words arrays classes slots slots.private classes.tuple classes.tuple.private math vectors math.vectors quotations -accessors combinators byte-arrays specialized-arrays ; +accessors combinators byte-arrays ; IN: mirrors TUPLE: mirror { object read-only } ; @@ -53,9 +53,6 @@ INSTANCE: array enumerated-sequence INSTANCE: vector enumerated-sequence INSTANCE: callable enumerated-sequence INSTANCE: byte-array enumerated-sequence -INSTANCE: specialized-array enumerated-sequence -INSTANCE: simd-128 enumerated-sequence -INSTANCE: simd-256 enumerated-sequence GENERIC: make-mirror ( obj -- assoc ) M: hashtable make-mirror ; diff --git a/basis/specialized-arrays/mirrors/mirrors.factor b/basis/specialized-arrays/mirrors/mirrors.factor new file mode 100644 index 0000000000..ee7953b501 --- /dev/null +++ b/basis/specialized-arrays/mirrors/mirrors.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2009 Joe Groff. +! See http://factorcode.org/license.txt for BSD license. +USING: mirrors specialized-arrays math.vectors ; +IN: specialized-arrays.mirrors + +INSTANCE: specialized-array enumerated-sequence +INSTANCE: simd-128 enumerated-sequence +INSTANCE: simd-256 enumerated-sequence diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 67c58987a1..7a15e5067d 100755 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -168,3 +168,7 @@ SYNTAX: SPECIALIZED-ARRAY: "prettyprint" vocab [ "specialized-arrays.prettyprint" require ] when + +"mirrors" vocab [ + "specialized-arrays.mirrors" require +] when From 2b142dabae6507d496a30f253ace74883fe76e21 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 04:32:17 -0500 Subject: [PATCH 088/109] Re-organize a few things to reduce '-include=' image size --- basis/bootstrap/stage2.factor | 2 -- basis/bootstrap/tools/tools.factor | 3 ++- basis/debugger/debugger.factor | 11 +++++++---- basis/mirrors/mirrors.factor | 6 +++++- basis/tools/errors/errors.factor | 4 ---- core/source-files/errors/errors.factor | 1 + 6 files changed, 15 insertions(+), 12 deletions(-) diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor index 3cbe155dd2..0b517c0e66 100644 --- a/basis/bootstrap/stage2.factor +++ b/basis/bootstrap/stage2.factor @@ -77,8 +77,6 @@ SYMBOL: bootstrap-time "stage2: deployment mode" print ] [ "debugger" require - "inspector" require - "tools.errors" require "listener" require "none" require ] if diff --git a/basis/bootstrap/tools/tools.factor b/basis/bootstrap/tools/tools.factor index 6bdfd6241c..848e310d63 100644 --- a/basis/bootstrap/tools/tools.factor +++ b/basis/bootstrap/tools/tools.factor @@ -2,8 +2,10 @@ USING: vocabs.loader sequences ; IN: bootstrap.tools { + "editors" "inspector" "bootstrap.image" + "see" "tools.annotations" "tools.crossref" "tools.errors" @@ -19,5 +21,4 @@ IN: bootstrap.tools "vocabs.hierarchy" "vocabs.refresh" "vocabs.refresh.monitor" - "editors" } [ require ] each diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 4888896866..2920421e6b 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -8,19 +8,22 @@ continuations.private combinators generic.math classes.builtin classes compiler.units generic.standard generic.single vocabs init kernel.private io.encodings accessors math.order destructors source-files parser classes.tuple.parser effects.parser lexer -generic.parser strings.parser vocabs.loader vocabs.parser see +generic.parser strings.parser vocabs.loader vocabs.parser source-files.errors ; IN: debugger -GENERIC: error. ( error -- ) GENERIC: error-help ( error -- topic ) -M: object error. . ; - M: object error-help drop f ; M: tuple error-help class ; +M: source-file-error error-help error>> error-help ; + +GENERIC: error. ( error -- ) + +M: object error. . ; + M: string error. print ; : :s ( -- ) diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor index e1871a35ca..65978f0b46 100644 --- a/basis/mirrors/mirrors.factor +++ b/basis/mirrors/mirrors.factor @@ -3,7 +3,7 @@ USING: assocs hashtables kernel sequences generic words arrays classes slots slots.private classes.tuple classes.tuple.private math vectors math.vectors quotations -accessors combinators byte-arrays ; +accessors combinators byte-arrays vocabs vocabs.loader ; IN: mirrors TUPLE: mirror { object read-only } ; @@ -59,3 +59,7 @@ M: hashtable make-mirror ; M: integer make-mirror drop f ; M: enumerated-sequence make-mirror ; M: object make-mirror ; + +"specialized-arrays" vocab [ + "specialized-arrays.mirrors" require +] when diff --git a/basis/tools/errors/errors.factor b/basis/tools/errors/errors.factor index 963ea7592c..0bf271535a 100644 --- a/basis/tools/errors/errors.factor +++ b/basis/tools/errors/errors.factor @@ -8,10 +8,6 @@ IN: tools.errors #! Tools for source-files.errors. Used by tools.tests and others #! for error reporting -M: source-file-error compute-restarts error>> compute-restarts ; - -M: source-file-error error-help error>> error-help ; - CONSTANT: +listener-input+ "" : error-location ( error -- string ) diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor index 93078c162b..f021944f86 100644 --- a/core/source-files/errors/errors.factor +++ b/core/source-files/errors/errors.factor @@ -17,6 +17,7 @@ TUPLE: source-file-error error asset file line# ; M: source-file-error error-file [ error>> error-file ] [ file>> ] bi or ; M: source-file-error error-line [ error>> error-line ] [ line#>> ] bi or ; +M: source-file-error compute-restarts error>> compute-restarts ; : sort-errors ( errors -- alist ) [ [ line#>> ] sort-with ] { } assoc-map-as sort-keys ; From 4e5537ebf2d1da71a9ceb70c565e9ce225f65393 Mon Sep 17 00:00:00 2001 From: Elie Chaftari Date: Fri, 23 Oct 2009 12:50:12 +0300 Subject: [PATCH 089/109] POP3 client library --- extra/pop3/authors.txt | 1 + extra/pop3/pop3-docs.factor | 312 ++++++++++++++++++++++++++++++++ extra/pop3/pop3-tests.factor | 68 +++++++ extra/pop3/pop3.factor | 199 ++++++++++++++++++++ extra/pop3/server/server.factor | 266 +++++++++++++++++++++++++++ extra/pop3/server/summary.txt | 1 + extra/pop3/summary.txt | 1 + extra/pop3/tags.txt | 2 + 8 files changed, 850 insertions(+) create mode 100644 extra/pop3/authors.txt create mode 100644 extra/pop3/pop3-docs.factor create mode 100644 extra/pop3/pop3-tests.factor create mode 100644 extra/pop3/pop3.factor create mode 100644 extra/pop3/server/server.factor create mode 100644 extra/pop3/server/summary.txt create mode 100644 extra/pop3/summary.txt create mode 100644 extra/pop3/tags.txt diff --git a/extra/pop3/authors.txt b/extra/pop3/authors.txt new file mode 100644 index 0000000000..0a1127186c --- /dev/null +++ b/extra/pop3/authors.txt @@ -0,0 +1 @@ +Elie Chaftari \ No newline at end of file diff --git a/extra/pop3/pop3-docs.factor b/extra/pop3/pop3-docs.factor new file mode 100644 index 0000000000..aeb6d210f6 --- /dev/null +++ b/extra/pop3/pop3-docs.factor @@ -0,0 +1,312 @@ +! Copyright (C) 2009 Elie Chaftari. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays assocs help.markup help.syntax kernel math +sequences strings ; +IN: pop3 + +HELP: +{ $values + + { "pop3-account" pop3-account } +} +{ $description "creates a " { $link pop3-account } " object with defaults for the port and timeout slots." } ; + +HELP: account +{ $values + + { "pop3-account" pop3-account } +} +{ $description "You only need to call " { $link connect } " after calling this word to reconnect to the latest accessed POP3 account." } +{ $examples + { $code + "account connect" + "" + } +} ; + +HELP: >user +{ $values + { "name" "userID of the account" } +} +{ $description "Sends the userID of the account on the POP3 server (this could be the full e-mail address)" $nl +"This must be the first command after " { $link connect } " if username and password have not been set with " { $link } "." +} ; + +HELP: >pwd +{ $values + { "password" "password for the userID" } +} +{ $description "Sends the clear-text password for the userID. The password may be case sensitive. This must be the next command after " { $link >user } "." } ; + +HELP: capa +{ $values + + { "array" array } +} +{ $description "Queries the mail server capabilities, as described in RFC 2449. It is advised to check for command support before calling the appropriate words (e.g. TOP UIDL)." } ; + +HELP: connect +{ $values + { "pop3-account" pop3-account } +} +{ $description "Opens a network connection to the pop3 mail server with the settings given in the pop3-account slots." } +{ $examples + { $code "USING: accessors pop3 ;" + "" + " \"pop.yourisp.com\" >>host" + " \"username@yourisp.com\" >>user" + " \"pass123\" >>pwd" + "connect" + "" + } +} ; + +HELP: consolidate +{ $values + + { "seq" sequence } +} +{ $description "Builds a sequence of email tuples, iterating over each email top and consolidating its headers with its number, uidl, and size." } ; + +HELP: delete +{ $values + { "message#" fixnum } +} +{ $description "This marks message number message# for deletion from the server. This is the way to get rid of a problem causing message. It is not actually deleted until the " { $link close } " word is issued. If you lose the connection to the mail server before calling the " { $link close } " word, the server should not delete any messages. Example: 3 delete" } ; + +HELP: headers +{ $values + + { "assoc" assoc } +} +{ $description "Gathers and associates the From:, Subject:, and To: headers of each message." } ; + +HELP: list +{ $values + + { "assoc" assoc } +} +{ $description "Lists each message with its number and size in bytes" } ; + +HELP: pop3-account +{ $class-description "A POP3 account on a POP3 server. It has the following slots:" + { $table + { { $slot "#" } "The ephemeral ordinal number of the message." } + { { $slot "host" } "The name or IP address of the remote host to which a POP3 connection is required." } + { { $slot "port" } "The POP3 server port (defaults to 110)." } + { { $slot "timeout" } "Maximum time in minutes to wait for a response from the POP3 server (defaults to 1 minutes)." } + { { $slot "user" } "The userID of the account on the POP3 server." } + { { $slot "pwd" } { "The clear-text password for the userID." } } + { { $slot "stream" } { "The duplex input/output stream wrapping the POP3 session." } } + { { $slot "capa" } { "A list of the mail server capabilities." } } + { { $slot "count" } { "Number of messages in the mailbox." } } + { { $slot "list" } { "A list of every message with its number and size in bytes" } } + { { $slot "uidls" } { "The UIDL (Unique IDentification Listing) of every message in the mailbox together with its ordinal number." } } + { { $slot "messages" } { "A sequence of email tuples in the mailbox containing each email's headers, number, uidl, and size." } } + } +"The " { $slot "host" } " is required; the rest are either set by default or optional." $nl +"The " { $slot "user" } " and " { $slot "pwd" } " must either be set before using " { $link connect } " or immediately after it with the " { $link >user } " and " { $link >pwd } " words." +} ; + +HELP: message +{ $class-description "An e-mail message having the following slots:" + { $table + { { $slot "#" } "The ephemeral ordinal number of the message." } + { { $slot "uidl" } "The POP3 UIDL (Unique IDentification Listing) of the message." } + { { $slot "headers" } "The From:, Subject:, and To: headers of the message." } + { { $slot "from" } "The sender of the message. An e-mail address." } + { { $slot "to" } "The recipients of the message." } + { { $slot "subject" } { "The subject of the message." } } + { { $slot "size" } { "The size of the message in octets." } } + } +} ; + +HELP: close +{ $description "Deletes any messages marked for deletion, and then logs you off of the mail server. This is the last command to use." } ; + +HELP: retrieve +{ $values + { "message#" fixnum } + { "seq" sequence } +} +{ $description "Sends message number message# to you. You should prepare for some base64 decoding. You probably want to do this with a mailer." } ; + +HELP: reset +{ $description "Resets the status of the remote POP3 server. This includes resetting the status of all messages to not be deleted." } ; + +HELP: count +{ $values + + { "n" fixnum } +} +{ $description "Gets the number of messages in the mailbox." } ; + +HELP: top +{ $values + { "message#" fixnum } { "#lines" fixnum } + { "seq" sequence } +} +{ $description "Lists the header for message# and the first #lines of the message text. For example, 1 0 top would list just the headers for message 1, where as 1 5 top would list the headers and first 5 lines of the message text." } ; + +HELP: uidl +{ $values + { "message#" fixnum } + { "uidl" string } +} +{ $description "Gets the POP3 UIDL (Unique IDentification Listing) of the given message#." } ; + +HELP: uidls +{ $values + + { "assoc" assoc } +} +{ $description "Gets the POP3 UIDL (Unique IDentification Listing) of every specific message in the mailbox together with its ordinal number. UIDL provides a mechanism that avoids numbering issues between POP3 sessions by assigning a permanent and unique ID for each message." } ; + +ARTICLE: "pop3" "POP3 client library" +"The " { $vocab-link "pop3" } " vocab implements a client interface to the POP3 protocol, enabling a Factor application to talk to POP3 servers. It allows interactive sessions similar to telnet ones to do maintenance on your mailbox on a POP3 mail server; to look at, and possibly delete, any problem causing message (e.g. too large, improperly formatted, etc.)." $nl +"Word names do not necessarily map directly to POP3 commands defined in RFC1081 or RFC1939, although most commands are supported." $nl +"This article assumes that you are familiar with the POP3 protocol." +$nl +"Connecting to the mail server:" +{ $subsections connect } +"You need to construct a pop3-account tuple first, setting at least the host slot." +{ $subsections } +{ $examples + { $code "USING: accessors pop3 ;" + "" + " \"pop.yourisp.com\" >>host" + " \"username@yourisp.com\" >>user" + " \"pass123\" >>pwd" + "connect" + "" + } +} +$nl +"If you do not supply the username or password, you will need to call the " { $link >user } " and " { $link >pwd } " vocabs in this order after the " { $link connect } " vocab." +{ $examples + { $code "USING: accessors pop3 ;" + "" + " \"pop.yourisp.com\" >>host" + "connect" + "" + "\"username@yourisp.com\" >user" + "\"pass123\" >pwd" + "" + } +} +$nl +{ $notes "Subsequent calls to the " { $link pop3-account } " thus created can be done by calling the " { $link account } " word. If you needed to reconnect to the same POP3 account after having called " { $link close } ", you only need to call " { $link account } " followed by " { $link connect } "." } +$nl +"Querying the mail server:" +$nl +"For its capabilities:" +{ $subsections capa } +{ $examples + { $code + "capa ." + "{ \"CAPA\" \"TOP\" \"UIDL\" }" + "" + } +} +$nl +"For the message count:" +{ $subsections count } +{ $examples + { $code + "count ." + "2" + "" + } +} +$nl +"For each message's size:" +{ $subsections list } +{ $examples + { $code + "list ." + "H{ { 1 \"1006\" } { 2 \"747\" } }" + "" + } +} +$nl +"For a specific message raw header, appropriate headers, or number of lines:" +{ $subsections top } +{ $examples + { $code + "1 0 top ." + "" + "" + } + { $code + "1 5 top ." + "" + "" + } + { $code + "1 0 top headers ." + "H{" + " { \"From:\" \"from@mail.com\" }" + " { \"Subject:\" \"Re:\" }" + " { \"To:\" \"username@host.com\" }" + "}" + "" + } +} +$nl +"To consolidate all the messages of this account into a single association:" +{ $subsections consolidate } +{ $examples + { $code + "consolidate ." +"""{ + T{ message + { # 1 } + { uidl \"000000d547ac2fc2\" } + { from \"from.first@mail.com\" } + { to \"username@host.com\" } + { subject \"First subject\" } + { size \"1006\" } + } + T{ message + { # 2 } + { uidl \"000000d647ac2fc2\" } + { from \"from.second@mail.com\" } + { to \"username@host.com\" } + { subject \"Second subject\" } + { size \"747\" } + } +}""" + "" + } +} +$nl +"You may want to delete message #2 but want to make sure you are deleting the right one. You can check that message #2 has the uidl from the example above." +{ $subsections uidl } +{ $examples + { $code + "2 uidl ." + "\"000000d647ac2fc2\"" + "" + } +} +$nl +"Now with your mind at rest, you can delete message #2. The message is marked for deletion." +{ $subsections delete } +{ $examples + { $code + "2 delete" + "" + } +} +$nl +"The messages marked for deletion are actually deleted only when " { $link close } " is called. This should be the last command you issue. " +{ $subsections close } +{ $examples + { $code + "close" + "" + } +} +{ $notes "If you change your mind at any point, you can call " { $link reset } " to reset the status of all messages to not be deleted." } ; + +ABOUT: "pop3" diff --git a/extra/pop3/pop3-tests.factor b/extra/pop3/pop3-tests.factor new file mode 100644 index 0000000000..8efc07ceee --- /dev/null +++ b/extra/pop3/pop3-tests.factor @@ -0,0 +1,68 @@ +! Copyright (C) 2009 Elie Chaftari. +! See http://factorcode.org/license.txt for BSD license. +USING: concurrency.promises namespaces kernel pop3 pop3.server +sequences tools.test accessors ; +IN: pop3.tests + +FROM: pop3 => count delete ; + + "p1" set + +[ ] [ "p1" get mock-pop3-server ] unit-test +[ ] [ + + "127.0.0.1" >>host + "p1" get ?promise >>port + connect +] unit-test +[ ] [ "username@host.com" >user ] unit-test +[ ] [ "password" >pwd ] unit-test +[ { "CAPA" "TOP" "UIDL" } ] [ capa ] unit-test +[ 2 ] [ count ] unit-test +[ H{ { 1 "1006" } { 2 "747" } } ] [ list ] unit-test +[ + H{ + { "From:" "from.first@mail.com" } + { "Subject:" "First test with mock POP3 server" } + { "To:" "username@host.com" } + } +] [ 1 0 top drop headers ] unit-test +[ + { + T{ message + { # 1 } + { uidl "000000d547ac2fc2" } + { from "from.first@mail.com" } + { to "username@host.com" } + { subject "First test with mock POP3 server" } + { size "1006" } + } + T{ message + { # 2 } + { uidl "000000d647ac2fc2" } + { from "from.second@mail.com" } + { to "username@host.com" } + { subject "Second test with mock POP3 server" } + { size "747" } + } + } +] [ consolidate ] unit-test +[ "000000d547ac2fc2" ] [ 1 uidl ] unit-test +[ ] [ 1 delete ] unit-test +[ ] [ reset ] unit-test +[ ] [ close ] unit-test + + + "p2" set + +[ ] [ "p2" get mock-pop3-server ] unit-test +[ ] [ + + "127.0.0.1" >>host + "p2" get ?promise >>port + "username@host.com" >>user + "password" >>pwd + connect +] unit-test +[ f ] [ 1 retrieve empty? ] unit-test +[ ] [ close ] unit-test diff --git a/extra/pop3/pop3.factor b/extra/pop3/pop3.factor new file mode 100644 index 0000000000..030d265f37 --- /dev/null +++ b/extra/pop3/pop3.factor @@ -0,0 +1,199 @@ +! Copyright (C) 2009 Elie Chaftari. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors annotations arrays assocs calendar combinators +fry hashtables io io.crlf io.encodings.utf8 io.sockets +io.streams.duplex io.timeouts kernel make math math.parser +math.ranges namespaces prettyprint sequences splitting +strings ; +IN: pop3 + +TUPLE: pop3-account +# host port timeout user pwd stream capa count list +uidls messages ; + +: ( -- pop3-account ) + pop3-account new + 110 >>port + 1 minutes >>timeout ; + +: account ( -- pop3-account ) pop3-account get ; + +TUPLE: message # uidl headers from to subject size ; + +> ; + +: ( -- message ) message new ; inline + +TUPLE: raw-source top headers content ; + +: ( -- raw-source ) raw-source new ; inline + +: raw ( -- raw-source ) raw-source get ; + +: set-read-timeout ( -- ) + stream [ + account timeout>> timeouts + ] with-stream* ; + +: get-ok ( -- ) + stream [ + readln dup "+OK" head? [ drop ] [ throw ] if + ] with-stream* ; + +: get-ok-and-total ( -- total ) + stream [ + readln dup "+OK" head? [ + " " split second string>number dup account (>>count) + ] [ throw ] if + ] with-stream* ; + +: get-ok-and-uidl ( -- uidl ) + stream [ + readln dup "+OK" head? [ + " " split last + ] [ throw ] if + ] with-stream* ; + +: command ( string -- ) write crlf flush get-ok ; + +: command-and-total ( string -- total ) write crlf flush + get-ok-and-total ; + +: command-and-uidl ( string -- uidl ) write crlf flush + get-ok-and-uidl ; + +: associate-split ( seq -- assoc ) + [ " " split1 ] H{ } map>assoc ; + +: split-map ( seq -- assoc ) + associate-split [ [ string>number ] dip ] assoc-map ; + +: (readlns) ( -- ) + readln dup "." = [ , ] dip [ (readlns) ] unless ; + +: readlns ( -- seq ) [ (readlns) ] { } make but-last ; + +: (list) ( -- ) + stream [ + "LIST" command + readlns account (>>list) + ] with-stream* ; + +: (uidls) ( -- ) + stream [ + "UIDL" command + readlns account (>>uidls) + ] with-stream* ; + +PRIVATE> + +: >user ( name -- ) + [ stream ] dip '[ + "USER " _ append command + ] with-stream* ; + +: >pwd ( password -- ) + [ stream ] dip '[ + "PASS " _ append command + ] with-stream* ; + +: connect ( pop3-account -- ) + [ + [ host>> ] [ port>> ] bi + utf8 drop + ] keep swap >>stream + { + [ pop3-account set ] + [ user>> [ >user ] when* ] + [ pwd>> [ >pwd ] when* ] + } cleave + set-read-timeout + get-ok ; + +: capa ( -- array ) + stream [ + "CAPA" command + readlns dup account (>>capa) + ] with-stream* ; + +: count ( -- n ) + stream [ + "STAT" command-and-total + ] with-stream* ; + +: list ( -- assoc ) + (list) account list>> split-map ; + +: uidl ( message# -- uidl ) + [ stream ] dip '[ + "UIDL " _ number>string append command-and-uidl + ] with-stream* ; + +: uidls ( -- assoc ) + (uidls) account uidls>> split-map ; + +: top ( message# #lines -- seq ) + raw-source set + [ stream ] 2dip '[ + "TOP " _ number>string append " " + append _ number>string append + command + readlns dup raw (>>top) + ] with-stream* ; + +: headers ( -- assoc ) + raw top>> { + [ + [ dup "From:" head? + [ raw [ swap suffix ] change-headers drop ] + [ drop ] if + ] each + ] + [ + [ dup "To:" head? + [ raw [ swap suffix ] change-headers drop ] + [ drop ] if + ] each + ] + [ + [ dup "Subject:" head? + [ raw [ swap suffix ] change-headers drop ] + [ drop ] if + ] each + ] + } cleave raw headers>> associate-split ; + +: retrieve ( message# -- seq ) + [ stream ] dip '[ + "RETR " _ number>string append command + readlns dup raw (>>content) + ] with-stream* ; + +: delete ( message# -- ) + [ stream ] dip '[ + "DELE " _ number>string append command + ] with-stream* ; + +: reset ( -- ) + stream [ "RSET" command ] with-stream* ; + +: consolidate ( -- seq ) + count zero? [ "No mail for account." ] [ + 1 account count>> [a,b] [ + { + [ 0 top drop ] + [ swap >># ] + [ uidls at >>uidl ] + [ list at >>size ] + } cleave + "From:" headers at >>from + "To:" headers at >>to + "Subject:" headers at >>subject + account [ swap suffix ] change-messages drop + ] each account messages>> + ] if ; + +: close ( -- ) + stream [ "QUIT" command ] with-stream ; diff --git a/extra/pop3/server/server.factor b/extra/pop3/server/server.factor new file mode 100644 index 0000000000..775a457fc5 --- /dev/null +++ b/extra/pop3/server/server.factor @@ -0,0 +1,266 @@ +! Copyright (C) 2009 Elie Chaftari. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors calendar combinators concurrency.promises +destructors fry io io.crlf io.encodings.utf8 io.sockets +io.sockets.secure.unix.debug io.streams.duplex io.timeouts +kernel locals math.parser namespaces prettyprint sequences +splitting threads ; +IN: pop3.server + +! Mock POP3 server for testing purposes. + +! $ telnet 127.0.0.1 (start-pop3-server outputs listening port) +! Trying 127.0.0.1... +! Connected to localhost. +! Escape character is '^]'. +! +OK POP3 server ready +! USER username@host.com +! +OK Password required +! PASS password +! +OK Logged in +! STAT +! +OK 2 1753 +! LIST +! +OK 2 messages: +! 1 1006 +! 2 747 +! . +! UIDL 1 +! +OK 1 000000d547ac2fc2 +! TOP 1 0 +! +OK +! Return-Path: +! Delivered-To: username@host.com +! Received: from User.local ([66.249.71.201]) +! by mail.isp.com with ESMTP id n95BgmJg012655 +! for ; Mon, 5 Oct 2009 14:42:59 +0300 +! Date: Mon, 5 Oct 2009 14:42:31 +0300 +! Message-Id: <4273644000823950677-1254742951070701@User.local> +! MIME-Version: 1.0 +! Content-Transfer-Encoding: base64 +! From: from.first@mail.com +! To: username@host.com +! Subject: First test with mock POP3 server +! Content-Type: text/plain; charset=UTF-8 +! +! . +! DELE 1 +! +OK Marked for deletion +! QUIT +! +OK POP3 server closing connection +! Connection closed by foreign host. + +: process ( -- ) + read-crlf { + { + [ dup "USER" head? ] + [ + + "+OK Password required\r\n" + write flush t + ] + } + { + [ dup "PASS" head? ] + [ + "+OK Logged in\r\n" + write flush t + ] + } + { + [ dup "CAPA" = ] + [ + "+OK\r\nCAPA\r\nTOP\r\nUIDL\r\n.\r\n" + write flush t + ] + } + { + [ dup "STAT" = ] + [ + "+OK 2 1753\r\n" + write flush t + ] + } + { + [ dup "LIST" = ] + [ + "+OK 2 messages:\r\n1 1006\r\n2 747\r\n.\r\n" + write flush t + ] + } + { + [ dup "UIDL" head? ] + [ + { + { + [ dup "UIDL 1" = ] + [ + "+OK 1 000000d547ac2fc2\r\n" + write flush t + ] + } + { + [ dup "UIDL 2" = ] + [ + "+OK 2 000000d647ac2fc2\r\n" + write flush t + ] + } + [ + "+OK\r\n1 000000d547ac2fc2\r\n2 000000d647ac2fc2\r\n.\r\n" + write flush t + ] + } cond + ] + } + { + [ dup "TOP" head? ] + [ + { + { + [ dup "TOP 1 0" = ] + [ +"""+OK +Return-Path: +Delivered-To: username@host.com +Received: from User.local ([66.249.71.201]) + by mail.isp.com with ESMTP id n95BgmJg012655 + for ; Mon, 5 Oct 2009 14:42:59 +0300 +Date: Mon, 5 Oct 2009 14:42:31 +0300 +Message-Id: <4273644000823950677-1254742951070701@User.local> +MIME-Version: 1.0 +Content-Transfer-Encoding: base64 +From: from.first@mail.com +To: username@host.com +Subject: First test with mock POP3 server +Content-Type: text/plain; charset=UTF-8 + +. +""" + write flush t + ] + } + { + [ dup "TOP 2 0" = ] + [ +"""+OK +Return-Path: +Delivered-To: username@host.com +Received: from User.local ([66.249.71.201]) + by mail.isp.com with ESMTP id n95BgmJg012655 + for ; Mon, 5 Oct 2009 14:44:09 +0300 +Date: Mon, 5 Oct 2009 14:43:11 +0300 +Message-Id: <9783644000823934577-4563442951070856@User.local> +MIME-Version: 1.0 +Content-Transfer-Encoding: base64 +From: from.second@mail.com +To: username@host.com +Subject: Second test with mock POP3 server +Content-Type: text/plain; charset=UTF-8 + +. +""" + write flush t + ] + } + } cond + ] + } + { + [ dup "RETR" head? ] + [ + { + { + [ dup "RETR 1" = ] + [ +"""+OK +Return-Path: +Delivered-To: username@host.com +Received: from User.local ([66.249.71.201]) + by mail.isp.com with ESMTP id n95BgmJg012655 + for ; Mon, 5 Oct 2009 14:42:59 +0300 +Date: Mon, 5 Oct 2009 14:42:31 +0300 +Message-Id: <4273644000823950677-1254742951070701@User.local> +MIME-Version: 1.0 +Content-Transfer-Encoding: base64 +From: from.first@mail.com +To: username@host.com +Subject: First test with mock POP3 server +Content-Type: text/plain; charset=UTF-8 + +This is the body of the first test. +. +""" + write flush t + ] + } + { + [ dup "RETR 2" = ] + [ +"""+OK +Return-Path: +Delivered-To: username@host.com +Received: from User.local ([66.249.71.201]) + by mail.isp.com with ESMTP id n95BgmJg012655 + for ; Mon, 5 Oct 2009 14:44:09 +0300 +Date: Mon, 5 Oct 2009 14:43:11 +0300 +Message-Id: <9783644000823934577-4563442951070856@User.local> +MIME-Version: 1.0 +Content-Transfer-Encoding: base64 +From: from.second@mail.com +To: username@host.com +Subject: Second test with mock POP3 server +Content-Type: text/plain; charset=UTF-8 + +This is the body of the second test. +. +""" + write flush t + ] + } + } cond + ] + } + { + [ dup "DELE" head? ] + [ + "+OK Marked for deletion\r\n" + write flush t + ] + } + { + [ dup "RSET" = ] + [ + "+OK\r\n" + write flush t + ] + } + { + [ dup "QUIT" = ] + [ + "+OK POP3 server closing connection\r\n" + write flush f + ] + } + } cond nip [ process ] when ; + +:: mock-pop3-server ( promise -- ) + #! Store the port we are running on in the promise. + [ + [ + "127.0.0.1" 0 utf8 [ + dup addr>> port>> promise fulfill + accept drop [ + 1 minutes timeouts + "+OK POP3 server ready\r\n" write flush + process + global [ flush ] bind + ] with-stream + ] with-disposal + ] with-test-context + ] in-thread ; + +: start-pop3-server ( -- ) + [ mock-pop3-server ] keep ?promise + number>string "POP3 server started on port " + prepend print ; diff --git a/extra/pop3/server/summary.txt b/extra/pop3/server/summary.txt new file mode 100644 index 0000000000..56d261eb25 --- /dev/null +++ b/extra/pop3/server/summary.txt @@ -0,0 +1 @@ +POP3 server for testing purposes diff --git a/extra/pop3/summary.txt b/extra/pop3/summary.txt new file mode 100644 index 0000000000..387a099622 --- /dev/null +++ b/extra/pop3/summary.txt @@ -0,0 +1 @@ +Retrieve mail via POP3 diff --git a/extra/pop3/tags.txt b/extra/pop3/tags.txt new file mode 100644 index 0000000000..80d57bb287 --- /dev/null +++ b/extra/pop3/tags.txt @@ -0,0 +1,2 @@ +enterprise +network From 1e13f94e9fbe2bab3debe2718a01743e11b2433f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 07:01:57 -0500 Subject: [PATCH 090/109] math.matrices: remove dead code --- basis/math/matrices/matrices.factor | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor index 8f75cb9442..f3d039e54a 100644 --- a/basis/math/matrices/matrices.factor +++ b/basis/math/matrices/matrices.factor @@ -110,18 +110,6 @@ IN: math.matrices : mmax ( m -- n ) [ -1/0. ] dip [ [ max ] each ] each ; : mnorm ( m -- n ) dup mmax abs m/n ; - - : cross ( vec1 vec2 -- vec3 ) [ [ { 1 2 1 } vshuffle ] [ { 2 0 0 } vshuffle ] bi* v* ] [ [ { 2 0 0 } vshuffle ] [ { 1 2 1 } vshuffle ] bi* v* ] 2bi v- ; inline From 00cef34d7421c76a0b96cb6d45dec2df69d1fde1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 07:02:11 -0500 Subject: [PATCH 091/109] gpu.shaders: '[ empty? not ] filter' is 'harvest' --- extra/gpu/shaders/shaders.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor index aece1b40d6..fc6d495dff 100755 --- a/extra/gpu/shaders/shaders.factor +++ b/extra/gpu/shaders/shaders.factor @@ -277,7 +277,7 @@ padding-no [ 0 ] initialize ] [ nip ] if ":" join ; : replace-log-line-numbers ( object log -- log' ) - "\n" split [ empty? not ] filter + "\n" split harvest [ replace-log-line-number ] with map "\n" join ; From b23ab401c8240a73b44cf68c6244a24e51c4e5b5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 07:42:29 -0500 Subject: [PATCH 092/109] mongodb.driver: fix for stricter stack effect checking --- extra/mongodb/driver/driver.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/extra/mongodb/driver/driver.factor b/extra/mongodb/driver/driver.factor index 574724dfaf..9538972582 100644 --- a/extra/mongodb/driver/driver.factor +++ b/extra/mongodb/driver/driver.factor @@ -188,9 +188,7 @@ M: mdb-query-msg skip : asc ( key -- spec ) 1 2array ; inline : desc ( key -- spec ) -1 2array ; inline -GENERIC# sort 1 ( mdb-query-msg sort-quot -- mdb-query-msg ) - -M: mdb-query-msg sort +: sort ( mdb-query-msg sort-quot -- mdb-query-msg ) output>array [ 1array >hashtable ] map >>orderby ; inline : key-spec ( spec-quot -- spec-assoc ) From e46259bd338a33454ce41fa9b09e80670eb9b590 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Oct 2009 07:50:56 -0500 Subject: [PATCH 093/109] compiler.tree.propagation.transforms: fix problem with 'shift' transform when input was a bignum --- basis/compiler/tests/optimizer.factor | 2 ++ .../compiler/tree/propagation/transforms/transforms.factor | 6 +++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 0c9b1817c8..3a0fada735 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -443,5 +443,7 @@ M: object bad-dispatch-position-test* ; [ -1 ] [ 3 4 0 dispatch-branch-problem ] unit-test [ 12 ] [ 3 4 1 dispatch-branch-problem ] unit-test +[ 1024 bignum ] [ 10 [ 1 >bignum swap >fixnum shift ] compile-call dup class ] unit-test + ! Not sure if I want to fix this... ! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with \ No newline at end of file diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index b8ff96f833..3a75ee37e1 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -100,8 +100,12 @@ IN: compiler.tree.propagation.transforms ] each ! Speeds up 2^ +: 2^? ( #call -- ? ) + in-d>> first value-info + { [ literal>> 1 = ] [ class>> fixnum class<= ] } 1&& ; + \ shift [ - in-d>> first value-info literal>> 1 = [ + 2^? [ cell-bits tag-bits get - 1 - '[ >fixnum dup 0 < [ 2drop 0 ] [ From 0c431f1222bdf66ea458ad10aaf3bb2ed87f8606 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 01:09:32 -0500 Subject: [PATCH 094/109] compiler.tree.propagation: fix broken corner cases in bitand and shift transforms, exposed by Hugh Aguilar's LC53 benchmark --- .../known-words/known-words.factor | 15 +++++- .../tree/propagation/propagation-tests.factor | 19 +++++++ .../propagation/transforms/transforms.factor | 53 ++++++++++--------- 3 files changed, 60 insertions(+), 27 deletions(-) diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index d4780b335b..e21ab74cc2 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -140,8 +140,19 @@ IN: compiler.tree.propagation.known-words '[ _ _ 2bi ] "outputs" set-word-prop ] each -\ shift [ [ interval-shift-safe ] [ may-overflow integer-valued ] binary-op ] each-derived-op -\ shift [ [ interval-shift-safe ] [ integer-valued ] binary-op ] each-fast-derived-op +: shift-op-class ( info1 info2 -- newclass ) + [ class>> ] bi@ + 2dup [ null-class? ] either? [ 2drop null ] [ drop math-closure ] if ; + +: shift-op ( word interval-quot post-proc-quot -- ) + '[ + [ shift-op-class ] [ _ binary-op-interval ] 2bi + @ + + ] "outputs" set-word-prop ; + +\ shift [ [ interval-shift-safe ] [ may-overflow integer-valued ] shift-op ] each-derived-op +\ shift [ [ interval-shift-safe ] [ integer-valued ] shift-op ] each-fast-derived-op \ bitand [ [ interval-bitand ] [ integer-valued ] binary-op ] each-derived-op \ bitor [ [ interval-bitor ] [ integer-valued ] binary-op ] each-derived-op diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 0a8cb61a9f..5d12c14f5f 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -407,10 +407,18 @@ IN: compiler.tree.propagation.tests [ { fixnum fixnum } declare 7 bitand neg shift ] final-classes ] unit-test +[ V{ fixnum } ] [ + [ { fixnum fixnum } declare 7 bitand neg >bignum shift ] final-classes +] unit-test + [ V{ fixnum } ] [ [ { fixnum } declare 1 swap 7 bitand shift ] final-classes ] unit-test +[ V{ fixnum } ] [ + [ { fixnum } declare 1 swap 7 bitand >bignum shift ] final-classes +] unit-test + cell-bits 32 = [ [ V{ integer } ] [ [ { fixnum } declare 1 swap 31 bitand shift ] @@ -900,9 +908,20 @@ M: tuple-with-read-only-slot clone [ t ] [ [ void* ] { } inlined? ] unit-test [ V{ void*-array } ] [ [ void* ] final-classes ] unit-test +! bitand identities [ t ] [ [ alien-unsigned-1 255 bitand ] { bitand fixnum-bitand } inlined? ] unit-test [ t ] [ [ alien-unsigned-1 255 swap bitand ] { bitand fixnum-bitand } inlined? ] unit-test [ t ] [ [ { fixnum } declare 256 rem -256 bitand ] { fixnum-bitand } inlined? ] unit-test [ t ] [ [ { fixnum } declare 250 rem -256 bitand ] { fixnum-bitand } inlined? ] unit-test [ f ] [ [ { fixnum } declare 257 rem -256 bitand ] { fixnum-bitand } inlined? ] unit-test + +[ V{ fixnum } ] [ [ >bignum 10 mod 2^ ] final-classes ] unit-test +[ V{ bignum } ] [ [ >bignum 10 bitand ] final-classes ] unit-test +[ V{ bignum } ] [ [ >bignum 10 >bignum bitand ] final-classes ] unit-test +[ V{ bignum } ] [ [ >bignum 10 mod ] final-classes ] unit-test +[ V{ bignum } ] [ [ { fixnum } declare -1 >bignum bitand ] final-classes ] unit-test +[ V{ bignum } ] [ [ { fixnum } declare -1 >bignum swap bitand ] final-classes ] unit-test + +! Could be bignum not integer but who cares +[ V{ integer } ] [ [ 10 >bignum bitand ] final-classes ] unit-test diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 3a75ee37e1..d1f5386450 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -42,30 +42,27 @@ IN: compiler.tree.propagation.transforms : positive-fixnum? ( obj -- ? ) { [ fixnum? ] [ 0 >= ] } 1&& ; -: simplify-bitand? ( value -- ? ) - value-info literal>> positive-fixnum? ; +: simplify-bitand? ( value1 value2 -- ? ) + [ literal>> positive-fixnum? ] + [ class>> fixnum swap class<= ] + bi* and ; -: all-ones? ( int -- ? ) - dup 1 + bitand zero? ; inline +: all-ones? ( n -- ? ) dup 1 + bitand zero? ; inline -: redundant-bitand? ( var 111... -- ? ) - [ value-info ] bi@ [ interval>> ] [ literal>> ] bi* { +: redundant-bitand? ( value1 value2 -- ? ) + [ interval>> ] [ literal>> ] bi* { [ nip integer? ] [ nip all-ones? ] [ 0 swap [a,b] interval-subset? ] } 2&& ; -: (zero-bitand?) ( value-info value-info' -- ? ) +: zero-bitand? ( value1 value2 -- ? ) [ interval>> ] [ literal>> ] bi* { [ nip integer? ] [ nip bitnot all-ones? ] [ 0 swap bitnot [a,b] interval-subset? ] } 2&& ; -: zero-bitand? ( var1 var2 -- ? ) - [ value-info ] bi@ - { [ (zero-bitand?) ] [ swap (zero-bitand?) ] } 2|| ; - { bitand-integer-integer bitand-integer-fixnum @@ -73,36 +70,42 @@ IN: compiler.tree.propagation.transforms bitand } [ [ - { + in-d>> first2 [ value-info ] bi@ { { - [ dup in-d>> first2 zero-bitand? ] - [ drop [ 2drop 0 ] ] + [ 2dup zero-bitand? ] + [ 2drop [ 2drop 0 ] ] } { - [ dup in-d>> first2 redundant-bitand? ] - [ drop [ drop ] ] + [ 2dup swap zero-bitand? ] + [ 2drop [ 2drop 0 ] ] } { - [ dup in-d>> first2 swap redundant-bitand? ] - [ drop [ nip ] ] + [ 2dup redundant-bitand? ] + [ 2drop [ drop ] ] } { - [ dup in-d>> first simplify-bitand? ] - [ drop [ >fixnum fixnum-bitand ] ] + [ 2dup swap redundant-bitand? ] + [ 2drop [ nip ] ] } { - [ dup in-d>> second simplify-bitand? ] - [ drop [ [ >fixnum ] dip fixnum-bitand ] ] + [ 2dup simplify-bitand? ] + [ 2drop [ >fixnum fixnum-bitand ] ] } - [ drop f ] + { + [ 2dup swap simplify-bitand? ] + [ 2drop [ [ >fixnum ] dip fixnum-bitand ] ] + } + [ 2drop f ] } cond ] "custom-inlining" set-word-prop ] each ! Speeds up 2^ : 2^? ( #call -- ? ) - in-d>> first value-info - { [ literal>> 1 = ] [ class>> fixnum class<= ] } 1&& ; + in-d>> first2 [ value-info ] bi@ + [ { [ literal>> 1 = ] [ class>> fixnum class<= ] } 1&& ] + [ class>> fixnum class<= ] + bi* and ; \ shift [ 2^? [ From fd1e992e7dccad1a744a2f8a347e51f353c79f71 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 03:54:53 -0500 Subject: [PATCH 095/109] vm: factor out code that visits object slots and code heap blocks into slot_visitor and code_block_visitor --- vm/code_block_visitor.hpp | 79 ++++++++++++++ vm/code_heap.cpp | 85 +++------------ vm/code_heap.hpp | 1 - vm/collector.hpp | 213 +++++++++++++++----------------------- vm/full_collector.cpp | 100 ++++-------------- vm/full_collector.hpp | 5 - vm/master.hpp | 2 + vm/profiler.cpp | 2 +- vm/quotations.cpp | 2 +- vm/slot_visitor.hpp | 101 ++++++++++++++++++ vm/vm.hpp | 7 +- vm/words.cpp | 4 +- 12 files changed, 310 insertions(+), 291 deletions(-) create mode 100644 vm/code_block_visitor.hpp create mode 100644 vm/slot_visitor.hpp diff --git a/vm/code_block_visitor.hpp b/vm/code_block_visitor.hpp new file mode 100644 index 0000000000..12146a940e --- /dev/null +++ b/vm/code_block_visitor.hpp @@ -0,0 +1,79 @@ +namespace factor +{ + +template struct call_frame_code_block_visitor { + Visitor visitor; + + explicit call_frame_code_block_visitor(Visitor visitor_) : visitor(visitor_) {} + + void operator()(stack_frame *frame) + { + cell offset = (cell)FRAME_RETURN_ADDRESS(frame,parent) - (cell)frame->xt; + + code_block *new_block = visitor.visit_code_block(parent->frame_code(frame)); + frame->xt = new_block->xt(); + + FRAME_RETURN_ADDRESS(frame,parent) = (void *)((cell)frame->xt + offset); + } +}; + +template void factor_vm::visit_object_code_block(object *obj, Visitor visitor) +{ + switch(obj->h.hi_tag()) + { + case WORD_TYPE: + { + word *w = (word *)obj; + if(w->code) + w->code = visitor.visit_code_block(w->code); + if(w->profiling) + w->code = visitor.visit_code_block(w->profiling); + + update_word_xt(obj); + break; + } + case QUOTATION_TYPE: + { + quotation *q = (quotation *)obj; + if(q->code) + set_quot_xt(visitor.visit_code_block(q->code)); + break; + } + case CALLSTACK_TYPE: + { + callstack *stack = (callstack *)obj; + call_frame_code_block_visitor call_frame_visitor(visitor); + iterate_callstack_object(stack,call_frame_visitor); + break; + } + } +} + +template void factor_vm::visit_context_code_blocks(Visitor visitor) +{ + callstack *stack = (callstack *)obj; + call_frame_code_block_visitor call_frame_visitor(visitor); + iterate_active_frames(call_frame_visitor); +} + +template struct callback_code_block_visitor { + callback_heap *callbacks; + Visitor visitor; + + explicit callback_code_block_visitor(callback_heap *callbacks_, Visitor visitor_) : + callbacks(callbacks_), visitor(visitor_) {} + + void operator()(callback *stub) + { + stub->compiled = visitor.visit_code_block(stub->compiled); + callbacks->update(stub); + } +}; + +template void factor_vm::visit_callback_code_blocks(Visitor visitor) +{ + callback_code_block_visitor callback_visitor(callbacks,visitor); + callbacks->iterate(callback_visitor); +} + +} diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 5ae55cb760..c837ec7615 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -188,7 +188,7 @@ void factor_vm::primitive_modify_code_heap() break; } - update_word_xt(word.value()); + update_word_xt(word.untagged()); } update_code_heap_words(); @@ -205,99 +205,42 @@ void factor_vm::primitive_code_room() dpush(tag_fixnum(max_free / 1024)); } -code_block *code_heap::forward_code_block(code_block *compiled) -{ - return (code_block *)allocator->state.forward_block(compiled); -} +struct code_block_forwarder { + mark_bits *forwarding_map; -struct callframe_forwarder { - factor_vm *parent; + explicit code_block_forwarder(mark_bits *forwarding_map_) : + forwarding_map(forwarding_map_) {} - explicit callframe_forwarder(factor_vm *parent_) : parent(parent_) {} - - void operator()(stack_frame *frame) + code_block *operator()(code_block *compiled) { - cell offset = (cell)FRAME_RETURN_ADDRESS(frame,parent) - (cell)frame->xt; - - code_block *forwarded = parent->code->forward_code_block(parent->frame_code(frame)); - frame->xt = forwarded->xt(); - - FRAME_RETURN_ADDRESS(frame,parent) = (void *)((cell)frame->xt + offset); + return (code_block *)forwarding_map->forward_block(compiled); } }; void factor_vm::forward_object_xts() { + code_block_forwarder forwarder(&code->allocator->state); + begin_scan(); cell obj; while(to_boolean(obj = next_object())) - { - switch(tagged(obj).type()) - { - case WORD_TYPE: - { - word *w = untag(obj); - - if(w->code) - w->code = code->forward_code_block(w->code); - if(w->profiling) - w->profiling = code->forward_code_block(w->profiling); - - update_word_xt(obj); - } - break; - case QUOTATION_TYPE: - { - quotation *quot = untag(obj); - - if(quot->code) - { - quot->code = code->forward_code_block(quot->code); - set_quot_xt(quot,quot->code); - } - } - break; - case CALLSTACK_TYPE: - { - callstack *stack = untag(obj); - callframe_forwarder forwarder(this); - iterate_callstack_object(stack,forwarder); - } - break; - default: - break; - } - } + visit_object_code_block(untag(obj),forwarder); end_scan(); } void factor_vm::forward_context_xts() { - callframe_forwarder forwarder(this); - iterate_active_frames(forwarder); + code_block_forwarder forwarder(&code->allocator->state); + visit_context_code_blocks(forwarder); } -struct callback_forwarder { - code_heap *code; - callback_heap *callbacks; - - callback_forwarder(code_heap *code_, callback_heap *callbacks_) : - code(code_), callbacks(callbacks_) {} - - void operator()(callback *stub) - { - stub->compiled = code->forward_code_block(stub->compiled); - callbacks->update(stub); - } -}; - void factor_vm::forward_callback_xts() { - callback_forwarder forwarder(code,callbacks); - callbacks->iterate(forwarder); + code_block_forwarder forwarder(&code->allocator->state); + visit_callback_code_blocks(forwarder); } /* Move all free space to the end of the code heap. Live blocks must be marked diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp index 2d9961c03a..5548892d3f 100755 --- a/vm/code_heap.hpp +++ b/vm/code_heap.hpp @@ -26,7 +26,6 @@ struct code_heap { void set_marked_p(code_block *compiled); void clear_mark_bits(); void code_heap_free(code_block *compiled); - code_block *forward_code_block(code_block *compiled); }; } diff --git a/vm/collector.hpp b/vm/collector.hpp index a1a7dc5695..6f6a5e31cd 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -1,20 +1,14 @@ namespace factor { -template struct collector { +template struct collector_workhorse { factor_vm *parent; - data_heap *data; - code_heap *code; - gc_state *current_gc; generation_statistics *stats; TargetGeneration *target; Policy policy; - explicit collector(factor_vm *parent_, generation_statistics *stats_, TargetGeneration *target_, Policy policy_) : + explicit collector_workhorse(factor_vm *parent_, generation_statistics *stats_, TargetGeneration *target_, Policy policy_) : parent(parent_), - data(parent_->data), - code(parent_->code), - current_gc(parent_->current_gc), stats(stats_), target(target_), policy(policy_) {} @@ -32,52 +26,12 @@ template struct collector { return untagged; } - void trace_handle(cell *handle) - { - cell pointer = *handle; - - if(immediate_p(pointer)) return; - - object *untagged = untag(pointer); - if(!policy.should_copy_p(untagged)) - { - policy.visited_object(untagged); - return; - } - - object *forwarding = resolve_forwarding(untagged); - - if(forwarding == untagged) - untagged = promote_object(untagged); - else if(policy.should_copy_p(forwarding)) - untagged = promote_object(forwarding); - else - { - untagged = forwarding; - policy.visited_object(untagged); - } - - *handle = RETAG(untagged,TAG(pointer)); - } - - void trace_slots(object *ptr) - { - cell *slot = (cell *)ptr; - cell *end = (cell *)((cell)ptr + parent->binary_payload_start(ptr)); - - if(slot != end) - { - slot++; - for(; slot < end; slot++) trace_handle(slot); - } - } - object *promote_object(object *untagged) { cell size = untagged->size(); object *newpointer = target->allot(size); /* XXX not exception-safe */ - if(!newpointer) longjmp(current_gc->gc_unwind,1); + if(!newpointer) longjmp(parent->current_gc->gc_unwind,1); memcpy(newpointer,untagged,size); untagged->h.forward_to(newpointer); @@ -90,68 +44,90 @@ template struct collector { return newpointer; } - void trace_stack_elements(segment *region, cell *top) + object *visit_handle(object *obj) { - for(cell *ptr = (cell *)region->start; ptr <= top; ptr++) - trace_handle(ptr); - } - - void trace_registered_locals() - { - std::vector::const_iterator iter = parent->gc_locals.begin(); - std::vector::const_iterator end = parent->gc_locals.end(); - - for(; iter < end; iter++) - trace_handle((cell *)(*iter)); - } - - void trace_registered_bignums() - { - std::vector::const_iterator iter = parent->gc_bignums.begin(); - std::vector::const_iterator end = parent->gc_bignums.end(); - - for(; iter < end; iter++) + if(!policy.should_copy_p(obj)) { - cell *handle = (cell *)(*iter); + policy.visited_object(obj); + return obj; + } - if(*handle) - { - *handle |= BIGNUM_TYPE; - trace_handle(handle); - *handle &= ~BIGNUM_TYPE; - } + object *forwarding = resolve_forwarding(obj); + + if(forwarding == obj) + return promote_object(obj); + else if(policy.should_copy_p(forwarding)) + return promote_object(forwarding); + else + { + policy.visited_object(forwarding); + return forwarding; } } +}; + +template +inline static slot_visitor > make_collector_workhorse( + factor_vm *parent, + generation_statistics *stats, + TargetGeneration *target, + Policy policy) +{ + return slot_visitor >(parent, + collector_workhorse(parent,stats,target,policy)); +} + +template struct collector { + factor_vm *parent; + data_heap *data; + code_heap *code; + generation_statistics *stats; + TargetGeneration *target; + slot_visitor > workhorse; + + explicit collector(factor_vm *parent_, generation_statistics *stats_, TargetGeneration *target_, Policy policy_) : + parent(parent_), + data(parent_->data), + code(parent_->code), + stats(stats_), + target(target_), + workhorse(make_collector_workhorse(parent_,stats_,target_,policy_)) {} + + void trace_handle(cell *handle) + { + workhorse.visit_handle(handle); + } + + void trace_slots(object *ptr) + { + workhorse.visit_slots(ptr); + } - /* Copy roots over at the start of GC, namely various constants, stacks, - the user environment and extra roots registered by local_roots.hpp */ void trace_roots() { - trace_handle(&parent->true_object); - trace_handle(&parent->bignum_zero); - trace_handle(&parent->bignum_pos_one); - trace_handle(&parent->bignum_neg_one); - - trace_registered_locals(); - trace_registered_bignums(); - - for(cell i = 0; i < special_object_count; i++) - trace_handle(&parent->special_objects[i]); + workhorse.visit_roots(); } void trace_contexts() { - context *ctx = parent->ctx; + workhorse.visit_contexts(); + } - while(ctx) + /* Trace all literals referenced from a code block. Only for aging and nursery collections */ + void trace_literal_references(code_block *compiled) + { + workhorse.visit_literal_references(compiled); + } + + void trace_code_heap_roots(std::set *remembered_set) + { + std::set::const_iterator iter = remembered_set->begin(); + std::set::const_iterator end = remembered_set->end(); + + for(; iter != end; iter++) { - trace_stack_elements(ctx->datastack_region,(cell *)ctx->datastack); - trace_stack_elements(ctx->retainstack_region,(cell *)ctx->retainstack); - - trace_handle(&ctx->catchstack_save); - trace_handle(&ctx->current_callback_save); - - ctx = ctx->next; + trace_literal_references(*iter); + parent->gc_stats.code_blocks_scanned++; } } @@ -167,17 +143,17 @@ template struct collector { inline cell card_deck_for_address(cell a) { - return addr_to_deck(a - this->data->start); + return addr_to_deck(a - data->start); } inline cell card_start_address(cell card) { - return (card << card_bits) + this->data->start; + return (card << card_bits) + data->start; } inline cell card_end_address(cell card) { - return ((card + 1) << card_bits) + this->data->start; + return ((card + 1) << card_bits) + data->start; } void trace_partial_objects(cell start, cell end, cell card_start, cell card_end) @@ -195,7 +171,7 @@ template struct collector { if(slot_ptr != end_ptr) { for(; slot_ptr < end_ptr; slot_ptr++) - this->trace_handle(slot_ptr); + workhorse.visit_handle(slot_ptr); } } } @@ -205,10 +181,10 @@ template struct collector { { u64 start_time = current_micros(); - card_deck *decks = this->data->decks; - card_deck *cards = this->data->cards; + card_deck *decks = data->decks; + card_deck *cards = data->cards; - cell gen_start_card = addr_to_card(gen->start - this->data->start); + cell gen_start_card = addr_to_card(gen->start - data->start); cell first_deck = card_deck_for_address(gen->start); cell last_deck = card_deck_for_address(gen->end); @@ -219,7 +195,7 @@ template struct collector { { if(decks[deck_index] & mask) { - this->parent->gc_stats.decks_scanned++; + parent->gc_stats.decks_scanned++; cell first_card = first_card_in_deck(deck_index); cell last_card = last_card_in_deck(deck_index); @@ -228,17 +204,17 @@ template struct collector { { if(cards[card_index] & mask) { - this->parent->gc_stats.cards_scanned++; + parent->gc_stats.cards_scanned++; if(end < card_start_address(card_index)) { start = gen->starts.find_object_containing_card(card_index - gen_start_card); - binary_start = start + this->parent->binary_payload_start((object *)start); + binary_start = start + parent->binary_payload_start((object *)start); end = start + ((object *)start)->size(); } #ifdef FACTOR_DEBUG - assert(addr_to_card(start - this->data->start) <= card_index); + assert(addr_to_card(start - data->start) <= card_index); assert(start < card_end_address(card_index)); #endif @@ -253,7 +229,7 @@ scan_next_object: { start = gen->next_object_after(start); if(start) { - binary_start = start + this->parent->binary_payload_start((object *)start); + binary_start = start + parent->binary_payload_start((object *)start); end = start + ((object *)start)->size(); goto scan_next_object; } @@ -270,24 +246,7 @@ scan_next_object: { } } -end: this->parent->gc_stats.card_scan_time += (current_micros() - start_time); - } - - /* Trace all literals referenced from a code block. Only for aging and nursery collections */ - void trace_literal_references(code_block *compiled) - { - this->trace_handle(&compiled->owner); - this->trace_handle(&compiled->literals); - this->trace_handle(&compiled->relocation); - this->parent->gc_stats.code_blocks_scanned++; - } - - void trace_code_heap_roots(std::set *remembered_set) - { - std::set::const_iterator iter = remembered_set->begin(); - std::set::const_iterator end = remembered_set->end(); - - for(; iter != end; iter++) trace_literal_references(*iter); +end: parent->gc_stats.card_scan_time += (current_micros() - start_time); } }; diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 817908ece5..fbffe5b33e 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -10,101 +10,36 @@ full_collector::full_collector(factor_vm *parent_) : parent_->data->tenured, full_policy(parent_)) {} -struct stack_frame_marker { - factor_vm *parent; +struct code_block_marker { + code_heap *code; full_collector *collector; - explicit stack_frame_marker(full_collector *collector_) : - parent(collector_->parent), collector(collector_) {} + explicit code_block_marker(code_heap *code_, full_collector *collector_) : + code(code_), collector(collector_) {} - void operator()(stack_frame *frame) + code_block *operator()(code_block *compiled) { - collector->mark_code_block(parent->frame_code(frame)); + if(!code->marked_p(compiled)) + { + code->set_marked_p(compiled); + collector->trace_literal_references(compiled); + } + + return compiled; } }; -/* Mark code blocks executing in currently active stack frames. */ -void full_collector::mark_active_blocks() -{ - stack_frame_marker marker(this); - parent->iterate_active_frames(marker); -} - -void full_collector::mark_object_code_block(object *obj) -{ - switch(obj->h.hi_tag()) - { - case WORD_TYPE: - { - word *w = (word *)obj; - if(w->code) - mark_code_block(w->code); - if(w->profiling) - mark_code_block(w->profiling); - break; - } - case QUOTATION_TYPE: - { - quotation *q = (quotation *)obj; - if(q->code) - mark_code_block(q->code); - break; - } - case CALLSTACK_TYPE: - { - callstack *stack = (callstack *)obj; - stack_frame_marker marker(this); - parent->iterate_callstack_object(stack,marker); - break; - } - } -} - -struct callback_tracer { - full_collector *collector; - - callback_tracer(full_collector *collector_) : collector(collector_) {} - - void operator()(callback *stub) - { - collector->mark_code_block(stub->compiled); - } -}; - -void full_collector::trace_callbacks() -{ - callback_tracer tracer(this); - parent->callbacks->iterate(tracer); -} - -/* Trace all literals referenced from a code block. Only for aging and nursery collections */ -void full_collector::trace_literal_references(code_block *compiled) -{ - this->trace_handle(&compiled->owner); - this->trace_handle(&compiled->literals); - this->trace_handle(&compiled->relocation); -} - -/* Mark all literals referenced from a word XT. Only for tenured -collections */ -void full_collector::mark_code_block(code_block *compiled) -{ - if(!this->code->marked_p(compiled)) - { - this->code->set_marked_p(compiled); - trace_literal_references(compiled); - } -} - void full_collector::mark_reachable_objects() { + code_block_marker marker(code,this); std::vector *mark_stack = &this->target->mark_stack; + while(!mark_stack->empty()) { object *obj = mark_stack->back(); mark_stack->pop_back(); this->trace_slots(obj); - this->mark_object_code_block(obj); + parent->visit_object_code_block(obj,marker); } } @@ -131,8 +66,9 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) if(trace_contexts_p) { collector.trace_contexts(); - collector.mark_active_blocks(); - collector.trace_callbacks(); + code_block_marker marker(code,&collector); + visit_context_code_blocks(marker); + visit_callback_code_blocks(marker); } collector.mark_reachable_objects(); diff --git a/vm/full_collector.hpp b/vm/full_collector.hpp index 9aef352b4b..f613558997 100644 --- a/vm/full_collector.hpp +++ b/vm/full_collector.hpp @@ -28,11 +28,6 @@ struct full_collector : collector { bool trace_contexts_p; full_collector(factor_vm *parent_); - void mark_active_blocks(); - void mark_object_code_block(object *object); - void trace_callbacks(); - void trace_literal_references(code_block *compiled); - void mark_code_block(code_block *compiled); void mark_reachable_objects(); }; diff --git a/vm/master.hpp b/vm/master.hpp index 9168cecce4..dc01429c30 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -72,11 +72,13 @@ namespace factor #include "vm.hpp" #include "tagged.hpp" #include "local_roots.hpp" +#include "slot_visitor.hpp" #include "collector.hpp" #include "copying_collector.hpp" #include "nursery_collector.hpp" #include "aging_collector.hpp" #include "to_tenured_collector.hpp" +#include "code_block_visitor.hpp" #include "full_collector.hpp" #include "callstack.hpp" #include "generic_arrays.hpp" diff --git a/vm/profiler.cpp b/vm/profiler.cpp index 5113b55cf7..2f5fc6fcf4 100755 --- a/vm/profiler.cpp +++ b/vm/profiler.cpp @@ -40,7 +40,7 @@ void factor_vm::set_profiling(bool profiling) tagged word(array_nth(words.untagged(),i)); if(profiling) word->counter = tag_fixnum(0); - update_word_xt(word.value()); + update_word_xt(word.untagged()); } update_code_heap_words(); diff --git a/vm/quotations.cpp b/vm/quotations.cpp index c65c0fe909..17b7c4328b 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -338,7 +338,7 @@ void factor_vm::compile_all_words() if(!word->code || !word->code->optimized_p()) jit_compile_word(word.value(),word->def,false); - update_word_xt(word.value()); + update_word_xt(word.untagged()); } diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp new file mode 100644 index 0000000000..a62fdd87ec --- /dev/null +++ b/vm/slot_visitor.hpp @@ -0,0 +1,101 @@ +namespace factor +{ + +template struct slot_visitor { + factor_vm *parent; + Visitor visitor; + + slot_visitor(factor_vm *parent_, Visitor visitor_) : + parent(parent_), visitor(visitor_) {} + + void visit_handle(cell *handle) + { + cell pointer = *handle; + + if(immediate_p(pointer)) return; + + object *untagged = untag(pointer); + untagged = visitor.visit_handle(untagged); + *handle = RETAG(untagged,TAG(pointer)); + } + + void visit_slots(object *ptr) + { + cell *slot = (cell *)ptr; + cell *end = (cell *)((cell)ptr + parent->binary_payload_start(ptr)); + + if(slot != end) + { + slot++; + for(; slot < end; slot++) visit_handle(slot); + } + } + + void visit_stack_elements(segment *region, cell *top) + { + for(cell *ptr = (cell *)region->start; ptr <= top; ptr++) + visit_handle(ptr); + } + + void visit_registered_locals() + { + std::vector::const_iterator iter = parent->gc_locals.begin(); + std::vector::const_iterator end = parent->gc_locals.end(); + + for(; iter < end; iter++) + visit_handle((cell *)(*iter)); + } + + void visit_registered_bignums() + { + std::vector::const_iterator iter = parent->gc_bignums.begin(); + std::vector::const_iterator end = parent->gc_bignums.end(); + + for(; iter < end; iter++) + { + cell *handle = (cell *)(*iter); + + if(*handle) + *handle = (cell)visitor.visit_handle(*(object **)handle); + } + } + + void visit_roots() + { + visit_handle(&parent->true_object); + visit_handle(&parent->bignum_zero); + visit_handle(&parent->bignum_pos_one); + visit_handle(&parent->bignum_neg_one); + + visit_registered_locals(); + visit_registered_bignums(); + + for(cell i = 0; i < special_object_count; i++) + visit_handle(&parent->special_objects[i]); + } + + void visit_contexts() + { + context *ctx = parent->ctx; + + while(ctx) + { + visit_stack_elements(ctx->datastack_region,(cell *)ctx->datastack); + visit_stack_elements(ctx->retainstack_region,(cell *)ctx->retainstack); + + visit_handle(&ctx->catchstack_save); + visit_handle(&ctx->current_callback_save); + + ctx = ctx->next; + } + } + + void visit_literal_references(code_block *compiled) + { + visit_handle(&compiled->owner); + visit_handle(&compiled->literals); + visit_handle(&compiled->relocation); + } +}; + +} diff --git a/vm/vm.hpp b/vm/vm.hpp index e22e45f22e..674f934bba 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -353,7 +353,7 @@ struct factor_vm word *allot_word(cell name_, cell vocab_, cell hashcode_); void primitive_word(); void primitive_word_xt(); - void update_word_xt(cell w_); + void update_word_xt(word *w_); void primitive_optimized_p(); void primitive_wrapper(); @@ -485,6 +485,11 @@ struct factor_vm code_block *allot_code_block(cell size, code_block_type type); code_block *add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_); + //code_block_visitor + template void visit_object_code_block(object *obj, Visitor visitor); + template void visit_context_code_blocks(Visitor visitor); + template void visit_callback_code_blocks(Visitor visitor); + //code heap inline void check_code_pointer(cell ptr) { diff --git a/vm/words.cpp b/vm/words.cpp index 37a3821069..4248c14b7d 100644 --- a/vm/words.cpp +++ b/vm/words.cpp @@ -23,7 +23,7 @@ word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_) new_word->code = NULL; jit_compile_word(new_word.value(),new_word->def,true); - update_word_xt(new_word.value()); + update_word_xt(new_word.untagged()); if(profiling_p) relocate_code_block(new_word->profiling); @@ -59,7 +59,7 @@ void factor_vm::primitive_word_xt() } /* Allocates memory */ -void factor_vm::update_word_xt(cell w_) +void factor_vm::update_word_xt(word *w_) { gc_root w(w_,this); From 29a27cfde4dc00161f4c8a02a67b07f7bf35f6ca Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 04:18:33 -0500 Subject: [PATCH 096/109] vm: data heap compaction work in progress --- Makefile | 1 + vm/code_block_visitor.hpp | 23 +++++----- vm/code_heap.cpp | 61 ------------------------- vm/collector.hpp | 2 +- vm/compaction.cpp | 96 +++++++++++++++++++++++++++++++++++++++ vm/compaction.hpp | 4 ++ vm/full_collector.cpp | 12 ++--- vm/gc.cpp | 6 +-- vm/master.hpp | 1 + vm/slot_visitor.hpp | 4 +- vm/vm.hpp | 11 ++--- 11 files changed, 130 insertions(+), 91 deletions(-) create mode 100644 vm/compaction.cpp create mode 100644 vm/compaction.hpp diff --git a/Makefile b/Makefile index 78f59a38bb..030a278543 100755 --- a/Makefile +++ b/Makefile @@ -41,6 +41,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ vm/callstack.o \ vm/code_block.o \ vm/code_heap.o \ + vm/compaction.o \ vm/contexts.o \ vm/data_heap.o \ vm/debug.o \ diff --git a/vm/code_block_visitor.hpp b/vm/code_block_visitor.hpp index 12146a940e..9683c39db5 100644 --- a/vm/code_block_visitor.hpp +++ b/vm/code_block_visitor.hpp @@ -2,15 +2,17 @@ namespace factor { template struct call_frame_code_block_visitor { + factor_vm *parent; Visitor visitor; - explicit call_frame_code_block_visitor(Visitor visitor_) : visitor(visitor_) {} + explicit call_frame_code_block_visitor(factor_vm *parent_, Visitor visitor_) : + parent(parent_), visitor(visitor_) {} void operator()(stack_frame *frame) { cell offset = (cell)FRAME_RETURN_ADDRESS(frame,parent) - (cell)frame->xt; - code_block *new_block = visitor.visit_code_block(parent->frame_code(frame)); + code_block *new_block = visitor(parent->frame_code(frame)); frame->xt = new_block->xt(); FRAME_RETURN_ADDRESS(frame,parent) = (void *)((cell)frame->xt + offset); @@ -25,24 +27,24 @@ template void factor_vm::visit_object_code_block(object *obj, { word *w = (word *)obj; if(w->code) - w->code = visitor.visit_code_block(w->code); + w->code = visitor(w->code); if(w->profiling) - w->code = visitor.visit_code_block(w->profiling); + w->code = visitor(w->profiling); - update_word_xt(obj); + update_word_xt(w); break; } case QUOTATION_TYPE: { quotation *q = (quotation *)obj; if(q->code) - set_quot_xt(visitor.visit_code_block(q->code)); + set_quot_xt(q,visitor(q->code)); break; } case CALLSTACK_TYPE: { callstack *stack = (callstack *)obj; - call_frame_code_block_visitor call_frame_visitor(visitor); + call_frame_code_block_visitor call_frame_visitor(this,visitor); iterate_callstack_object(stack,call_frame_visitor); break; } @@ -51,8 +53,7 @@ template void factor_vm::visit_object_code_block(object *obj, template void factor_vm::visit_context_code_blocks(Visitor visitor) { - callstack *stack = (callstack *)obj; - call_frame_code_block_visitor call_frame_visitor(visitor); + call_frame_code_block_visitor call_frame_visitor(this,visitor); iterate_active_frames(call_frame_visitor); } @@ -65,14 +66,14 @@ template struct callback_code_block_visitor { void operator()(callback *stub) { - stub->compiled = visitor.visit_code_block(stub->compiled); + stub->compiled = visitor(stub->compiled); callbacks->update(stub); } }; template void factor_vm::visit_callback_code_blocks(Visitor visitor) { - callback_code_block_visitor callback_visitor(callbacks,visitor); + callback_code_block_visitor callback_visitor(callbacks,visitor); callbacks->iterate(callback_visitor); } diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index c837ec7615..ef257bb935 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -205,67 +205,6 @@ void factor_vm::primitive_code_room() dpush(tag_fixnum(max_free / 1024)); } -struct code_block_forwarder { - mark_bits *forwarding_map; - - explicit code_block_forwarder(mark_bits *forwarding_map_) : - forwarding_map(forwarding_map_) {} - - code_block *operator()(code_block *compiled) - { - return (code_block *)forwarding_map->forward_block(compiled); - } -}; - -void factor_vm::forward_object_xts() -{ - code_block_forwarder forwarder(&code->allocator->state); - - begin_scan(); - - cell obj; - - while(to_boolean(obj = next_object())) - visit_object_code_block(untag(obj),forwarder); - - end_scan(); -} - -void factor_vm::forward_context_xts() -{ - code_block_forwarder forwarder(&code->allocator->state); - visit_context_code_blocks(forwarder); -} - -void factor_vm::forward_callback_xts() -{ - code_block_forwarder forwarder(&code->allocator->state); - visit_callback_code_blocks(forwarder); -} - -/* Move all free space to the end of the code heap. Live blocks must be marked -on entry to this function. XTs in code blocks must be updated after this -function returns. */ -void factor_vm::compact_code_heap(bool trace_contexts_p) -{ - /* Figure out where blocks are going to go */ - code->allocator->state.compute_forwarding(); - - /* Update references to the code heap from the data heap */ - forward_object_xts(); - if(trace_contexts_p) - { - forward_context_xts(); - forward_callback_xts(); - } - - /* Move code blocks and update references amongst them (this requires - that the data heap is up to date since relocation looks up object XTs) */ - code_heap_relocator relocator(this); - code_heap_iterator iter(relocator); - code->allocator->compact(iter); -} - struct stack_trace_stripper { explicit stack_trace_stripper() {} diff --git a/vm/collector.hpp b/vm/collector.hpp index 6f6a5e31cd..86ae963774 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -44,7 +44,7 @@ template struct collector_workhorse return newpointer; } - object *visit_handle(object *obj) + object *visit_object(object *obj) { if(!policy.should_copy_p(obj)) { diff --git a/vm/compaction.cpp b/vm/compaction.cpp new file mode 100644 index 0000000000..b0ced6fcb0 --- /dev/null +++ b/vm/compaction.cpp @@ -0,0 +1,96 @@ +#include "master.hpp" + +namespace factor { + +struct object_slot_forwarder { + mark_bits *forwarding_map; + + explicit object_slot_forwarder(mark_bits *forwarding_map_) : + forwarding_map(forwarding_map_) {} + + object *visit_object(object *obj) + { + return forwarding_map->forward_block(obj); + } +}; + +struct code_block_forwarder { + mark_bits *forwarding_map; + + explicit code_block_forwarder(mark_bits *forwarding_map_) : + forwarding_map(forwarding_map_) {} + + code_block *operator()(code_block *compiled) + { + return (code_block *)forwarding_map->forward_block(compiled); + } +}; + +struct object_compaction_updater { + factor_vm *parent; + slot_visitor slot_forwarder; + code_block_forwarder code_forwarder; + + explicit object_compaction_updater(factor_vm *parent_, + slot_visitor slot_forwader_, + code_block_forwarder code_forwarder_) : + parent(parent_), + slot_forwarder(slot_forwader_), + code_forwarder(code_forwarder_) {} + + void operator()(object *obj, cell size) + { + slot_forwarder.visit_slots(obj); + parent->visit_object_code_block(obj,code_forwarder); + } +}; + +struct code_block_compaction_updater { + factor_vm *parent; + slot_visitor slot_forwarder; + + explicit code_block_compaction_updater(factor_vm *parent_, slot_visitor slot_forwader_) : + parent(parent_), slot_forwarder(slot_forwader_) {} + + void operator()(code_block *compiled, cell size) + { + slot_forwarder.visit_literal_references(compiled); + parent->relocate_code_block(compiled); + } +}; + +void factor_vm::compact_full_impl(bool trace_contexts_p) +{ + tenured_space *tenured = data->tenured; + mark_bits *data_forwarding_map = &tenured->state; + mark_bits *code_forwarding_map = &code->allocator->state; + + /* Figure out where blocks are going to go */ + data_forwarding_map->compute_forwarding(); + code_forwarding_map->compute_forwarding(); + + /* Update root pointers */ + slot_visitor slot_forwarder(this,object_slot_forwarder(data_forwarding_map)); + code_block_forwarder code_forwarder(code_forwarding_map); + + slot_forwarder.visit_roots(); + if(trace_contexts_p) + { + slot_forwarder.visit_contexts(); + visit_context_code_blocks(code_forwarder); + visit_callback_code_blocks(code_forwarder); + } + + /* Slide everything in tenured space up, and update data and code heap + pointers inside objects. */ + object_compaction_updater object_updater(this,slot_forwarder,code_forwarder); + tenured->compact(object_updater); + + /* Slide everything in the code heap up, and update data and code heap + pointers inside code blocks. */ + code_block_compaction_updater code_block_updater(this,slot_forwarder); + code_heap_iterator iter(code_block_updater); + code->allocator->compact(iter); +} + +} diff --git a/vm/compaction.hpp b/vm/compaction.hpp new file mode 100644 index 0000000000..412ef35bb4 --- /dev/null +++ b/vm/compaction.hpp @@ -0,0 +1,4 @@ +namespace factor +{ + +} diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index fbffe5b33e..531b76bf31 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -85,7 +85,7 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p, - bool compact_code_heap_p) + bool compact_p) { /* Grow the data heap and copy all live objects to the new heap. */ data_heap *old = data; @@ -93,18 +93,18 @@ void factor_vm::collect_growing_heap(cell requested_bytes, collect_full_impl(trace_contexts_p); delete old; - if(compact_code_heap_p) - compact_code_heap(trace_contexts_p); + if(compact_p) + compact_full_impl(trace_contexts_p); else relocate_code_heap(); } -void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p) +void factor_vm::collect_full(bool trace_contexts_p, bool compact_p) { collect_full_impl(trace_contexts_p); - if(compact_code_heap_p) - compact_code_heap(trace_contexts_p); + if(compact_p) + compact_full_impl(trace_contexts_p); else update_code_heap_words_and_literals(); } diff --git a/vm/gc.cpp b/vm/gc.cpp index 6b3ec80481..1851924cd5 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -28,7 +28,7 @@ void factor_vm::record_gc_stats(generation_statistics *stats) void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p, - bool compact_code_heap_p) + bool compact_p) { assert(!gc_off); assert(!current_gc); @@ -83,11 +83,11 @@ void factor_vm::gc(gc_op op, record_gc_stats(&gc_stats.aging_stats); break; case collect_full_op: - collect_full(trace_contexts_p,compact_code_heap_p); + collect_full(trace_contexts_p,compact_p); record_gc_stats(&gc_stats.full_stats); break; case collect_growing_heap_op: - collect_growing_heap(requested_bytes,trace_contexts_p,compact_code_heap_p); + collect_growing_heap(requested_bytes,trace_contexts_p,compact_p); record_gc_stats(&gc_stats.full_stats); break; default: diff --git a/vm/master.hpp b/vm/master.hpp index dc01429c30..1947c0ad50 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -79,6 +79,7 @@ namespace factor #include "aging_collector.hpp" #include "to_tenured_collector.hpp" #include "code_block_visitor.hpp" +#include "compaction.hpp" #include "full_collector.hpp" #include "callstack.hpp" #include "generic_arrays.hpp" diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp index a62fdd87ec..6e0f6839e2 100644 --- a/vm/slot_visitor.hpp +++ b/vm/slot_visitor.hpp @@ -15,7 +15,7 @@ template struct slot_visitor { if(immediate_p(pointer)) return; object *untagged = untag(pointer); - untagged = visitor.visit_handle(untagged); + untagged = visitor.visit_object(untagged); *handle = RETAG(untagged,TAG(pointer)); } @@ -56,7 +56,7 @@ template struct slot_visitor { cell *handle = (cell *)(*iter); if(*handle) - *handle = (cell)visitor.visit_handle(*(object **)handle); + *handle = (cell)visitor.visit_object(*(object **)handle); } } diff --git a/vm/vm.hpp b/vm/vm.hpp index 674f934bba..b596b7a50c 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -249,10 +249,11 @@ struct factor_vm void collect_aging(); void collect_to_tenured(); void collect_full_impl(bool trace_contexts_p); - void collect_growing_heap(cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p); - void collect_full(bool trace_contexts_p, bool compact_code_heap_p); + void compact_full_impl(bool trace_contexts_p); + void collect_growing_heap(cell requested_bytes, bool trace_contexts_p, bool compact_p); + void collect_full(bool trace_contexts_p, bool compact_p); void record_gc_stats(generation_statistics *stats); - void gc(gc_op op, cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p); + void gc(gc_op op, cell requested_bytes, bool trace_contexts_p, bool compact_p); void primitive_minor_gc(); void primitive_full_gc(); void primitive_compact_gc(); @@ -506,10 +507,6 @@ struct factor_vm void relocate_code_heap(); void primitive_modify_code_heap(); void primitive_code_room(); - void forward_object_xts(); - void forward_context_xts(); - void forward_callback_xts(); - void compact_code_heap(bool trace_contexts_p); void primitive_strip_stack_traces(); /* Apply a function to every code block */ From 03f4b4cdd683a259fb2fdb4cbc625602e8b1a6af Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 04:27:45 -0500 Subject: [PATCH 097/109] vm: move binary_payload_start() method from factor_vm to object class --- vm/collector.hpp | 4 ++-- vm/data_heap.cpp | 20 ++++++++++---------- vm/generic_arrays.hpp | 2 +- vm/layouts.hpp | 1 + vm/slot_visitor.hpp | 2 +- vm/tuples.hpp | 2 +- vm/vm.hpp | 3 +-- 7 files changed, 17 insertions(+), 17 deletions(-) diff --git a/vm/collector.hpp b/vm/collector.hpp index 86ae963774..e0ff53df9b 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -209,7 +209,7 @@ template struct collector { if(end < card_start_address(card_index)) { start = gen->starts.find_object_containing_card(card_index - gen_start_card); - binary_start = start + parent->binary_payload_start((object *)start); + binary_start = start + ((object *)start)->binary_payload_start(); end = start + ((object *)start)->size(); } @@ -229,7 +229,7 @@ scan_next_object: { start = gen->next_object_after(start); if(start) { - binary_start = start + parent->binary_payload_start((object *)start); + binary_start = ((object *)start)->binary_payload_start(); end = start + ((object *)start)->size(); goto scan_next_object; } diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 6178dc8861..b210adb8e1 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -159,17 +159,12 @@ cell object::size() const } } -void factor_vm::primitive_size() -{ - box_unsigned_cell(object_size(dpop())); -} - /* The number of cells from the start of the object which should be scanned by the GC. Some types have a binary payload at the end (string, word, DLL) which we ignore. */ -cell factor_vm::binary_payload_start(object *pointer) +cell object::binary_payload_start() const { - switch(pointer->h.hi_tag()) + switch(h.hi_tag()) { /* these objects do not refer to other objects at all */ case FLOAT_TYPE: @@ -190,17 +185,22 @@ cell factor_vm::binary_payload_start(object *pointer) return sizeof(string); /* everything else consists entirely of pointers */ case ARRAY_TYPE: - return array_size(array_capacity((array*)pointer)); + return array_size(array_capacity((array*)this)); case TUPLE_TYPE: - return tuple_size(untag(((tuple *)pointer)->layout)); + return tuple_size(untag(((tuple *)this)->layout)); case WRAPPER_TYPE: return sizeof(wrapper); default: - critical_error("Invalid header",(cell)pointer); + critical_error("Invalid header",(cell)this); return 0; /* can't happen */ } } +void factor_vm::primitive_size() +{ + box_unsigned_cell(object_size(dpop())); +} + /* Push memory usage statistics in data heap */ void factor_vm::primitive_data_room() { diff --git a/vm/generic_arrays.hpp b/vm/generic_arrays.hpp index e1d2c4dc0b..89eb56a70d 100755 --- a/vm/generic_arrays.hpp +++ b/vm/generic_arrays.hpp @@ -1,7 +1,7 @@ namespace factor { -template cell array_capacity(Array *array) +template cell array_capacity(const Array *array) { #ifdef FACTOR_DEBUG assert(array->h.hi_tag() == Array::type_number); diff --git a/vm/layouts.hpp b/vm/layouts.hpp index c90be1b2dd..b3cba58495 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -148,6 +148,7 @@ struct object { header h; cell size() const; + cell binary_payload_start() const; cell *slots() const { return (cell *)this; } diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp index 6e0f6839e2..67a51549b1 100644 --- a/vm/slot_visitor.hpp +++ b/vm/slot_visitor.hpp @@ -22,7 +22,7 @@ template struct slot_visitor { void visit_slots(object *ptr) { cell *slot = (cell *)ptr; - cell *end = (cell *)((cell)ptr + parent->binary_payload_start(ptr)); + cell *end = (cell *)((cell)ptr + ptr->binary_payload_start()); if(slot != end) { diff --git a/vm/tuples.hpp b/vm/tuples.hpp index 04b23b5857..bcd041fc65 100644 --- a/vm/tuples.hpp +++ b/vm/tuples.hpp @@ -1,7 +1,7 @@ namespace factor { -inline static cell tuple_size(tuple_layout *layout) +inline static cell tuple_size(const tuple_layout *layout) { cell size = untag_fixnum(layout->size); return sizeof(tuple) + size * sizeof(cell); diff --git a/vm/vm.hpp b/vm/vm.hpp index b596b7a50c..0b66025374 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -223,7 +223,6 @@ struct factor_vm void set_data_heap(data_heap *data_); void init_data_heap(cell young_size, cell aging_size, cell tenured_size); void primitive_size(); - cell binary_payload_start(object *pointer); void primitive_data_room(); void begin_scan(); void end_scan(); @@ -576,7 +575,7 @@ struct factor_vm template void do_slots(cell obj, Iterator &iter) { cell scan = obj; - cell payload_start = binary_payload_start((object *)obj); + cell payload_start = ((object *)obj)->binary_payload_start(); cell end = obj + payload_start; scan += sizeof(cell); From d855593f1ff4c9c4a4b7e8841be5405cb9bb2b23 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 04:36:29 -0500 Subject: [PATCH 098/109] vm: clean up code heap visitor --- vm/code_block_visitor.hpp | 94 +++++++++++++++++++++------------------ vm/compaction.cpp | 12 ++--- vm/full_collector.cpp | 31 ++++++------- vm/full_collector.hpp | 1 - vm/vm.hpp | 5 --- 5 files changed, 70 insertions(+), 73 deletions(-) diff --git a/vm/code_block_visitor.hpp b/vm/code_block_visitor.hpp index 9683c39db5..09bbecc757 100644 --- a/vm/code_block_visitor.hpp +++ b/vm/code_block_visitor.hpp @@ -19,44 +19,6 @@ template struct call_frame_code_block_visitor { } }; -template void factor_vm::visit_object_code_block(object *obj, Visitor visitor) -{ - switch(obj->h.hi_tag()) - { - case WORD_TYPE: - { - word *w = (word *)obj; - if(w->code) - w->code = visitor(w->code); - if(w->profiling) - w->code = visitor(w->profiling); - - update_word_xt(w); - break; - } - case QUOTATION_TYPE: - { - quotation *q = (quotation *)obj; - if(q->code) - set_quot_xt(q,visitor(q->code)); - break; - } - case CALLSTACK_TYPE: - { - callstack *stack = (callstack *)obj; - call_frame_code_block_visitor call_frame_visitor(this,visitor); - iterate_callstack_object(stack,call_frame_visitor); - break; - } - } -} - -template void factor_vm::visit_context_code_blocks(Visitor visitor) -{ - call_frame_code_block_visitor call_frame_visitor(this,visitor); - iterate_active_frames(call_frame_visitor); -} - template struct callback_code_block_visitor { callback_heap *callbacks; Visitor visitor; @@ -71,10 +33,56 @@ template struct callback_code_block_visitor { } }; -template void factor_vm::visit_callback_code_blocks(Visitor visitor) -{ - callback_code_block_visitor callback_visitor(callbacks,visitor); - callbacks->iterate(callback_visitor); -} +template struct code_block_visitor { + factor_vm *parent; + Visitor visitor; + + explicit code_block_visitor(factor_vm *parent_, Visitor visitor_) : + parent(parent_), visitor(visitor_) {} + void visit_object_code_block(object *obj) + { + switch(obj->h.hi_tag()) + { + case WORD_TYPE: + { + word *w = (word *)obj; + if(w->code) + w->code = visitor(w->code); + if(w->profiling) + w->code = visitor(w->profiling); + + parent->update_word_xt(w); + break; + } + case QUOTATION_TYPE: + { + quotation *q = (quotation *)obj; + if(q->code) + parent->set_quot_xt(q,visitor(q->code)); + break; + } + case CALLSTACK_TYPE: + { + callstack *stack = (callstack *)obj; + call_frame_code_block_visitor call_frame_visitor(parent,visitor); + parent->iterate_callstack_object(stack,call_frame_visitor); + break; + } + } + } + + void visit_context_code_blocks() + { + call_frame_code_block_visitor call_frame_visitor(parent,visitor); + parent->iterate_active_frames(call_frame_visitor); + } + + void visit_callback_code_blocks() + { + callback_code_block_visitor callback_visitor(parent->callbacks,visitor); + parent->callbacks->iterate(callback_visitor); + } + +}; } diff --git a/vm/compaction.cpp b/vm/compaction.cpp index b0ced6fcb0..3cf5e5b46c 100644 --- a/vm/compaction.cpp +++ b/vm/compaction.cpp @@ -29,11 +29,11 @@ struct code_block_forwarder { struct object_compaction_updater { factor_vm *parent; slot_visitor slot_forwarder; - code_block_forwarder code_forwarder; + code_block_visitor code_forwarder; explicit object_compaction_updater(factor_vm *parent_, slot_visitor slot_forwader_, - code_block_forwarder code_forwarder_) : + code_block_visitor code_forwarder_) : parent(parent_), slot_forwarder(slot_forwader_), code_forwarder(code_forwarder_) {} @@ -41,7 +41,7 @@ struct object_compaction_updater { void operator()(object *obj, cell size) { slot_forwarder.visit_slots(obj); - parent->visit_object_code_block(obj,code_forwarder); + code_forwarder.visit_object_code_block(obj); } }; @@ -71,14 +71,14 @@ void factor_vm::compact_full_impl(bool trace_contexts_p) /* Update root pointers */ slot_visitor slot_forwarder(this,object_slot_forwarder(data_forwarding_map)); - code_block_forwarder code_forwarder(code_forwarding_map); + code_block_visitor code_forwarder(this,code_block_forwarder(code_forwarding_map)); slot_forwarder.visit_roots(); if(trace_contexts_p) { slot_forwarder.visit_contexts(); - visit_context_code_blocks(code_forwarder); - visit_callback_code_blocks(code_forwarder); + code_forwarder.visit_context_code_blocks(); + code_forwarder.visit_callback_code_blocks(); } /* Slide everything in tenured space up, and update data and code heap diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 531b76bf31..2afb4181f7 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -29,20 +29,6 @@ struct code_block_marker { } }; -void full_collector::mark_reachable_objects() -{ - code_block_marker marker(code,this); - std::vector *mark_stack = &this->target->mark_stack; - - while(!mark_stack->empty()) - { - object *obj = mark_stack->back(); - mark_stack->pop_back(); - this->trace_slots(obj); - parent->visit_object_code_block(obj,marker); - } -} - struct object_start_map_updater { object_start_map *starts; @@ -62,16 +48,25 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) data->tenured->clear_mark_bits(); data->tenured->clear_mark_stack(); + code_block_visitor code_marker(this,code_block_marker(code,&collector)); + collector.trace_roots(); if(trace_contexts_p) { collector.trace_contexts(); - code_block_marker marker(code,&collector); - visit_context_code_blocks(marker); - visit_callback_code_blocks(marker); + code_marker.visit_context_code_blocks(); + code_marker.visit_callback_code_blocks(); } - collector.mark_reachable_objects(); + std::vector *mark_stack = &data->tenured->mark_stack; + + while(!mark_stack->empty()) + { + object *obj = mark_stack->back(); + mark_stack->pop_back(); + collector.trace_slots(obj); + code_marker.visit_object_code_block(obj); + } data->tenured->starts.clear_object_start_offsets(); object_start_map_updater updater(&data->tenured->starts); diff --git a/vm/full_collector.hpp b/vm/full_collector.hpp index f613558997..c9750302d1 100644 --- a/vm/full_collector.hpp +++ b/vm/full_collector.hpp @@ -28,7 +28,6 @@ struct full_collector : collector { bool trace_contexts_p; full_collector(factor_vm *parent_); - void mark_reachable_objects(); }; } diff --git a/vm/vm.hpp b/vm/vm.hpp index 0b66025374..762a34d225 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -485,11 +485,6 @@ struct factor_vm code_block *allot_code_block(cell size, code_block_type type); code_block *add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_); - //code_block_visitor - template void visit_object_code_block(object *obj, Visitor visitor); - template void visit_context_code_blocks(Visitor visitor); - template void visit_callback_code_blocks(Visitor visitor); - //code heap inline void check_code_pointer(cell ptr) { From 45a955b5bb4d691fd1d4e421876db661d14fbc50 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 04:43:11 -0500 Subject: [PATCH 099/109] vm: fix typo in card tracing logic --- vm/collector.hpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/collector.hpp b/vm/collector.hpp index e0ff53df9b..54683556b1 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -229,7 +229,7 @@ scan_next_object: { start = gen->next_object_after(start); if(start) { - binary_start = ((object *)start)->binary_payload_start(); + binary_start = start + ((object *)start)->binary_payload_start(); end = start + ((object *)start)->size(); goto scan_next_object; } From 62e718eaa922b5d72aeef3a190feb1e8e57f664d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 21:24:06 -0500 Subject: [PATCH 100/109] vm: combine heap_block and code_block structs, eliminates some boilerplate --- vm/code_block.cpp | 7 +++--- vm/code_heap.cpp | 11 ++++----- vm/code_heap.hpp | 4 ++-- vm/compaction.cpp | 11 ++++----- vm/debug.cpp | 10 ++++---- vm/free_list_allocator.hpp | 29 ++++++++++++++++++---- vm/layouts.hpp | 49 ++++++++++---------------------------- vm/vm.hpp | 12 +--------- 8 files changed, 59 insertions(+), 74 deletions(-) diff --git a/vm/code_block.cpp b/vm/code_block.cpp index 687bbcf500..831c2388bb 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -439,7 +439,7 @@ void factor_vm::fixup_labels(array *labels, code_block *compiled) /* Might GC */ code_block *factor_vm::allot_code_block(cell size, code_block_type type) { - heap_block *block = code->allocator->allot(size + sizeof(code_block)); + code_block *block = code->allocator->allot(size + sizeof(code_block)); /* If allocation failed, do a full GC and compact the code heap. A full GC that occurs as a result of the data heap filling up does not @@ -465,9 +465,8 @@ code_block *factor_vm::allot_code_block(cell size, code_block_type type) } } - code_block *compiled = (code_block *)block; - compiled->set_type(type); - return compiled; + block->set_type(type); + return block; } /* Might GC */ diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index ef257bb935..bd40b1f0da 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -8,7 +8,7 @@ code_heap::code_heap(cell size) if(size > (1L << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size); seg = new segment(align_page(size),true); if(!seg) fatal_error("Out of memory in heap allocator",size); - allocator = new free_list_allocator(size,seg->start); + allocator = new free_list_allocator(size,seg->start); } code_heap::~code_heap() @@ -36,7 +36,7 @@ bool code_heap::needs_fixup_p(code_block *compiled) return needs_fixup.count(compiled) > 0; } -bool code_heap::marked_p(heap_block *compiled) +bool code_heap::marked_p(code_block *compiled) { return allocator->state.marked_p(compiled); } @@ -109,9 +109,9 @@ struct word_and_literal_code_heap_updater { word_and_literal_code_heap_updater(factor_vm *parent_) : parent(parent_) {} - void operator()(heap_block *block, cell size) + void operator()(code_block *block, cell size) { - parent->update_code_block_words_and_literals((code_block *)block); + parent->update_code_block_words_and_literals(block); } }; @@ -137,8 +137,7 @@ struct code_heap_relocator { void factor_vm::relocate_code_heap() { code_heap_relocator relocator(this); - code_heap_iterator iter(relocator); - code->allocator->sweep(iter); + code->allocator->sweep(relocator); } void factor_vm::primitive_modify_code_heap() diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp index 5548892d3f..38e53d9fbe 100755 --- a/vm/code_heap.hpp +++ b/vm/code_heap.hpp @@ -6,7 +6,7 @@ struct code_heap { segment *seg; /* Memory allocator */ - free_list_allocator *allocator; + free_list_allocator *allocator; /* Set of blocks which need full relocation. */ std::set needs_fixup; @@ -22,7 +22,7 @@ struct code_heap { void write_barrier(code_block *compiled); void clear_remembered_set(); bool needs_fixup_p(code_block *compiled); - bool marked_p(heap_block *compiled); + bool marked_p(code_block *compiled); void set_marked_p(code_block *compiled); void clear_mark_bits(); void code_heap_free(code_block *compiled); diff --git a/vm/compaction.cpp b/vm/compaction.cpp index 3cf5e5b46c..d29e8aa20d 100644 --- a/vm/compaction.cpp +++ b/vm/compaction.cpp @@ -15,14 +15,14 @@ struct object_slot_forwarder { }; struct code_block_forwarder { - mark_bits *forwarding_map; + mark_bits *forwarding_map; - explicit code_block_forwarder(mark_bits *forwarding_map_) : + explicit code_block_forwarder(mark_bits *forwarding_map_) : forwarding_map(forwarding_map_) {} code_block *operator()(code_block *compiled) { - return (code_block *)forwarding_map->forward_block(compiled); + return forwarding_map->forward_block(compiled); } }; @@ -63,7 +63,7 @@ void factor_vm::compact_full_impl(bool trace_contexts_p) { tenured_space *tenured = data->tenured; mark_bits *data_forwarding_map = &tenured->state; - mark_bits *code_forwarding_map = &code->allocator->state; + mark_bits *code_forwarding_map = &code->allocator->state; /* Figure out where blocks are going to go */ data_forwarding_map->compute_forwarding(); @@ -89,8 +89,7 @@ void factor_vm::compact_full_impl(bool trace_contexts_p) /* Slide everything in the code heap up, and update data and code heap pointers inside code blocks. */ code_block_compaction_updater code_block_updater(this,slot_forwarder); - code_heap_iterator iter(code_block_updater); - code->allocator->compact(iter); + code->allocator->compact(code_block_updater); } } diff --git a/vm/debug.cpp b/vm/debug.cpp index 91fb1ea1d3..1ee2b858fb 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -293,21 +293,21 @@ struct code_block_printer { code_block_printer(factor_vm *parent_) : parent(parent_), reloc_size(0), literal_size(0) {} - void operator()(heap_block *scan, cell size) + void operator()(code_block *scan, cell size) { const char *status; if(scan->free_p()) status = "free"; else if(parent->code->marked_p(scan)) { - reloc_size += parent->object_size(((code_block *)scan)->relocation); - literal_size += parent->object_size(((code_block *)scan)->literals); + reloc_size += parent->object_size(scan->relocation); + literal_size += parent->object_size(scan->literals); status = "marked"; } else { - reloc_size += parent->object_size(((code_block *)scan)->relocation); - literal_size += parent->object_size(((code_block *)scan)->literals); + reloc_size += parent->object_size(scan->relocation); + literal_size += parent->object_size(scan->literals); status = "allocated"; } diff --git a/vm/free_list_allocator.hpp b/vm/free_list_allocator.hpp index 8332399279..01e7ea6116 100644 --- a/vm/free_list_allocator.hpp +++ b/vm/free_list_allocator.hpp @@ -3,6 +3,27 @@ namespace factor static const cell free_list_count = 32; +struct free_heap_block +{ + cell header; + free_heap_block *next_free; + + bool free_p() const + { + return header & 1 == 1; + } + + cell size() const + { + return header >> 3; + } + + void make_free(cell size) + { + header = (size << 3) | 1; + } +}; + struct free_list { free_heap_block *small_blocks[free_list_count]; free_heap_block *large_blocks; @@ -248,7 +269,7 @@ void free_list_allocator::sweep() if(prev && prev->free_p()) { free_heap_block *free_prev = (free_heap_block *)prev; - free_prev->set_size(free_prev->size() + size); + free_prev->make_free(free_prev->size() + size); } else prev = scan; @@ -264,7 +285,7 @@ void free_list_allocator::sweep() if(prev && prev->free_p()) { free_heap_block *free_prev = (free_heap_block *)prev; - free_prev->set_size(free_prev->size() + size); + free_prev->make_free(free_prev->size() + size); } else { @@ -300,7 +321,7 @@ void free_list_allocator::sweep(Iterator &iter) if(prev && prev->free_p()) { free_heap_block *free_prev = (free_heap_block *)prev; - free_prev->set_size(free_prev->size() + size); + free_prev->make_free(free_prev->size() + size); } else prev = scan; @@ -317,7 +338,7 @@ void free_list_allocator::sweep(Iterator &iter) if(prev && prev->free_p()) { free_heap_block *free_prev = (free_heap_block *)prev; - free_prev->set_size(free_prev->size() + size); + free_prev->make_free(free_prev->size() + size); } else { diff --git a/vm/layouts.hpp b/vm/layouts.hpp index b3cba58495..f6c88064d4 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -221,49 +221,16 @@ struct string : public object { }; /* The compiled code heap is structured into blocks. */ -struct heap_block +struct code_block { cell header; - - bool free_p() const - { - return header & 1 == 1; - } - - cell size() const - { - cell bytes = header >> 3; -#ifdef FACTOR_DEBUG - assert(bytes > 0); -#endif - return bytes; - } - - void set_size(cell size) - { - header = ((header & 0x7) | (size << 3)); - } -}; - -struct free_heap_block : public heap_block -{ - free_heap_block *next_free; - - void make_free(cell size) - { - header = (size << 3) | 1; - } -}; - -struct code_block : public heap_block -{ cell owner; /* tagged pointer to word, quotation or f */ cell literals; /* tagged pointer to array or f */ cell relocation; /* tagged pointer to byte-array or f */ - void *xt() const + bool free_p() const { - return (void *)(this + 1); + return header & 1 == 1; } code_block_type type() const @@ -285,6 +252,16 @@ struct code_block : public heap_block { return type() == code_block_optimized; } + + cell size() const + { + return header >> 3; + } + + void *xt() const + { + return (void *)(this + 1); + } }; /* Assembly code makes assumptions about the layout of this struct */ diff --git a/vm/vm.hpp b/vm/vm.hpp index 762a34d225..29084d255d 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -504,18 +504,8 @@ struct factor_vm void primitive_strip_stack_traces(); /* Apply a function to every code block */ - template struct code_heap_iterator { - Iterator &iter; - explicit code_heap_iterator(Iterator &iter_) : iter(iter_) {} - void operator()(heap_block *block, cell size) - { - iter((code_block *)block,size); - } - }; - - template void iterate_code_heap(Iterator &iter_) + template void iterate_code_heap(Iterator &iter) { - code_heap_iterator iter(iter_); code->allocator->iterate(iter); } From fae27fb3619099b2c6518e96b87350c9c1bec39a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 23:02:58 -0500 Subject: [PATCH 101/109] vm: make some more ctors explicit just for kicks --- vm/aging_collector.hpp | 4 ++-- vm/aging_space.hpp | 2 +- vm/bump_allocator.hpp | 2 +- vm/code_heap.cpp | 5 +++-- vm/copying_collector.hpp | 2 +- vm/debug.cpp | 2 +- vm/full_collector.cpp | 2 +- vm/full_collector.hpp | 4 ++-- vm/image.cpp | 2 +- vm/local_roots.hpp | 2 +- vm/nursery_collector.hpp | 4 ++-- vm/nursery_space.hpp | 2 +- vm/object_start_map.hpp | 2 +- vm/slot_visitor.hpp | 2 +- vm/tenured_space.hpp | 2 +- vm/to_tenured_collector.hpp | 4 ++-- 16 files changed, 22 insertions(+), 21 deletions(-) diff --git a/vm/aging_collector.hpp b/vm/aging_collector.hpp index a04261d826..56550b211a 100644 --- a/vm/aging_collector.hpp +++ b/vm/aging_collector.hpp @@ -6,7 +6,7 @@ struct aging_policy { aging_space *aging; tenured_space *tenured; - aging_policy(factor_vm *parent_) : + explicit aging_policy(factor_vm *parent_) : parent(parent_), aging(parent->data->aging), tenured(parent->data->tenured) {} @@ -22,7 +22,7 @@ struct aging_policy { }; struct aging_collector : copying_collector { - aging_collector(factor_vm *parent_); + explicit aging_collector(factor_vm *parent_); }; } diff --git a/vm/aging_space.hpp b/vm/aging_space.hpp index 99efd44de5..7a28f54ebf 100644 --- a/vm/aging_space.hpp +++ b/vm/aging_space.hpp @@ -4,7 +4,7 @@ namespace factor struct aging_space : bump_allocator { object_start_map starts; - aging_space(cell size, cell start) : + explicit aging_space(cell size, cell start) : bump_allocator(size,start), starts(size,start) {} object *allot(cell size) diff --git a/vm/bump_allocator.hpp b/vm/bump_allocator.hpp index b41613b540..8f4fabe9a7 100644 --- a/vm/bump_allocator.hpp +++ b/vm/bump_allocator.hpp @@ -8,7 +8,7 @@ template struct bump_allocator { cell end; cell size; - bump_allocator(cell size_, cell start_) : + explicit bump_allocator(cell size_, cell start_) : here(start_), start(start_), end(start_ + size_), size(size_) {} inline bool contains_p(Block *block) diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index bd40b1f0da..2ce6d00b7c 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -88,6 +88,7 @@ struct word_updater { factor_vm *parent; explicit word_updater(factor_vm *parent_) : parent(parent_) {} + void operator()(code_block *compiled, cell size) { parent->update_word_references(compiled); @@ -107,7 +108,7 @@ to literals and other words. */ struct word_and_literal_code_heap_updater { factor_vm *parent; - word_and_literal_code_heap_updater(factor_vm *parent_) : parent(parent_) {} + explicit word_and_literal_code_heap_updater(factor_vm *parent_) : parent(parent_) {} void operator()(code_block *block, cell size) { @@ -126,7 +127,7 @@ references to card and deck arrays. */ struct code_heap_relocator { factor_vm *parent; - code_heap_relocator(factor_vm *parent_) : parent(parent_) {} + explicit code_heap_relocator(factor_vm *parent_) : parent(parent_) {} void operator()(code_block *block, cell size) { diff --git a/vm/copying_collector.hpp b/vm/copying_collector.hpp index 012aa4ec10..f79f97d34e 100644 --- a/vm/copying_collector.hpp +++ b/vm/copying_collector.hpp @@ -7,7 +7,7 @@ struct dummy_unmarker { struct simple_unmarker { card unmask; - simple_unmarker(card unmask_) : unmask(unmask_) {} + explicit simple_unmarker(card unmask_) : unmask(unmask_) {} void operator()(card *ptr) { *ptr &= ~unmask; } }; diff --git a/vm/debug.cpp b/vm/debug.cpp index 1ee2b858fb..0598d164e6 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -290,7 +290,7 @@ struct code_block_printer { factor_vm *parent; cell reloc_size, literal_size; - code_block_printer(factor_vm *parent_) : + explicit code_block_printer(factor_vm *parent_) : parent(parent_), reloc_size(0), literal_size(0) {} void operator()(code_block *scan, cell size) diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 2afb4181f7..18e368ab2b 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -32,7 +32,7 @@ struct code_block_marker { struct object_start_map_updater { object_start_map *starts; - object_start_map_updater(object_start_map *starts_) : starts(starts_) {} + explicit object_start_map_updater(object_start_map *starts_) : starts(starts_) {} void operator()(object *obj, cell size) { diff --git a/vm/full_collector.hpp b/vm/full_collector.hpp index c9750302d1..eb125b7429 100644 --- a/vm/full_collector.hpp +++ b/vm/full_collector.hpp @@ -5,7 +5,7 @@ struct full_policy { factor_vm *parent; tenured_space *tenured; - full_policy(factor_vm *parent_) : parent(parent_), tenured(parent->data->tenured) {} + explicit full_policy(factor_vm *parent_) : parent(parent_), tenured(parent->data->tenured) {} bool should_copy_p(object *untagged) { @@ -27,7 +27,7 @@ struct full_policy { struct full_collector : collector { bool trace_contexts_p; - full_collector(factor_vm *parent_); + explicit full_collector(factor_vm *parent_); }; } diff --git a/vm/image.cpp b/vm/image.cpp index 1b7debc2b2..bee351b830 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -215,7 +215,7 @@ struct code_block_fixupper { factor_vm *parent; cell data_relocation_base; - code_block_fixupper(factor_vm *parent_, cell data_relocation_base_) : + explicit code_block_fixupper(factor_vm *parent_, cell data_relocation_base_) : parent(parent_), data_relocation_base(data_relocation_base_) { } void operator()(code_block *compiled, cell size) diff --git a/vm/local_roots.hpp b/vm/local_roots.hpp index 58142be8f2..442a91f350 100644 --- a/vm/local_roots.hpp +++ b/vm/local_roots.hpp @@ -7,7 +7,7 @@ struct gc_root : public tagged factor_vm *parent; void push() { parent->gc_locals.push_back((cell)this); } - + explicit gc_root(cell value_,factor_vm *vm) : tagged(value_),parent(vm) { push(); } explicit gc_root(Type *value_, factor_vm *vm) : tagged(value_),parent(vm) { push(); } diff --git a/vm/nursery_collector.hpp b/vm/nursery_collector.hpp index 778efab138..de9b38d283 100644 --- a/vm/nursery_collector.hpp +++ b/vm/nursery_collector.hpp @@ -4,7 +4,7 @@ namespace factor struct nursery_policy { factor_vm *parent; - nursery_policy(factor_vm *parent_) : parent(parent_) {} + explicit nursery_policy(factor_vm *parent_) : parent(parent_) {} bool should_copy_p(object *obj) { @@ -17,7 +17,7 @@ struct nursery_policy { }; struct nursery_collector : copying_collector { - nursery_collector(factor_vm *parent_); + explicit nursery_collector(factor_vm *parent_); }; } diff --git a/vm/nursery_space.hpp b/vm/nursery_space.hpp index 4425c1612b..c44d2a8e44 100644 --- a/vm/nursery_space.hpp +++ b/vm/nursery_space.hpp @@ -3,7 +3,7 @@ namespace factor struct nursery_space : bump_allocator { - nursery_space(cell size, cell start) : bump_allocator(size,start) {} + explicit nursery_space(cell size, cell start) : bump_allocator(size,start) {} }; } diff --git a/vm/object_start_map.hpp b/vm/object_start_map.hpp index 640e205852..69f9c11a6a 100644 --- a/vm/object_start_map.hpp +++ b/vm/object_start_map.hpp @@ -8,7 +8,7 @@ struct object_start_map { card *object_start_offsets; card *object_start_offsets_end; - object_start_map(cell size_, cell start_); + explicit object_start_map(cell size_, cell start_); ~object_start_map(); cell first_object_in_card(cell card_index); diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp index 67a51549b1..b564949072 100644 --- a/vm/slot_visitor.hpp +++ b/vm/slot_visitor.hpp @@ -5,7 +5,7 @@ template struct slot_visitor { factor_vm *parent; Visitor visitor; - slot_visitor(factor_vm *parent_, Visitor visitor_) : + explicit slot_visitor(factor_vm *parent_, Visitor visitor_) : parent(parent_), visitor(visitor_) {} void visit_handle(cell *handle) diff --git a/vm/tenured_space.hpp b/vm/tenured_space.hpp index 7cc4131fa0..1b3baeaf52 100644 --- a/vm/tenured_space.hpp +++ b/vm/tenured_space.hpp @@ -5,7 +5,7 @@ struct tenured_space : free_list_allocator { object_start_map starts; std::vector mark_stack; - tenured_space(cell size, cell start) : + explicit tenured_space(cell size, cell start) : free_list_allocator(size,start), starts(size,start) {} object *allot(cell size) diff --git a/vm/to_tenured_collector.hpp b/vm/to_tenured_collector.hpp index e87ba5ee29..2f2717efd1 100644 --- a/vm/to_tenured_collector.hpp +++ b/vm/to_tenured_collector.hpp @@ -5,7 +5,7 @@ struct to_tenured_policy { factor_vm *myvm; tenured_space *tenured; - to_tenured_policy(factor_vm *myvm_) : myvm(myvm_), tenured(myvm->data->tenured) {} + explicit to_tenured_policy(factor_vm *myvm_) : myvm(myvm_), tenured(myvm->data->tenured) {} bool should_copy_p(object *untagged) { @@ -21,7 +21,7 @@ struct to_tenured_policy { }; struct to_tenured_collector : collector { - to_tenured_collector(factor_vm *myvm_); + explicit to_tenured_collector(factor_vm *myvm_); void tenure_reachable_objects(); }; From 0b65b194c9b1a5322518383a8e618fd137a29e65 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 23:49:33 -0500 Subject: [PATCH 102/109] vm: fix 'data-room' primitive to report correct sizes for tenured space --- vm/data_heap.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index b210adb8e1..57f6608e6b 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -219,7 +219,7 @@ void factor_vm::primitive_data_room() cell used, total_free, max_free; data->tenured->usage(&used,&total_free,&max_free); a.add(tag_fixnum(total_free >> 10)); - a.add(tag_fixnum(used >> 10)); + a.add(tag_fixnum(data->tenured->size >> 10)); a.trim(); dpush(a.elements.value()); From 0c1e2663029d30242a3f5f55ac28060b27bb94ce Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 24 Oct 2009 23:51:14 -0500 Subject: [PATCH 103/109] vm: got data heap compaction working --- vm/compaction.cpp | 67 ++++++++++++++++++++++++++++++++------ vm/free_list_allocator.hpp | 31 ++++++++++++++---- vm/object_start_map.cpp | 1 + vm/slot_visitor.hpp | 9 +++-- 4 files changed, 89 insertions(+), 19 deletions(-) diff --git a/vm/compaction.cpp b/vm/compaction.cpp index d29e8aa20d..05d6a186db 100644 --- a/vm/compaction.cpp +++ b/vm/compaction.cpp @@ -26,21 +26,66 @@ struct code_block_forwarder { } }; +static inline cell tuple_size_with_forwarding(mark_bits *forwarding_map, object *obj) +{ + /* The tuple layout may or may not have been forwarded already. Tricky. */ + object *layout_obj = (object *)UNTAG(((tuple *)obj)->layout); + tuple_layout *layout; + + if(layout_obj < obj) + { + /* It's already been moved up; dereference through forwarding + map to get the size */ + layout = (tuple_layout *)forwarding_map->forward_block(layout_obj); + } + else + { + /* It hasn't been moved up yet; dereference directly */ + layout = (tuple_layout *)layout_obj; + } + + return tuple_size(layout); +} + +struct compaction_sizer { + mark_bits *forwarding_map; + + explicit compaction_sizer(mark_bits *forwarding_map_) : + forwarding_map(forwarding_map_) {} + + cell operator()(object *obj) + { + if(obj->free_p() || obj->h.hi_tag() != TUPLE_TYPE) + return obj->size(); + else + return align(tuple_size_with_forwarding(forwarding_map,obj),data_alignment); + } +}; + struct object_compaction_updater { factor_vm *parent; slot_visitor slot_forwarder; code_block_visitor code_forwarder; + mark_bits *data_forwarding_map; explicit object_compaction_updater(factor_vm *parent_, - slot_visitor slot_forwader_, - code_block_visitor code_forwarder_) : + slot_visitor slot_forwarder_, + code_block_visitor code_forwarder_, + mark_bits *data_forwarding_map_) : parent(parent_), - slot_forwarder(slot_forwader_), - code_forwarder(code_forwarder_) {} + slot_forwarder(slot_forwarder_), + code_forwarder(code_forwarder_), + data_forwarding_map(data_forwarding_map_) {} void operator()(object *obj, cell size) { - slot_forwarder.visit_slots(obj); + cell payload_start; + if(obj->h.hi_tag() == TUPLE_TYPE) + payload_start = tuple_size_with_forwarding(data_forwarding_map,obj); + else + payload_start = obj->binary_payload_start(); + + slot_forwarder.visit_slots(obj,payload_start); code_forwarder.visit_object_code_block(obj); } }; @@ -49,8 +94,8 @@ struct code_block_compaction_updater { factor_vm *parent; slot_visitor slot_forwarder; - explicit code_block_compaction_updater(factor_vm *parent_, slot_visitor slot_forwader_) : - parent(parent_), slot_forwarder(slot_forwader_) {} + explicit code_block_compaction_updater(factor_vm *parent_, slot_visitor slot_forwarder_) : + parent(parent_), slot_forwarder(slot_forwarder_) {} void operator()(code_block *compiled, cell size) { @@ -83,13 +128,15 @@ void factor_vm::compact_full_impl(bool trace_contexts_p) /* Slide everything in tenured space up, and update data and code heap pointers inside objects. */ - object_compaction_updater object_updater(this,slot_forwarder,code_forwarder); - tenured->compact(object_updater); + object_compaction_updater object_updater(this,slot_forwarder,code_forwarder,data_forwarding_map); + compaction_sizer object_sizer(data_forwarding_map); + tenured->compact(object_updater,object_sizer); /* Slide everything in the code heap up, and update data and code heap pointers inside code blocks. */ code_block_compaction_updater code_block_updater(this,slot_forwarder); - code->allocator->compact(code_block_updater); + standard_sizer code_block_sizer; + code->allocator->compact(code_block_updater,code_block_sizer); } } diff --git a/vm/free_list_allocator.hpp b/vm/free_list_allocator.hpp index 01e7ea6116..0f2271beac 100644 --- a/vm/free_list_allocator.hpp +++ b/vm/free_list_allocator.hpp @@ -53,7 +53,8 @@ template struct free_list_allocator { cell occupied(); void sweep(); template void sweep(Iterator &iter); - template void compact(Iterator &iter); + template void compact(Iterator &iter, Sizer &sizer); + template void iterate(Iterator &iter, Sizer &sizer); template void iterate(Iterator &iter); }; @@ -358,31 +359,47 @@ void free_list_allocator::sweep(Iterator &iter) /* The forwarding map must be computed first by calling state.compute_forwarding(). */ template -template -void free_list_allocator::compact(Iterator &iter) +template +void free_list_allocator::compact(Iterator &iter, Sizer &sizer) { heap_compactor compactor(&state,first_block(),iter); - this->iterate(compactor); + this->iterate(compactor,sizer); /* Now update the free list; there will be a single free block at the end */ this->initial_free_list((cell)compactor.address - this->start); } +/* During compaction we have to be careful and measure object sizes differently */ template -template -void free_list_allocator::iterate(Iterator &iter) +template +void free_list_allocator::iterate(Iterator &iter, Sizer &sizer) { Block *scan = first_block(); Block *end = last_block(); while(scan != end) { - cell size = scan->size(); + cell size = sizer(scan); Block *next = (Block *)((cell)scan + size); if(!scan->free_p()) iter(scan,size); scan = next; } } +template struct standard_sizer { + cell operator()(Block *block) + { + return block->size(); + } +}; + +template +template +void free_list_allocator::iterate(Iterator &iter) +{ + standard_sizer sizer; + iterate(iter,sizer); +} + } diff --git a/vm/object_start_map.cpp b/vm/object_start_map.cpp index 5f992e783e..cb4f86c6c3 100644 --- a/vm/object_start_map.cpp +++ b/vm/object_start_map.cpp @@ -8,6 +8,7 @@ object_start_map::object_start_map(cell size_, cell start_) : { object_start_offsets = new card[addr_to_card(size_)]; object_start_offsets_end = object_start_offsets + addr_to_card(size_); + clear_object_start_offsets(); } object_start_map::~object_start_map() diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp index b564949072..48fb0c1af6 100644 --- a/vm/slot_visitor.hpp +++ b/vm/slot_visitor.hpp @@ -19,10 +19,10 @@ template struct slot_visitor { *handle = RETAG(untagged,TAG(pointer)); } - void visit_slots(object *ptr) + void visit_slots(object *ptr, cell payload_start) { cell *slot = (cell *)ptr; - cell *end = (cell *)((cell)ptr + ptr->binary_payload_start()); + cell *end = (cell *)((cell)ptr + payload_start); if(slot != end) { @@ -31,6 +31,11 @@ template struct slot_visitor { } } + void visit_slots(object *ptr) + { + visit_slots(ptr,ptr->binary_payload_start()); + } + void visit_stack_elements(segment *region, cell *top) { for(cell *ptr = (cell *)region->start; ptr <= top; ptr++) From b6a21b19a99c0f01631e139b436b24699fec7fb1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Oct 2009 00:06:45 -0500 Subject: [PATCH 104/109] vm: fix compaction when callback heap has entries in it --- vm/compaction.cpp | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/vm/compaction.cpp b/vm/compaction.cpp index 05d6a186db..a98876ffd4 100644 --- a/vm/compaction.cpp +++ b/vm/compaction.cpp @@ -118,14 +118,6 @@ void factor_vm::compact_full_impl(bool trace_contexts_p) slot_visitor slot_forwarder(this,object_slot_forwarder(data_forwarding_map)); code_block_visitor code_forwarder(this,code_block_forwarder(code_forwarding_map)); - slot_forwarder.visit_roots(); - if(trace_contexts_p) - { - slot_forwarder.visit_contexts(); - code_forwarder.visit_context_code_blocks(); - code_forwarder.visit_callback_code_blocks(); - } - /* Slide everything in tenured space up, and update data and code heap pointers inside objects. */ object_compaction_updater object_updater(this,slot_forwarder,code_forwarder,data_forwarding_map); @@ -137,6 +129,14 @@ void factor_vm::compact_full_impl(bool trace_contexts_p) code_block_compaction_updater code_block_updater(this,slot_forwarder); standard_sizer code_block_sizer; code->allocator->compact(code_block_updater,code_block_sizer); + + slot_forwarder.visit_roots(); + if(trace_contexts_p) + { + slot_forwarder.visit_contexts(); + code_forwarder.visit_context_code_blocks(); + code_forwarder.visit_callback_code_blocks(); + } } } From b7181d14a8340a2ad8f9db143bd7a63401c21d39 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Oct 2009 08:07:21 -0500 Subject: [PATCH 105/109] vm: debugging compaction --- vm/compaction.cpp | 31 ++++++++++++++++++++----------- vm/free_list_allocator.hpp | 18 ++++++++++++++++++ vm/full_collector.cpp | 27 ++++++++++++++++++--------- vm/mark_bits.hpp | 28 ++++++++-------------------- vm/vm.hpp | 5 +++-- 5 files changed, 67 insertions(+), 42 deletions(-) diff --git a/vm/compaction.cpp b/vm/compaction.cpp index a98876ffd4..74dd8935da 100644 --- a/vm/compaction.cpp +++ b/vm/compaction.cpp @@ -67,6 +67,7 @@ struct object_compaction_updater { slot_visitor slot_forwarder; code_block_visitor code_forwarder; mark_bits *data_forwarding_map; + object_start_map *starts; explicit object_compaction_updater(factor_vm *parent_, slot_visitor slot_forwarder_, @@ -75,18 +76,22 @@ struct object_compaction_updater { parent(parent_), slot_forwarder(slot_forwarder_), code_forwarder(code_forwarder_), - data_forwarding_map(data_forwarding_map_) {} + data_forwarding_map(data_forwarding_map_), + starts(&parent->data->tenured->starts) {} - void operator()(object *obj, cell size) + void operator()(object *old_address, object *new_address, cell size) { cell payload_start; - if(obj->h.hi_tag() == TUPLE_TYPE) - payload_start = tuple_size_with_forwarding(data_forwarding_map,obj); + if(old_address->h.hi_tag() == TUPLE_TYPE) + payload_start = tuple_size_with_forwarding(data_forwarding_map,old_address); else - payload_start = obj->binary_payload_start(); + payload_start = old_address->binary_payload_start(); - slot_forwarder.visit_slots(obj,payload_start); - code_forwarder.visit_object_code_block(obj); + memmove(new_address,old_address,size); + + slot_forwarder.visit_slots(new_address,payload_start); + code_forwarder.visit_object_code_block(new_address); + starts->record_object_start_offset(new_address); } }; @@ -97,14 +102,15 @@ struct code_block_compaction_updater { explicit code_block_compaction_updater(factor_vm *parent_, slot_visitor slot_forwarder_) : parent(parent_), slot_forwarder(slot_forwarder_) {} - void operator()(code_block *compiled, cell size) + void operator()(code_block *old_address, code_block *new_address, cell size) { - slot_forwarder.visit_literal_references(compiled); - parent->relocate_code_block(compiled); + memmove(new_address,old_address,size); + slot_forwarder.visit_literal_references(new_address); + parent->relocate_code_block(new_address); } }; -void factor_vm::compact_full_impl(bool trace_contexts_p) +void factor_vm::collect_full_compact(bool trace_contexts_p) { tenured_space *tenured = data->tenured; mark_bits *data_forwarding_map = &tenured->state; @@ -118,6 +124,9 @@ void factor_vm::compact_full_impl(bool trace_contexts_p) slot_visitor slot_forwarder(this,object_slot_forwarder(data_forwarding_map)); code_block_visitor code_forwarder(this,code_block_forwarder(code_forwarding_map)); + /* Object start offsets get recomputed by the object_compaction_updater */ + data->tenured->starts.clear_object_start_offsets(); + /* Slide everything in tenured space up, and update data and code heap pointers inside objects. */ object_compaction_updater object_updater(this,slot_forwarder,code_forwarder,data_forwarding_map); diff --git a/vm/free_list_allocator.hpp b/vm/free_list_allocator.hpp index 0f2271beac..822a40f797 100644 --- a/vm/free_list_allocator.hpp +++ b/vm/free_list_allocator.hpp @@ -356,6 +356,24 @@ void free_list_allocator::sweep(Iterator &iter) this->add_to_free_list((free_heap_block *)prev); } +template struct heap_compactor { + mark_bits *state; + char *address; + Iterator &iter; + + explicit heap_compactor(mark_bits *state_, Block *address_, Iterator &iter_) : + state(state_), address((char *)address_), iter(iter_) {} + + void operator()(Block *block, cell size) + { + if(this->state->marked_p(block)) + { + iter(block,(Block *)address,size); + address += size; + } + } +}; + /* The forwarding map must be computed first by calling state.compute_forwarding(). */ template diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 18e368ab2b..65d0edbd47 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -40,7 +40,7 @@ struct object_start_map_updater { } }; -void factor_vm::collect_full_impl(bool trace_contexts_p) +void factor_vm::collect_full_mark(bool trace_contexts_p) { full_collector collector(this); @@ -68,16 +68,19 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) code_marker.visit_object_code_block(obj); } - data->tenured->starts.clear_object_start_offsets(); - object_start_map_updater updater(&data->tenured->starts); - data->tenured->sweep(updater); - data->reset_generation(data->tenured); data->reset_generation(data->aging); data->reset_generation(&nursery); code->clear_remembered_set(); } +void factor_vm::collect_full_sweep() +{ + data->tenured->starts.clear_object_start_offsets(); + object_start_map_updater updater(&data->tenured->starts); + data->tenured->sweep(updater); +} + void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p, bool compact_p) @@ -85,23 +88,29 @@ void factor_vm::collect_growing_heap(cell requested_bytes, /* Grow the data heap and copy all live objects to the new heap. */ data_heap *old = data; set_data_heap(data->grow(requested_bytes)); - collect_full_impl(trace_contexts_p); + collect_full_mark(trace_contexts_p); delete old; if(compact_p) - compact_full_impl(trace_contexts_p); + collect_full_compact(trace_contexts_p); else + { + collect_full_sweep(); relocate_code_heap(); + } } void factor_vm::collect_full(bool trace_contexts_p, bool compact_p) { - collect_full_impl(trace_contexts_p); + collect_full_mark(trace_contexts_p); if(compact_p) - compact_full_impl(trace_contexts_p); + collect_full_compact(trace_contexts_p); else + { + collect_full_sweep(); update_code_heap_words_and_literals(); + } } } diff --git a/vm/mark_bits.hpp b/vm/mark_bits.hpp index cd739346f0..8b6b0c75eb 100644 --- a/vm/mark_bits.hpp +++ b/vm/mark_bits.hpp @@ -139,32 +139,20 @@ template struct mark_bits { /* We have the popcount for every 64 entries; look up and compute the rest */ Block *forward_block(Block *original) { +#ifdef FACTOR_DEBUG + assert(marked_p(original)); +#endif std::pair pair = bitmap_deref(original); cell approx_popcount = forwarding[pair.first]; u64 mask = ((u64)1 << pair.second) - 1; cell new_line_number = approx_popcount + popcount(marked[pair.first] & mask); - return line_block(new_line_number); - } -}; - -template struct heap_compactor { - mark_bits *state; - char *address; - Iterator &iter; - - explicit heap_compactor(mark_bits *state_, Block *address_, Iterator &iter_) : - state(state_), address((char *)address_), iter(iter_) {} - - void operator()(Block *block, cell size) - { - if(this->state->marked_p(block)) - { - memmove(address,block,size); - iter((Block *)address,size); - address += size; - } + Block *new_block = line_block(new_line_number); +#ifdef FACTOR_DEBUG + assert(new_block <= original); +#endif + return new_block; } }; diff --git a/vm/vm.hpp b/vm/vm.hpp index 29084d255d..f0f37619d2 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -247,8 +247,9 @@ struct factor_vm void collect_nursery(); void collect_aging(); void collect_to_tenured(); - void collect_full_impl(bool trace_contexts_p); - void compact_full_impl(bool trace_contexts_p); + void collect_full_mark(bool trace_contexts_p); + void collect_full_sweep(); + void collect_full_compact(bool trace_contexts_p); void collect_growing_heap(cell requested_bytes, bool trace_contexts_p, bool compact_p); void collect_full(bool trace_contexts_p, bool compact_p); void record_gc_stats(generation_statistics *stats); From 49baf397f42bf870cdaa5f07faffe17ff9bcde41 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Oct 2009 08:07:36 -0500 Subject: [PATCH 106/109] vm: tagged typechecks work better with DEBUG=1 --- vm/tagged.hpp | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/vm/tagged.hpp b/vm/tagged.hpp index c5325542cb..ea696c6358 100755 --- a/vm/tagged.hpp +++ b/vm/tagged.hpp @@ -16,13 +16,10 @@ struct tagged { cell value_; - cell value() const { return value_; } - Type *untagged() const { return (Type *)(UNTAG(value_)); } - cell type() const { cell tag = TAG(value_); if(tag == OBJECT_TYPE) - return untagged()->h.hi_tag(); + return ((object *)UNTAG(value_))->h.hi_tag(); else return tag; } @@ -40,23 +37,27 @@ struct tagged return type_p(Type::type_number); } + cell value() const { +#ifdef FACTOR_DEBUG + assert(type_p()); +#endif + return value_; + } + Type *untagged() const { +#ifdef FACTOR_DEBUG + assert(type_p()); +#endif + return (Type *)(UNTAG(value_)); + } + Type *untag_check(factor_vm *parent) const { if(!type_p()) parent->type_error(Type::type_number,value_); return untagged(); } - explicit tagged(cell tagged) : value_(tagged) { -#ifdef FACTOR_DEBUG - assert(type_p()); -#endif - } - - explicit tagged(Type *untagged) : value_(factor::tag(untagged)) { -#ifdef FACTOR_DEBUG - assert(type_p()); -#endif - } + explicit tagged(cell tagged) : value_(tagged) {} + explicit tagged(Type *untagged) : value_(factor::tag(untagged)) {} Type *operator->() const { return untagged(); } cell *operator&() const { return &value_; } From cf247c23a2f0e3597fa8f3bfd9826f2769de8d6a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Oct 2009 13:18:06 -0500 Subject: [PATCH 107/109] vm: room. now prints mark stack size, and total/contiguous free space --- .../known-words/known-words.factor | 4 +- basis/tools/memory/memory.factor | 78 +++++++------------ vm/code_heap.cpp | 14 +++- vm/data_heap.cpp | 18 +++-- 4 files changed, 53 insertions(+), 61 deletions(-) diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 8cddac5a75..d064776673 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -507,10 +507,10 @@ M: bad-executable summary \ (save-image-and-exit) { byte-array } { } define-primitive -\ data-room { } { integer integer array } define-primitive +\ data-room { } { array } define-primitive \ data-room make-flushable -\ code-room { } { integer integer integer integer } define-primitive +\ code-room { } { array } define-primitive \ code-room make-flushable \ micros { } { integer } define-primitive diff --git a/basis/tools/memory/memory.factor b/basis/tools/memory/memory.factor index 81785f7ea4..2f1827a8ff 100644 --- a/basis/tools/memory/memory.factor +++ b/basis/tools/memory/memory.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences arrays generic assocs io math namespaces parser prettyprint strings io.styles words @@ -8,48 +8,41 @@ IN: tools.memory string dup length 4 > [ 3 cut* "," glue ] when - " KB" append write-cell ; + " KB" append ; -: write-total/used/free ( free total str -- ) - [ - write-cell - dup write-size - over - write-size - write-size - ] with-row ; +: memory-table. ( sizes seq -- ) + swap [ kilobytes ] map zip simple-table. ; -: write-total ( n str -- ) - [ - write-cell - write-size - [ ] with-cell - [ ] with-cell - ] with-row ; +: young-room. ( seq -- ) + { "Total:" "Allocated:" "Free:" } memory-table. ; -: write-headings ( seq -- ) - [ [ write-cell ] each ] with-row ; +: nursery-room. ( seq -- ) "- Nursery space" print young-room. ; -: (data-room.) ( -- ) - data-room 2 [ - [ first2 ] [ number>string "Generation " prepend ] bi* - write-total/used/free - ] each-index - "Decks" write-total - "Cards" write-total ; +: aging-room. ( seq -- ) "- Aging space" print young-room. ; -: write-labeled-size ( n string -- ) - [ write-cell write-size ] with-row ; +: mark-sweep-table. ( sizes -- ) + { "Total:" "Allocated:" "Contiguous free:" "Total free:" } memory-table. ; -: (code-room.) ( -- ) - code-room { - [ "Size:" write-labeled-size ] - [ "Used:" write-labeled-size ] - [ "Total free space:" write-labeled-size ] - [ "Largest free block:" write-labeled-size ] - } spread ; +: tenured-room. ( seq -- ) "- Tenured space" print mark-sweep-table. ; + +: misc-room. ( seq -- ) + "- Miscellaneous buffers" print + { "Card array:" "Deck array:" "Mark stack:" } memory-table. ; + +: data-room. ( -- ) + "==== DATA HEAP" print nl + data-room + 3 cut [ nursery-room. nl ] dip + 3 cut [ aging-room. nl ] dip + 4 cut [ tenured-room. nl ] dip + misc-room. ; + +: code-room. ( -- ) + "==== CODE HEAP" print nl + code-room mark-sweep-table. ; : heap-stat-step ( obj counts sizes -- ) [ [ class ] dip inc-at ] @@ -57,18 +50,7 @@ IN: tools.memory PRIVATE> -: room. ( -- ) - "==== DATA HEAP" print - standard-table-style [ - { "" "Total" "Used" "Free" } write-headings - (data-room.) - ] tabular-output - nl nl - "==== CODE HEAP" print - standard-table-style [ - (code-room.) - ] tabular-output - nl ; +: room. ( -- ) data-room. nl code-room. ; : heap-stats ( -- counts sizes ) [ ] instances H{ } clone H{ } clone @@ -76,7 +58,7 @@ PRIVATE> : heap-stats. ( -- ) heap-stats dup keys natural-sort standard-table-style [ - { "Class" "Bytes" "Instances" } write-headings + [ { "Class" "Bytes" "Instances" } [ write-cell ] each ] with-row [ [ dup pprint-cell diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 2ce6d00b7c..ae53869ef2 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -197,12 +197,18 @@ void factor_vm::primitive_modify_code_heap() /* Push the free space and total size of the code heap */ void factor_vm::primitive_code_room() { + growable_array a(this); + cell used, total_free, max_free; code->allocator->usage(&used,&total_free,&max_free); - dpush(tag_fixnum(code->seg->size / 1024)); - dpush(tag_fixnum(used / 1024)); - dpush(tag_fixnum(total_free / 1024)); - dpush(tag_fixnum(max_free / 1024)); + + a.add(tag_fixnum(code->seg->size >> 10)); + a.add(tag_fixnum(used >> 10)); + a.add(tag_fixnum(total_free >> 10)); + a.add(tag_fixnum(max_free >> 10)); + + a.trim(); + dpush(a.elements.value()); } struct stack_trace_stripper { diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 57f6608e6b..3dd46fd848 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -204,22 +204,26 @@ void factor_vm::primitive_size() /* Push memory usage statistics in data heap */ void factor_vm::primitive_data_room() { - dpush(tag_fixnum((data->cards_end - data->cards) >> 10)); - dpush(tag_fixnum((data->decks_end - data->decks) >> 10)); - growable_array a(this); - a.add(tag_fixnum((nursery.end - nursery.here) >> 10)); a.add(tag_fixnum((nursery.size) >> 10)); + a.add(tag_fixnum((nursery.here - nursery.start) >> 10)); + a.add(tag_fixnum((nursery.end - nursery.here) >> 10)); - a.add(tag_fixnum((data->aging->end - data->aging->here) >> 10)); a.add(tag_fixnum((data->aging->size) >> 10)); + a.add(tag_fixnum((data->aging->here - data->aging->start) >> 10)); + a.add(tag_fixnum((data->aging->end - data->aging->here) >> 10)); - //XXX cell used, total_free, max_free; data->tenured->usage(&used,&total_free,&max_free); - a.add(tag_fixnum(total_free >> 10)); a.add(tag_fixnum(data->tenured->size >> 10)); + a.add(tag_fixnum(used >> 10)); + a.add(tag_fixnum(total_free >> 10)); + a.add(tag_fixnum(max_free >> 10)); + + a.add(tag_fixnum((data->cards_end - data->cards) >> 10)); + a.add(tag_fixnum((data->decks_end - data->decks) >> 10)); + a.add(tag_fixnum((data->tenured->mark_stack.capacity()) >> 10)); a.trim(); dpush(a.elements.value()); From 7d8c85443e31b1c55c3d765d9e40e49f07a84ae2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Oct 2009 13:27:40 -0500 Subject: [PATCH 108/109] vm: vm: fix large object allocation logic and change default heap image size for 2009 --- vm/factor.cpp | 2 +- vm/free_list_allocator.hpp | 22 ++++++++++++++++++++++ vm/gc.cpp | 30 ++++++++++++++---------------- vm/image.cpp | 5 +---- 4 files changed, 38 insertions(+), 21 deletions(-) diff --git a/vm/factor.cpp b/vm/factor.cpp index df27de84fd..24a3e01237 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -32,7 +32,7 @@ void factor_vm::default_parameters(vm_parameters *p) p->code_size = 8 * sizeof(cell); p->young_size = sizeof(cell) / 4; p->aging_size = sizeof(cell) / 2; - p->tenured_size = 4 * sizeof(cell); + p->tenured_size = 16 * sizeof(cell); #endif p->max_pic_size = 3; diff --git a/vm/free_list_allocator.hpp b/vm/free_list_allocator.hpp index 822a40f797..d796379799 100644 --- a/vm/free_list_allocator.hpp +++ b/vm/free_list_allocator.hpp @@ -47,6 +47,7 @@ template struct free_list_allocator { void assert_free_block(free_heap_block *block); free_heap_block *find_free_block(cell size); free_heap_block *split_free_block(free_heap_block *block, cell size); + bool can_allot_p(cell size); Block *allot(cell size); void free(Block *block); void usage(cell *used, cell *total_free, cell *max_free); @@ -180,6 +181,27 @@ template free_heap_block *free_list_allocator::split_free return block; } +template bool free_list_allocator::can_allot_p(cell size) +{ + cell attempt = size; + + while(attempt < free_list_count * block_granularity) + { + int index = attempt / block_granularity; + if(free_blocks.small_blocks[index]) return true; + attempt *= 2; + } + + free_heap_block *block = free_blocks.large_blocks; + while(block) + { + if(block->size() >= size) return true; + block = block->next_free; + } + + return false; +} + template Block *free_list_allocator::allot(cell size) { size = align(size,block_granularity); diff --git a/vm/gc.cpp b/vm/gc.cpp index 1851924cd5..4b530172c1 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -115,7 +115,7 @@ void factor_vm::primitive_full_gc() gc(collect_full_op, 0, /* requested size */ true, /* trace contexts? */ - false /* compact code heap? */); + true /* compact code heap? */); } void factor_vm::primitive_compact_gc() @@ -231,7 +231,7 @@ object *factor_vm::allot_object(header header, cell size) /* If the object is smaller than the nursery, allocate it in the nursery, after a GC if needed */ - if(nursery.size > size) + if(size < nursery.size) { /* If there is insufficient room, collect the nursery */ if(nursery.here + size > nursery.end) @@ -239,23 +239,21 @@ object *factor_vm::allot_object(header header, cell size) obj = nursery.allot(size); } - /* If the object is bigger than the nursery, allocate it in - tenured space */ else { - /* If tenured space does not have enough room, collect */ - //XXX - //if(data->tenured->here + size > data->tenured->end) - primitive_full_gc(); - - /* If it still won't fit, grow the heap */ - //XXX - //if(data->tenured->here + size > data->tenured->end) + /* If tenured space does not have enough room, collect and compact */ + if(!data->tenured->can_allot_p(size)) { - gc(collect_growing_heap_op, - size, /* requested size */ - true, /* trace contexts? */ - false /* compact code heap? */); + primitive_compact_gc(); + + /* If it still won't fit, grow the heap */ + if(!data->tenured->can_allot_p(size)) + { + gc(collect_growing_heap_op, + size, /* requested size */ + true, /* trace contexts? */ + false /* compact code heap? */); + } } obj = data->tenured->allot(size); diff --git a/vm/image.cpp b/vm/image.cpp index bee351b830..2e4433d3b5 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -16,10 +16,7 @@ void factor_vm::init_objects(image_header *h) void factor_vm::load_data_heap(FILE *file, image_header *h, vm_parameters *p) { - cell good_size = h->data_size + (1 << 20); - - if(good_size > p->tenured_size) - p->tenured_size = good_size; + p->tenured_size = std::max((h->data_size * 3) / 2,p->tenured_size); init_data_heap(p->young_size, p->aging_size, From c30df42e4846feae02c4220f73e4206199e902bd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Oct 2009 14:02:14 -0500 Subject: [PATCH 109/109] vm: make compaction its own gc_op --- vm/compaction.cpp | 2 +- vm/full_collector.cpp | 32 +++++--------------------------- vm/gc.cpp | 31 ++++++++++++++++--------------- vm/gc.hpp | 1 + vm/image.cpp | 5 ++--- vm/vm.hpp | 11 +++++------ 6 files changed, 30 insertions(+), 52 deletions(-) diff --git a/vm/compaction.cpp b/vm/compaction.cpp index 74dd8935da..399971805b 100644 --- a/vm/compaction.cpp +++ b/vm/compaction.cpp @@ -110,7 +110,7 @@ struct code_block_compaction_updater { } }; -void factor_vm::collect_full_compact(bool trace_contexts_p) +void factor_vm::collect_compact_impl(bool trace_contexts_p) { tenured_space *tenured = data->tenured; mark_bits *data_forwarding_map = &tenured->state; diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index 65d0edbd47..09e32574fd 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -40,7 +40,7 @@ struct object_start_map_updater { } }; -void factor_vm::collect_full_mark(bool trace_contexts_p) +void factor_vm::collect_mark_impl(bool trace_contexts_p) { full_collector collector(this); @@ -74,43 +74,21 @@ void factor_vm::collect_full_mark(bool trace_contexts_p) code->clear_remembered_set(); } -void factor_vm::collect_full_sweep() +void factor_vm::collect_sweep_impl() { data->tenured->starts.clear_object_start_offsets(); object_start_map_updater updater(&data->tenured->starts); data->tenured->sweep(updater); } -void factor_vm::collect_growing_heap(cell requested_bytes, - bool trace_contexts_p, - bool compact_p) +void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p) { /* Grow the data heap and copy all live objects to the new heap. */ data_heap *old = data; set_data_heap(data->grow(requested_bytes)); - collect_full_mark(trace_contexts_p); + collect_mark_impl(trace_contexts_p); + collect_compact_impl(trace_contexts_p); delete old; - - if(compact_p) - collect_full_compact(trace_contexts_p); - else - { - collect_full_sweep(); - relocate_code_heap(); - } -} - -void factor_vm::collect_full(bool trace_contexts_p, bool compact_p) -{ - collect_full_mark(trace_contexts_p); - - if(compact_p) - collect_full_compact(trace_contexts_p); - else - { - collect_full_sweep(); - update_code_heap_words_and_literals(); - } } } diff --git a/vm/gc.cpp b/vm/gc.cpp index 4b530172c1..2c361bcd19 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -25,10 +25,7 @@ void factor_vm::record_gc_stats(generation_statistics *stats) stats->max_gc_time = gc_elapsed; } -void factor_vm::gc(gc_op op, - cell requested_bytes, - bool trace_contexts_p, - bool compact_p) +void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p) { assert(!gc_off); assert(!current_gc); @@ -57,6 +54,7 @@ void factor_vm::gc(gc_op op, current_gc->op = collect_full_op; break; case collect_full_op: + case collect_compact_op: current_gc->op = collect_growing_heap_op; break; default: @@ -83,11 +81,18 @@ void factor_vm::gc(gc_op op, record_gc_stats(&gc_stats.aging_stats); break; case collect_full_op: - collect_full(trace_contexts_p,compact_p); + collect_mark_impl(trace_contexts_p); + collect_sweep_impl(); + update_code_heap_words_and_literals(); + record_gc_stats(&gc_stats.full_stats); + break; + case collect_compact_op: + collect_mark_impl(trace_contexts_p); + collect_compact_impl(trace_contexts_p); record_gc_stats(&gc_stats.full_stats); break; case collect_growing_heap_op: - collect_growing_heap(requested_bytes,trace_contexts_p,compact_p); + collect_growing_heap(requested_bytes,trace_contexts_p); record_gc_stats(&gc_stats.full_stats); break; default: @@ -106,24 +111,21 @@ void factor_vm::primitive_minor_gc() { gc(collect_nursery_op, 0, /* requested size */ - true, /* trace contexts? */ - false /* compact code heap? */); + true /* trace contexts? */); } void factor_vm::primitive_full_gc() { gc(collect_full_op, 0, /* requested size */ - true, /* trace contexts? */ - true /* compact code heap? */); + true /* trace contexts? */); } void factor_vm::primitive_compact_gc() { - gc(collect_full_op, + gc(collect_compact_op, 0, /* requested size */ - true, /* trace contexts? */ - true /* compact code heap? */); + true /* trace contexts? */); } void factor_vm::add_gc_stats(generation_statistics *stats, growable_array *result) @@ -251,8 +253,7 @@ object *factor_vm::allot_object(header header, cell size) { gc(collect_growing_heap_op, size, /* requested size */ - true, /* trace contexts? */ - false /* compact code heap? */); + true /* trace contexts? */); } } diff --git a/vm/gc.hpp b/vm/gc.hpp index 18b926ed8c..a4162ed620 100755 --- a/vm/gc.hpp +++ b/vm/gc.hpp @@ -6,6 +6,7 @@ enum gc_op { collect_aging_op, collect_to_tenured_op, collect_full_op, + collect_compact_op, collect_growing_heap_op }; diff --git a/vm/image.cpp b/vm/image.cpp index 2e4433d3b5..c35c0a32b8 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -327,10 +327,9 @@ void factor_vm::primitive_save_image_and_exit() for(cell i = 0; i < special_object_count; i++) if(!save_env_p(i)) special_objects[i] = false_object; - gc(collect_full_op, + gc(collect_compact_op, 0, /* requested size */ - false, /* discard objects only reachable from stacks */ - true /* compact the code heap */); + false /* discard objects only reachable from stacks */); /* Save the image */ if(save_image((vm_char *)(path.untagged() + 1))) diff --git a/vm/vm.hpp b/vm/vm.hpp index f0f37619d2..0124affefa 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -247,13 +247,12 @@ struct factor_vm void collect_nursery(); void collect_aging(); void collect_to_tenured(); - void collect_full_mark(bool trace_contexts_p); - void collect_full_sweep(); - void collect_full_compact(bool trace_contexts_p); - void collect_growing_heap(cell requested_bytes, bool trace_contexts_p, bool compact_p); - void collect_full(bool trace_contexts_p, bool compact_p); + void collect_mark_impl(bool trace_contexts_p); + void collect_sweep_impl(); + void collect_compact_impl(bool trace_contexts_p); + void collect_growing_heap(cell requested_bytes, bool trace_contexts_p); void record_gc_stats(generation_statistics *stats); - void gc(gc_op op, cell requested_bytes, bool trace_contexts_p, bool compact_p); + void gc(gc_op op, cell requested_bytes, bool trace_contexts_p); void primitive_minor_gc(); void primitive_full_gc(); void primitive_compact_gc();