#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 !!! %option stack=30
// 2 !!! 19-Feb-82 !!!! 15/5/78
// 3 {Modified run under new subsystem so that it can support its own supervisor}
// 4
// 5 !!!!!!!!!!!%CONTROL 1; ! ... TEST ONLY SWITCHES
// 6 %CONSTSTRING(5) VERSION = "4.12"
const _imp_string5 VERSION = _imp_str_init("4.12");
// 7
// 8 %CONSTINTEGER GBASE= 426
// 9 %CONSTINTEGER GMAX = 512; !???
// 10
// 11 {Changed from %CONST to %OWN to get 8.1 pass1 to accept source}
// 12 %ownSHORTINTEGERARRAY PHRASE(132:255) = 326, 137, 219, 0,
static short int PHRASE[124] = {
326, 137, 219, 0, 386, 164, 242, 246, 216, 210, 229, 98, 378, 183, 310, 292, 268, 259, 349, 221, 367,
364, 410, 413, 416, 419, 422, 391, 405, 199, 236, 158, 382, 357, 0, 278, 285, 307, 302, 318, 321, 346,
341, 370, 425, 426, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 7, 40, 49, 96, 0};
struct _imp_dv PHRASE_dv = {PHRASE, sizeof(short int) /*, dims, <bounds> */};
// 13+ 386, 164, 242, 246, 216, 210, 229, 98,
// 14+ 378, 183, 310, 292, 268, 259, 349, 221,
// 15+ 367, 364, 410, 413, 416, 419, 422, 391,
// 16+ 405, 199, 236, 158, 382, 357, 0, 278,
// 17+ 285, 307, 302, 318, 321, 346, 341, 370,
// 18+ 425, 426, 0, 0, 0, 0, 0, 0,
// 19+ 0, 0, 0, 0, 0, 0, 0, 0,
// 20+ 0, 0, 0, 0, 0, 0, 0, 0,
// 21+ 0, 0, 0, 0, 0, 0, 0, 0,
// 22+ 0, 0, 0, 0, 0, 0, 0, 0,
// 23+ 0, 0, 0, 0, 0, 0, 0, 0,
// 24+ 0, 0, 0, 0, 0, 0, 0, 0,
// 25+ 0, 0, 0, 0, 0, 0, 0, 0,
// 26+ 0, 0, 0, 0, 0, 0, 0, 0,
// 27+ 0, 0, 1, 7, 40, 49, 96, 0
// 28
// 29 %CONSTBYTEINTEGERARRAY ATOMIC(105:130) =
const unsigned char ATOMIC[26] = {14, 9, 4, 20, 6, 110, 111, 30, 3, 80, 59, 59, 13,
4, 13, 59, 43, 73, 79, 72, 71, 4, 2, 2, 4, 2};
struct _imp_dv ATOMIC_dv = {ATOMIC, sizeof(unsigned char) /*, dims, <bounds> */};
// 30+ 14, 9, 4, 20, 6, 110, 111, 30,
// 31+ 3, 80, 59, 59, 13, 4, 13, 59,
// 32+ 43, 73, 79, 72, 71, 4, 2, 2,
// 33+ 4, 2
// 34
// 35 %OWNSHORTINTEGERARRAY GRAM(0:GMAX) =
static short int GRAM[513] = {
0, -32765, 4, 5, 511, 8198, 4, -32748, -32747, -32741, -32740, -32739, -32738, -32737,
15, -32736, -32750, 511, -32257, 15, 27, 22, -32744, 511, 8217, -32747, 511, 511,
511, 27, 33, 37, 36, 8226, -32750, 511, 16, 8230, -32737, 511, -32726, 511,
43, 44, -32725, -32721, 27, -32725, 44, -32708, -32706, -32698, -32689, -32688, -32687, -32741,
-32675, -32686, -32741, 66, -32706, 511, -32698, -32695, -32257, 27, -24482, -24482, -32673, 511,
71, -32694, -32695, 511, -32695, -32257, 77, -32681, 511, 89, -32257, 4187, -32685, 84,
-32685, -32695, 511, -32695, 27, -32703, 73, -32695, 511, 8219, 8219, 12315, 97, 27,
-32657, -32647, -32655, -32654, -32647, -32660, -32653, -32651, -32646, 122, -32645, -32649, 120, -32644,
121, -32643, 126, -32645, 119, -32641, 128, -24576, 8192, 129, 130, 0, 8192, 8192,
8192, 8192, 131, 132, 133, 134, 114, 115, 135, -32649, 123, -32768, -32622, -32621,
-32620, -32624, -32619, 150, -32623, 8344, 8192, 126, 125, 154, -32613, 0, -32612, 0,
157, 0, 20480, 150, -32607, -32606, 163, 4096, 4608, 2048, -32594, -32768, -32768, -32594,
-32594, -32593, -32593, -32591, -32591, 177, 178, -32589, 0, 180, 181, 0, 182, 0,
175, -32594, -32768, -32768, -32594, -32594, -32594, -32574, -32574, -32573, -32573, 195, 196, 197,
0, 198, 194, -32564, -32564, -32562, -32562, 206, -32561, 0, 208, 0, 209, 204,
-32555, -32768, 0, 214, 12503, 0, 8409, -32552, 0, -24576, 8192, -32542, 223, -32541,
-32540, 174, 0, 215, 0, -32532, -32536, 241, -32529, -24576, -32533, 8192, -32533, -32533,
8192, -24576, 8192, 0, 243, -32526, -32768, 243, -32520, 249, 250, 254, -32516, 0,
-32518, 250, 8447, 256, -32510, 0, 0, -32507, 262, 4608, 2311, 264, 18697, -32501,
0, 10240, -32498, 271, 272, 273, 274, 125, 16659, -32491, 0, 8192, -32768, -32486,
-32485, 0, 215, 8476, 0, -32768, -32768, -32478, -32477, 0, 215, 284, -32468, -32474,
8487, -32474, -32467, -32468, -32468, 0, 8489, 8488, 8495, -32466, -32462, 0, 8496, 8500,
-32461, 0, -32452, 8504, -32457, -32451, -32452, 0, 8506, 8505, 8511, -32450, 0, 8514,
-32447, -32443, 0, 8515, -32434, -32440, 8521, -32440, -32430, -32429, -32429, 0, 8527, -32428,
-32428, 0, 8522, 8523, 8527, 8534, -32427, -32423, 0, 8535, 8539, -32422, 0, 350,
-24223, -24222, 0, 355, 351, -24223, 0, 8550, 359, 8552, 361, 8554, 363, 8192,
365, 4462, 0, 368, -32401, 0, 371, 4468, 373, 12662, -32392, 377, 371, 0,
379, 8572, -32390, 0, 383, 8576, 385, 8407, -32380, 0, -32378, 8448, 388, -32768,
-32768, -32370, -32370, -32369, -32369, 399, 401, -32366, 0, 0, 403, 404, 398, 406,
4503, -32359, 377, 406, 411, 4508, 365, 414, 4511, 411, 417, 4514, 414, 420,
4517, 417, 423, 4520, 420, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0};
struct _imp_dv GRAM_dv = {GRAM, sizeof(short int) /*, dims, <bounds> */};
// 36+ 0, -32765, 4, 5, 511, 8198, 4, -32748,
// 37+ -32747, -32741, -32740, -32739, -32738, -32737, 15, -32736,
// 38+ -32750, 511, -32257, 15, 27, 22, -32744, 511,
// 39+ 8217, -32747, 511, 511, 511, 27, 33, 37,
// 40+ 36, 8226, -32750, 511, 16, 8230, -32737, 511,
// 41+ -32726, 511, 43, 44, -32725, -32721, 27, -32725,
// 42+ 44, -32708, -32706, -32698, -32689, -32688, -32687, -32741,
// 43+ -32675, -32686, -32741, 66, -32706, 511, -32698, -32695,
// 44+ -32257, 27, -24482, -24482, -32673, 511, 71, -32694,
// 45+ -32695, 511, -32695, -32257, 77, -32681, 511, 89,
// 46+ -32257, 4187, -32685, 84, -32685, -32695, 511, -32695,
// 47+ 27, -32703, 73, -32695, 511, 8219, 8219, 12315,
// 48+ 97, 27, -32657, -32647, -32655, -32654, -32647, -32660,
// 49+ -32653, -32651, -32646, 122, -32645, -32649, 120, -32644,
// 50+ 121, -32643, 126, -32645, 119, -32641, 128, -24576,
// 51+ 8192, 129, 130, 0, 8192, 8192, 8192, 8192,
// 52+ 131, 132, 133, 134, 114, 115, 135, -32649,
// 53+ 123, -32768, -32622, -32621, -32620, -32624, -32619, 150,
// 54+ -32623, 8344, 8192, 126, 125, 154, -32613, 0,
// 55+ -32612, 0, 157, 0, 20480, 150, -32607, -32606,
// 56+ 163, 4096, 4608, 2048, -32594, -32768, -32768, -32594,
// 57+ -32594, -32593, -32593, -32591, -32591, 177, 178, -32589,
// 58+ 0, 180, 181, 0, 182, 0, 175, -32594,
// 59+ -32768, -32768, -32594, -32594, -32594, -32574, -32574, -32573,
// 60+ -32573, 195, 196, 197, 0, 198, 194, -32564,
// 61+ -32564, -32562, -32562, 206, -32561, 0, 208, 0,
// 62+ 209, 204, -32555, -32768, 0, 214, 12503, 0,
// 63+ 8409, -32552, 0, -24576, 8192, -32542, 223, -32541,
// 64+ -32540, 174, 0, 215, 0, -32532, -32536, 241,
// 65+ -32529, -24576, -32533, 8192, -32533, -32533, 8192, -24576,
// 66+ 8192, 0, 243, -32526, -32768, 243, -32520, 249,
// 67+ 250, 254, -32516, 0, -32518, 250, 8447, 256,
// 68+ -32510, 0, 0, -32507, 262, 4608, 2311, 264,
// 69+ 18697, -32501, 0, 10240, -32498, 271, 272, 273,
// 70+ 274, 125, 16659, -32491, 0, 8192, -32768, -32486,
// 71+ -32485, 0, 215, 8476, 0, -32768, -32768, -32478,
// 72+ -32477, 0, 215, 284, -32468, -32474, 8487, -32474,
// 73+ -32467, -32468, -32468, 0, 8489, 8488, 8495, -32466,
// 74+ -32462, 0, 8496, 8500, -32461, 0, -32452, 8504,
// 75+ -32457, -32451, -32452, 0, 8506, 8505, 8511, -32450,
// 76+ 0, 8514, -32447, -32443, 0, 8515, -32434, -32440,
// 77+ 8521, -32440, -32430, -32429, -32429, 0, 8527, -32428,
// 78+ -32428, 0, 8522, 8523, 8527, 8534, -32427, -32423,
// 79+ 0, 8535, 8539, -32422, 0, 350, -24223, -24222,
// 80+ 0, 355, 351, -24223, 0, 8550, 359, 8552,
// 81+ 361, 8554, 363, 8192, 365, 4462, 0, 368,
// 82+ -32401, 0, 371, 4468, 373, 12662, -32392, 377,
// 83+ 371, 0, 379, 8572, -32390, 0, 383, 8576,
// 84+ 385, 8407, -32380, 0, -32378, 8448, 388, -32768,
// 85+ -32768, -32370, -32370, -32369, -32369, 399, 401, -32366,
// 86+ 0, 0, 403, 404, 398, 406, 4503, -32359,
// 87+ 377, 406, 411, 4508, 365, 414, 4511, 411,
// 88+ 417, 4514, 414, 420, 4517, 417, 423, 4520,
// 89+ 420, 0, 0, 0, 0, 0, 0, 0,
// 90+ 0, 0, 0, 0, 0, 0, 0, 0,
// 91+ 0, 0, 0, 0, 0, 0, 0, 0,
// 92+ 0, 0, 0, 0, 0, 0, 0, 0,
// 93+ 0, 0, 0, 0, 0, 0, 0, 0,
// 94+ 0, 0, 0, 0, 0, 0, 0, 0,
// 95+ 0, 0, 0, 0, 0, 0, 0, 0,
// 96+ 0, 0, 0, 0, 0, 0, 0, 0,
// 97+ 0, 0, 0, 0, 0, 0, 0, 0,
// 98+ 0, 0, 0, 0, 0, 0, 0, 0,
// 99+ 0, 0, 0, 0, 0, 0, 0, 0,
// 100+ 0
// 101
// 102 %OWNBYTEINTEGERARRAY GCLASS(0:GMAX) =
static unsigned char GCLASS[513] = {
255, 114, 116, 1, 89, 162, 2, 53, 54, 49, 50, 51, 52, 57, 142, 1, 118, 117, 13, 142, 152, 152, 6,
117, 142, 118, 117, 13, 59, 144, 59, 152, 83, 164, 6, 117, 128, 164, 4, 13, 1, 13, 56, 59, 56, 4,
2, 56, 59, 34, 35, 28, 29, 10, 11, 33, 42, 19, 48, 133, 35, 13, 28, 12, 119, 133, 28, 29, 11,
13, 150, 5, 12, 119, 12, 119, 133, 35, 13, 150, 119, 165, 15, 83, 4, 12, 119, 12, 133, 5, 10, 10,
119, 83, 150, 165, 1, 138, 63, 62, 61, 60, 64, 75, 74, 77, 78, 76, 94, 109, 20, 20, 95, 20, 109,
94, 109, 20, 95, 83, 161, 101, 101, 143, 159, 137, 163, 166, 101, 153, 153, 153, 102, 102, 102, 109, 94, 23,
8, 22, 21, 24, 73, 143, 15, 83, 141, 90, 91, 101, 112, 0, 4, 0, 153, 133, 147, 102, 86, 87, 88,
147, 146, 140, 70, 67, 68, 69, 71, 74, 75, 76, 77, 78, 101, 94, 0, 101, 153, 137, 153, 102, 102, 70,
67, 68, 69, 72, 71, 74, 75, 76, 77, 78, 94, 101, 145, 153, 102, 74, 75, 76, 77, 78, 94, 0, 101,
161, 153, 102, 80, 81, 115, 1, 147, 2, 134, 105, 0, 82, 145, 99, 100, 1, 32, 79, 149, 150, 151, 86,
87, 88, 43, 84, 45, 83, 43, 45, 83, 84, 83, 82, 139, 4, 2, 139, 53, 51, 59, 152, 4, 0, 59,
139, 164, 97, 4, 0, 136, 99, 100, 148, 140, 46, 140, 46, 0, 140, 99, 100, 132, 137, 46, 108, 132, 46,
0, 132, 83, 1, 9, 145, 147, 167, 106, 84, 83, 1, 9, 145, 132, 168, 43, 45, 167, 36, 38, 39, 40,
0, 170, 169, 167, 36, 38, 0, 169, 167, 36, 0, 43, 168, 37, 41, 40, 0, 172, 171, 168, 37, 0, 168,
37, 41, 0, 171, 43, 45, 168, 36, 38, 39, 40, 0, 174, 39, 40, 0, 173, 174, 172, 168, 36, 38, 0,
173, 168, 36, 0, 151, 30, 31, 0, 151, 151, 30, 0, 137, 6, 147, 4, 147, 126, 147, 1, 147, 127, 59,
4, 0, 1, 147, 113, 147, 4, 2, 98, 97, 152, 175, 4, 0, 1, 162, 113, 162, 59, 139, 4, 164, 59,
70, 69, 74, 75, 76, 77, 78, 94, 95, 0, 159, 101, 153, 102, 1, 147, 4, 127, 98, 1, 147, 107, 1,
147, 107, 1, 147, 107, 1, 147, 107, 1, 147, 107, 124, 125, 147, 107, 147, 107, 147, 107, 147, 127, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0};
struct _imp_dv GCLASS_dv = {GCLASS, sizeof(unsigned char) /*, dims, <bounds> */};
// 103+ 255, 114, 116, 1, 89, 162, 2, 53,
// 104+ 54, 49, 50, 51, 52, 57, 142, 1,
// 105+ 118, 117, 13, 142, 152, 152, 6, 117,
// 106+ 142, 118, 117, 13, 59, 144, 59, 152,
// 107+ 83, 164, 6, 117, 128, 164, 4, 13,
// 108+ 1, 13, 56, 59, 56, 4, 2, 56,
// 109+ 59, 34, 35, 28, 29, 10, 11, 33,
// 110+ 42, 19, 48, 133, 35, 13, 28, 12,
// 111+ 119, 133, 28, 29, 11, 13, 150, 5,
// 112+ 12, 119, 12, 119, 133, 35, 13, 150,
// 113+ 119, 165, 15, 83, 4, 12, 119, 12,
// 114+ 133, 5, 10, 10, 119, 83, 150, 165,
// 115+ 1, 138, 63, 62, 61, 60, 64, 75,
// 116+ 74, 77, 78, 76, 94, 109, 20, 20,
// 117+ 95, 20, 109, 94, 109, 20, 95, 83,
// 118+ 161, 101, 101, 143, 159, 137, 163, 166,
// 119+ 101, 153, 153, 153, 102, 102, 102, 109,
// 120+ 94, 23, 8, 22, 21, 24, 73, 143,
// 121+ 15, 83, 141, 90, 91, 101, 112, 0,
// 122+ 4, 0, 153, 133, 147, 102, 86, 87,
// 123+ 88, 147, 146, 140, 70, 67, 68, 69,
// 124+ 71, 74, 75, 76, 77, 78, 101, 94,
// 125+ 0, 101, 153, 137, 153, 102, 102, 70,
// 126+ 67, 68, 69, 72, 71, 74, 75, 76,
// 127+ 77, 78, 94, 101, 145, 153, 102, 74,
// 128+ 75, 76, 77, 78, 94, 0, 101, 161,
// 129+ 153, 102, 80, 81, 115, 1, 147, 2,
// 130+ 134, 105, 0, 82, 145, 99, 100, 1,
// 131+ 32, 79, 149, 150, 151, 86, 87, 88,
// 132+ 43, 84, 45, 83, 43, 45, 83, 84,
// 133+ 83, 82, 139, 4, 2, 139, 53, 51,
// 134+ 59, 152, 4, 0, 59, 139, 164, 97,
// 135+ 4, 0, 136, 99, 100, 148, 140, 46,
// 136+ 140, 46, 0, 140, 99, 100, 132, 137,
// 137+ 46, 108, 132, 46, 0, 132, 83, 1,
// 138+ 9, 145, 147, 167, 106, 84, 83, 1,
// 139+ 9, 145, 132, 168, 43, 45, 167, 36,
// 140+ 38, 39, 40, 0, 170, 169, 167, 36,
// 141+ 38, 0, 169, 167, 36, 0, 43, 168,
// 142+ 37, 41, 40, 0, 172, 171, 168, 37,
// 143+ 0, 168, 37, 41, 0, 171, 43, 45,
// 144+ 168, 36, 38, 39, 40, 0, 174, 39,
// 145+ 40, 0, 173, 174, 172, 168, 36, 38,
// 146+ 0, 173, 168, 36, 0, 151, 30, 31,
// 147+ 0, 151, 151, 30, 0, 137, 6, 147,
// 148+ 4, 147, 126, 147, 1, 147, 127, 59,
// 149+ 4, 0, 1, 147, 113, 147, 4, 2,
// 150+ 98, 97, 152, 175, 4, 0, 1, 162,
// 151+ 113, 162, 59, 139, 4, 164, 59, 70,
// 152+ 69, 74, 75, 76, 77, 78, 94, 95,
// 153+ 0, 159, 101, 153, 102, 1, 147, 4,
// 154+ 127, 98, 1, 147, 107, 1, 147, 107,
// 155+ 1, 147, 107, 1, 147, 107, 1, 147,
// 156+ 107, 124, 125, 147, 107, 147, 107, 147,
// 157+ 107, 147, 127, 0, 0, 0, 0, 0,
// 158+ 0, 0, 0, 0, 0, 0, 0, 0,
// 159+ 0, 0, 0, 0, 0, 0, 0, 0,
// 160+ 0, 0, 0, 0, 0, 0, 0, 0,
// 161+ 0, 0, 0, 0, 0, 0, 0, 0,
// 162+ 0, 0, 0, 0, 0, 0, 0, 0,
// 163+ 0, 0, 0, 0, 0, 0, 0, 0,
// 164+ 0, 0, 0, 0, 0, 0, 0, 0,
// 165+ 0, 0, 0, 0, 0, 0, 0, 0,
// 166+ 0, 0, 0, 0, 0, 0, 0, 0,
// 167+ 0
// 168
// 169 %CONSTSHORTINTEGERARRAY KDICT(32: 538) =
const short int KDICT[507] = {
0, 511, 131, 527, 131, 131, 531, 131, 535, 539, 543, 551, 555, 559,
575, 579, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 591, 594,
599, 619, 635, 131, 131, 652, 724, 752, 840, 876, 1020, 128, 128, 1084,
128, 128, 1296, 1320, 1344, 1384, 1408, 128, 1460, 1824, 2056, 2080, 128, 2112,
128, 128, 128, 131, 2127, 131, 131, 2151, 131, 131, 131, 131, 131, 131,
131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131,
131, 131, 131, 131, 131, 131, 131, 131, 2155, 131, 131, -32351, -16119, 16679,
16743, 18734, 16614, 16385, 16386, -16282, 16489, 17128, 16388, -32322, -15576, 17195, 16392, 21710,
-32465, 19369, 16550, 16387, 16397, -32196, -32451, 18542, 18798, 16804, -32323, -14138, 18670, 19284,
-32195, -32450, 18606, 16868, 18862, -30642, 10578, 11457, -31922, -32429, 16823, 8912, 67, 16951,
9921, 69, -32429, 16887, 8912, 67, 17079, 68, 18910, -32187, 10841, 69, 16896, 9415,
78, 17393, -30070, -32177, 8665, 8908, 16394, -31027, 78, -31533, 84, -32183, 10194, 76,
17386, 10958, 69, 18135, 84, 16512, 8909, 10830, 16391, 16384, -32055, 10073, 9921, 8649,
16704, 9153, 10190, 8915, 17322, -28340, -31026, -31530, 88, -32055, 8916, 10066, 9793, 16768,
84, 18071, 10053, 84, 16399, 68, -32433, 21873, 70, -31034, -31540, 80, -32059, 10194,
10567, 9921, 22001, 9938, 22065, 10697, 84, 17904, 9801, 69, 21937, 8915, 19171, -31039,
-31543, -32306, 10575, 16395, -32429, 17143, 8912, 67, 17207, 9422, 9299, 19106, 10700, 69,
17623, -26042, 10830, 9157, 10565, -28607, -29626, -30643, -31794, -32301, -15243, 17528, 8912, 67,
23416, 9921, 69, -32301, -15179, 17592, 8912, 67, 23480, 10305, -32301, -14734, 18040, 8912,
67, 24306, 78, -32301, -14798, 17976, 8912, 67, 24370, 10578, 11457, -31922, -32429, 18163,
8912, 67, 23539, 9921, 69, -32301, -14539, 18232, 8912, 67, 23608, 18204, -32183, 10063,
71, 17024, 10835, 17840, 10305, -32429, 16631, 8912, 67, 16695, -32319, 10831, 18464, 8909,
-32301, -16201, 16568, 8912, 67, 17015, -32050, -32302, 10071, 16448, 18975, 19219, -31291, 8914,
9412, 8387, 8916, -32301, -15694, 17080, 8912, 67, 24050, 9938, 16832, -31419, 10959, 9428,
8910, -32301, -15886, 16888, 8912, 67, 24114, -29759, -30909, -31408, -32173, 10964, 10066, 17495,
9813, 7892, -32451, 17430, 17045, 8389, 84, 19041, 10575, 68, -32088, 10182, 9938, 10817,
21810, 21521, 76, -27455, -28474, -29491, -30642, -32301, -10123, 22648, -31540, -32178, 8912, 67,
23672, 10575, 8397, 76, 18032, 10063, 71, 17968, 9921, 69, -32301, -10059, 22712, 8912,
67, 23736, 10305, -32301, -9614, 23160, 8912, 67, 24178, 78, -32301, -9678, 23096, 8912,
67, 24242, 10578, 11457, -31922, -32429, 23283, 8912, 67, 23795, 9921, 69, -32301, -9419,
23352, 8912, 67, 23864, -25656, -26167, -26672, -31532, -32041, 10713, 8916, 77, 16640, 10825,
9283, 16825, -28223, -28593, 9426, 9166, -29144, -30015, -31034, -32051, 8398, 8909, -12107, 20664,
10305, -32301, -11662, 21112, 8912, 67, 24498, 78, -32301, -11726, 21048, 8912, 67, 23922,
10578, 11457, 8398, 8909, -11467, 21304, 20496, 80, 17751, 10834, 16396, 8645, -8206, 24567,
10055, 9793, 17688, 10575, 84, 16960, -32184, 10962, 69, 17559, 10053, 16389, 78, -32180,
9428, 76, 18397, 10693, 83, 18268, 9416, 8908, 18333, -32067, -32292, -15771, 17005, 17252,
18734, 16402, 16649};
struct _imp_dv KDICT_dv = {KDICT, sizeof(short int) /*, dims, <bounds> */};
// 170+ 0, 511, 131, 527, 131, 131, 531, 131,
// 171+ 535, 539, 543, 551, 555, 559, 575, 579,
// 172+ 129, 129, 129, 129, 129, 129, 129, 129,
// 173+ 129, 129, 591, 594, 599, 619, 635, 131,
// 174+ 131, 652, 724, 752, 840, 876, 1020, 128,
// 175+ 128, 1084, 128, 128, 1296, 1320, 1344, 1384,
// 176+ 1408, 128, 1460, 1824, 2056, 2080, 128, 2112,
// 177+ 128, 128, 128, 131, 2127, 131, 131, 2151,
// 178+ 131, 131, 131, 131, 131, 131, 131, 131,
// 179+ 131, 131, 131, 131, 131, 131, 131, 131,
// 180+ 131, 131, 131, 131, 131, 131, 131, 131,
// 181+ 131, 131, 131, 131, 2155, 131, 131, -32351,
// 182+ -16119, 16679, 16743, 18734, 16614, 16385, 16386, -16282,
// 183+ 16489, 17128, 16388, -32322, -15576, 17195, 16392, 21710,
// 184+ -32465, 19369, 16550, 16387, 16397, -32196, -32451, 18542,
// 185+ 18798, 16804, -32323, -14138, 18670, 19284, -32195, -32450,
// 186+ 18606, 16868, 18862, -30642, 10578, 11457, -31922, -32429,
// 187+ 16823, 8912, 67, 16951, 9921, 69, -32429, 16887,
// 188+ 8912, 67, 17079, 68, 18910, -32187, 10841, 69,
// 189+ 16896, 9415, 78, 17393, -30070, -32177, 8665, 8908,
// 190+ 16394, -31027, 78, -31533, 84, -32183, 10194, 76,
// 191+ 17386, 10958, 69, 18135, 84, 16512, 8909, 10830,
// 192+ 16391, 16384, -32055, 10073, 9921, 8649, 16704, 9153,
// 193+ 10190, 8915, 17322, -28340, -31026, -31530, 88, -32055,
// 194+ 8916, 10066, 9793, 16768, 84, 18071, 10053, 84,
// 195+ 16399, 68, -32433, 21873, 70, -31034, -31540, 80,
// 196+ -32059, 10194, 10567, 9921, 22001, 9938, 22065, 10697,
// 197+ 84, 17904, 9801, 69, 21937, 8915, 19171, -31039,
// 198+ -31543, -32306, 10575, 16395, -32429, 17143, 8912, 67,
// 199+ 17207, 9422, 9299, 19106, 10700, 69, 17623, -26042,
// 200+ 10830, 9157, 10565, -28607, -29626, -30643, -31794, -32301,
// 201+ -15243, 17528, 8912, 67, 23416, 9921, 69, -32301,
// 202+ -15179, 17592, 8912, 67, 23480, 10305, -32301, -14734,
// 203+ 18040, 8912, 67, 24306, 78, -32301, -14798, 17976,
// 204+ 8912, 67, 24370, 10578, 11457, -31922, -32429, 18163,
// 205+ 8912, 67, 23539, 9921, 69, -32301, -14539, 18232,
// 206+ 8912, 67, 23608, 18204, -32183, 10063, 71, 17024,
// 207+ 10835, 17840, 10305, -32429, 16631, 8912, 67, 16695,
// 208+ -32319, 10831, 18464, 8909, -32301, -16201, 16568, 8912,
// 209+ 67, 17015, -32050, -32302, 10071, 16448, 18975, 19219,
// 210+ -31291, 8914, 9412, 8387, 8916, -32301, -15694, 17080,
// 211+ 8912, 67, 24050, 9938, 16832, -31419, 10959, 9428,
// 212+ 8910, -32301, -15886, 16888, 8912, 67, 24114, -29759,
// 213+ -30909, -31408, -32173, 10964, 10066, 17495, 9813, 7892,
// 214+ -32451, 17430, 17045, 8389, 84, 19041, 10575, 68,
// 215+ -32088, 10182, 9938, 10817, 21810, 21521, 76, -27455,
// 216+ -28474, -29491, -30642, -32301, -10123, 22648, -31540, -32178,
// 217+ 8912, 67, 23672, 10575, 8397, 76, 18032, 10063,
// 218+ 71, 17968, 9921, 69, -32301, -10059, 22712, 8912,
// 219+ 67, 23736, 10305, -32301, -9614, 23160, 8912, 67,
// 220+ 24178, 78, -32301, -9678, 23096, 8912, 67, 24242,
// 221+ 10578, 11457, -31922, -32429, 23283, 8912, 67, 23795,
// 222+ 9921, 69, -32301, -9419, 23352, 8912, 67, 23864,
// 223+ -25656, -26167, -26672, -31532, -32041, 10713, 8916, 77,
// 224+ 16640, 10825, 9283, 16825, -28223, -28593, 9426, 9166,
// 225+ -29144, -30015, -31034, -32051, 8398, 8909, -12107, 20664,
// 226+ 10305, -32301, -11662, 21112, 8912, 67, 24498, 78,
// 227+ -32301, -11726, 21048, 8912, 67, 23922, 10578, 11457,
// 228+ 8398, 8909, -11467, 21304, 20496, 80, 17751, 10834,
// 229+ 16396, 8645, -8206, 24567, 10055, 9793, 17688, 10575,
// 230+ 84, 16960, -32184, 10962, 69, 17559, 10053, 16389,
// 231+ 78, -32180, 9428, 76, 18397, 10693, 83, 18268,
// 232+ 9416, 8908, 18333, -32067, -32292, -15771, 17005, 17252,
// 233+ 18734, 16402, 16649
// 234
// 235 !*******************************************
// 236 !* *
// 237 !* TRANSPORTABLE IMP COMPILER *
// 238 !* *
// 239 !* COPYRIGHT PETER S. ROBERTSON *
// 240 !* DEPARTMENT OF COMPUTER SCIENCE *
// 241 !* UNIVERSITY OF EDINBURGH *
// 242 !* ALL RIGHTS RESERVED *
// 243 !* *
// 244 !*******************************************
// 245 !
// 246 ! THROUGHOUT THE SOURCE TEXT OF THIS PROGRAM, THE LOWER CASE
// 247 ! ALPHABET IS REPRESENTED BY LETTER+32 E.G. 'A'+32
// 248
// 249 %CONSTINTEGER SS0=250, SS1=251, SS2=252, SS3=253, SS4=254
// 250 %CONSTINTEGER NULL=512; !???
// 251 %CONSTINTEGER TRANSP = 18
// 252 %CONSTINTEGER PHRASES = 132
// 253 %CONSTINTEGER EQUIVS = 105
// 254 %CONSTINTEGER DIRECTIVES = 86
// 255 %CONSTINTEGER ANAPP=160
// 256 %CONSTINTEGER GLOBAL=0
// 257 %CONSTINTEGER ICONST=83, RCONST=84, SCONST=82
// 258 %CONSTINTEGER LB=1, RB=2
// 259 %CONSTINTEGER PRE1=49, PRE2=57
// 260 %CONSTINTEGER OWN1=53, OWN2=51
// 261 %CONSTINTEGER SET1=60, SET2=64
// 262 %CONSTINTEGER CHECK1=66, CHECK2=72
// 263 %CONSTINTEGER DEF1=60, DEF2=79
// 264 %CONSTINTEGER IDENT=59, SWITCH=80, COMMENT=7
// 265 %CONSTINTEGER TERMIN=13
// 266 %CONSTINTEGER APPEP=153
// 267 %CONSTINTEGER PAGE SIZE = 64
// 268 %CONSTINTEGER STX = 2
// 269 %CONSTINTEGER PAGE = 12
// 270 !*********************************************
// 271 !* OTYPE * MOD * SPECD * FORMAT * APP * LINK *
// 272 !*********************************************
// 273 ! 3 2 1 1 1 8
// 274 !
// 275 ! OTYPE : 1 OWN
// 276 ! 2 CONST
// 277 ! 3 EXTRINSIC
// 278 ! 4 SYSTEM
// 279 ! 5 DYNAMIC
// 280 ! 6 EXTERNAL
// 281 ! 7 PERM
// 282 !
// 283 !*******************************
// 284 !* LENGTH * USED * TYPE * FORM *
// 285 !*******************************
// 286 ! 8 1 3 4
// 287 !
// 288 %BEGIN
int main(int argc, char **argv) { /*%begin*/
_imp_initialise(argc, argv);
// 289 ! ------I/O STREAM ASSIGNMENTS CHANGED TEMPORARILY------
// 290 %CONSTINTEGER PRIM = 2, PROG = 1; ! INPUT STREAMS
// 291 %CONSTINTEGER REPORT=3,OBJ=2, LISTING=1; ! OUTPUT STREAMS
// 292 %CONSTINTEGER EOP=87; ! ENDOFPROGRAM SUBATOM
// 293 %CONSTINTEGER EOF=86; ! ENDOFFILE SUBATOM
// 294 %CONSTINTEGER TEXT LIMIT=255; ! MAX STRING LENGTH
// 295 %CONSTBYTEINTEGERARRAY CMAP(0 : 15)= 0, 67, 68, 81, 65, 83, 80, 73,
const unsigned char CMAP[16] = {0, 67, 68, 81, 65, 83, 80, 73, 72, 71, 79, 69, 70, 66, 0, 0};
struct _imp_dv CMAP_dv = {CMAP, sizeof(unsigned char) /*, dims, <bounds> */};
// 296+ 72, 71, 79, 69, 7 0, 66, 0, 0
// 297 %CONSTINTEGER STRING = 16, RECORD=17; ! STRING/RECORD SUBATOMS
// 298 %CONSTINTEGER SPECIAL=55; ! SPECIAL DECLARATOR
// 299 %CONSTINTEGER RFN=65; ! RECORDFORMAT NAME CLASS
// 300 %CONSTINTEGER ULINE=18; ! CLASS FOR '_'
// 301 %CONSTINTEGER NULL STRING=401
// 302 %OWNINTEGER PERMIN = 1; ! PERM/PROG SWITCH
static int PERMIN = 1;
// 303 %OWNINTEGER DIAG = 0, CONTROL = 0
static int DIAG = 0;
static int CONTROL = 0;
// 304 %OWNINTEGER BPT=0; ! CODE BUFFER POINTER
static int BPT = 0;
// 305 %OWNSHORTINTEGERARRAY BUFFER(1 : 401)
static short int BUFFER[401];
struct _imp_dv BUFFER_dv = {BUFFER, sizeof(short int) /*, dims, <bounds> */};
auto void FAULT(int N);
// 306 %CONSTINTEGER MCODE = 38
// 307
// 308 ! %DIAGNOSE FLAGS (2\\N)
// 309 !
// 310 ! 0 - GRAMMAR TRACE
// 311 ! 1 - RECORD USE
// 312 ! 2 - APP DEFN.
// 313 ! 3 - RECORD DEFN.
// 314 !
// 315 %ROUTINESPEC FAULT(%INTEGER N)
// 316 !*********************************************
// 317 !* ALMOST THE WHOLE COMPILER ASSUMES A 16 BIT WORD. *
// 318 !*********************************************
// 319 %OWNINTEGER MARK = ' '
static int MARK = 32;
// 320 %OWNINTEGER FILE = 0; ! BEGIN OR EXTERNAL FILE ?
static int FILE = 0;
// 321 %CONSTINTEGER DICT END = 2750
// 322 %INTEGERARRAY DICT(0:DICT END)
int DICT[2751];
struct _imp_dv DICT_dv = {DICT, sizeof(int) /*, dims, <bounds> */};
// 323 %CONSTINTEGER MAX LAB = 80
// 324 %BYTEINTEGERARRAY LABINF(1 : MAX LAB)
unsigned char LABINF[80];
struct _imp_dv LABINF_dv = {LABINF, sizeof(unsigned char) /*, dims, <bounds> */};
// 325 %INTEGER LIST, LREALS; ! OPTION FLAGS
int LIST;
int LREALS;
// 326 %INTEGER STATS; ! NUMBER OF STATEMENTS
int STATS;
// 327 %ownINTEGER CODE = 0; ! OBJECT FILE SIZE
static int CODE = 0;
// 328 %INTEGER LINES; ! LINES ON LISTING PAGE
int LINES;
// 329 %INTEGER LINENUM; ! CURRENT LINE NUMBER
int LINENUM;
// 330 %INTEGER LIT; ! LAST LITERAL POS
int LIT;
// 331 %INTEGER LIT POS; ! LITERAL TEXT POINTER
int LITPOS;
// 332 %INTEGER LIMIT; ! DIGIT SEARCH LIMIT
int LIMIT;
// 333 %INTEGER DIGIT; ! CURRECT DIGIT
int DIGIT;
// 334 %INTEGER OLD SYM; ! FIRST SYM OF NAME
int OLDSYM;
// 335 %INTEGER LABEL; ! CURRENT LABEL
int LABEL;
// 336 %INTEGER X; ! CURRENT TAG APP/FORMAT
int X;
// 337 %ownINTEGER SYM = 0; ! CURRENT INPUT SYMBOL
static int SYM = 0;
// 338 %INTEGER ATOM1; ! CURRENT ATOM
int ATOM1;
// 339 %INTEGER ATOM2; ! VARIANT OF ATOM1
int ATOM2;
// 340 %INTEGER SUBATOM; ! EXTRA INFO
int SUBATOM;
// 341 %INTEGER LAST; ! LAST ATOM TYPE
int LAST;
// 342 %INTEGER SS TYPE; ! 0 LABEL, 1 DECLARATION,
int SSTYPE;
// 343 ! 2 FORMAL PARAMS, 3 STATEMENT
// 344 %INTEGER SYMTYPE; ! -2:LETTER, -1: DIGIT
int SYMTYPE;
// 345 ! 0:TERMINATOR, 1: OTHER
// 346 %INTEGER TYPE; ! VARIABLE TYPE WANTED
int TYPE;
// 347 %INTEGER VAR TYPE; ! VARIABLE TYPE FOUND
int VARTYPE;
// 348 %ownINTEGER POS = 0; ! CURRENT INPUT POSITION
static int POS = 0;
// 349 %INTEGER ATOM POS; ! CURRENT ATOM START POSN.
int ATOMPOS;
// 350 %INTEGER DUP; ! DUPLICATE FLAG
int DUP;
// 351 %INTEGER OUT; ! CURRENT OUTPUT STREAM
int OUT;
// 352 %INTEGER PREFIX, SPREFIX; ! OWN, BYTE, EXTERNAL ETC.
int PREFIX;
int SPREFIX;
// 353 %INTEGER CONST INT
int CONSTINT;
// 354 %INTEGER O TYPE
int OTYPE;
// 355 %INTEGER DEC TYPE; ! CURRENT DECLARATOR
int DECTYPE;
// 356 %OWNINTEGERARRAY CNEST(0 :10); ! STACK FOR CONDITIONS
static int CNEST[11];
struct _imp_dv CNEST_dv = {CNEST, sizeof(int) /*, dims, <bounds> */};
// 357 %OWNBYTEINTEGERARRAY LINE(1 : 73); ! INPUT LINE BUFFER
static unsigned char LINE[73];
struct _imp_dv LINE_dv = {LINE, sizeof(unsigned char) /*, dims, <bounds> */};
// 358 %CONSTINTEGER RECLEN = -300; ! -(MAX LENGTH OF ANALYSIS RECORD)
// 359 %INTEGERARRAY REF, CO, SUB, LOC(RECLEN : -1)
int REF[300];
struct _imp_dv REF_dv = {REF, sizeof(int) /*, dims, <bounds> */};
int CO[300];
struct _imp_dv CO_dv = {CO, sizeof(int) /*, dims, <bounds> */};
int SUB[300];
struct _imp_dv SUB_dv = {SUB, sizeof(int) /*, dims, <bounds> */};
int LOC[300];
struct _imp_dv LOC_dv = {LOC, sizeof(int) /*, dims, <bounds> */};
// 360 %INTEGER SS; ! SOURCE STATEMENT ENTRY
int SS;
// 361 %INTEGER A; ! ATOM POINTER
int A;
// 362 %INTEGER P; ! PHRASE POINTER
int P;
// 363 %INTEGER FAULTY; ! FAULT INDICATOR
int FAULTY;
// 364 %INTEGER F TYPE; ! TYPE OF FAULT
int FTYPE;
// 365 %INTEGER G LIMIT; ! END OF GRAM POINTER
int GLIMIT;
// 366 %INTEGER T LIMIT; ! MAX EXTENT OF DICTIONARY
int TLIMIT;
// 367 %INTEGER TMAX; ! CURRENT MAX TAG (FREE)
int TMAX;
// 368 %INTEGER T BASE; ! FIRST NAME AT CURRENT LEVEL
int TBASE;
// 369 %INTEGER DP; ! END OF CURRENT NAME
int DP;
// 370 %INTEGER RELOCATE; ! RELOCATION FOR FORMATS
int RELOCATE;
// 371 %INTEGER APP
int APP;
// 372 %SHORTINTEGERNAME PAPP; ! ==PHRASE(APPEP)
short int *PAPP;
// 373 %INTEGER EILAB; ! %ELSEIF LABEL
int EILAB;
// 374 %ownINTEGER MARGIN = 0
static int MARGIN = 0;
// 375 %INTEGER INHIBIT; ! FLAG FOR DECLARATIONS MISPLA
int INHIBIT;
// 376
// 377 %ROUTINE SEND
void SEND(void) {
// 378 %INTEGER J
int J;
// 379 %RETURN %IF BPT <= 0
if (BPT > 0) goto L_0001;
return;
L_0001:;
// 380 FAULT(22) %IF BPT >= LITPOS
if (BPT < LITPOS) goto L_0002;
FAULT(22);
L_0002:;
// 381 %IF FAULTY = 0 %START
if (FAULTY != 0) goto L_0003;
// 382 SELECTOUTPUT(OBJ)
_imp_SELECTOUTPUT(2);
// 383 PRINTSYMBOL(BUFFER(J)) %FOR J = 1,1,BPT
// %for J = 1, 1, BPT %cycle
{
int _final = BPT;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, BPT");
J = 0;
L_0004:
if (J == _final) goto L_0005;
J += 1;
_imp_PRINTSYMBOL(BUFFER[J - 1]);
goto L_0004;
}
L_0005:;
// 384 SELECTOUTPUT(LISTING)
_imp_SELECTOUTPUT(1);
// 385 %FINISH
L_0003:;
// 386 BPT=0
BPT = 0;
// 387 %END
return;
} /* end of SEND */
// 388 %ROUTINE PUT(%INTEGER N)
void PUT(int N) {
// 389 CODE = CODE+1
CODE = CODE + 1;
// 390 SEND %IF BPT > 71
if (BPT <= 71) goto L_0007;
SEND();
L_0007:;
// 391 BPT=BPT+1; BUFFER(BPT)=N
BPT = BPT + 1;
BUFFER[BPT - 1] = N;
// 392 %END
return;
} /* end of PUT */
// 393 %ROUTINE ADDR(%INTEGER N)
void ADDR(int N) {
// 394 %INTEGER V
int V;
// 395 V=N//10
V = ((long)N / (long)10);
// 396 ADDR(V) %UNLESS V=0
if (V == 0) goto L_0008;
ADDR(V);
L_0008:;
// 397 PUT(N-V*10+'0')
PUT(N - V * 10 + 48);
// 398 %END
return;
} /* end of ADDR */
// 399 %ROUTINE OP(%INTEGER C, A)
void OP(int C, int A) {
// 400 PUT(C); ADDR(A)
PUT(C);
ADDR(A);
// 401 %END
return;
} /* end of OP */
// 402 %ROUTINE PRINT NAME(%INTEGER N)
void PRINTNAME(int N) {
// 403 %INTEGER D, FLAG
int D;
int FLAG;
// 404 ! ----- 'UNPACK' USES AT LEAST A 30-BIT WORD ----
// 405 %ROUTINE UNPACK(%INTEGER V)
void UNPACK(int V) {
// 406 %INTEGER J, N, C
int J;
int N;
int C;
// 407 %CYCLE J = 24,-6,0
// %for J = 24, -6, 0 %cycle
{
J = 30;
L_0009:
if (J == 0) goto L_000A;
J -= 6;
// 408 C = (V>>J)&63
C = (unsigned int)V >> J & 63;
// 409 %IF C # 0 %START
if (C == 0) goto L_000C;
// 410 C = C+32; ! ADD IN 32 REMOVED WHEN PACKING
C = C + 32;
// 411 %IF FLAG # 0 %START
if (FLAG == 0) goto L_000D;
// 412 %IF FLAG < 0 %THEN PUT(C) %ELSE PRINT SYMBOL(C)
if (FLAG >= 0) goto L_000E;
PUT(C);
goto L_000F;
L_000E:;
_imp_PRINTSYMBOL(C);
L_000F:;
// 413 FLAG = FLAG+1
FLAG = FLAG + 1;
// 414 %FINISH
L_000D:;
// 415 %FINISH
L_000C:;
// 416 %REPEAT
goto L_0009;
}
L_000A:;
// 417 %END
return;
} /* end of UNPACK */
// ?N unused
// 418 %IF N < 0 %THEN N = -N %AND FLAG = -13 %ELSE FLAG = 1
if (N >= 0) goto L_0010;
N = -N;
FLAG = -13;
goto L_0011;
L_0010:;
FLAG = 1;
L_0011:;
// 419 D=DICT(N)
D = DICT[N];
// 420 UNPACK(DICT(D-2)) %FOR D = N-D&255, 1, N-D>>11&3
// %for D = N - (D & 255), 1, N - ((unsigned int)D >> 11 & 3) %cycle
{
int _initial = N - (D & 255), _final = N - ((unsigned int)D >> 11 & 3);
if (invalid_for_loop(_initial, 1, _final))
_imp_signal(5, 1, 0, "Illegal cycle D = N - (D & 255), 1, N - ((unsigned int)D >> 11 & 3)");
D = _initial - (1);
L_0012:
if (D == _final) goto L_0013;
D += 1;
UNPACK(DICT[D - 2]);
goto L_0012;
}
L_0013:;
// 421 %END
return;
} /* end of PRINTNAME */
// 422
// 423 %ROUTINE FAULT(%INTEGER N)
void FAULT(int N) {
// 424 %INTEGER ERROR POS, STREAM, SPACING, pos2
int ERRORPOS;
int STREAM;
int SPACING;
int POS2;
// 425 %SWITCH FM(-1 : 24)
int FM_index;
int FM_line;
char *FM_file;
static const void *FM[26] = {&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing};
// 426 STREAM = REPORT; SELECTOUTPUT(REPORT)
STREAM = 3;
_imp_SELECTOUTPUT(3);
// 427 ATOM POS = DUP %IF DUP # 0
if (DUP == 0) goto L_0014;
ATOMPOS = DUP;
L_0014:;
// 428 ERROR POS = ATOM POS
ERRORPOS = ATOMPOS;
// 429 ERROR POS = 0 %IF ERROR POS = POS %AND N > 1
if (ERRORPOS != POS) goto L_0015;
if (N <= 1) goto L_0015;
ERRORPOS = 0;
L_0015:;
// 430 FAULTY=FAULTY+1
FAULTY = FAULTY + 1;
// 431 SPACING = MARGIN+ERROR POS+8 -2
SPACING = MARGIN + ERRORPOS + 8 - 2;
// 432 %CYCLE
L_0016:;
// 433 %IF POS > 0 %AND (LIST # 0 %OR STREAM = REPORT) %START
if (POS <= 0) goto L_0017;
if (LIST != 0) goto L_0006;
if (STREAM != 3) goto L_0017;
L_0006:;
// 434 WRITE(LINE NUM, 4) %AND SPACE %IF STREAM # REPORT
if (STREAM == 3) goto L_0018;
_imp_WRITE(LINENUM, 4);
_imp_SPACE();
L_0018:;
// 435 pos2 = POS
POS2 = POS;
// 436 %CYCLE POS = 1,1,pos2
// %for POS = 1, 1, POS2 %cycle
{
int _final = POS2;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle POS = 1, 1, POS2");
POS = 0;
L_0019:
if (POS == _final) goto L_001A;
POS += 1;
// ?Non-local
// 437 PRINTSYMBOL('|') %IF POS = ERROR POS %AND STREAM=REPORT
if (POS != ERRORPOS) goto L_001C;
if (STREAM != 3) goto L_001C;
_imp_PRINTSYMBOL(124);
L_001C:;
// 438 PRINTSYMBOL(LINE(POS))
_imp_PRINTSYMBOL(LINE[POS - 1]);
// 439 %REPEAT
goto L_0019;
}
L_001A:;
// 440 SYM=LINE(POS)
SYM = LINE[POS - 1];
// 441 %FINISH
L_0017:;
// 442 NEWLINE %IF SYM # NL
if (SYM == 10) goto L_001D;
_imp_NEWLINE();
L_001D:;
// 443 PRINTSYMBOL('*')
_imp_PRINTSYMBOL(42);
// 444 %IF STREAM = REPORT %START
if (STREAM != 3) goto L_001E;
// 445 WRITE(LINE NUM, 4); SPACE
_imp_WRITE(LINENUM, 4);
_imp_SPACE();
// 446 %ELSE
goto L_001F;
L_001E:;
// 447 SPACE
_imp_SPACE();
// 448 %IF ERROR POS # 0 %START
if (ERRORPOS == 0) goto L_0020;
// 449 SPACES(SPACING-1); PRINTSTRING("! ")
_imp_SPACES(SPACING - 1);
_imp_PRINTSTRING(_imp_str_literal("! "));
// 450 %FINISH
L_0020:;
// 451 %FINISH
L_001F:;
// 452 ->FM(N)
FM_line = __LINE__;
FM_file = __FILE__;
FM_index = N;
goto case_FM_dispatch;
// 453 FM(24): PRINTSTRING("COMPILER ERROR!"); ->F
case_FM_24:;
_imp_PRINTSTRING(_imp_str_literal("COMPILER ERROR!"));
goto U_1000;
// 454 FM(20): PRINTSTRING("TEXT TOO LONG"); ->F
case_FM_20:;
_imp_PRINTSTRING(_imp_str_literal("TEXT TOO LONG"));
goto U_1000;
// 455 FM(21): PRINTSTRING("TOO MANY NAMES"); ->F
case_FM_21:;
_imp_PRINTSTRING(_imp_str_literal("TOO MANY NAMES"));
goto U_1000;
// 456 FM(22): PRINTSTRING("TOO MANY LONG NAMES"); ->F
case_FM_22:;
_imp_PRINTSTRING(_imp_str_literal("TOO MANY LONG NAMES"));
goto U_1000;
// 457 FM(23): PRINTSTRING("PROGRAM TOO COMPLEX"); ->F
case_FM_23:;
_imp_PRINTSTRING(_imp_str_literal("PROGRAM TOO COMPLEX"));
goto U_1000;
// 458 FM(18): PRINTSTRING("ACCESS")
case_FM_18:;
_imp_PRINTSTRING(_imp_str_literal("ACCESS"));
// 459 FAULTY = FAULTY-1 %IF STREAM = REPORT
if (STREAM != 3) goto L_0022;
FAULTY = FAULTY - 1;
L_0022:;
// 460 ->F
goto U_1000;
// 461 FM(0): PRINTSTRING("FORM"); ->F
case_FM_0:;
_imp_PRINTSTRING(_imp_str_literal("FORM"));
goto U_1000;
// 462 FM(1): PRINTSTRING("ATOM"); ->F
case_FM_1:;
_imp_PRINTSTRING(_imp_str_literal("ATOM"));
goto U_1000;
// 463 FM(2): PRINTSTRING("TYPE"); ->F
case_FM_2:;
_imp_PRINTSTRING(_imp_str_literal("TYPE"));
goto U_1000;
// 464 FM(3): PRINTSTRING("NAME"); ->F
case_FM_3:;
_imp_PRINTSTRING(_imp_str_literal("NAME"));
goto U_1000;
// 465 FM(4): PRINTSTRING("SIZE"); ->F
case_FM_4:;
_imp_PRINTSTRING(_imp_str_literal("SIZE"));
goto U_1000;
// 466 FM(5): PRINTSTRING("CONTEXT"); ->F
case_FM_5:;
_imp_PRINTSTRING(_imp_str_literal("CONTEXT"));
goto U_1000;
// 467 FM(6): PRINTSTRING("MATCH"); ->F
case_FM_6:;
_imp_PRINTSTRING(_imp_str_literal("MATCH"));
goto U_1000;
// 468 FM(7): PRINTSTRING("COPY"); ->F
case_FM_7:;
_imp_PRINTSTRING(_imp_str_literal("COPY"));
goto U_1000;
// 469 FM(8): PRINTSTRING("SPEC"); ->F
case_FM_8:;
_imp_PRINTSTRING(_imp_str_literal("SPEC"));
goto U_1000;
// 470 FM(9): PRINTSTRING("%END"); ->MISS
case_FM_9:;
_imp_PRINTSTRING(_imp_str_literal("%END"));
goto U_1001;
// 471 FM(10): PRINTSTRING("%CYCLE"); ->MISS
case_FM_10:;
_imp_PRINTSTRING(_imp_str_literal("%CYCLE"));
goto U_1001;
// 472 FM(11): PRINTSTRING("%REPEAT"); ->MISS
case_FM_11:;
_imp_PRINTSTRING(_imp_str_literal("%REPEAT"));
goto U_1001;
// 473 FM(12): PRINTSYMBOL('"'); PRINT NAME(X); PRINTSYMBOL('"'); ->MISS
case_FM_12:;
_imp_PRINTSYMBOL(34);
PRINTNAME(X);
_imp_PRINTSYMBOL(34);
goto U_1001;
// 474 FM(13): PRINTSTRING("%START"); ->MISS
case_FM_13:;
_imp_PRINTSTRING(_imp_str_literal("%START"));
goto U_1001;
// 475 FM(14): PRINTSTRING("%FINISH"); ->MISS
case_FM_14:;
_imp_PRINTSTRING(_imp_str_literal("%FINISH"));
goto U_1001;
// 476 FM(15): PRINTSTRING("ORDER"); ->F
case_FM_15:;
_imp_PRINTSTRING(_imp_str_literal("ORDER"));
goto U_1000;
// 477 FM(16): PRINTSTRING("BOUNDS"); ->F
case_FM_16:;
_imp_PRINTSTRING(_imp_str_literal("BOUNDS"));
goto U_1000;
// 478 FM(17): PRINTSTRING("RESULT")
case_FM_17:;
_imp_PRINTSTRING(_imp_str_literal("RESULT"));
// 479 MISS: PRINTSTRING(" MISSING")
U_1001:;
_imp_PRINTSTRING(_imp_str_literal(" MISSING"));
// 480 F: NEWLINE
U_1000:;
_imp_NEWLINE();
// 481 %EXIT %IF STREAM = LISTING
if (STREAM != 1) goto L_0023;
goto L_0024;
L_0023:;
// 482 STREAM = LISTING; SELECTOUTPUT(LISTING)
STREAM = 1;
_imp_SELECTOUTPUT(1);
// 483 %REPEAT
goto L_0016;
L_0024:;
// 484 MARGIN = MARGIN+POS %AND SPACES(MARGIN+8) %IF SYM # NL
if (SYM == 10) goto L_0025;
MARGIN = MARGIN + POS;
_imp_SPACES(MARGIN + 8);
L_0025:;
// 485 POS = 0; OUT = 0
POS = 0;
OUT = 0;
// 486 %SIGNAL 0,10 %IF N >= 20
if (N < 20) goto L_0026;
_imp_signal(0, 10, 0, "");
L_0026:;
// 487 %END
return;
case_FM_dispatch:
if (FM_index < -1 || FM_index > 24)
_imp_signalf(6, 3, FM_index, "->FM(%d) out of bounds at %s line %d", FM_index, FM_file, FM_line);
goto *FM[FM_index - -1];
case_FM_missing:
_imp_signalf(8, 2, FM_index, "switch jump to undefined label FM(%d): at %s line %d", FM_index, FM_file, FM_line);
} /* end of FAULT */
// 488
// 489 ! ---- 'C GEN' DEPENDS ON A 32-BIT WORD ----
// 490 %ROUTINE C GEN(%INTEGER N)
void CGEN(int N) {
// 491 %INTEGER J, M, L
int J;
int M;
int L;
// 492 M = N; N = |M|
M = N;
N = _imp_IMOD(M);
// 493 %IF N>>16 = 0 %THEN L = 4 %ELSE L = 8
if ((unsigned int)N >> 16 != 0) goto L_0027;
L = 4;
goto L_0028;
L_0027:;
L = 8;
L_0028:;
// 494 PUT('N'); PUT(L+1+'0'); PUT(','); PUT('Y')
PUT(78);
PUT(L + 1 + 48);
PUT(44);
PUT(89);
// 495 PUT( (N>>J)&15+'A' ) %FOR J = (L-1)*4, -4, 0
// %for J = (L - 1) * 4, -4, 0 %cycle
{
int _initial = (L - 1) * 4;
if (invalid_for_loop(_initial, -4, 0)) _imp_signal(5, 1, 0, "Illegal cycle J = (L - 1) * 4, -4, 0");
J = _initial - (-4);
L_0029:
if (J == 0) goto L_002A;
J -= 4;
PUT(((unsigned int)N >> J & 15) + 65);
goto L_0029;
}
L_002A:;
// 496 PUT('U') %IF M < 0
if (M >= 0) goto L_002B;
PUT(85);
L_002B:;
// 497 LIT = CODE
LIT = CODE;
// 498 %END
return;
} /* end of CGEN */
// 499 %INTEGERFN EVAL(%INTEGER P)
int EVAL(int P) {
// 500 %CONSTBYTEINTEGERARRAY BASIS('V' : 'Z')=3,1,8,4,0
const unsigned char BASIS[5] = {3, 1, 8, 4, 0};
struct _imp_dv BASIS_dv = {BASIS, sizeof(unsigned char) /*, dims, <bounds> */};
// 501 %INTEGER N, J, B, S, L, MOD
int N;
int J;
int B;
int S;
int L;
int MOD;
// 502 N=0
N = 0;
// 503 %RESULT = DICT(-P) %IF P < 0
if (P >= 0) goto L_002C;
return DICT[-P];
L_002C:;
// 504 L=BUFFER(P); %RESULT=0 %IF L=0 %OR L=1
L = BUFFER[P - 1];
if (L == 0) goto L_000B;
if (L != 1) goto L_002D;
L_000B:;
return 0;
L_002D:;
// 505 B=BUFFER(P-1); %RESULT=B %IF L < 0
B = BUFFER[P - 1 - 1];
if (L >= 0) goto L_002E;
return B;
L_002E:;
// 506 B=BASIS(B)
B = BASIS[B - 86];
// 507 MOD='A'; MOD=0 %IF B=8
MOD = 65;
if (B != 8) goto L_002F;
MOD = 0;
L_002F:;
// 508 %CYCLE J=P-2,-1,P-L
// %for J = P - 2, -1, P - L %cycle
{
int _initial = P - 2, _final = P - L;
if (invalid_for_loop(_initial, -1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = P - 2, -1, P - L");
J = _initial - (-1);
L_0030:
if (J == _final) goto L_0031;
J -= 1;
// 509 S=BUFFER(J)-MOD
S = BUFFER[J - 1] - MOD;
// 510 %IF B=0 %THEN N=N*10 %ELSE N=N<<B
if (B != 0) goto L_0033;
N = N * 10;
goto L_0034;
L_0033:;
N = N << B;
L_0034:;
// 511 N=N+S
N = N + S;
// 512 %REPEAT
goto L_0030;
}
L_0031:;
// 513 %RESULT=N
return N;
// 514 %END
} /* end of EVAL */
// 515
// 516 %ROUTINE COMPILE BLOCK(%INTEGER LEVEL, BLOCK TYPE, %C
void COMPILEBLOCK(int LEVEL, int BLOCKTYPE, int *FPP) {
// 517+ %INTEGERNAME FPP)
// 518 %INTEGER J, K, XX, COUNT, ACCESS = 0
int J;
int K;
int XX;
int COUNT;
int ACCESS;
ACCESS = 0;
// 519 %INTEGER FP; ! START OF FORMAT
int FP;
// 520 %INTEGER FORMAT; ! CURRENT FORMAT POINTER
int FORMAT;
// 521 %INTEGER A CHAIN; ! ARRAY CHAIN
int ACHAIN;
// 522 %INTEGER OLD LABEL
int OLDLABEL;
// 523 %INTEGER APARM, OLD T BASE, OLD T LIMIT
int APARM;
int OLDTBASE;
int OLDTLIMIT;
// 524 %OWNINTEGER SPEC=1
static int SPEC = 1;
// 525 OLD T BASE=T BASE
OLDTBASE = TBASE;
// 526 T BASE=T MAX
TBASE = TMAX;
// 527 OLD T LIMIT=T LIMIT; OLD LABEL = LABEL
OLDTLIMIT = TLIMIT;
OLDLABEL = LABEL;
// 528 INHIBIT = INHIBIT<<1
INHIBIT = INHIBIT << 1;
// 529
// 530 %ROUTINE DEF LAB(%INTEGER L)
void DEFLAB(int L) {
// 531 INHIBIT = INHIBIT!1
INHIBIT = INHIBIT | 1;
// 532 PUT(':'); ADDR(L)
PUT(58);
ADDR(L);
// 533 ACCESS = 1
ACCESS = 1;
// 534 %END
return;
} /* end of DEFLAB */
// 535 %ROUTINE ANALYSE SS(%INTEGER CONT)
void ANALYSESS(int CONT) {
// 536 %INTEGER CLASS; ! CLASS OF ATOM WANTED
int CLASS;
// 537 %INTEGER LIM; ! LOOKUP LIMIT
int LIM;
// 538 %OWNINTEGER TAG=0; ! CURRENT VAR TAG
static int TAG = 0;
// 539 %OWNINTEGER DELIM = '"'
static int DELIM = 34;
// 540 %OWNINTEGER QUOTE=0; ! TEXT MODE FLAG
static int QUOTE = 0;
// 541 %OWNINTEGER KEY=0; ! SYMBOL DICT KEY
static int KEY = 0;
// 542
// 543 %ROUTINE DECLARE IDEN
void DECLAREIDEN(void) {
// 544 %INTEGER EXTRA, FF
int EXTRA;
int FF;
// 545 %INTEGERNAME FLAG
int *FLAG;
// 546 %IF SUBATOM#0 %START; ! ALREADY EXISTS
if (SUBATOM == 0) goto L_0035;
// 547 FLAG == DICT(SUBATOM)
FLAG = (int *)/*?*/ &DICT[SUBATOM];
// 548 TAG=DICT(SUBATOM-1)
TAG = DICT[SUBATOM - 1];
// 549 %IF FLAG&1024#0 %START; ! SPEC GIVEN
if (*FLAG & 1024 == 0) goto L_0036;
// 550 %IF TAG&15=3 %START; ! LABEL REF
if (TAG & 15 != 3) goto L_0037;
// 551 FLAG=FLAG!!1024 %IF DECTYPE=3
if (DECTYPE != 3) goto L_0038;
*FLAG = *FLAG ^ 1024;
L_0038:;
// 552 %RETURN
return;
// 553 %FINISH
L_0037:;
// 554 %IF DECTYPE = TAG&(\128) %OR DECTYPE=1 %START;! SAME TYPE
if (DECTYPE == TAG & (~128)) goto L_001B;
if (DECTYPE != 1) goto L_0039;
L_001B:;
// 555 %IF (7 <= TAG&15 <= 10 %AND SPEC > 0) %C
{
// Double-sided test on TAG & 15 (Part I)
int tmp;
if (7 > (tmp = TAG & 15)) goto L_003A;
// Double-sided test on TAG & 15 (Part II)
if (tmp > 10) goto L_003A;
}
if (SPEC > 0) goto L_003B;
L_003A:;
if (TAG & 15 == 4) goto L_003B;
if (DECTYPE != 1) goto L_003C;
L_003B:;
// 556+ %OR TAG&15 = 4 %OR DECTYPE=1 %START; ! VALID REDEFINITION
// 557 FLAG = FLAG!!1024; ! REMOVE SPEC BIT
*FLAG = *FLAG ^ 1024;
// 558 DECTYPE = TAG&(\128)
DECTYPE = TAG & (~128);
// 559 %RETURN
return;
// 560 %FINISH
L_003C:;
// 561 %FINISH
L_0039:;
// 562 %FINISH
L_0036:;
// 563 DUP=ATOM POS %IF DUP=0
if (DUP != 0) goto L_003D;
DUP = ATOMPOS;
L_003D:;
// 564 %RETURN %IF DECTYPE=0; ! LABEL
if (DECTYPE != 0) goto L_003E;
return;
L_003E:;
// 565 %FINISH
L_0035:;
// 566 EXTRA=DP; ! APP + FORMAT
EXTRA = DP;
// 567 TAG=DECTYPE
TAG = DECTYPE;
// 568 FF=0
FF = 0;
// 569 %IF DECTYPE = 0 %START
if (DECTYPE != 0) goto L_003F;
// 570 TAG = 3; FF = 1024
TAG = 3;
FF = 1024;
// 571 %ELSE
goto L_0040;
L_003F:;
// 572 FF = FF!SPREFIX<<13
FF = FF | SPREFIX << 13;
// 573 %FINISH
L_0040:;
// 574 %IF TAG&15 >= 7 %START; ! APP NEEDED
if (TAG & 15 < 7) goto L_0041;
// 575 FF = FF!1024 %IF SSTYPE = 2 %AND TAG&15 <= 10
if (SSTYPE != 2) goto L_0042;
if (TAG & 15 > 10) goto L_0042;
FF = FF | 1024;
L_0042:;
// 576 CONST INT = 0
CONSTINT = 0;
// 577 %UNLESS 11#TAG&15#13 %START
{
// Double-sided test on TAG & 15 (Part I)
int tmp;
if (11 == (tmp = TAG & 15)) goto L_0043;
// Double-sided test on TAG & 15 (Part II)
if (tmp != 13) goto L_0044;
}
L_0043:;
// 578 %IF SPREFIX=1 %OR SPREFIX=2 %C
if (SPREFIX == 1) goto L_0045;
if (SPREFIX != 2) goto L_0046;
L_0045:;
DICT[DP] = APP;
goto L_0047;
L_0046:;
// 579+ %THEN DICT(DP)=APP %ELSE %START
// 580 APARM=1; DICT(DP)=A CHAIN
APARM = 1;
DICT[DP] = ACHAIN;
// 581 A CHAIN=DP
ACHAIN = DP;
// 582 %FINISH
L_0047:;
// 583 %FINISH %ELSE DICT(DP)=0
goto L_0048;
L_0044:;
DICT[DP] = 0;
L_0048:;
// 584 DP=DP+1; FF=FF!256; ! SET APP BIT
DP = DP + 1;
FF = FF | 256;
// 585 FF=FF!1024 %IF SPEC < 0 %AND SPREFIX < 3
if (SPEC >= 0) goto L_0049;
if (SPREFIX >= 3) goto L_0049;
FF = FF | 1024;
L_0049:;
// 586 %FINISH
L_0041:;
// 587 %IF TAG&X'70'=X'50' %START; ! RECORD
if (TAG & 112 != 80) goto L_004A;
// 588 DICT(DP)=FORMAT; DP=DP+1
DICT[DP] = FORMAT;
DP = DP + 1;
// 589 FF=FF!512; ! SET FORMAT BIT
FF = FF | 512;
// 590 %FINISH
L_004A:;
// 591 %IF TAG&15=6 %START; ! SWITCH
if (TAG & 15 != 6) goto L_004B;
// 592 DICT(DP)=0
DICT[DP] = 0;
// 593 DP=DP+1
DP = DP + 1;
// 594 %FINISH
L_004B:;
// 595 TAG = TAG!128 %IF SPREFIX > 3 %OR PERMIN# 0
if (SPREFIX > 3) goto L_0032;
if (PERMIN == 0) goto L_004C;
L_0032:;
TAG = TAG | 128;
L_004C:;
// 596 %IF CONST INT # 0 %START
if (CONSTINT == 0) goto L_004D;
// 597 DICT(DP) = 0; DP = DP+1
DICT[DP] = 0;
DP = DP + 1;
// 598 TAG = TAG&X'FFF0'+5
TAG = (TAG & 65520) + 5;
// 599 %FINISH
L_004D:;
// 600 EXTRA=DP-EXTRA; ! 1=APP, 2=APP+FORMAT, 0=NEITH
EXTRA = DP - EXTRA;
// 601 DICT(DP) = TAG; TYPE=TAG>>4&7
DICT[DP] = TAG;
TYPE = (unsigned int)TAG >> 4 & 7;
// 602 DP=DP+1
DP = DP + 1;
// 603 DICT(DP) = FF!(DP-T MAX-2)!EXTRA<<11
DICT[DP] = FF | DP - TMAX - 2 | EXTRA << 11;
// 604 SUBATOM=DP; TMAX=DP+1
SUBATOM = DP;
TMAX = DP + 1;
// 605 X=DP
X = DP;
// 606 %END
return;
} /* end of DECLAREIDEN */
// 607
// 608 %ROUTINE READ SYM
void READSYM(void) {
// 609 %IF SYM<32 %START
if (SYM >= 32) goto L_004E;
// 610 LINE NUM = LINE NUM+1
LINENUM = LINENUM + 1;
// 611 ATOM POS = 0; POS = 0; MARGIN = 0
ATOMPOS = 0;
POS = 0;
MARGIN = 0;
// 612 %IF LIST = 0 %START
if (LIST != 0) goto L_004F;
// 613 WRITE(LINE NUM, 5)
_imp_WRITE(LINENUM, 5);
// 614 %IF QUOTE # 0 %THEN PRINT SYMBOL('"') %ELSE %START
if (QUOTE == 0) goto L_0050;
_imp_PRINTSYMBOL(34);
goto L_0051;
L_0050:;
// 615 PRINT SYMBOL(MARK); MARK = ' '
_imp_PRINTSYMBOL(MARK);
MARK = 32;
// 616 %FINISH
L_0051:;
// 617 SPACE
_imp_SPACE();
// 618 %FINISH
L_004F:;
// 619 SYM TYPE=1
SYMTYPE = 1;
// 620 %FINISH
L_004E:;
// 621 %CYCLE
L_0052:;
// 622 %CYCLE
L_0053:;
// 623 READSYMBOL(SYM)
_imp_READSYMBOL(/*?*/ &SYM);
// 624 %IF SYM = PAGE %START
if (SYM != 12) goto L_0054;
// 625 LINES = 0 %AND %CONTINUE %IF QUOTE = 0
if (QUOTE != 0) goto L_0055;
LINES = 0;
goto L_0056;
L_0055:;
// 626 LINES = PAGE SIZE
LINES = 64;
// 627 %FINISH
L_0054:;
// 628 PRINTSYMBOL(SYM) %IF LIST = 0
if (LIST != 0) goto L_0057;
_imp_PRINTSYMBOL(SYM);
L_0057:;
// 629 POS=POS+1 %AND LINE(POS)=SYM %UNLESS POS >= 73
if (POS >= 73) goto L_0058;
POS = POS + 1;
LINE[POS - 1] = SYM;
L_0058:;
// 630 %RETURN %IF QUOTE#0
if (QUOTE == 0) goto L_0059;
return;
L_0059:;
// 631 %EXIT %IF SYM#' '
if (SYM == 32) goto L_005A;
goto L_005B;
L_005A:;
// 632 SYM TYPE=1
SYMTYPE = 1;
// 633 %REPEAT
L_0056:;
goto L_0053;
L_005B:;
// 634 %EXIT %UNLESS SYM='%'
if (SYM == 37) goto L_005C;
goto L_005D;
L_005C:;
// 635 SYM TYPE=2
SYMTYPE = 2;
// 636 %REPEAT
goto L_0052;
L_005D:;
// 637 %IF SYM<32 %THEN SYMTYPE=0 %AND MARK='+' %ELSE %START
if (SYM >= 32) goto L_005E;
SYMTYPE = 0;
MARK = 43;
goto L_005F;
L_005E:;
// 638 SYM=SYM-32 %IF 'A'+32 <= SYM <= 'Z'+32; ! ...CONVERT LOWER CASE
{
// Double-sided test on SYM (Part I)
int tmp;
if (65 + 32 > (tmp = SYM)) goto L_0060;
// Double-sided test on SYM (Part II)
if (tmp > 90 + 32) goto L_0060;
}
SYM = SYM - 32;
L_0060:;
// 639 KEY=KDICT(SYM)
KEY = KDICT[SYM - 32];
// 640 SYM TYPE=KEY&3-2 %UNLESS KEY&3=0 %AND SYMTYPE=2
if (KEY & 3 != 0) goto L_0061;
if (SYMTYPE == 2) goto L_0062;
L_0061:;
SYMTYPE = (KEY & 3) - 2;
L_0062:;
// 641 %FINISH
L_005F:;
// 642 %END
return;
} /* end of READSYM */
// 643
// 644 %ROUTINE LOOKUP(%INTEGER P)
void LOOKUP(int P) {
// 645 %INTEGER OLD, NEW, L, DISP, D, SIZE, FIRST
int OLD;
int NEW;
int L;
int DISP;
int D;
int SIZE;
int FIRST;
// 646 COUNT=0; SIZE = DP-TMAX+1; FIRST = DICT(T MAX)
COUNT = 0;
SIZE = DP - TMAX + 1;
FIRST = DICT[TMAX];
// 647 %WHILE P > LIM %CYCLE
L_0063:;
if (P <= LIM) goto L_0064;
// 648 COUNT = COUNT-1
COUNT = COUNT - 1;
// 649 P=P-1
P = P - 1;
// 650 D=DICT(P)
D = DICT[P];
// 651 DISP=D&255+2
DISP = (D & 255) + 2;
// 652 L=D>>11&3; OLD=P-DISP; X=P; P=OLD
L = (unsigned int)D >> 11 & 3;
OLD = P - DISP;
X = P;
P = OLD;
// 653 %IF SIZE+L-DISP=0 %AND DICT(OLD) = FIRST %START
if (SIZE + L - DISP != 0) goto L_0065;
if (DICT[OLD] != FIRST) goto L_0065;
// 654 NEW=T MAX
NEW = TMAX;
// 655 %CYCLE
L_0066:;
// 656 NEW = NEW+1; OLD = OLD+1
NEW = NEW + 1;
OLD = OLD + 1;
// 657 %IF NEW=DP %START; ! FOUND IT
if (NEW != DP) goto L_0067;
// 658 O TYPE = D>>13
OTYPE = (unsigned int)D >> 13;
// 659 TAG = DICT(X-1)
TAG = DICT[X - 1];
// 660 ATOM2=CMAP(TAG&15); ! FORM -> CLASS
ATOM2 = CMAP[TAG & 15];
// 661 SUB ATOM=X; VAR TYPE=TAG>>4&7
SUBATOM = X;
VARTYPE = (unsigned int)TAG >> 4 & 7;
// 662 ATOM2 = 66 %IF VARTYPE = 0 %AND ATOM2 = 68
if (VARTYPE != 0) goto L_0068;
if (ATOM2 != 68) goto L_0068;
ATOM2 = 66;
L_0068:;
// 663 ATOM1 = ATOM2 %AND SUBATOM = -OLD %IF ATOM2 = ICONST
if (ATOM2 != 83) goto L_0069;
ATOM1 = ATOM2;
SUBATOM = -OLD;
L_0069:;
// 664 %IF D&256#0 %START; ! SET APP
if (D & 256 == 0) goto L_006A;
// 665 PAPP=|DICT(OLD)|
*PAPP = _imp_IMOD(DICT[OLD]);
// 666 %IF PAPP=0 %START
if (*PAPP != 0) goto L_006B;
// 667 %IF 11 <= TAG&15 <= 12 %START
{
// Double-sided test on TAG & 15 (Part I)
int tmp;
if (11 > (tmp = TAG & 15)) goto L_006C;
// Double-sided test on TAG & 15 (Part II)
if (tmp > 12) goto L_006C;
}
// 668 PAPP=PHRASE(ANAPP)
*PAPP = PHRASE[28];
// 669 APARM=OLD<<3+1; ! 1 DIMEN
APARM = (OLD << 3) + 1;
// 670 %ELSE
goto L_006D;
L_006C:;
// 671 F TYPE=8
FTYPE = 8;
// 672 %RETURN %IF SPEC < 0
if (SPEC >= 0) goto L_006E;
return;
L_006E:;
// 673 ATOM1=0; ATOM2=0
ATOM1 = 0;
ATOM2 = 0;
// 674 %FINISH
L_006D:;
// 675 %FINISH
L_006B:;
// 676 OLD=OLD+1
OLD = OLD + 1;
// 677 %FINISH %ELSE PAPP=APP; ! DEFAULT APP
goto L_006F;
L_006A:;
*PAPP = APP;
L_006F:;
// 678 FORMAT=0
FORMAT = 0;
// 679 %IF D&512#0 %START
if (D & 512 == 0) goto L_0070;
// 680 %IF ATOM2=RFN %THEN FORMAT=SUBATOM %ELSE %START
if (ATOM2 != 65) goto L_0071;
FORMAT = SUBATOM;
goto L_0072;
L_0071:;
// 681 FORMAT=DICT(DICT(OLD)-2)
FORMAT = DICT[DICT[OLD] - 2];
// 682 ATOM2=ATOM2+7
ATOM2 = ATOM2 + 7;
// 683 %FINISH
L_0072:;
// 684 %FINISH
L_0070:;
// 685 DICT(X-1)=DICT(X-1)!128 %UNLESS SPEC < 0
if (SPEC < 0) goto L_0073;
DICT[X - 1] = DICT[X - 1] | 128;
L_0073:;
// 686 SUBATOM=COUNT %IF LIM > T MAX
if (LIM <= TMAX) goto L_0074;
SUBATOM = COUNT;
L_0074:;
// 687 %RETURN
return;
// 688 %FINISH
L_0067:;
// 689 %EXIT %IF DICT(NEW) # DICT(OLD)
if (DICT[NEW] == DICT[OLD]) goto L_0075;
goto L_0076;
L_0075:;
// 690 %REPEAT
goto L_0066;
L_0076:;
// 691 %FINISH
L_0065:;
// 692 %REPEAT
goto L_0063;
L_0064:;
// 693 %END
return;
} /* end of LOOKUP */
// 694
// 695 %ROUTINE CODE DIGIT
void CODEDIGIT(void) {
// 696 %IF LIMIT=0 %START; ! MULTI CHAR
if (LIMIT != 0) goto L_0077;
// 697 DIGIT = SYM
DIGIT = SYM;
// 698 %IF DIGIT = '''' %START
if (DIGIT != 39) goto L_0078;
// 699 QUOTE = 0
QUOTE = 0;
// 700 READSYM
READSYM();
// 701 DIGIT = -1 %AND %RETURN %UNLESS SYM = ''''
if (SYM == 39) goto L_0079;
DIGIT = -1;
return;
L_0079:;
// 702 QUOTE = 1
QUOTE = 1;
// 703 %FINISH
L_0078:;
// 704 READSYM
READSYM();
// 705 %ELSE
goto L_007A;
L_0077:;
// 706 %IF '0' <= SYM <= '9' %OR 'A' <= SYM <= 'F' %START
{
// Double-sided test on SYM (Part I)
int tmp;
if (48 > (tmp = SYM)) goto L_007B;
// Double-sided test on SYM (Part II)
if (tmp <= 57) goto L_007C;
}
L_007B:;
{
// Double-sided test on SYM (Part I)
int tmp;
if (65 > (tmp = SYM)) goto L_007D;
// Double-sided test on SYM (Part II)
if (tmp > 70) goto L_007D;
}
L_007C:;
// 707 %IF SYM <= '9' %THEN DIGIT = SYM-'0' %C
if (SYM > 57) goto L_007E;
DIGIT = SYM - 48;
goto L_007F;
L_007E:;
DIGIT = SYM - 65 + 10;
L_007F:;
// 708+ %ELSE DIGIT = SYM-'A'+10
// 709 %IF DIGIT <= LIMIT %START
if (DIGIT > LIMIT) goto L_0080;
// 710 DIGIT = DIGIT+'A'
DIGIT = DIGIT + 65;
// 711 READ SYM
READSYM();
// 712 %RETURN
return;
// 713 %FINISH
L_0080:;
// 714 %FINISH
L_007D:;
// 715 DIGIT=0; QUOTE=0
DIGIT = 0;
QUOTE = 0;
// 716 %IF SYM='''' %START
if (SYM != 39) goto L_0081;
// 717 %IF LIMIT # 9 %START
if (LIMIT == 9) goto L_0082;
// 718 DIGIT = -1; READSYM
DIGIT = -1;
READSYM();
// 719 %FINISH
L_0082:;
// 720 %FINISH
L_0081:;
// 721 %FINISH
L_007A:;
// 722 %END
return;
} /* end of CODEDIGIT */
// 723
// 724 %ROUTINE CODE ATOM
void CODEATOM(void) {
// 725 %INTEGER TP
int TP;
// 726 %ROUTINE TPUT(%INTEGER S)
void TPUT(int S) {
// 727 POS = 0 %IF S < 32
if (S >= 32) goto L_0083;
POS = 0;
L_0083:;
// 728 FAULT(20) %IF TP = TEXT LIMIT
if (TP != 255) goto L_0084;
FAULT(20);
L_0084:;
// 729 TP = TP+1; BUFFER(LITPOS-TP) = S
TP = TP + 1;
BUFFER[LITPOS - TP - 1] = S;
// 730 %END
return;
} /* end of TPUT */
// 731 %INTEGERNAME SS
int *SS;
// 732 %INTEGER DTYPE, XTYPE, SRMOD, SLEN, PREFIX
int DTYPE;
int XTYPE;
int SRMOD;
int SLEN;
int PREFIX;
// 733 %INTEGER J, K, L, S, LP
int J;
int K;
int L;
int S;
int LP;
// 734 %CONSTBYTEINTEGERARRAY BASE SYM(1 : 4)= 'X', 'M', 'B', 'K'
const unsigned char BASESYM[4] = {88, 77, 66, 75};
struct _imp_dv BASESYM_dv = {BASESYM, sizeof(unsigned char) /*, dims, <bounds> */};
// 735 %CONSTSHORTINTEGERARRAY BASE INF(1:4)=
const short int BASEINF[4] = {22799, 22528, 22273, 22023};
struct _imp_dv BASEINF_dv = {BASEINF, sizeof(short int) /*, dims, <bounds> */};
// 736+ X'590F',X'5800',X'5701',X'5607'
// 737 %CONSTSHORTINTEGER SPS=117; ! START OF SPEC SUB
// 738 %CONSTBYTEINTEGERARRAY SPEC SUB(SPS : 127)=%C
const unsigned char SPECSUB[11] = {8, 9, 10, 7, 105, 104, 25, 24, 72, 73, 1};
struct _imp_dv SPECSUB_dv = {SPECSUB, sizeof(unsigned char) /*, dims, <bounds> */};
// 739+ 8,9,10,7,105,104,25,24,72,73,1
// 740 %CONSTSHORTINTEGERARRAY P VALUE(0 : 10)=%C
const short int PVALUE[11] = {0, [1 ... 2] = 6183, 4199, [4 ... 5] = 295, 4263, 167, 9240, 17432, 8728};
struct _imp_dv PVALUE_dv = {PVALUE, sizeof(short int) /*, dims, <bounds> */};
// 741+ 0,
// 742+ X'1827'(2), X'1067', X'0127'(2),X'10A7',
// 743+ X'00A7',X'2418',X'4418',
// 744+ X'2218'
// 745 %CONSTSHORTINTEGERARRAY SATOMS(1 : 12) =
const short int SATOMS[12] = {53, 14389, 12856, 50, 14389, 51, 14389, 51, 14389, 14389, 12856, 50};
struct _imp_dv SATOMS_dv = {SATOMS, sizeof(short int) /*, dims, <bounds> */};
// 746+ ! SPEC, NAME, MAP, MAPSPEC, <NULL>,
// 747+ X'0035', X'3835', X'3238', X'0032', X'3835',
// 748+ ! ARRAY ARRAYNAME ARRAYSPEC NAMESPEC ARRAYNAMESPEC,
// 749+ X'0033', X'3835', X'0033', X'3835', X'3835',
// 750+ ! FN, FNSPEC
// 751+ X'3238', X'0032'
// 752
// 753 %CONSTBYTEINTEGERARRAY SCLASS(1 : 12) =
const unsigned char SCLASS[12] = {109, 2, 9, 118, 1, 11, 12, 111, 110, 112, 8, 117};
struct _imp_dv SCLASS_dv = {SCLASS, sizeof(unsigned char) /*, dims, <bounds> */};
// 754+ ! SPEC, NAME, MAP, MAPSPEC, <NULL>,
// 755+ 109, 2, 9, 118, 1,
// 756+ ! ARRAY, ARRAYNAME,ARRAYSPEC,NAMESPEC, ARRAYNAMESPEC,
// 757+ 11, 12, 111, 110, 112,
// 758+ ! FN, FNSPEC
// 759+ 8, 117
// 760 %CONSTINTEGER XSPS = 109
// 761 %CONSTINTEGERARRAY XMOD(XSPS : 116) = 17,18,27,28,97,98,107,108
const int XMOD[8] = {17, 18, 27, 28, 97, 98, 107, 108};
struct _imp_dv XMOD_dv = {XMOD, sizeof(int) /*, dims, <bounds> */};
// 762 LP=LIT POS
LP = LITPOS;
// 763 ATOM POS=POS; LAST=ATOM1
ATOMPOS = POS;
LAST = ATOM1;
// 764 %IF QUOTE#0 %START; ! CONTINUATION OF STRING CONST
if (QUOTE == 0) goto L_0085;
// 765 TP=0
TP = 0;
// 766 TPUT(QUOTE>>8); TPUT(QUOTE&255)
TPUT((unsigned int)QUOTE >> 8);
TPUT(QUOTE & 255);
// 767 %CYCLE
L_0086:;
// 768 READSYM
READSYM();
// 769 %IF SYM= DELIM %START
if (SYM != DELIM) goto L_0087;
// 770 QUOTE=0
QUOTE = 0;
// 771 READSYM; %EXIT %IF SYM# DELIM
READSYM();
if (SYM == DELIM) goto L_0088;
goto L_0089;
L_0088:;
// 772 QUOTE=1
QUOTE = 1;
// 773 %FINISH
L_0087:;
// 774 TPUT(SYM)
TPUT(SYM);
// 775 %REPEAT
goto L_0086;
L_0089:;
// 776 BUFFER(LIT POS)=TP
BUFFER[LITPOS - 1] = TP;
// 777 LITPOS=LITPOS-TP-1
LITPOS = LITPOS - TP - 1;
// 778 %FINISH
L_0085:;
// 779 SLEN=0; XTYPE=0; SRMOD=0; PREFIX=0
SLEN = 0;
XTYPE = 0;
SRMOD = 0;
PREFIX = 0;
// 780 %CYCLE
L_008A:;
// 781 ATOM1=0; ATOM2=0; SUB ATOM=0; TAG=0
ATOM1 = 0;
ATOM2 = 0;
SUBATOM = 0;
TAG = 0;
// 782 ATOM1=TERMIN %AND %RETURN %IF SYMTYPE=0
if (SYMTYPE != 0) goto L_008B;
ATOM1 = 13;
return;
L_008B:;
// 783 %IF SYMTYPE=-1 %START; ! DIGIT
if (SYMTYPE != -1) goto L_008C;
// 784 %UNLESS (LAST=0 %AND OUT=0) %OR LAST=8%START
if (LAST != 0) goto L_008D;
if (OUT == 0) goto L_008E;
L_008D:;
if (LAST == 8) goto L_008E;
// 785 LIMIT=9; DIGIT='Z'
LIMIT = 9;
DIGIT = 90;
// 786 NEW BASE: ATOM1=ICONST; ATOM2 = ICONST
U_1002:;
ATOM1 = 83;
ATOM2 = 83;
// 787 %CYCLE
L_008F:;
// 788 LIT POS=LIT POS-1
LITPOS = LITPOS - 1;
// 789 BUFFER(LIT POS)=DIGIT
BUFFER[LITPOS - 1] = DIGIT;
// 790 CODE DIGIT
CODEDIGIT();
// 791 %IF DIGIT <= 0 %START
if (DIGIT > 0) goto L_0090;
// 792 %IF LIMIT = 9 %AND SYM = '.' %AND ATOM1 = ICONST %START
if (LIMIT != 9) goto L_0091;
if (SYM != 46) goto L_0091;
if (ATOM1 != 83) goto L_0091;
// 793 DIGIT = '.'
DIGIT = 46;
// 794 ATOM1 = RCONST; ATOM2 = RCONST
ATOM1 = 84;
ATOM2 = 84;
// 795 LP = LP-1
LP = LP - 1;
// 796 READ SYM
READSYM();
// 797 %ELSE
goto L_0092;
L_0091:;
// 798 ATOM1=0 %IF LIMIT#9 %AND DIGIT=0
if (LIMIT == 9) goto L_0093;
if (DIGIT != 0) goto L_0093;
ATOM1 = 0;
L_0093:;
// 799 BUFFER(LP)=LP-LITPOS
BUFFER[LP - 1] = LP - LITPOS;
// 800 LIT POS=LIT POS-1
LITPOS = LITPOS - 1;
// 801 SUBATOM=LP
SUBATOM = LP;
// 802 FAULT(23) %IF LITPOS <= 0
if (LITPOS > 0) goto L_0094;
FAULT(23);
L_0094:;
// 803 %RETURN
return;
// 804 %FINISH
L_0092:;
// 805 %FINISH
L_0090:;
// 806 %REPEAT
goto L_008F;
// 807 %FINISH
L_008E:;
// 808 %FINISH
L_008C:;
// 809 %IF SYM TYPE < 0 %START; ! LETTER
if (SYMTYPE >= 0) goto L_0095;
// 810 DP=T MAX
DP = TMAX;
// 811 OLD SYM=SYM
OLDSYM = SYM;
// 812 ! ---- THE FOLLOWING PACKING ROUTINE IS WORD-LENGTH DEPENDENT BUT CAN
// 813 ! BE MODIFIED WITH NO OTHER SIDE-EFFECTS PROVIDED COMPLEMENTARY
// 814 ! ALTERATIONS ARE MADE TO 'UNPACK' IN ROUTINE 'PRINT NAME' ----
// 815 %CYCLE
L_0096:;
// 816 SS == DICT(DP)
SS = (int *)/*?*/ &DICT[DP];
// 817 SS = SYM-32
*SS = SYM - 32;
// 818 READ SYM; %EXIT %IF SYM TYPE >= 0
READSYM();
if (SYMTYPE < 0) goto L_0097;
goto L_0098;
L_0097:;
// 819 OLD SYM=0
OLDSYM = 0;
// 820 SS = (SS<<6) + (SYM-32)
*SS = (*SS << 6) + (SYM - 32);
// 821 READ SYM; %EXIT %IF SYM TYPE >= 0
READSYM();
if (SYMTYPE < 0) goto L_0099;
goto L_0098;
L_0099:;
// 822 SS = (SS<<6) + (SYM-32)
*SS = (*SS << 6) + (SYM - 32);
// 823 READ SYM; %EXIT %IF SYM TYPE >= 0
READSYM();
if (SYMTYPE < 0) goto L_009A;
goto L_0098;
L_009A:;
// 824 SS = (SS<<6) + (SYM-32)
*SS = (*SS << 6) + (SYM - 32);
// 825 READ SYM; %EXIT %IF SYM TYPE >= 0
READSYM();
if (SYMTYPE < 0) goto L_009B;
goto L_0098;
L_009B:;
// 826 SS = (SS<<6) + (SYM-32)
*SS = (*SS << 6) + (SYM - 32);
// 827 READ SYM; %EXIT %IF SYM TYPE >= 0
READSYM();
if (SYMTYPE < 0) goto L_009C;
goto L_0098;
L_009C:;
// 828 DP=DP+1
DP = DP + 1;
// 829 %REPEAT
goto L_0096;
L_0098:;
// 830 %IF SYM='''' %AND OLD SYM # 0 %START
if (SYM != 39) goto L_009D;
if (OLDSYM == 0) goto L_009D;
// 831 DELIM = ''''
DELIM = 39;
// 832 %CYCLE J=1,1,4
// %for J = 1, 1, 4 %cycle
{
J = 0;
L_009E:
if (J == 4) goto L_009F;
J += 1;
// 833 %IF OLD SYM=BASE SYM(J) %START
if (OLDSYM != BASESYM[J - 1]) goto L_00A1;
// 834 QUOTE = 1
QUOTE = 1;
// 835 K=BASE INF(J)
K = BASEINF[J - 1];
// 836 DIGIT=K>>8; LIMIT=K&255
DIGIT = (unsigned int)K >> 8;
LIMIT = K & 255;
// 837 READSYM
READSYM();
// 838 -> NEW BASE
goto U_1002;
// 839 %FINISH
L_00A1:;
// 840 %REPEAT
goto L_009E;
}
L_009F:;
// 841 %FINISH
L_009D:;
// 842 DP=DP+1
DP = DP + 1;
// 843 FAULT(21) %IF DP >= T LIMIT
if (DP < TLIMIT) goto L_00A2;
FAULT(21);
L_00A2:;
// 844 ATOM1=IDENT; ATOM2=IDENT
ATOM1 = 59;
ATOM2 = 59;
// 845 LIM=T BASE; LOOKUP(T MAX)
LIM = TBASE;
LOOKUP(TMAX);
// 846 %RETURN
return;
// 847 %FINISH
L_0095:;
// 848 %IF SYM='''' %OR SYM = '"' %START
if (SYM == 39) goto L_00A3;
if (SYM != 34) goto L_00A4;
L_00A3:;
// 849 DELIM = SYM
DELIM = SYM;
// 850 QUOTE=1; ! INTO TEXT MODE
QUOTE = 1;
// 851 ATOM1=SCONST; ! SYMBOL, OR
ATOM1 = 82;
// 852 ATOM2=ICONST; ! STRING
ATOM2 = 83;
// 853 READSYM; SUB ATOM=SYM; ! FIRST CHAR
READSYM();
SUBATOM = SYM;
// 854 QUOTE=0 %IF SUBATOM=DELIM
if (SUBATOM != DELIM) goto L_00A5;
QUOTE = 0;
L_00A5:;
// 855 READSYM
READSYM();
// 856 %IF SUBATOM=DELIM %START; ! ' ' FOUND
if (SUBATOM != DELIM) goto L_00A6;
// 857 %IF SYM#DELIM %START; ! NULL SYMBOL OR STRING
if (SYM == DELIM) goto L_00A7;
// 858 SUB ATOM=NULL STRING; %RETURN
SUBATOM = 401;
return;
// 859 %FINISH
L_00A7:;
// 860 ! ' ' ' FOUND
// 861 QUOTE=1
QUOTE = 1;
// 862 READSYM; ! '' -> '
READSYM();
// 863 %FINISH
L_00A6:;
// 864 %IF SYM=DELIM %START; ! FOUND DELIM %OR '?'
if (SYM != DELIM) goto L_00A8;
// 865 QUOTE=0
QUOTE = 0;
// 866 READ SYM; ! SKIP QUOTE
READSYM();
// 867 %IF SYM#DELIM %START
if (SYM == DELIM) goto L_00A9;
// 868 LITPOS=LITPOS-2
LITPOS = LITPOS - 2;
// 869 BUFFER(LITPOS+2)=-1
BUFFER[LITPOS + 2 - 1] = -1;
// 870 BUFFER(LITPOS+1)=SUBATOM
BUFFER[LITPOS + 1 - 1] = SUBATOM;
// 871 SUBATOM=LITPOS+2
SUBATOM = LITPOS + 2;
// 872 %RETURN
return;
// 873 %FINISH
L_00A9:;
// 874 %FINISH
L_00A8:;
// 875 QUOTE=SUBATOM<<8+SYM; ! PRESERVE SYMBOLS
QUOTE = (SUBATOM << 8) + SYM;
// 876 ATOM2=SCONST; ! IT MUST BE A STRING
ATOM2 = 82;
// 877 SUBATOM=LITPOS
SUBATOM = LITPOS;
// 878 %RETURN
return;
// 879 %FINISH
L_00A4:;
// 880 DP=KEY>>2; ! INDEX INTO DICT
DP = (unsigned int)KEY >> 2;
// 881 READ SYM; ! GET NEXT SYMBOL
READSYM();
// 882 %CYCLE
L_00AA:;
// 883 S=KDICT(DP)
S = KDICT[DP - 32];
// 884 %EXIT %IF S&X'4000'#0; ! END OF LIST MARKER
if (S & 16384 == 0) goto L_00AB;
goto L_00AC;
L_00AB:;
// 885 %IF S&127#SYM %OR SYMTYPE < 0 %START
if (S & 127 != SYM) goto L_00AD;
if (SYMTYPE >= 0) goto L_00AE;
L_00AD:;
// 886 ATOM POS=POS %AND %RETURN %IF S >= 0
if (S < 0) goto L_00AF;
ATOMPOS = POS;
return;
L_00AF:;
// 887 DP=DP+1; ! ONTO ALTERNATIVE
DP = DP + 1;
// 888 %ELSE
goto L_00B0;
L_00AE:;
// 889 K = S>>7&127; READ SYM
K = (unsigned int)S >> 7 & 127;
READSYM();
// 890 %IF S > 0 %START
if (S <= 0) goto L_00B1;
// 891 %IF K # 0 %START
if (K == 0) goto L_00B2;
// 892 ATOM POS = POS %AND %RETURN %IF K#SYM %OR SYMTYPE<0
if (K != SYM) goto L_00B3;
if (SYMTYPE >= 0) goto L_00B4;
L_00B3:;
ATOMPOS = POS;
return;
L_00B4:;
// 893 READ SYM
READSYM();
// 894 %FINISH
L_00B2:;
// 895 K = 1
K = 1;
// 896 %FINISH
L_00B1:;
// 897 DP = DP+K
DP = DP + K;
// 898 %FINISH
L_00B0:;
// 899 %REPEAT
goto L_00AA;
L_00AC:;
// 900 ATOM1=S&63; ! PICK OFF CLASS
ATOM1 = S & 63;
// 901 SUB ATOM=S>>6&255
SUBATOM = (unsigned int)S >> 6 & 255;
// 902 %EXIT %IF ATOM1#0
if (ATOM1 == 0) goto L_00B5;
goto L_00B6;
L_00B5:;
// 903 L=P VALUE(SUBATOM)
L = PVALUE[SUBATOM];
// 904 %IF L#0 %START
if (L == 0) goto L_00B7;
// 905 %RETURN %IF PREFIX&L&63 # 0 %OR (LAST # 0 %AND L&1 # 0)
if (PREFIX & L & 63 != 0) goto L_00B8;
if (LAST == 0) goto L_00B9;
if (L & 1 == 0) goto L_00B9;
L_00B8:;
return;
L_00B9:;
// 906 PREFIX=PREFIX!L>>6
PREFIX = PREFIX | (unsigned int)L >> 6;
// 907 XTYPE=SUBATOM %IF SUBATOM <= 7
if (SUBATOM > 7) goto L_00BA;
XTYPE = SUBATOM;
L_00BA:;
// 908 %FINISH
L_00B7:;
// 909 ATOM POS=POS
ATOMPOS = POS;
// 910 %REPEAT; ! ROUND FOR ANOTHER
goto L_008A;
L_00B6:;
// 911 ATOM2=KDICT(DP+1)&63 %IF S < 0; ! VARIANT
if (S >= 0) goto L_00BB;
ATOM2 = KDICT[DP + 1 - 32] & 63;
L_00BB:;
// 912 %IF ATOM1=STRING %OR ATOM1=RECORD %START
if (ATOM1 == 16) goto L_00BC;
if (ATOM1 != 17) goto L_00BD;
L_00BC:;
// 913 DTYPE=ATOM1
DTYPE = ATOM1;
// 914 CODE ATOM
CODEATOM();
// 915 %IF DTYPE=STRING %START
if (DTYPE != 16) goto L_00BE;
// 916 ATOM1=0 %AND %RETURN %UNLESS ATOM1=ICONST
if (ATOM1 == 83) goto L_00BF;
ATOM1 = 0;
return;
L_00BF:;
// 917 SLEN=EVAL(SUBATOM); ! STRING LENGTH
SLEN = EVAL(SUBATOM);
// 918 %UNLESS 0 < SLEN <= TEXT LIMIT %START
{
// Double-sided test on SLEN (Part I)
int tmp;
if (0 >= (tmp = SLEN)) goto L_00C0;
// Double-sided test on SLEN (Part II)
if (tmp <= 255) goto L_00C1;
}
L_00C0:;
// 919 ATOM1=0; F TYPE=4
ATOM1 = 0;
FTYPE = 4;
// 920 %RETURN
return;
// 921 %FINISH
L_00C1:;
// 922 SRMOD=X'40'; ! TYPE FOR STRING
SRMOD = 64;
// 923 %ELSE
goto L_00C2;
L_00BE:;
// 924 %IF ATOM2=IDENT %START
if (ATOM2 != 59) goto L_00C3;
// 925 LIM=GLOBAL; LOOKUP(T BASE)
LIM = 0;
LOOKUP(TBASE);
// 926 %FINISH
L_00C3:;
// 927 %UNLESS ATOM2 = RFN %START
if (ATOM2 == 65) goto L_00C4;
// 928 F TYPE = 3
FTYPE = 3;
// 929 ATOM1 = 0; ATOM2 = 0
ATOM1 = 0;
ATOM2 = 0;
// 930 %RETURN
return;
// 931 %FINISH
L_00C4:;
// 932 SRMOD=X'50'; ! TYPE FOR RECORD
SRMOD = 80;
// 933 %FINISH
L_00C2:;
// 934 CODE ATOM
CODEATOM();
// 935 ATOM1=0 %AND %RETURN %IF ATOM1#RB
if (ATOM1 == 2) goto L_00C5;
ATOM1 = 0;
return;
L_00C5:;
// 936 %IF SYM TYPE=2 %START; ! KEYWORD FOLLOWS
if (SYMTYPE != 2) goto L_00C6;
// 937 CODE ATOM
CODEATOM();
// 938 %IF ATOM1 # SPECIAL %AND ATOM2 # SPECIAL %START
if (ATOM1 == 55) goto L_00C7;
if (ATOM2 == 55) goto L_00C7;
// 939 ATOM1 = 0; ATOM2 = 0; %RETURN
ATOM1 = 0;
ATOM2 = 0;
return;
// 940 %FINISH
L_00C7:;
// 941 SUBATOM = 1 %IF SUBATOM = 127;! SPEC
if (SUBATOM != 127) goto L_00C8;
SUBATOM = 1;
L_00C8:;
// 942 %FINISH %ELSE SUBATOM=5; ! NULL SPECIAL
goto L_00C9;
L_00C6:;
SUBATOM = 5;
L_00C9:;
// 943 ATOM1=0 %AND %RETURN %C
if (DTYPE != 17) goto L_00CA;
if (SUBATOM < 11) goto L_00CA;
ATOM1 = 0;
return;
L_00CA:;
// 944+ %IF DTYPE=RECORD %AND SUBATOM >= 11
// 945 K=SATOMS(SUBATOM)
K = SATOMS[SUBATOM - 1];
// 946 ATOM1=K&255; ATOM2=K>>8&255
ATOM1 = K & 255;
ATOM2 = (unsigned int)K >> 8 & 255;
// 947 SUBATOM=SCLASS(SUBATOM)
SUBATOM = SCLASS[SUBATOM - 1];
// 948 %ELSE
goto L_00CB;
L_00BD:;
// 949 %UNLESS PRE1 <= ATOM1 <= PRE2 %START
{
// Double-sided test on ATOM1 (Part I)
int tmp;
if (49 > (tmp = ATOM1)) goto L_00CC;
// Double-sided test on ATOM1 (Part II)
if (tmp <= 57) goto L_00CD;
}
L_00CC:;
// 950 ATOM1=0 %IF PREFIX#0
if (PREFIX == 0) goto L_00CE;
ATOM1 = 0;
L_00CE:;
// 951 %RETURN
return;
// 952 %FINISH
L_00CD:;
// 953 %FINISH
L_00CB:;
// 954 %IF SUBATOM >= SPS %START
if (SUBATOM < 117) goto L_00CF;
// 955 SPEC = -1; SUBATOM = SPEC SUB(SUBATOM)
SPEC = -1;
SUBATOM = SPECSUB[SUBATOM - 117];
// 956 %ELSE %IF SUBATOM >= XSPS
goto L_00D0;
L_00CF:;
if (SUBATOM < 109) goto L_00D1;
// 957 %IF XTYPE # 6 %START
if (XTYPE == 6) goto L_00D2;
// 958 ATOM1 = 0; ATOM2 = 0; %RETURN
ATOM1 = 0;
ATOM2 = 0;
return;
// 959 %FINISH
L_00D2:;
// 960 XTYPE = 3; ! EXTRINSIC!!
XTYPE = 3;
// 961 SUBATOM = XMOD(SUBATOM)
SUBATOM = XMOD[SUBATOM - 109];
// 962 SRMOD = SRMOD-X'10' %IF SRMOD # 0
if (SRMOD == 0) goto L_00D3;
SRMOD = SRMOD - 16;
L_00D3:;
// 963 %FINISH
L_00D1:;
L_00D0:;
// 964 %IF PREFIX&64#0 %START; ! OWN DATA
if (PREFIX & 64 == 0) goto L_00D4;
// 965 %UNLESS ATOM1 = OWN1 %OR ATOM1 = OWN2 %START;! NON-DATA
if (ATOM1 == 53) goto L_00D5;
if (ATOM1 == 51) goto L_00D5;
// 966 %IF XTYPE <= 3 %START; ! CONSTROUTINE ?
if (XTYPE > 3) goto L_00D6;
// 967 ATOM1 = 0; %RETURN
ATOM1 = 0;
return;
// 968 %FINISH
L_00D6:;
// 969 %ELSE
goto L_00D7;
L_00D5:;
// 970 ATOM1=ATOM1+1; ! ONTO '%OWN' VARIANT
ATOM1 = ATOM1 + 1;
// 971 OUT=(SUB ATOM+SRMOD)>>4
OUT = (unsigned int)SUBATOM + SRMOD >> 4;
// 972 %IF SUBATOM&1 = 0 %START; ! CONSTNAME ?
if (SUBATOM & 1 != 0) goto L_00D8;
// 973 OUT = 1; ! ADDRESSES ARE INTEGERS
OUT = 1;
// 974 %ELSE
goto L_00D9;
L_00D8:;
// 975 CONST INT = 1 %IF XTYPE = 2 %C
if (XTYPE != 2) goto L_00DA;
if (SUBATOM + SRMOD & 112 > 48) goto L_00DA;
CONSTINT = 1;
L_00DA:;
// 976+ %AND (SUBATOM+SRMOD)&X'70' <= X'30'
// 977 %FINISH
L_00D9:;
// 978 OUT = 15 %IF XTYPE = 3; ! DON'T INITIALIZE EXTRINSICS
if (XTYPE != 3) goto L_00DB;
OUT = 15;
L_00DB:;
// 979 %FINISH
L_00D7:;
// 980 %FINISH
L_00D4:;
// 981 SUBATOM=SUBATOM+LREALS %IF SUBATOM&X'70'=X'60'
if (SUBATOM & 112 != 96) goto L_00DC;
SUBATOM = SUBATOM + LREALS;
L_00DC:;
// 982 SUBATOM=SUBATOM+SLEN<<8+SRMOD+(PREFIX>>3&X'70')
SUBATOM = SUBATOM + (SLEN << 8) + SRMOD + ((unsigned int)PREFIX >> 3 & 112);
// 983 DEC TYPE=SUBATOM
DECTYPE = SUBATOM;
// 984 SPREFIX=XTYPE
SPREFIX = XTYPE;
// 985 PREFIX=0
PREFIX = 0;
// 986 %END
return;
} /* end of CODEATOM */
// 987 !*************************************************************
// 988 !* DEC TYPE: <EXT><EXTR><CONST><OWN><DYN><SYS><FLAG1><FLAG2> *
// 989 !*************************************************************
// 990 %INTEGERFN GAPP
int GAPP(void) {
// 991 %CONSTINTEGER PSEP = 129, PCALL = 130
// 992 %INTEGER L, P, TYPE, NEXT, C
int L;
int P;
int TYPE;
int NEXT;
int C;
// 993 %INTEGERFN CLASS(%INTEGER T)
int CLASS(int T) {
// 994 %CONSTBYTEINTEGERARRAY EXPS(0 : 7)=0,147(3),140,0,146(2)
const unsigned char EXPS[8] = {0, [1 ... 3] = 147, 140, 0, [6 ... 7] = 146};
struct _imp_dv EXPS_dv = {EXPS, sizeof(unsigned char) /*, dims, <bounds> */};
// 995 %CONSTBYTEINTEGERARRAY PARM MAP(0 : 15)=0,0,137,0,0,0,0,122,
const unsigned char PARMMAP[16] = {0, 0, 137, 0, 0, 0, 0, 122, 176, 177, 123, 0, 159, 0, 0, 0};
struct _imp_dv PARMMAP_dv = {PARMMAP, sizeof(unsigned char) /*, dims, <bounds> */};
// 996+ 176,177,123,0,159,0,0,0
// 997 %CONSTBYTEINTEGERARRAY TMOD(0:7) = 0,8(3),4,0,9,9
const unsigned char TMOD[8] = {0, [1 ... 3] = 8, 4, 0, 9, 9};
struct _imp_dv TMOD_dv = {TMOD, sizeof(unsigned char) /*, dims, <bounds> */};
// 998 TYPE = T>>4
TYPE = (unsigned int)T >> 4;
// 999 TYPE = TMOD(TYPE) %AND %RESULT = EXPS(T>>4) %IF T&15 = 1;! EXPRN
if (T & 15 != 1) goto L_00DD;
TYPE = TMOD[TYPE];
return EXPS[(unsigned int)T >> 4];
L_00DD:;
// 1000 TYPE = 10 %IF TYPE = 0
if (TYPE != 0) goto L_00DE;
TYPE = 10;
L_00DE:;
// 1001 %RESULT=PARM MAP(T&15); ! CORRECT CLASS FOR NAMES
return PARMMAP[T & 15];
// 1002 %END
} /* end of CLASS */
// 1003 %ROUTINE SET GCELL(%INTEGER C, GC, LEN)
void SETGCELL(int C, int GC, int LEN) {
// 1004 C = C<<9; C = C+L %UNLESS GC = PCALL
C = C << 9;
if (GC == 130) goto L_00DF;
C = C + L;
L_00DF:;
// 1005 %WHILE L#GLIMIT %CYCLE
L_00E0:;
if (L == GLIMIT) goto L_00E1;
// 1006 L=L+1
L = L + 1;
// 1007 %RETURN %IF GRAM(L)=C %AND GCLASS(L) = GC %C
if (GRAM[L] != C) goto L_00E2;
if (GCLASS[L] != GC) goto L_00E2;
if (TAG & 112 != 64) goto L_00E3;
if (GRAM[L - 1] != LEN) goto L_00E2;
L_00E3:;
return;
L_00E2:;
// 1008+ %AND (TAG&X'70'#X'40' %OR GRAM(L-1)=LEN)
// 1009 %REPEAT
goto L_00E0;
L_00E1:;
// 1010 %IF TAG&X'70'=X'40' %START
if (TAG & 112 != 64) goto L_00E4;
// 1011 GLIMIT=GLIMIT+1; GRAM(GLIMIT)=LEN; ! SET STRING LE
GLIMIT = GLIMIT + 1;
GRAM[GLIMIT] = LEN;
// 1012 %FINISH
L_00E4:;
// 1013 GLIMIT=GLIMIT+1; GRAM(GLIMIT)=C; GCLASS(GLIMIT) = GC
GLIMIT = GLIMIT + 1;
GRAM[GLIMIT] = C;
GCLASS[GLIMIT] = GC;
// 1014 L=GLIMIT
L = GLIMIT;
// 1015 %IF DIAG&4 # 0 %START
if (DIAG & 4 == 0) goto L_00E5;
// 1016 PRINTSTRING("SET"); WRITE(L, 3)
_imp_PRINTSTRING(_imp_str_literal("SET"));
_imp_WRITE(L, 3);
// 1017 WRITE(C, 3); WRITE(GC, 3); WRITE(LEN, 3)
_imp_WRITE(C, 3);
_imp_WRITE(GC, 3);
_imp_WRITE(LEN, 3);
// 1018 NEWLINE
_imp_NEWLINE();
// 1019 %FINISH
L_00E5:;
// 1020 %END
return;
} /* end of SETGCELL */
// 1021
// 1022 %RESULT = NULL %IF TBASE=TMAX
if (TBASE != TMAX) goto L_00E6;
return 512;
L_00E6:;
// 1023 L = GBASE; P = TMAX
L = 426;
P = TMAX;
// 1024 SET GCELL(0, PCALL, 0)
SETGCELL(0, 130, 0);
// 1025 %CYCLE
L_00E7:;
// 1026 P = P-1
P = P - 1;
// 1027 NEXT = P-DICT(P)&255-2
NEXT = P - (DICT[P] & 255) - 2;
// 1028 TAG = DICT(P-1)
TAG = DICT[P - 1];
// 1029 C = CLASS(TAG&127)
C = CLASS(TAG & 127);
// 1030 SET GCELL(TYPE, C, TAG>>8&255)
SETGCELL(TYPE, C, (unsigned int)TAG >> 8 & 255);
// 1031 %EXIT %IF NEXT <= TBASE
if (NEXT > TBASE) goto L_00E8;
goto L_00E9;
L_00E8:;
// 1032 P = NEXT
P = NEXT;
// 1033 SET GCELL(0, PSEP, 0)
SETGCELL(0, 129, 0);
// 1034 %REPEAT
goto L_00E7;
L_00E9:;
// 1035 SET GCELL(0, LB, 0)
SETGCELL(0, 1, 0);
// 1036 FAULT(23) %IF GLIMIT >= GMAX
if (GLIMIT < 512) goto L_00EA;
FAULT(23);
L_00EA:;
// 1037 %RESULT=L
return L;
// 1038 %END
} /* end of GAPP */
// 1039
// 1040 %ROUTINE HEX(%INTEGER N)
void HEX(int N) {
// 1041 %INTEGER J,K
int J;
int K;
// 1042 %CYCLE J = 1, 1, 4
// %for J = 1, 1, 4 %cycle
{
J = 0;
L_00EB:
if (J == 4) goto L_00EC;
J += 1;
// 1043 K = N>>12; N = N<<4
K = (unsigned int)N >> 12;
N = N << 4;
// 1044 %IF K > 9 %THEN K = K-10+'A' %ELSE K = K+'0'
if (K <= 9) goto L_00EE;
K = K - 10 + 65;
goto L_00EF;
L_00EE:;
K = K + 48;
L_00EF:;
// 1045 PRINTSYMBOL(K)
_imp_PRINTSYMBOL(K);
// 1046 %REPEAT
goto L_00EB;
}
L_00EC:;
// 1047 %END
return;
} /* end of HEX */
// 1048 %ROUTINE ANALYSE(%INTEGER G)
void ANALYSE(int G) {
// 1049 %SWITCH DIR(86:102)
int DIR_index;
int DIR_line;
char *DIR_file;
static const void *DIR[17] = {&&case_DIR_missing, &&case_DIR_missing, &&case_DIR_missing, &&case_DIR_missing,
&&case_DIR_missing, &&case_DIR_missing, &&case_DIR_missing, &&case_DIR_missing,
&&case_DIR_missing, &&case_DIR_missing, &&case_DIR_missing, &&case_DIR_missing,
&&case_DIR_missing, &&case_DIR_missing, &&case_DIR_missing, &&case_DIR_missing,
&&case_DIR_missing};
// 1050 %INTEGER EXTEND, AMBIG, SUB LOCK, DOWN LOCK
int EXTEND;
int AMBIG;
int SUBLOCK;
int DOWNLOCK;
// 1051 %INTEGER J, K, L, N, A1, NODE, NEW TYPE, T
int J;
int K;
int L;
int N;
int A1;
int NODE;
int NEWTYPE;
int T;
// 1052
// 1053 %ROUTINE REORDER
void REORDER(void) {
// 1054 %INTEGERNAME X, Y
int *X;
int *Y;
// 1055 %INTEGER R
int R;
// 1056 K=0
K = 0;
// 1057 %WHILE N < 0 %CYCLE
L_00F0:;
if (N >= 0) goto L_00F1;
// 1058 R=REF(N); J=CO(N)
R = REF[N + 300];
J = CO[N + 300];
// 1059 %IF LOC(N)&X'FF' > TRANSP %START;! DROP TRANSPARENT
if (LOC[N + 300] & 255 <= 18) goto L_00F2;
// 1060 X == K; R=R&X'6000'; ! PICK OFF ORDER
X = (int *)/*?*/ &K;
R = R & 24576;
// 1061 %WHILE X#0 %CYCLE
L_00F3:;
if (*X == 0) goto L_00F4;
// 1062 Y == REF(X)
Y = (int *)/*?*/ &REF[*X + 300];
// 1063 %EXIT %IF Y&X'6000' <= R
if (*Y & 24576 > R) goto L_00F5;
goto L_00F4;
L_00F5:;
// 1064 Y=Y-X'2000'; ! DECREMENT ORDERING CODE
*Y = *Y - 8192;
// 1065 X == CO(X); ! ON DOWN THE CHAIN
X = (int *)/*?*/ &CO[*X + 300];
// 1066 %REPEAT
goto L_00F3;
L_00F4:;
// 1067 CO(N)=X; X=N
CO[N + 300] = *X;
*X = N;
// 1068 %FINISH
L_00F2:;
// 1069 N=J
N = J;
// 1070 %REPEAT
goto L_00F0;
L_00F1:;
// 1071 %IF DIAG&8 # 0 %START
if (DIAG & 8 == 0) goto L_00F6;
// 1072 PRINTSTRING("REORDER N ="); WRITE(N, 3); NEWLINE
_imp_PRINTSTRING(_imp_str_literal("REORDER N ="));
_imp_WRITE(N, 3);
_imp_NEWLINE();
// 1073 %FINISH
L_00F6:;
// 1074 %END
return;
} /* end of REORDER */
// 1075 %ROUTINE SHOW(%INTEGER Z)
void SHOW(int Z) {
// 1076 WRITE(Z, 3)
_imp_WRITE(Z, 3);
// 1077 PRINTSTRING(" [")
_imp_PRINTSTRING(_imp_str_literal(" ["));
// 1078 HEX(REF(Z))
HEX(REF[Z + 300]);
// 1079 SPACE; HEX(CO(Z))
_imp_SPACE();
HEX(CO[Z + 300]);
// 1080 SPACE; HEX(SUB(Z))
_imp_SPACE();
HEX(SUB[Z + 300]);
// 1081 SPACE; HEX(LOC(Z))
_imp_SPACE();
HEX(LOC[Z + 300]);
// 1082 PRINTSYMBOL(']'); NEWLINE
_imp_PRINTSYMBOL(93);
_imp_NEWLINE();
// 1083 %END
return;
} /* end of SHOW */
// 1084 EXTEND=0; SUB LOCK = 0; DOWN LOCK = 0
EXTEND = 0;
SUBLOCK = 0;
DOWNLOCK = 0;
// 1085 A=0; A1=0; N=0; NODE=0
A = 0;
A1 = 0;
N = 0;
NODE = 0;
// 1086 AMBIG=0
AMBIG = 0;
// 1087 P = RECLEN
P = -300;
// 1088 L1: J=GRAM(G); K = GCLASS(G); ->EOP %IF K = 0
U_1003:;
J = GRAM[G];
K = GCLASS[G];
if (K != 0) goto L_00F7;
goto U_1002;
L_00F7:;
// 1089 NEW TYPE = J>>9&15
NEWTYPE = (unsigned int)J >> 9 & 15;
// 1090 NEW TYPE = TYPE %IF NEW TYPE = 0
if (NEWTYPE != 0) goto L_00F8;
NEWTYPE = TYPE;
L_00F8:;
// 1091 %IF DIAG&1 # 0 %START
if (DIAG & 1 == 0) goto L_00F9;
// 1092 WRITE(G, 4); WRITE(K, 3)
_imp_WRITE(G, 4);
_imp_WRITE(K, 3);
// 1093 WRITE(ATOM1, 3); WRITE(ATOM2, 3); WRITE(SUBATOM, 3)
_imp_WRITE(ATOM1, 3);
_imp_WRITE(ATOM2, 3);
_imp_WRITE(SUBATOM, 3);
// 1094 WRITE(TYPE, 2); WRITE(FORMAT, 3)
_imp_WRITE(TYPE, 2);
_imp_WRITE(FORMAT, 3);
// 1095 NEWLINE
_imp_NEWLINE();
// 1096 %FINISH
L_00F9:;
// 1097 %IF K >= PHRASES %START; ! PHRASE
if (K < 132) goto L_00FA;
// 1098 P=P+1; F TYPE=4 %AND -> ERROR %IF P=A
P = P + 1;
if (P != A) goto L_00FB;
FTYPE = 4;
goto U_1004;
L_00FB:;
// 1099 REF(P)=J; CO(P)=N
REF[P + 300] = J;
CO[P + 300] = N;
// 1100 LOC(P)=TYPE<<8+K
LOC[P + 300] = (TYPE << 8) + K;
// 1101 TYPE=NEW TYPE
TYPE = NEWTYPE;
// 1102 SHOW(P) %IF DIAG&8 # 0
if (DIAG & 8 == 0) goto L_00FC;
SHOW(P);
L_00FC:;
// 1103 N=-P
N = -P;
// 1104 G=PHRASE(K)
G = PHRASE[K - 132];
// 1105 -> L1
goto U_1003;
// 1106 %FINISH
L_00FA:;
// 1107 CLASS=K
CLASS = K;
// 1108 CLASS=ATOMIC(CLASS) %IF CLASS >= EQUIVS
if (CLASS < 105) goto L_00FD;
CLASS = ATOMIC[CLASS - 105];
L_00FD:;
// 1109 ->DIR(CLASS) %IF CLASS >= DIRECTIVES
if (CLASS < 86) goto L_00FE;
DIR_line = __LINE__;
DIR_file = __FILE__;
DIR_index = CLASS;
goto case_DIR_dispatch;
L_00FE:;
// 1110 %IF ATOM2=IDENT %AND (DEF1 <= CLASS <= DEF2 %OR CLASS = ICONST)%START
if (ATOM2 != 59) goto L_0100;
{
// Double-sided test on CLASS (Part I)
int tmp;
if (60 > (tmp = CLASS)) goto L_0101;
// Double-sided test on CLASS (Part II)
if (tmp <= 79) goto L_00ED;
}
L_0101:;
if (CLASS != 83) goto L_0100;
L_00ED:;
// 1111 LIM=GLOBAL; LOOKUP(T BASE)
LIM = 0;
LOOKUP(TBASE);
// 1112 %FINISH
L_0100:;
// 1113 %IF SET1 <= CLASS <= SET2 %AND %C
{
// Double-sided test on CLASS (Part I)
int tmp;
if (60 > (tmp = CLASS)) goto L_0102;
// Double-sided test on CLASS (Part II)
if (tmp > 64) goto L_0102;
}
if (OTYPE != 2) goto L_0103;
if (ATOM2 == 68) goto L_0103;
if (ATOM2 != 70) goto L_0102;
L_0103:;
// 1114+ (OTYPE#2 %OR ATOM2=68 %OR ATOM2=70) %START
// 1115 CLASS = CLASS+7; TYPE = TAG>>4&7
CLASS = CLASS + 7;
TYPE = (unsigned int)TAG >> 4 & 7;
// 1116 %FINISH
L_0102:;
// 1117 NEW TYPE=TYPE
NEWTYPE = TYPE;
// 1118 %IF CLASS=ATOM1 %OR CLASS=ATOM2 %START
if (CLASS == ATOM1) goto L_0104;
if (CLASS != ATOM2) goto L_0105;
L_0104:;
// 1119 %IF CLASS = IDENT %START
if (CLASS != 59) goto L_0106;
// 1120 DECLARE IDEN
DECLAREIDEN();
// 1121 TYPE = 15 %IF NEWTYPE = 15
if (NEWTYPE != 15) goto L_0107;
TYPE = 15;
L_0107:;
// 1122 %FINISH
L_0106:;
// 1123 %IF CHECK1 <= CLASS <= CHECK2 %START
{
// Double-sided test on CLASS (Part I)
int tmp;
if (66 > (tmp = CLASS)) goto L_0108;
// Double-sided test on CLASS (Part II)
if (tmp > 72) goto L_0108;
}
// 1124 %IF VAR TYPE#TYPE %START
if (VARTYPE == TYPE) goto L_0109;
// 1125 %UNLESS VARTYPE <= 3 %AND (TYPE=8 %OR TYPE=9) %START
if (VARTYPE > 3) goto L_00A0;
if (TYPE == 8) goto L_010A;
if (TYPE == 9) goto L_010A;
L_00A0:;
// 1126 %UNLESS VARTYPE >= 6 %AND TYPE=9 %START
if (VARTYPE < 6) goto L_010B;
if (TYPE == 9) goto L_010C;
L_010B:;
// 1127 %UNLESS TYPE = 10 %START
if (TYPE == 10) goto L_010D;
// 1128 F TYPE = 2; ->ALT
FTYPE = 2;
goto U_1005;
// 1129 %FINISH
L_010D:;
// 1130 %FINISH
L_010C:;
// 1131 %FINISH
L_010A:;
// 1132 %FINISH
L_0109:;
// 1133 F TYPE=0
FTYPE = 0;
// 1134 %FINISH
L_0108:;
// 1135 ENTRY: A=A-1; F TYPE=4 %AND -> ERROR %IF A=P
U_1006:;
A = A - 1;
if (A != P) goto L_010E;
FTYPE = 4;
goto U_1004;
L_010E:;
// 1136 REF(A)=J; CO(A)=N
REF[A + 300] = J;
CO[A + 300] = N;
// 1137 LOC(A)=TYPE<<8+K
LOC[A + 300] = (TYPE << 8) + K;
// 1138 TYPE=NEW TYPE
TYPE = NEWTYPE;
// 1139 SUB(A)=SUBATOM
SUB[A + 300] = SUBATOM;
// 1140 SHOW(A) %IF DIAG&8 # 0
if (DIAG & 8 == 0) goto L_010F;
SHOW(A);
L_010F:;
// 1141 ->DONE %IF J&511 = 511; ! END OF SS
if (J & 511 != 511) goto L_0110;
goto U_1007;
L_0110:;
// 1142 -> NEXT %IF AMBIG=0; ! NOT AMBIGUOUS
if (AMBIG != 0) goto L_0111;
goto U_1008;
L_0111:;
// 1143 G=AMBIG; AMBIG=0; -> L1
G = AMBIG;
AMBIG = 0;
goto U_1003;
// 1144 %FINISH
L_0105:;
// 1145 ALT: G=G+1; -> L1 %IF J < 0; ! TRY ALTERNATIVE
U_1005:;
G = G + 1;
if (J >= 0) goto L_0112;
goto U_1003;
L_0112:;
// 1146 NEXT: %IF NODE=A1 %START; ! LAST NODE FOR THIS ATOM
U_1008:;
if (NODE != A1) goto L_0113;
// 1147 EXTEND=0; SUB LOCK=0; DOWN LOCK = 0
EXTEND = 0;
SUBLOCK = 0;
DOWNLOCK = 0;
// 1148 -> ERROR %IF NODE=A; ! NO NEW NODES
if (NODE != A) goto L_0114;
goto U_1004;
L_0114:;
// 1149 A1=A
A1 = A;
// 1150 CODE ATOM %IF CLASS < DIRECTIVES; ! GET NEXT ATOM
if (CLASS >= 86) goto L_0115;
CODEATOM();
L_0115:;
// 1151 %FINISH
L_0113:;
// 1152 NODE=NODE-1; N=NODE
NODE = NODE - 1;
N = NODE;
// 1153 %IF EXTEND#0 %START
if (EXTEND == 0) goto L_0116;
// 1154 K = LOC(N)&255
K = LOC[N + 300] & 255;
// 1155 %IF K # 0 %START
if (K == 0) goto L_0117;
// 1156 J=REF(N)
J = REF[N + 300];
// 1157 TYPE = LOC(N)>>8
TYPE = (unsigned int)LOC[N + 300] >> 8;
// 1158 N=CO(N); ! WELL ?
N = CO[N + 300];
// 1159 -> ENTRY
goto U_1006;
// 1160 %FINISH
L_0117:;
// 1161 %FINISH
L_0116:;
// 1162 -> SKIP
goto U_1009;
// 1163 EOP: REORDER
U_1002:;
REORDER();
// 1164 N=-N; SUB(N)=K
N = -N;
SUB[N + 300] = K;
// 1165 SKIP: ! ON DOWN CHAIN
U_1009:;
// 1166 G=REF(N)&511; -> EOP %IF G=0
G = REF[N + 300] & 511;
if (G != 0) goto L_0118;
goto U_1002;
L_0118:;
// 1167 TYPE=LOC(N)>>8
TYPE = (unsigned int)LOC[N + 300] >> 8;
// 1168 -> L1
goto U_1003;
// 1169 DIR(89): ! %COLON
case_DIR_89:;
// 1170 -> ERROR %UNLESS ATOM1=3; ! LOOK FOR COLON
if (ATOM1 == 3) goto L_0119;
goto U_1004;
L_0119:;
// 1171 DONE: N=A; REORDER; SS=K
U_1007:;
N = A;
REORDER();
SS = K;
// 1172 %RETURN %IF DUP=0
if (DUP != 0) goto L_011A;
return;
L_011A:;
// 1173 F TYPE=7
FTYPE = 7;
// 1174 ERROR:
U_1004:;
// 1175 QUOTE=0 %AND READSYM %WHILE NL#SYM#';'
L_011B:;
{
// Double-sided test on SYM (Part I)
int tmp;
if (10 == (tmp = SYM)) goto L_011C;
// Double-sided test on SYM (Part II)
if (tmp == 59) goto L_011C;
}
QUOTE = 0;
READSYM();
goto L_011B;
L_011C:;
// 1176 %IF F TYPE=0 %START
if (FTYPE != 0) goto L_011D;
// 1177 %IF ATOM1=IDENT %AND LIM=GLOBAL %START
if (ATOM1 != 59) goto L_011E;
if (LIM != 0) goto L_011E;
// 1178 F TYPE=3
FTYPE = 3;
// 1179 %ELSE %IF ATOM1 = 0
goto L_011F;
L_011E:;
if (ATOM1 != 0) goto L_0120;
// 1180 FTYPE = 1
FTYPE = 1;
// 1181 %ELSE %IF SCONST <= ATOM1 <= RCONST
goto L_011F;
L_0120:;
{
// Double-sided test on ATOM1 (Part I)
int tmp;
if (82 > (tmp = ATOM1)) goto L_0121;
// Double-sided test on ATOM1 (Part II)
if (tmp > 84) goto L_0121;
}
// 1182 FTYPE = 2
FTYPE = 2;
// 1183 FTYPE = 5 %IF TYPE = 15
if (TYPE != 15) goto L_0122;
FTYPE = 5;
L_0122:;
// 1184 %FINISH
L_0121:;
L_011F:;
// 1185 %FINISH
L_011D:;
// 1186 FAULT(F TYPE)
FAULT(FTYPE);
// 1187 QUOTE=0; SYMTYPE=0; DEC TYPE=0
QUOTE = 0;
SYMTYPE = 0;
DECTYPE = 0;
// 1188 PREFIX=0; SPREFIX=0; CONST INT = 0
PREFIX = 0;
SPREFIX = 0;
CONSTINT = 0;
// 1189 %RETURN
return;
// 1190 DIR(86): ! %INT
case_DIR_86:;
// 1191 -> ALT %IF TYPE > 3 %AND TYPE#8; ! NOT INTEGER
if (TYPE <= 3) goto L_0123;
if (TYPE == 8) goto L_0123;
goto U_1005;
L_0123:;
// 1192 DCONT:
U_100A:;
// 1193 G = J&511
G = J & 511;
// 1194 -> EOP %IF G=0; ! END OF PHRASE
if (G != 0) goto L_0124;
goto U_1002;
L_0124:;
// 1195 -> L1
goto U_1003;
// 1196 DIR(87): ! %REAL
case_DIR_87:;
// 1197 -> ALT %IF TYPE < 6 %OR TYPE=8 %OR TYPE = 15;! NOT REAL
if (TYPE < 6) goto L_0125;
if (TYPE == 8) goto L_0125;
if (TYPE != 15) goto L_0126;
L_0125:;
goto U_1005;
L_0126:;
// 1198 -> DCONT
goto U_100A;
// 1199 DIR(88): ! %STR
case_DIR_88:;
// 1200 -> ALT %IF TYPE#4; ! NOT STRING
if (TYPE == 4) goto L_0127;
goto U_1005;
L_0127:;
// 1201 -> DCONT
goto U_100A;
// 1202 DIR(90): ! %FN
case_DIR_90:;
// 1203 %IF BLOCK TYPE&15 # 8 %START; ! NOT A FUNCTION
if (BLOCKTYPE & 15 == 8) goto L_0128;
// 1204 ->DALT %IF DIAG >= 0 %OR BLOCKTYPE&15 # 9; ! OR A FUNNY MAP
if (DIAG >= 0) goto L_0129;
if (BLOCKTYPE & 15 == 9) goto L_012A;
L_0129:;
goto U_100B;
L_012A:;
// 1205 %FINISH
L_0128:;
// 1206 TYPE=BLOCK TYPE>>4&7
TYPE = (unsigned int)BLOCKTYPE >> 4 & 7;
// 1207 %IF TYPE <= 3 %THEN TYPE=8 %ELSE %START
if (TYPE > 3) goto L_012B;
TYPE = 8;
goto L_012C;
L_012B:;
// 1208 TYPE=9 %IF TYPE >= 6
if (TYPE < 6) goto L_012D;
TYPE = 9;
L_012D:;
// 1209 %FINISH
L_012C:;
// 1210 -> DCONT
goto U_100A;
// 1211 DIR(91): ! %M
case_DIR_91:;
// 1212 -> DALT %IF BLOCK TYPE&15#9; ! NOT A MAP
if (BLOCKTYPE & 15 == 9) goto L_012E;
goto U_100B;
L_012E:;
// 1213 TYPE=BLOCK TYPE>>4&7
TYPE = (unsigned int)BLOCKTYPE >> 4 & 7;
// 1214 -> DCONT
goto U_100A;
// 1215 DIR(94): ! %SUB
case_DIR_94:;
// 1216 -> DCONT %IF SUB LOCK#0
if (SUBLOCK == 0) goto L_012F;
goto U_100A;
L_012F:;
// 1217 -> ALT %UNLESS ATOM1=U LINE
if (ATOM1 == 18) goto L_0130;
goto U_1005;
L_0130:;
// 1218 -> ERROR %IF SYMTYPE # -2
if (SYMTYPE == -2) goto L_0131;
goto U_1004;
L_0131:;
// 1219 L=FORMAT
L = FORMAT;
// 1220 CODE ATOM
CODEATOM();
// 1221 ATOM2=0
ATOM2 = 0;
// 1222 F TYPE=8 %AND -> ERROR %IF L <= 0
if (L > 0) goto L_0132;
FTYPE = 8;
goto U_1004;
L_0132:;
// 1223 LIM=DICT(L); ! ONTO THE END
LIM = DICT[L];
// 1224 LOOKUP(L); ! LOOK FOR SUBNAME
LOOKUP(L);
// 1225 F TYPE=3 %AND -> ERROR %IF ATOM2=0
if (ATOM2 != 0) goto L_0133;
FTYPE = 3;
goto U_1004;
L_0133:;
// 1226 ! NOT FOUND
// 1227 SUB LOCK=1
SUBLOCK = 1;
// 1228 -> DCONT
goto U_100A;
// 1229 DIR(95): ! %APP
case_DIR_95:;
// 1230 -> ALT %UNLESS ATOM1=LB
if (ATOM1 == 1) goto L_0134;
goto U_1005;
L_0134:;
// 1231 -> DCONT
goto U_100A;
// 1232 DIR(97): ! %SETPLUS
case_DIR_97:;
// 1233 PAPP = APP
*PAPP = APP;
// 1234 L = PHRASE(152+APARM&7)
L = PHRASE[152 + (APARM & 7) - 132];
// 1235 DICT(APARM>>3)=L %IF APARM&X'FFF8'#0
if (APARM & 65528 == 0) goto L_0135;
DICT[(unsigned int)APARM >> 3] = L;
L_0135:;
// 1236 %WHILE A CHAIN#0 %CYCLE
L_0136:;
if (ACHAIN == 0) goto L_0137;
// 1237 T=A CHAIN; A CHAIN=DICT(T); DICT(T)=L
T = ACHAIN;
ACHAIN = DICT[T];
DICT[T] = L;
// 1238 %REPEAT
goto L_0136;
L_0137:;
// 1239 ! SET APP FOR ARRAY
// 1240 -> DCONT
goto U_100A;
// 1241 DIR(98): ! %PLUS
case_DIR_98:;
// 1242 F TYPE=4 %AND -> ERROR %IF APARM&7=6
if (APARM & 7 != 6) goto L_0138;
FTYPE = 4;
goto U_1004;
L_0138:;
// 1243 APARM=APARM+1
APARM = APARM + 1;
// 1244 -> DCONT
goto U_100A;
// 1245 DIR(99): ! %AMBIG
case_DIR_99:;
// 1246 AMBIG=J&511
AMBIG = J & 511;
// 1247 -> ALT
goto U_1005;
// 1248 DIR(100): ! %DUMMY
case_DIR_100:;
// 1249 EXTEND = 1 %IF A1 # A
if (A1 == A) goto L_0139;
EXTEND = 1;
L_0139:;
// 1250 A1 = A1-1; K = 0
A1 = A1 - 1;
K = 0;
// 1251 ->ENTRY
goto U_1006;
// 1252 DIR(101): ! %LUP
case_DIR_101:;
// 1253 DICT(T LIMIT-2)=APARM
DICT[TLIMIT - 2] = APARM;
// 1254 DICT(T LIMIT-1)=FORMAT
DICT[TLIMIT - 1] = FORMAT;
// 1255 ->DCONT %UNLESS NODE = A1
if (NODE == A1) goto L_013A;
goto U_100A;
L_013A:;
// 1256 TLIMIT = TLIMIT-2; FAULT(23) %IF T LIMIT <= T MAX
TLIMIT = TLIMIT - 2;
if (TLIMIT > TMAX) goto L_013B;
FAULT(23);
L_013B:;
// 1257 -> DCONT
goto U_100A;
// 1258 DIR(102): ! %LDOWN
case_DIR_102:;
// 1259 ->DCONT %IF DOWN LOCK # 0
if (DOWNLOCK == 0) goto L_013C;
goto U_100A;
L_013C:;
// 1260 DOWN LOCK = 1
DOWNLOCK = 1;
// 1261 APARM=DICT(T LIMIT )
APARM = DICT[TLIMIT];
// 1262 FORMAT=DICT(T LIMIT+1)
FORMAT = DICT[TLIMIT + 1];
// 1263 T LIMIT = T LIMIT+2 %IF NODE = A1
if (NODE != A1) goto L_013D;
TLIMIT = TLIMIT + 2;
L_013D:;
// 1264 -> D CONT
goto U_100A;
// 1265 DALT: F TYPE=5; ! CONTEXT
U_100B:;
FTYPE = 5;
// 1266 -> ALT
goto U_1005;
// 1267 %END; ! OF ANALYSE
case_DIR_dispatch:
if (DIR_index < 86 || DIR_index > 102)
_imp_signalf(6, 3, DIR_index, "->DIR(%d) out of bounds at %s line %d", DIR_index, DIR_file, DIR_line);
goto *DIR[DIR_index - 86];
case_DIR_missing:
_imp_signalf(8, 2, DIR_index, "switch jump to undefined label DIR(%d): at %s line %d", DIR_index, DIR_file,
DIR_line);
} /* end of ANALYSE */
// 1268 FORMAT=0; APARM=0; RELOCATE=0
FORMAT = 0;
APARM = 0;
RELOCATE = 0;
// 1269 LITPOS=400
LITPOS = 400;
// 1270 SS=0; DEC TYPE=0; DUP=0; CONST INT = 0
SS = 0;
DECTYPE = 0;
DUP = 0;
CONSTINT = 0;
// 1271 PREFIX=0; SPREFIX=0
PREFIX = 0;
SPREFIX = 0;
// 1272 A CHAIN=0; F TYPE=0; MARK = ' '
ACHAIN = 0;
FTYPE = 0;
MARK = 32;
// 1273 %IF CONT=0 %START
if (CONT != 0) goto L_013E;
// 1274 MARGIN = MARGIN+POS
MARGIN = MARGIN + POS;
// 1275 %IF SYM TYPE=0 %START
if (SYMTYPE != 0) goto L_013F;
// 1276 POS=0; READ SYM
POS = 0;
READSYM();
// 1277 %FINISH
L_013F:;
// 1278 ATOM1=0
ATOM1 = 0;
// 1279 %IF SYMTYPE=0 %OR SYM='!' %START
if (SYMTYPE == 0) goto L_0140;
if (SYM != 33) goto L_0141;
L_0140:;
// 1280 SKIP: READSYM %WHILE SYMTYPE#0
U_100C:;
L_0142:;
if (SYMTYPE == 0) goto L_0143;
READSYM();
goto L_0142;
L_0143:;
// 1281 %RETURN
return;
// 1282 %FINISH
L_0141:;
// 1283 CODE ATOM; -> SKIP %IF ATOM1=COMMENT
CODEATOM();
if (ATOM1 != 7) goto L_0144;
goto U_100C;
L_0144:;
// 1284 STATS=STATS+1
STATS = STATS + 1;
// 1285 OP('O',LINE NUM) %IF PERMIN = 0; ! DUMP LINE NUMBER
if (PERMIN != 0) goto L_0145;
OP(79, LINENUM);
L_0145:;
// 1286 %IF ATOM1 = MCODE %AND SUBATOM = 1 %START
if (ATOM1 != 38) goto L_0146;
if (SUBATOM != 1) goto L_0146;
// 1287 CODE ATOM
CODEATOM();
// 1288 %IF ATOM2 = IDENT %START
if (ATOM2 != 59) goto L_0147;
// 1289 LIM = GLOBAL; LOOKUP(T BASE)
LIM = 0;
LOOKUP(TBASE);
// 1290 %FINISH
L_0147:;
// 1291 FAULT(0) %IF ATOM2 # ICONST
if (ATOM2 == 83) goto L_0148;
FAULT(0);
L_0148:;
// 1292 CGEN(EVAL(SUBATOM)); PUT('P')
CGEN(EVAL(SUBATOM));
PUT(80);
// 1293 %RETURN
return;
// 1294 %FINISH
L_0146:;
// 1295 TYPE=0
TYPE = 0;
// 1296 %IF ATOM1=IDENT %AND (SYM=':' %OR ATOM2=SWITCH) %START
if (ATOM1 != 59) goto L_0149;
if (SYM == 58) goto L_014A;
if (ATOM2 != 80) goto L_0149;
L_014A:;
// 1297 DEC TYPE=3
DECTYPE = 3;
// 1298 SS TYPE=0; ANALYSE(PHRASE(SS0));! LABEL
SSTYPE = 0;
ANALYSE(PHRASE[118]);
// 1299 %ELSE
goto L_014B;
L_0149:;
// 1300 %IF DEC TYPE#0 %OR OUT#0 %START
if (DECTYPE != 0) goto L_014C;
if (OUT == 0) goto L_014D;
L_014C:;
// 1301 TYPE=OUT
TYPE = OUT;
// 1302 SS TYPE=1; ANALYSE(PHRASE(SS1));! DECLARATION
SSTYPE = 1;
ANALYSE(PHRASE[119]);
// 1303 %ELSE
goto L_014E;
L_014D:;
// 1304 SS TYPE=3; ANALYSE(PHRASE(SS3));! STATEMENT
SSTYPE = 3;
ANALYSE(PHRASE[121]);
// 1305 %FINISH
L_014E:;
// 1306 %FINISH
L_014B:;
// 1307 %RETURN
return;
// 1308 %FINISH
L_013E:;
// 1309 CODE ATOM
CODEATOM();
// 1310 %IF CONT > 0 %START; ! APP
if (CONT <= 0) goto L_014F;
// 1311 SS TYPE=2; ANALYSE(PHRASE(SS2)); ! FORMAL PARAMETER
SSTYPE = 2;
ANALYSE(PHRASE[120]);
// 1312 J=GAPP
J = GAPP();
// 1313 FAULT(6) %IF 0#|FPP|#J
{
// Double-sided test on _imp_IMOD(*FPP) (Part I)
int tmp;
if (0 == (tmp = _imp_IMOD(*FPP))) goto L_0150;
// Double-sided test on _imp_IMOD(*FPP) (Part II)
if (tmp == J) goto L_0150;
}
FAULT(6);
L_0150:;
// 1314 FPP=J*SPEC
*FPP = J * SPEC;
// 1315 %ELSE; ! RECORDFORMAT
goto L_0151;
L_014F:;
// 1316 FP=TMAX; ! REMEMBER START OF NAMES
FP = TMAX;
// 1317 SS TYPE=4; ANALYSE(PHRASE(SS4))
SSTYPE = 4;
ANALYSE(PHRASE[122]);
// 1318 %IF SS#0 %AND TMAX > FP %START
if (SS == 0) goto L_0152;
if (TMAX <= FP) goto L_0152;
// 1319 J=T LIMIT+TBASE-TMAX-1
J = TLIMIT + TBASE - TMAX - 1;
// 1320 FAULT(21) %IF J <= TMAX
if (J > TMAX) goto L_0153;
FAULT(21);
L_0153:;
// 1321 FPP=T LIMIT-1; ! FILL IN FORMAT REFERENCE
*FPP = TLIMIT - 1;
// 1322 DICT(FPP)=J; ! END OF FORMAT
DICT[*FPP] = J;
// 1323 RELOCATE=J-FP
RELOCATE = J - FP;
// 1324 %CYCLE K=J,1,FPP-1
// %for K = J, 1, *FPP - 1 %cycle
{
int _initial = J, _final = *FPP - 1;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle K = J, 1, *FPP - 1");
K = _initial - (1);
L_0154:
if (K == _final) goto L_0155;
K += 1;
// ?Non-local
// 1325 DICT(K)=DICT(FP)
DICT[K] = DICT[FP];
// 1326 FP=FP+1
FP = FP + 1;
// 1327 %REPEAT
goto L_0154;
}
L_0155:;
// 1328 T LIMIT=J
TLIMIT = J;
// 1329 %FINISH
L_0152:;
// 1330 %FINISH
L_0151:;
// 1331 %END; ! ANALYSE SS
return;
} /* end of ANALYSESS */
// 1332 %ROUTINE COMPILE SS
void COMPILESS(void) {
// 1333 %CONSTBYTEINTEGERARRAY RCOMP(33:40)=34,33,35,36,38,37,39,40
const unsigned char RCOMP[8] = {34, 33, 35, 36, 38, 37, 39, 40};
struct _imp_dv RCOMP_dv = {RCOMP, sizeof(unsigned char) /*, dims, <bounds> */};
// 1334 %CONSTBYTEINTEGERARRAY COMP(33:40)='>','<','=','#',')','(',116,107
const unsigned char COMP[8] = {62, 60, 61, 35, 41, 40, 116, 107};
struct _imp_dv COMP_dv = {COMP, sizeof(unsigned char) /*, dims, <bounds> */};
// 1335 ! 116 = LOWER CASE 'T', 107 = LOWER CASE 'K'
// 1336 %CONSTBYTEINTEGERARRAY CON OP(82 : 84)='''', 'N', 'D'
const unsigned char CONOP[3] = {39, 78, 68};
struct _imp_dv CONOP_dv = {CONOP, sizeof(unsigned char) /*, dims, <bounds> */};
// 1337 %CONSTBYTEINTEGERARRAY OPCODE(1:10)='*','/','&','!',
const unsigned char OPCODE[10] = {42, 47, 38, 33, 37, 91, 93, 46, 92, 120};
struct _imp_dv OPCODE_dv = {OPCODE, sizeof(unsigned char) /*, dims, <bounds> */};
// 1338+ '%','[',']','.','\',120
// 1339 ! 120 = LOWER CASE 'X'
// 1340 %SWITCH C(1 : 130), D(50 : 57)
int C_index;
int C_line;
char *C_file;
static const void *C[130] = {
&&case_C_1, &&case_C_2, &&case_C_3, &&case_C_4, &&case_C_5, &&case_C_6,
&&case_C_7, &&case_C_8, &&case_C_9, &&case_C_10, &&case_C_11, &&case_C_12,
&&case_C_13, &&case_C_14, &&case_C_15, &&case_C_16, &&case_C_17, &&case_C_18,
&&case_C_19, &&case_C_20, &&case_C_21, &&case_C_22, &&case_C_23, &&case_C_24,
&&case_C_25, &&case_C_26, &&case_C_27, &&case_C_28, &&case_C_29, &&case_C_30,
&&case_C_31, &&case_C_32, &&case_C_33, &&case_C_34, &&case_C_35, &&case_C_36,
&&case_C_37, &&case_C_38, &&case_C_39, &&case_C_40, &&case_C_41, &&case_C_42,
&&case_C_43, &&case_C_44, &&case_C_45, &&case_C_46, &&case_C_missing, &&case_C_missing,
&&case_C_49, &&case_C_50, &&case_C_51, &&case_C_52, &&case_C_53, &&case_C_54,
&&case_C_missing, &&case_C_56, &&case_C_57, &&case_C_missing, &&case_C_missing, &&case_C_60,
&&case_C_61, &&case_C_62, &&case_C_63, &&case_C_64, &&case_C_65, &&case_C_66,
&&case_C_67, &&case_C_68, &&case_C_69, &&case_C_70, &&case_C_71, &&case_C_72,
&&case_C_73, &&case_C_74, &&case_C_75, &&case_C_76, &&case_C_77, &&case_C_78,
&&case_C_79, &&case_C_80, &&case_C_81, &&case_C_82, &&case_C_83, &&case_C_84,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_105, &&case_C_106, &&case_C_107, &&case_C_108,
&&case_C_109, &&case_C_110, &&case_C_111, &&case_C_112, &&case_C_113, &&case_C_114,
&&case_C_115, &&case_C_116, &&case_C_117, &&case_C_118, &&case_C_119, &&case_C_missing,
&&case_C_missing, &&case_C_122, &&case_C_123, &&case_C_124, &&case_C_125, &&case_C_126,
&&case_C_127, &&case_C_128, &&case_C_129, &&case_C_130};
int D_index;
int D_line;
char *D_file;
static const void *D[8] = {&&case_D_50, &&case_D_51, &&case_D_52, &&case_D_53,
&&case_D_54, &&case_D_missing, &&case_D_56, &&case_D_57};
// 1341 %BYTEINTEGERNAME MM
unsigned char *MM;
// 1342 %INTEGERNAME M
int *M;
// 1343 %INTEGER L, DIM, K
int L;
int DIM;
int K;
// 1344 %OWNINTEGER OWN DEF=0
static int OWNDEF = 0;
// 1345 %OWNINTEGER BP SIZE=0
static int BPSIZE = 0;
// 1346 %INTEGER CALL PENDING, PRED PENDING, PRED OP
int CALLPENDING;
int PREDPENDING;
int PREDOP;
// 1347 %INTEGER GLOBAL NOT, LOCAL NOT
int GLOBALNOT;
int LOCALNOT;
// 1348 %INTEGER CLAST, CMOD, OPS, BIT, CLEVEL, DOUBLE
int CLAST;
int CMOD;
int OPS;
int BIT;
int CLEVEL;
int DOUBLE;
// 1349 %INTEGER PLAB, LOOP LAB, ULAB, CONDS, ELSE
int PLAB;
int LOOPLAB;
int ULAB;
int CONDS;
int ELSE;
// 1350 %INTEGER LIT1, LIT2, STARTT
int LIT1;
int LIT2;
int STARTT;
// 1351 %INTEGER NEXT, CLASS, DCLASS, LINK
int NEXT;
int CLASS;
int DCLASS;
int LINK;
// 1352
// 1353 %ROUTINE AOP(%INTEGER C, A)
void AOP(int C, int A) {
// 1354 PUT(C)
PUT(C);
// 1355 %IF A < 0 %START
if (A >= 0) goto L_0157;
// 1356 A = -A; PUT('-')
A = -A;
PUT(45);
// 1357 %ELSE
goto L_0158;
L_0157:;
// 1358 A = A//2
A = ((long)A / (long)2);
// 1359 %FINISH
L_0158:;
// 1360 ADDR(A)
ADDR(A);
// 1361 %END
return;
} /* end of AOP */
// 1362
// 1363 %ROUTINE EXTRA(%INTEGER N)
void EXTRA(int N) {
// 1364 PUT(','); ADDR(N)
PUT(44);
ADDR(N);
// 1365 %END
return;
} /* end of EXTRA */
// 1366
// 1367 %ROUTINE DEF(%INTEGER N)
void DEF(int N) {
// 1368 %INTEGER K
int K;
// 1369 N=N+RELOCATE
N = N + RELOCATE;
// 1370 AOP('$',N); PRINT NAME(-N)
AOP(36, N);
PRINTNAME(-N);
// 1371 K=DICT(N-1)
K = DICT[N - 1];
// 1372 EXTRA(K&127); ! TYPE!FORM
EXTRA(K & 127);
// 1373 EXTRA(K>>8&255); ! MAX STRING LENGTH
EXTRA((unsigned int)K >> 8 & 255);
// 1374 EXTRA(DICT(N)>>13&7); ! OTYPE
EXTRA((unsigned int)DICT[N] >> 13 & 7);
// 1375 ! RECORD
// 1376 AOP(',',DICT(N-2)) %IF K&X'70'=X'50' %AND K&127#84
if (K & 112 != 80) goto L_0159;
if (K & 127 == 84) goto L_0159;
AOP(44, DICT[N - 2]);
L_0159:;
// 1377 %END
return;
} /* end of DEF */
// 1378
// 1379 %ROUTINE CALL
void CALL(void) {
// 1380 %INTEGER P
int P;
// 1381 CALL PENDING = 1
CALLPENDING = 1;
// 1382 AOP('@',X)
AOP(64, X);
// 1383 P = X
P = X;
// 1384 P = P-1 %IF DICT(X)&512 # 0
if (DICT[X] & 512 == 0) goto L_015A;
P = P - 1;
L_015A:;
// 1385 %IF |DICT(P-2)| = NULL %START
if (_imp_IMOD(DICT[P - 2]) != 512) goto L_015B;
// 1386 PUT('E'); CALL PENDING = 0
PUT(69);
CALLPENDING = 0;
// 1387 %ELSE
goto L_015C;
L_015B:;
// 1388 PRED PENDING = PRED PENDING<<1
PREDPENDING = PREDPENDING << 1;
// 1389 %FINISH
L_015C:;
// 1390 %END
return;
} /* end of CALL */
// 1391 %ROUTINE SET SIZE
void SETSIZE(void) {
// 1392 BP SIZE=LIT1-LIT2+1
BPSIZE = LIT1 - LIT2 + 1;
// 1393 %IF BPSIZE <= 0 %START
if (BPSIZE > 0) goto L_015D;
// 1394 ATOM POS=0; FAULT(4)
ATOMPOS = 0;
FAULT(4);
// 1395 BP SIZE=1
BPSIZE = 1;
// 1396 %FINISH
L_015D:;
// 1397 PUT('B'+32); ADDR(BP SIZE)
PUT(66 + 32);
ADDR(BPSIZE);
// 1398 %END
return;
} /* end of SETSIZE */
// 1399
// 1400 %ROUTINE POP LAB(%INTEGER MODE)
void POPLAB(int MODE) {
// 1401 %INTEGER L
int L;
// 1402 %IF LABEL > OLD LABEL %START
if (LABEL <= OLDLABEL) goto L_015E;
// 1403 L = LAB INF(LABEL>>2)
L = LABINF[((unsigned int)LABEL >> 2) - 1];
// 1404 %IF (L!!MODE)&1 # 0 %START
if ((L ^ MODE) & 1 == 0) goto L_015F;
// 1405 LABEL = LABEL-4; P LAB = LABEL
LABEL = LABEL - 4;
PLAB = LABEL;
// 1406 EILAB = PLAB+1 %IF L&4 # 0
if (L & 4 == 0) goto L_0160;
EILAB = PLAB + 1;
L_0160:;
// 1407 P LAB = P LAB+1 %IF L&3 = 3
if (L & 3 != 3) goto L_0161;
PLAB = PLAB + 1;
L_0161:;
// 1408 PLAB = 0 %IF L&8 = 0; ! NO EXIT CONDITION
if (L & 8 != 0) goto L_0162;
PLAB = 0;
L_0162:;
// 1409 %RETURN
return;
// 1410 %FINISH
L_015F:;
// 1411 %FINISH
L_015E:;
// 1412 %IF MODE = 0 %THEN MODE = 13 %ELSE MODE = 10
if (MODE != 0) goto L_0163;
MODE = 13;
goto L_0164;
L_0163:;
MODE = 10;
L_0164:;
// 1413 FAULT(MODE); ACCESS = 1
FAULT(MODE);
ACCESS = 1;
// 1414 %END
return;
} /* end of POPLAB */
// 1415
// 1416 %ROUTINE C END
void CEND(void) {
// 1417 %INTEGER L, T,LIM, FLAG
int L;
int T;
int LIM;
int FLAG;
// 1418 %IF X=88 %START; ! ENDOFPERM
if (X != 88) goto L_0165;
// 1419 STATS=0; LINE NUM=0
STATS = 0;
LINENUM = 0;
// 1420 LIST=LIST&1; DEC TYPE=0
LIST = LIST & 1;
DECTYPE = 0;
// 1421 SELECTINPUT(PROG); ! ONTO SOURCE PROGRAM
_imp_SELECTINPUT(1);
// 1422 PERMIN = 0; ! SHOW NOT IN PERM
PERMIN = 0;
// 1423 %RETURN
return;
// 1424 %FINISH
L_0165:;
// 1425 ATOM POS = 0; FLAG = SYM
ATOMPOS = 0;
FLAG = SYM;
// 1426 %IF LEVEL = 1 %AND X # EOP %AND FILE = 2 %START
if (LEVEL != 1) goto L_0166;
if (X == 87) goto L_0166;
if (FILE != 2) goto L_0166;
// 1427 DEC TYPE = EOP; FAULT(5)
DECTYPE = 87;
FAULT(5);
// 1428 %FINISH
L_0166:;
// 1429 LIM = T BASE
LIM = TBASE;
// 1430 %IF X=EOP %OR X=EOF %START; ! EOP
if (X == 87) goto L_0167;
if (X != 86) goto L_0168;
L_0167:;
// 1431 X = X-EOF; ! EOF -> 0, EOP -> L1
X = X - 86;
// 1432 FAULT(5) %UNLESS X = LEVEL
if (X == LEVEL) goto L_0169;
FAULT(5);
L_0169:;
// 1433 PUT(';')
PUT(59);
// 1434 %WHILE LEVEL > 1 %CYCLE
L_016A:;
if (LEVEL <= 1) goto L_016B;
// 1435 FAULT(9)
FAULT(9);
// 1436 LEVEL=LEVEL-1
LEVEL = LEVEL - 1;
// 1437 %REPEAT
goto L_016A;
L_016B:;
// 1438 LIM = GLOBAL; ! GIVE UNUSED FOR GLOBALS
LIM = 0;
// 1439 %ELSE
goto L_016C;
L_0168:;
// 1440 FAULT(5) %IF LEVEL <= 1 %AND FILE = 2
if (LEVEL > 1) goto L_016D;
if (FILE != 2) goto L_016D;
FAULT(5);
L_016D:;
// 1441 PUT(';')
PUT(59);
// 1442 %FINISH
L_016C:;
// 1443 %WHILE LABEL > OLD LABEL %CYCLE
L_016E:;
if (LABEL <= OLDLABEL) goto L_016F;
// 1444 L=LABINF(LABEL>>2)
L = LABINF[((unsigned int)LABEL >> 2) - 1];
// 1445 %IF L&7=2 %THEN L=11 %ELSE L=14
if (L & 7 != 2) goto L_0170;
L = 11;
goto L_0171;
L_0170:;
L = 14;
L_0171:;
// 1446 LABEL=LABEL-4
LABEL = LABEL - 4;
// 1447 FAULT(L)
FAULT(L);
// 1448 %REPEAT
goto L_016E;
L_016F:;
// 1449 FAULT(17) %IF ACCESS # 0 %AND 8 <= BLOCKTYPE&15 <= 10
if (ACCESS == 0) goto L_0172;
{
// Double-sided test on BLOCKTYPE & 15 (Part I)
int tmp;
if (8 > (tmp = BLOCKTYPE & 15)) goto L_0172;
// Double-sided test on BLOCKTYPE & 15 (Part II)
if (tmp > 10) goto L_0172;
}
FAULT(17);
L_0172:;
// 1450 X=T MAX-1
X = TMAX - 1;
// 1451 %WHILE X > LIM %CYCLE
L_0173:;
if (X <= LIM) goto L_0174;
// 1452 T=DICT(X)
T = DICT[X];
// 1453 %IF DICT(X-1)&128=0=LIST %AND T&X'400' = 0 %START
{
// Double-sided test on 0 (Part I)
int tmp;
if (DICT[X - 1] & 128 != (tmp = 0)) goto L_0175;
// Double-sided test on 0 (Part II)
if (tmp != LIST) goto L_0175;
}
if (T & 1024 != 0) goto L_0175;
// 1454 %IF CONTROL&X'1000' = 0 %START
if (CONTROL & 4096 != 0) goto L_0176;
// 1455 %IF FLAG # NL %START
if (FLAG == 10) goto L_0177;
// 1456 MARGIN = MARGIN+POS
MARGIN = MARGIN + POS;
// 1457 NEWLINE
_imp_NEWLINE();
// 1458 FLAG = 0
FLAG = 0;
// 1459 %FINISH
L_0177:;
// 1460 PRINTSTRING("? ")
_imp_PRINTSTRING(_imp_str_literal("? "));
// 1461 PRINT NAME(X)
PRINTNAME(X);
// 1462 PRINTSTRING(" UNUSED
_imp_PRINTSTRING(_imp_str_literal(" UNUSED\n"));
// 1463+ ")
// 1464 %FINISH
L_0176:;
// 1465 %FINISH
L_0175:;
// 1466 FAULT(12) %IF T&X'400'#0
if (T & 1024 == 0) goto L_0178;
FAULT(12);
L_0178:;
// 1467 X=X-T&255-3
X = X - (T & 255) - 3;
// 1468 %REPEAT
goto L_0173;
L_0174:;
// 1469 printsymbol(11)
_imp_PRINTSYMBOL(11);
// 1470 SPACES(MARGIN+8) %IF FLAG = 0
if (FLAG != 0) goto L_0179;
_imp_SPACES(MARGIN + 8);
L_0179:;
// 1471 %END
return;
} /* end of CEND */
// 1472 FAULT(24) %IF LABEL < 4 %OR LABEL > MAX LAB<<2
if (LABEL < 4) goto L_017A;
if (LABEL <= 80 << 2) goto L_017B;
L_017A:;
FAULT(24);
L_017B:;
// 1473 %IF ACCESS = 0 %AND SSTYPE = 3 %AND 33 # LOC(-1)&255 # 34 %START
if (ACCESS != 0) goto L_017C;
if (SSTYPE != 3) goto L_017C;
{
// Double-sided test on LOC[299] & 255 (Part I)
int tmp;
if (33 == (tmp = LOC[299] & 255)) goto L_017C;
// Double-sided test on LOC[299] & 255 (Part II)
if (tmp == 34) goto L_017C;
}
// 1474 FAULT(18) %IF CONTROL&X'1000' = 0; ACCESS = 1
if (CONTROL & 4096 != 0) goto L_017D;
FAULT(18);
L_017D:;
ACCESS = 1;
// 1475 %FINISH
L_017C:;
// 1476 CONDS=0; DIM=0; PRED PENDING = 0; PRED OP = 0
CONDS = 0;
DIM = 0;
PREDPENDING = 0;
PREDOP = 0;
// 1477 STARTT=0; ! DEFAULT TO CYCLE
STARTT = 0;
// 1478 PLAB=0; ULAB=0; LOOP LAB=0; ELSE = 0; EILAB = 0
PLAB = 0;
ULAB = 0;
LOOPLAB = 0;
ELSE = 0;
EILAB = 0;
// 1479 LIT1=0; LIT2=0
LIT1 = 0;
LIT2 = 0;
// 1480 NEXT=SS; LINK=0
NEXT = SS;
LINK = 0;
// 1481 LIT=0
LIT = 0;
// 1482 DCLASS = 0
DCLASS = 0;
// 1483 TOP: %CYCLE
U_100D:;
L_017E:;
// 1484 X=SUB(NEXT)
X = SUB[NEXT + 300];
// 1485 %EXIT %UNLESS X < 0 %AND NEXT <= P
if (X >= 0) goto L_017F;
if (NEXT <= P) goto L_0180;
L_017F:;
goto L_0181;
L_0180:;
// 1486 %IF CO(NEXT)#0 %START
if (CO[NEXT + 300] == 0) goto L_0182;
// 1487 SUB(NEXT)=LINK; LINK=NEXT
SUB[NEXT + 300] = LINK;
LINK = NEXT;
// 1488 %FINISH
L_0182:;
// 1489 NEXT=X
NEXT = X;
// 1490 %REPEAT
goto L_017E;
L_0181:;
// 1491 CLASS=LOC(NEXT)&255
CLASS = LOC[NEXT + 300] & 255;
// 1492 %IF DIAG&2 # 0 %START
if (DIAG & 2 == 0) goto L_0183;
// 1493 PRINTSTRING("C ="); WRITE(CLASS, 3)
_imp_PRINTSTRING(_imp_str_literal("C ="));
_imp_WRITE(CLASS, 3);
// 1494 PRINTSTRING(" X ="); WRITE(X, 3)
_imp_PRINTSTRING(_imp_str_literal(" X ="));
_imp_WRITE(X, 3);
// 1495 PRINTSTRING(" NEXT ="); WRITE(NEXT, 3)
_imp_PRINTSTRING(_imp_str_literal(" NEXT ="));
_imp_WRITE(NEXT, 3);
// 1496 NEWLINE
_imp_NEWLINE();
// 1497 %FINISH
L_0183:;
// 1498 NEXT=CO(NEXT)
NEXT = CO[NEXT + 300];
// 1499 -> C(X) %IF CLASS < PRE1
if (CLASS >= 49) goto L_0184;
C_line = __LINE__;
C_file = __FILE__;
C_index = X;
goto case_C_dispatch;
L_0184:;
// 1500 -> CONT %IF CLASS=APPEP
if (CLASS != 153) goto L_0186;
goto U_100E;
L_0186:;
// 1501 -> C(CLASS) %UNLESS CLASS=IDENT
if (CLASS == 59) goto L_0187;
C_line = __LINE__;
C_file = __FILE__;
C_index = CLASS;
goto case_C_dispatch;
L_0187:;
// 1502 -> D(DCLASS)
D_line = __LINE__;
D_file = __FILE__;
D_index = DCLASS;
goto case_D_dispatch;
// 1503 ACONT: ACCESS = 0
U_100F:;
ACCESS = 0;
// 1504 C(112): ! %AND (UI)
case_C_112:;
// 1505 CONT: %CYCLE
U_100E:;
L_0189:;
// 1506 ->TOP %IF NEXT#0
if (NEXT == 0) goto L_018A;
goto U_100D;
L_018A:;
// 1507 ->RETURN %IF LINK=0
if (LINK != 0) goto L_018B;
goto U_1010;
L_018B:;
// 1508 NEXT=CO(LINK); LINK=SUB(LINK)
NEXT = CO[LINK + 300];
LINK = SUB[LINK + 300];
// 1509 %REPEAT
goto L_0189;
// 1510 C(9): ! '\'
case_C_9:;
// 1511 %IF CLASS = 45 %START;! LOGICAL NOT
if (CLASS != 45) goto L_018C;
// 1512 LIT1=\LIT1 %AND LIT = LIT+1 %IF LIT=CODE
if (LIT != CODE) goto L_018D;
LIT1 = (~LIT1);
LIT = LIT + 1;
L_018D:;
// 1513 %ELSE
goto L_018E;
L_018C:;
// 1514 X = 10
X = 10;
// 1515 %FINISH
L_018E:;
// 1516 C(1): ! '*'
case_C_1:;
// 1517 C(2): ! '/'
case_C_2:;
// 1518 C(3): ! '&'
case_C_3:;
// 1519 C(4): ! '!'
case_C_4:;
// 1520 C(5): ! '!!'
case_C_5:;
// 1521 C(6): ! '<<'
case_C_6:;
// 1522 C(7): ! '>>'
case_C_7:;
// 1523 C(8): ! '.'
case_C_8:;
// 1524 PUT(OPCODE(X)); -> CONT
PUT(OPCODE[X - 1]);
goto U_100E;
// 1525 C(46):PUT('Q'); ->CONT;! REAL DIVIDE
case_C_46:;
PUT(81);
goto U_100E;
// 1526 C(10): PUT('M'); -> ACONT; ! %RESULT==
case_C_10:;
PUT(77);
goto U_100F;
// 1527 C(11): PUT('+') %UNLESS CLASS=44; ! UNARY PLUS
case_C_11:;
if (CLASS == 44) goto L_018F;
PUT(43);
L_018F:;
// 1528 -> CONT
goto U_100E;
// 1529 C(12): %IF CLASS#43 %THEN PUT('-') %ELSE %START
case_C_12:;
if (CLASS == 43) goto L_0190;
PUT(45);
goto L_0191;
L_0190:;
// 1530 LIT1=-LIT1 %AND LIT = LIT+1 %IF LIT=CODE
if (LIT != CODE) goto L_0192;
LIT1 = -LIT1;
LIT = LIT + 1;
L_0192:;
// 1531 PUT('U')
PUT(85);
// 1532 %FINISH
L_0191:;
// 1533 -> CONT
goto U_100E;
// 1534 C(13): PUT('X'); ->CONT; ! \\
case_C_13:;
PUT(88);
goto U_100E;
// 1535 C(14): PUT('Y'+32); DIAG = LIT1; -> CONT; ! DIAG
case_C_14:;
PUT(89 + 32);
DIAG = LIT1;
goto U_100E;
// 1536 C(15): PUT('Z'+32); CONTROL = LIT1; -> CONT; ! CONTROL
case_C_15:;
PUT(90 + 32);
CONTROL = LIT1;
goto U_100E;
// 1537 C(16): PUT('V'); -> ACONT; ! %RESULT=
case_C_16:;
PUT(86);
goto U_100F;
// 1538 C(17): %IF BLOCKTYPE # 7 %START
case_C_17:;
if (BLOCKTYPE == 7) goto L_0193;
// 1539 FAULT(5) %UNLESS DIAG < 0 %AND BLOCKTYPE&15 = 8
if (DIAG >= 0) goto L_0194;
if (BLOCKTYPE & 15 == 8) goto L_0195;
L_0194:;
FAULT(5);
L_0195:;
// 1540 %FINISH
L_0193:;
// 1541 PUT('R'); -> ACONT; ! RETURN
PUT(82);
goto U_100F;
// 1542 C(18): PUT('T'); -> PREDT; ! TRUE
case_C_18:;
PUT(84);
goto U_1011;
// 1543 C(19): PUT('K'); ! FALSE
case_C_19:;
PUT(75);
// 1544 PREDT: FAULT(5) %UNLESS BLOCKTYPE = 10
U_1011:;
if (BLOCKTYPE == 10) goto L_0196;
FAULT(5);
L_0196:;
// 1545 ->ACONT
goto U_100F;
// 1546 C(20): PUT(101); -> ACONT; ! %SIGNAL
case_C_20:;
PUT(101);
goto U_100F;
// 1547 C(44):LIT2 = 0; ! %ON %EVENT
case_C_44:;
LIT2 = 0;
// 1548 FAULT(15) %IF INHIBIT&1 # 0
if (INHIBIT & 1 == 0) goto L_0197;
FAULT(15);
L_0197:;
// 1549 INHIBIT = INHIBIT!1
INHIBIT = INHIBIT | 1;
// 1550 %CYCLE
L_0198:;
// 1551 %EXIT %IF NEXT = 0
if (NEXT != 0) goto L_0199;
goto L_019A;
L_0199:;
// 1552 X = SUB(NEXT)
X = SUB[NEXT + 300];
// 1553 %EXIT %IF (X < 0 %AND NEXT <= P) %OR LOC(NEXT)&255 # ICONST
if (X >= 0) goto L_019B;
if (NEXT <= P) goto L_019C;
L_019B:;
if (LOC[NEXT + 300] & 255 == 83) goto L_019D;
L_019C:;
goto L_019A;
L_019D:;
// 1554 NEXT = CO(NEXT)
NEXT = CO[NEXT + 300];
// 1555 LIT1 = EVAL(X)
LIT1 = EVAL(X);
// 1556 FAULT(16) %AND LIT1 = 0 %UNLESS 0 <= LIT1 <= 15
{
// Double-sided test on LIT1 (Part I)
int tmp;
if (0 > (tmp = LIT1)) goto L_019E;
// Double-sided test on LIT1 (Part II)
if (tmp <= 15) goto L_019F;
}
L_019E:;
FAULT(16);
LIT1 = 0;
L_019F:;
// 1557 LIT2 = LIT2!(1<<LIT1)
LIT2 = LIT2 | 1 << LIT1;
// 1558 %REPEAT
goto L_0198;
L_019A:;
// 1559 FAULT(16) %IF LIT2 = 0
if (LIT2 != 0) goto L_01A0;
FAULT(16);
L_01A0:;
// 1560 STARTT = 1+8
STARTT = 1 + 8;
// 1561 OP(111, LIT2); OP(',', LABEL)
OP(111, LIT2);
OP(44, LABEL);
// 1562 ->CONT
goto U_100E;
// 1563 C(21): PUT('S'+32); -> ACONT; ! %STOP
case_C_21:;
PUT(83 + 32);
goto U_100F;
// 1564 C(22): LIST=LIST&2; -> CONT; ! %LIST
case_C_22:;
LIST = LIST & 2;
goto U_100E;
// 1565 C(23): LIST=LIST!1; -> CONT; ! %ENDOFLIST
case_C_23:;
LIST = LIST | 1;
goto U_100E;
// 1566 C(24): LREALS=16; -> CONT; ! %REALSLONG
case_C_24:;
LREALS = 16;
goto U_100E;
// 1567 C(25): LREALS=0; -> CONT; ! %REALSNORMAL
case_C_25:;
LREALS = 0;
goto U_100E;
// 1568 C(109):PUT('S'); -> CONT; ! 'EQ'
case_C_109:;
PUT(83);
goto U_100E;
// 1569 C(45): PUT('Z'); -> CONT; ! EQEQ
case_C_45:;
PUT(90);
goto U_100E;
// 1570 C(26): ! EXIT
case_C_26:;
// 1571 C(27): ! CONTINUE
case_C_27:;
// 1572 L=LABEL
L = LABEL;
// 1573 %WHILE L > OLD LABEL %CYCLE
L_01A1:;
if (L <= OLDLABEL) goto L_01A2;
// 1574 %IF LABINF(L>>2)&7=2 %START;! CYCLE FOUND
if (LABINF[((unsigned int)L >> 2) - 1] & 7 != 2) goto L_01A3;
// 1575 %IF X = 26 %START
if (X != 26) goto L_01A4;
// 1576 MM == LABINF(L>>2)
MM = (unsigned char *)/*?*/ &LABINF[((unsigned int)L >> 2) - 1];
// 1577 MM = MM!8
*MM = *MM | 8;
// 1578 L = L-2; X = 'F'
L = L - 2;
X = 70;
// 1579 %ELSE
goto L_01A5;
L_01A4:;
// 1580 X = 113
X = 113;
// 1581 %FINISH
L_01A5:;
// 1582 OP(X,L-2)
OP(X, L - 2);
// 1583 -> ACONT
goto U_100F;
// 1584 %FINISH
L_01A3:;
// 1585 L=L-4
L = L - 4;
// 1586 %REPEAT
goto L_01A1;
L_01A2:;
// 1587 FAULT(10); ->CONT
FAULT(10);
goto U_100E;
// 1588 C(31): ULAB=LABEL+3; OP(117,ULAB); ! UNTIL
case_C_31:;
ULAB = LABEL + 3;
OP(117, ULAB);
// 1589 C(30): LOOP LAB=LABEL+2; DEF LAB(LOOP LAB);! WHILE
case_C_30:;
LOOPLAB = LABEL + 2;
DEFLAB(LOOPLAB);
// 1590 C(28): ! IF
case_C_28:;
// 1591 C(29): ! UNLESS
case_C_29:;
// 1592 EILAB = PLAB %IF ELSE # 0
if (ELSE == 0) goto L_01A6;
EILAB = PLAB;
L_01A6:;
// 1593 INHIBIT = INHIBIT!1
INHIBIT = INHIBIT | 1;
// 1594 CONDS=1; DOUBLE=0
CONDS = 1;
DOUBLE = 0;
// 1595 STARTT=(X-26)>>1+8
STARTT = ((unsigned int)X - 26 >> 1) + 8;
// 1596 GLOBAL NOT=0; C LAST=1
GLOBALNOT = 0;
CLAST = 1;
// 1597 CMOD=0; CLEVEL=1; OPS=1
CMOD = 0;
CLEVEL = 1;
OPS = 1;
// 1598 LOCAL NOT=X&1; P LAB=LABEL
LOCALNOT = X & 1;
PLAB = LABEL;
// 1599 CNEST(0)=P LAB; CNEST(1)=P LAB
CNEST[0] = PLAB;
CNEST[1] = PLAB;
// 1600 -> CONT
goto U_100E;
// 1601 C(32): LOCAL NOT=LOCAL NOT!!1; -> CONT; ! %NOT
case_C_32:;
LOCALNOT = LOCALNOT ^ 1;
goto U_100E;
// 1602 C(79):
case_C_79:;
// 1603 CALL; ! P
CALL();
// 1604 PRED OP = 4
PREDOP = 4;
// 1605 ->PAC %IF CALL PENDING = 0
if (CALLPENDING != 0) goto L_01A7;
goto U_1012;
L_01A7:;
// 1606 PRED PENDING = PRED PENDING!2
PREDPENDING = PREDPENDING | 2;
// 1607 ->CONT
goto U_100E;
// 1608 C(108): PUT('C'); ! ACOMP
case_C_108:;
PUT(67);
// 1609 PAC: X=35; ! '='
U_1012:;
X = 35;
// 1610 CONDS = CONDS-1
CONDS = CONDS - 1;
// 1611 -> COP
goto U_1013;
// 1612 C(33): ! <
case_C_33:;
// 1613 C(34): ! >
case_C_34:;
// 1614 C(35): ! =
case_C_35:;
// 1615 C(36): ! #
case_C_36:;
// 1616 C(37): ! <=
case_C_37:;
// 1617 C(38): ! >=
case_C_38:;
// 1618 CONDS=CONDS-1
CONDS = CONDS - 1;
// 1619 %IF NEXT#0 %START; ! DOUBLE SIDED
if (NEXT == 0) goto L_01A8;
// 1620 PUT(126); ! SHOW DOUBLE SIDED
PUT(126);
// 1621 DOUBLE=1; BIT=1; ! PSEUDO %AND
DOUBLE = 1;
BIT = 1;
// 1622 -> ANDOP
goto U_1014;
// 1623 %FINISH
L_01A8:;
// 1624 %IF DOUBLE # 0 %START
if (DOUBLE == 0) goto L_01A9;
// 1625 DOUBLE = 0; X = RCOMP(X)
DOUBLE = 0;
X = RCOMP[X - 33];
// 1626 %FINISH
L_01A9:;
// 1627 PUT('?')
PUT(63);
// 1628 COP: LOCAL NOT=(LOCAL NOT!!GLOBAL NOT)&1
U_1013:;
LOCALNOT = (LOCALNOT ^ GLOBALNOT) & 1;
// 1629 X=X!!7 %IF LOCAL NOT#0
if (LOCALNOT == 0) goto L_01AA;
X = X ^ 7;
L_01AA:;
// 1630 %IF CLAST#0 %START
if (CLAST == 0) goto L_01AB;
// 1631 X=X!!7 %IF OPS&1#0
if (OPS & 1 == 0) goto L_01AC;
X = X ^ 7;
L_01AC:;
// 1632 OP(COMP(X+PRED OP),CNEST(CLEVEL))
OP(COMP[X + PREDOP - 33], CNEST[CLEVEL]);
// 1633 %ELSE
goto L_01AD;
L_01AB:;
// 1634 %WHILE CMOD&1#0 %CYCLE
L_01AE:;
if (CMOD & 1 == 0) goto L_01AF;
// 1635 CMOD=CMOD>>1; OPS=OPS>>1
CMOD = (unsigned int)CMOD >> 1;
OPS = (unsigned int)OPS >> 1;
// 1636 CLEVEL=CLEVEL-1
CLEVEL = CLEVEL - 1;
// 1637 GLOBAL NOT=GLOBAL NOT>>1
GLOBALNOT = (unsigned int)GLOBALNOT >> 1;
// 1638 %REPEAT
goto L_01AE;
L_01AF:;
// 1639 CMOD=CMOD>>1; OPS=OPS>>1; CLEVEL=CLEVEL-1
CMOD = (unsigned int)CMOD >> 1;
OPS = (unsigned int)OPS >> 1;
CLEVEL = CLEVEL - 1;
// 1640 GLOBAL NOT=GLOBAL NOT>>1
GLOBALNOT = (unsigned int)GLOBALNOT >> 1;
// 1641 X=X!!7 %IF OPS&1#0
if (OPS & 1 == 0) goto L_01B0;
X = X ^ 7;
L_01B0:;
// 1642 OP(COMP(X+PRED OP),CNEST(CLEVEL))
OP(COMP[X + PREDOP - 33], CNEST[CLEVEL]);
// 1643 DEF LAB(LABEL) %UNLESS LABEL=CNEST(CLEVEL)
if (LABEL == CNEST[CLEVEL]) goto L_01B1;
DEFLAB(LABEL);
L_01B1:;
// 1644 LABEL=CNEST(CLEVEL)
LABEL = CNEST[CLEVEL];
// 1645 %FINISH
L_01AD:;
// 1646 CLAST=0; LOCAL NOT=0; PRED OP = 0
CLAST = 0;
LOCALNOT = 0;
PREDOP = 0;
// 1647 DEF LAB(ULAB) %IF CONDS <= 0 %AND ULAB#0
if (CONDS > 0) goto L_01B2;
if (ULAB == 0) goto L_01B2;
DEFLAB(ULAB);
L_01B2:;
// 1648 PUT('"') %IF DOUBLE # 0
if (DOUBLE == 0) goto L_01B3;
PUT(34);
L_01B3:;
// 1649 -> CONT
goto U_100E;
// 1650 C(39): ! AND
case_C_39:;
// 1651 C(40): ! OR
case_C_40:;
// 1652 BIT=X&1; ! 1=AND, 0=OR
BIT = X & 1;
// 1653 ANDOP: CONDS=CONDS+1
U_1014:;
CONDS = CONDS + 1;
// 1654 LOCAL NOT=(LOCAL NOT!!GLOBAL NOT)&1
LOCALNOT = (LOCALNOT ^ GLOBALNOT) & 1;
// 1655 BIT=BIT!!LOCAL NOT
BIT = BIT ^ LOCALNOT;
// 1656 %IF BIT=OPS&1 %START
if (BIT != OPS & 1) goto L_01B4;
// 1657 %IF CLAST#0 %START
if (CLAST == 0) goto L_01B5;
// 1658 CMOD=CMOD<<1
CMOD = CMOD << 1;
// 1659 CNEST(CLEVEL+1)=CNEST(CLEVEL)
CNEST[CLEVEL + 1] = CNEST[CLEVEL];
// 1660 CLEVEL=CLEVEL+1
CLEVEL = CLEVEL + 1;
// 1661 OPS=OPS<<1!BIT
OPS = OPS << 1 | BIT;
// 1662 GLOBAL NOT=GLOBAL NOT<<1!LOCAL NOT
GLOBALNOT = GLOBALNOT << 1 | LOCALNOT;
// 1663 %FINISH
L_01B5:;
// 1664 %ELSE
goto L_01B6;
L_01B4:;
// 1665 CMOD=CMOD<<1
CMOD = CMOD << 1;
// 1666 %IF CLAST#0 %START
if (CLAST == 0) goto L_01B7;
// 1667 LABEL=LABEL+4
LABEL = LABEL + 4;
// 1668 CLEVEL=CLEVEL+1; CNEST(CLEVEL)=LABEL
CLEVEL = CLEVEL + 1;
CNEST[CLEVEL] = LABEL;
// 1669 %ELSE
goto L_01B8;
L_01B7:;
// 1670 CMOD=CMOD!1
CMOD = CMOD | 1;
// 1671 %IF OPS>>1&1 = BIT %START
if ((unsigned int)OPS >> 1 & 1 != BIT) goto L_01B9;
// 1672 L = CNEST(CLEVEL-1)
L = CNEST[CLEVEL - 1];
// 1673 %ELSE
goto L_01BA;
L_01B9:;
// 1674 LABEL=LABEL+4; L=LABEL
LABEL = LABEL + 4;
L = LABEL;
// 1675 %FINISH
L_01BA:;
// 1676 CLEVEL=CLEVEL+1; CNEST(CLEVEL)=L
CLEVEL = CLEVEL + 1;
CNEST[CLEVEL] = L;
// 1677 %FINISH
L_01B8:;
// 1678 OPS=OPS<<1!BIT
OPS = OPS << 1 | BIT;
// 1679 GLOBAL NOT=GLOBAL NOT<<1!LOCAL NOT
GLOBALNOT = GLOBALNOT << 1 | LOCALNOT;
// 1680 %FINISH
L_01B6:;
// 1681 CLAST=1; LOCAL NOT=0
CLAST = 1;
LOCALNOT = 0;
// 1682 -> CONT %IF DOUBLE=0
if (DOUBLE != 0) goto L_01BB;
goto U_100E;
L_01BB:;
// 1683 -> COP; ! REJOIN CONDITIONS
goto U_1013;
// 1684 C(119): ! STARTT
case_C_119:;
// 1685 STARTT = 2 %AND DEF LAB(LABEL+2) %IF STARTT = 0
if (STARTT != 0) goto L_01BC;
STARTT = 2;
DEFLAB(LABEL + 2);
L_01BC:;
// 1686 LABEL = LABEL+4
LABEL = LABEL + 4;
// 1687 FAULT(23) %IF LABEL>>2 > MAX LAB
if ((unsigned int)LABEL >> 2 <= 80) goto L_01BD;
FAULT(23);
L_01BD:;
// 1688 LABINF(LABEL>>2) = STARTT+ELSE
LABINF[((unsigned int)LABEL >> 2) - 1] = STARTT + ELSE;
// 1689 LOOP LAB = 0; P LAB = 0; ! LABEL NO LONGER PENDING
LOOPLAB = 0;
PLAB = 0;
// 1690 ELSE = 0; EILAB = 0
ELSE = 0;
EILAB = 0;
// 1691 ->CONT
goto U_100E;
// 1692 C(41): OP('B',LABEL-2); ! REPEAT
case_C_41:;
OP(66, LABEL - 2);
// 1693 ACCESS = 0
ACCESS = 0;
// 1694 C(42): POP LAB(X&1); ->CONT; ! FINISH
case_C_42:;
POPLAB(X & 1);
goto U_100E;
// 1695 C(43): ! ELSE
case_C_43:;
// 1696 POP LAB(0) %IF P LAB = 0; ! (FINISH) ELSE ...
if (PLAB != 0) goto L_01BE;
POPLAB(0);
L_01BE:;
// 1697 FAULT(5) %AND -> RETURN %IF PLAB&1#0
if (PLAB & 1 == 0) goto L_01BF;
FAULT(5);
goto U_1010;
L_01BF:;
// 1698 OP('F',PLAB+1) %UNLESS ACCESS = 0
if (ACCESS == 0) goto L_01C0;
OP(70, PLAB + 1);
L_01C0:;
// 1699 DEF LAB(PLAB)
DEFLAB(PLAB);
// 1700 PLAB=PLAB+1
PLAB = PLAB + 1;
// 1701 STARTT=3+8; ! SHOW ELSE
STARTT = 3 + 8;
// 1702 ELSE = 4
ELSE = 4;
// 1703 -> CONT
goto U_100E;
// 1704 C(54): OWN DEF=0; OUT=0; ! OWNVTYPE
case_C_54:;
OWNDEF = 0;
OUT = 0;
// 1705 C(51): ! ATYPE
case_C_51:;
// 1706 C(52): ! OWN ATYPE
case_C_52:;
// 1707 C(53): ! VTYPE
case_C_53:;
// 1708 C(56): ! TYPE
case_C_56:;
// 1709 FAULT(15) %IF INHIBIT&1 # 0 %AND SPEC > 0
if (INHIBIT & 1 == 0) goto L_01C1;
if (SPEC <= 0) goto L_01C1;
FAULT(15);
L_01C1:;
// 1710 C(50): ! RTYPE
case_C_50:;
// 1711 C(57): ! SWITCH
case_C_57:;
// 1712 DCLASS=CLASS; -> CONT
DCLASS = CLASS;
goto U_100E;
// 1713 C(60): ! VSET
case_C_60:;
// 1714 C(61): ! NSET
case_C_61:;
// 1715 C(67): ! V
case_C_67:;
// 1716 C(68): ! N
case_C_68:;
// 1717 C(74): ! RECV
case_C_74:;
// 1718 C(75): ! RECN
case_C_75:;
// 1719 C(122): ! RTP
case_C_122:;
// 1720 C(123): ! PP
case_C_123:;
// 1721 C(124): ! FNP
case_C_124:;
// 1722 C(125): ! MP
case_C_125:;
// 1723 C(77): ! RECAN
case_C_77:;
// 1724 C(63): ! ANSET
case_C_63:;
// 1725 C(70): ! AN
case_C_70:;
// 1726 C(62): ! ASET
case_C_62:;
// 1727 C(69): ! A
case_C_69:;
// 1728 C(76): ! RECA
case_C_76:;
// 1729 AOP('@', X); ->CONT
AOP(64, X);
goto U_100E;
// 1730 C(65): ! RFN
case_C_65:;
// 1731 C(66): ! AFN
case_C_66:;
// 1732 -> CONT
goto U_100E;
// 1733 C(71): ! M
case_C_71:;
// 1734 C(72): ! F
case_C_72:;
// 1735 C(73): ! RT
case_C_73:;
// 1736 C(78): ! RECORDMAP
case_C_78:;
// 1737 C(64): ! MSET
case_C_64:;
// 1738 CALL; -> CONT
CALL();
goto U_100E;
// 1739 C(83): LIT2=LIT1; LIT1=EVAL(X); ! 'ICONST'
case_C_83:;
LIT2 = LIT1;
LIT1 = EVAL(X);
// 1740 CGEN(LIT1) %AND ->CONT %IF X < 0
if (X >= 0) goto L_01C2;
CGEN(LIT1);
goto U_100E;
L_01C2:;
// 1741 C(82): ! SCONST
case_C_82:;
// 1742 C(84): ! 'RCONST'
case_C_84:;
// 1743 L=BUFFER(X)
L = BUFFER[X - 1];
// 1744 %IF L <= 0 %AND CLASS=ICONST %START; ! SYMBOL
if (L > 0) goto L_01C3;
if (CLASS != 83) goto L_01C3;
// 1745 OP('N',3); L=BUFFER(X-1)
OP(78, 3);
L = BUFFER[X - 1 - 1];
// 1746 PUT(','); PUT('Z')
PUT(44);
PUT(90);
// 1747 X=L//10
X = ((long)L / (long)10);
// 1748 PUT(X+'A')
PUT(X + 65);
// 1749 PUT(L-X*10+'A')
PUT(L - X * 10 + 65);
// 1750 %ELSE
goto L_01C4;
L_01C3:;
// 1751 L=|L|
L = _imp_IMOD(L);
// 1752 OP(CONOP(CLASS),L)
OP(CONOP[CLASS - 82], L);
// 1753 %IF L > 0 %START
if (L <= 0) goto L_01C5;
// 1754 %integer x2
int X2;
// 1755 PUT(',')
PUT(44);
// 1756 x2 = X
X2 = X;
// 1757 %CYCLE X=x2-1,-1,x2-L
// %for X = X2 - 1, -1, X2 - L %cycle
{
int _initial = X2 - 1, _final = X2 - L;
if (invalid_for_loop(_initial, -1, _final)) _imp_signal(5, 1, 0, "Illegal cycle X = X2 - 1, -1, X2 - L");
X = _initial - (-1);
L_01C6:
if (X == _final) goto L_01C7;
X -= 1;
// ?Non-local
// 1758 PUT(BUFFER(X))
PUT(BUFFER[X - 1]);
// 1759 %REPEAT
goto L_01C6;
}
L_01C7:;
// 1760 %FINISH
L_01C5:;
// 1761 %FINISH
L_01C4:;
// 1762 LIT=CODE
LIT = CODE;
// 1763 -> CONT
goto U_100E;
// 1764 C(105):PUT('.'); -> CONT; ! '.'
case_C_105:;
PUT(46);
goto U_100E;
// 1765 C(106):PUT('V'+32); -> CONT
case_C_106:;
PUT(86 + 32);
goto U_100E;
// 1766 C(126):PUT('F'+32); ! COM
case_C_126:;
PUT(70 + 32);
// 1767 STARTT=2+8; ! PSEUDO %CYCLE
STARTT = 2 + 8;
// 1768 P LAB=LABEL; LOOP LAB=P LAB+2
PLAB = LABEL;
LOOPLAB = PLAB + 2;
// 1769 DEF LAB(LOOP LAB)
DEFLAB(LOOPLAB);
// 1770 -> CONT
goto U_100E;
// 1771 C(113): ! BSEP
case_C_113:;
// 1772 %IF SPREFIX=0 %THEN DIM=DIM+1 %ELSE SET SIZE
if (SPREFIX != 0) goto L_01C8;
DIM = DIM + 1;
goto L_01C9;
L_01C8:;
SETSIZE();
L_01C9:;
// 1773 -> CONT
goto U_100E;
// 1774 C(116): AOP('L',X)
case_C_116:;
AOP(76, X);
// 1775 ACCESS = 1
ACCESS = 1;
// 1776 INHIBIT = INHIBIT!1; -> CONT
INHIBIT = INHIBIT | 1;
goto U_100E;
// 1777 C(80): INHIBIT = INHIBIT!1; ! SWITCH
case_C_80:;
INHIBIT = INHIBIT | 1;
// 1778 AOP('W',X); ->ACONT
AOP(87, X);
goto U_100F;
// 1779 C(114):INHIBIT = INHIBIT!1; ! SLAB
case_C_114:;
INHIBIT = INHIBIT | 1;
// 1780 ACCESS = 1
ACCESS = 1;
// 1781 AOP('_',X)
AOP(95, X);
// 1782 L=DICT(X-2); ! POINTER TO TABLE
L = DICT[X - 2];
// 1783 K=DICT(L); ! LOWER BOUND
K = DICT[L];
// 1784 FAULT(16) %AND ->CONT %UNLESS K <= LIT1 <= DICT(L-1)
{
// Double-sided test on LIT1 (Part I)
int tmp;
if (K > (tmp = LIT1)) goto L_01CA;
// Double-sided test on LIT1 (Part II)
if (tmp <= DICT[L - 1]) goto L_01CB;
}
L_01CA:;
FAULT(16);
goto U_100E;
L_01CB:;
// 1785 K=LIT1-K
K = LIT1 - K;
// 1786 L=L-K>>4; ! ENTRY POINT
L = L - ((unsigned int)K >> 4);
// 1787 K=1<<(K&15); ! REQUISITE BIT
K = 1 << (K & 15);
// 1788 M == DICT(L-2)
M = (int *)/*?*/ &DICT[L - 2];
// 1789 FAULT(7) %IF M&K#0
if (*M & K == 0) goto L_01CC;
FAULT(7);
L_01CC:;
// 1790 M = M!K
*M = *M | K;
// 1791 -> CONT
goto U_100E;
// 1792 C(81): INHIBIT = INHIBIT!1; ! 'BL'
case_C_81:;
INHIBIT = INHIBIT | 1;
// 1793 C(115): AOP('J',X); -> ACONT; ! 'FL'
case_C_115:;
AOP(74, X);
goto U_100F;
// 1794 C(128):LIT1 = BPSIZE %IF LIT1 = 0
case_C_128:;
if (LIT1 != 0) goto L_01CD;
LIT1 = BPSIZE;
L_01CD:;
// 1795 BPSIZE=BP SIZE-LIT1+1; ! ORB
BPSIZE = BPSIZE - LIT1 + 1;
// 1796 -> OF %IF LIT1 <= 0
if (LIT1 > 0) goto L_01CE;
goto U_1015;
L_01CE:;
// 1797 -> CONT
goto U_100E;
// 1798 C(129):PUT('P'+32); ->CONT; ! PSEP
case_C_129:;
PUT(80 + 32);
goto U_100E;
// 1799 C(130):PUT('P'+32); PUT('E')
case_C_130:;
PUT(80 + 32);
PUT(69);
// 1800 PRED PENDING = PRED PENDING>>1
PREDPENDING = (unsigned int)PREDPENDING >> 1;
// 1801 PRED PENDING = PRED PENDING-1 %AND ->PAC %IF PRED PENDING&1 # 0
if (PREDPENDING & 1 == 0) goto L_01CF;
PREDPENDING = PREDPENDING - 1;
goto U_1012;
L_01CF:;
// 1802 ->CONT
goto U_100E;
// 1803 C(107): PUT('I'+32); ->CONT; ! ASSEP
case_C_107:;
PUT(73 + 32);
goto U_100E;
// 1804 C(118): %IF DCLASS#54 %START; ! OSEP
case_C_118:;
if (DCLASS == 54) goto L_01D0;
// 1805 BP SIZE=BP SIZE-1
BPSIZE = BPSIZE - 1;
// 1806 %IF BP SIZE <= 0 %START
if (BPSIZE > 0) goto L_01D1;
// 1807 OF: ATOM POS=0; FAULT(16)
U_1015:;
ATOMPOS = 0;
FAULT(16);
// 1808 OUT=0
OUT = 0;
// 1809 -> RETURN
goto U_1010;
// 1810 %FINISH
L_01D1:;
// 1811 %FINISH
L_01D0:;
// 1812 OSEP: PUT('A')
U_1016:;
PUT(65);
// 1813 EXTRA(OWN DEF) %IF OWN DEF > 1
if (OWNDEF <= 1) goto L_01D2;
EXTRA(OWNDEF);
L_01D2:;
// 1814 OWN DEF=0; LIT1 = 0
OWNDEF = 0;
LIT1 = 0;
// 1815 -> CONT
goto U_100E;
// 1816 C(117): BP SIZE=BP SIZE-1 %IF OUT#0; ! OWNT
case_C_117:;
if (OUT == 0) goto L_01D3;
BPSIZE = BPSIZE - 1;
L_01D3:;
// 1817 OUT=0
OUT = 0;
// 1818 -> OSEP %IF BP SIZE=0
if (BPSIZE != 0) goto L_01D4;
goto U_1016;
L_01D4:;
// 1819 BP SIZE=0
BPSIZE = 0;
// 1820 -> OF %IF BUFFER(BPT)='A' %OR LIT = CODE
if (BUFFER[BPT - 1] == 65) goto L_01D5;
if (LIT != CODE) goto L_01D6;
L_01D5:;
goto U_1015;
L_01D6:;
// 1821 PUT('I'); ! INDICATE CLEAR
PUT(73);
// 1822 -> CONT
goto U_100E;
// 1823 C(110): ! LRB
case_C_110:;
// 1824 C(111): ! RRB
case_C_111:;
// 1825 -> CONT
goto U_100E;
// 1826 C(127):PUT('A'+32); -> CONT
case_C_127:;
PUT(65 + 32);
goto U_100E;
// 1827 D(54): OWN DEF=OWN DEF+1; ! OWNVTYPE
case_D_54:;
OWNDEF = OWNDEF + 1;
// 1828 DICT(X-2) = LIT1 %IF CONST INT # 0
if (CONSTINT == 0) goto L_01D7;
DICT[X - 2] = LIT1;
L_01D7:;
// 1829 -> DDD
goto U_1017;
// 1830 D(57): ! SWITCH
case_D_57:;
// 1831 %IF LIT=CODE %THEN %START; ! SWITCH DEF
if (LIT != CODE) goto L_01D8;
// 1832 PUT('W'+32)
PUT(87 + 32);
// 1833 DICT(X-2)=T LIMIT-1
DICT[X - 2] = TLIMIT - 1;
// 1834 DICT(TLIMIT-1)=LIT2; ! LOWER BOUND
DICT[TLIMIT - 1] = LIT2;
// 1835 DICT(TLIMIT-2)=LIT1; ! UPPER BOUND
DICT[TLIMIT - 2] = LIT1;
// 1836 %IF LIT1 < LIT2 %START; ! BOUNDS INSIDE-OUT
if (LIT1 >= LIT2) goto L_01D9;
// 1837 ATOM POS=0; FAULT(4)
ATOMPOS = 0;
FAULT(4);
// 1838 LIT1=LIT2
LIT1 = LIT2;
// 1839 %FINISH
L_01D9:;
// 1840 K=LIT1-LIT2+1
K = LIT1 - LIT2 + 1;
// 1841 K=(K+15)>>4; ! ENTRIES NEEDED
K = (unsigned int)K + 15 >> 4;
// 1842 TLIMIT=TLIMIT-K-3
TLIMIT = TLIMIT - K - 3;
// 1843 FAULT(23) %IF T LIMIT <= TMAX
if (TLIMIT > TMAX) goto L_01DA;
FAULT(23);
L_01DA:;
// 1844 DICT(L)=0 %FOR L = TLIMIT,1,TLIMIT+K
// %for L = TLIMIT, 1, TLIMIT + K %cycle
{
int _initial = TLIMIT, _final = TLIMIT + K;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle L = TLIMIT, 1, TLIMIT + K");
L = _initial - (1);
L_01DB:
if (L == _final) goto L_01DC;
L += 1;
DICT[L] = 0;
goto L_01DB;
}
L_01DC:;
// 1845 %FINISH
L_01D8:;
// 1846 D(50): ! RTYPE
case_D_50:;
// 1847 OP('F',0) %IF DCLASS=50 %AND DEC TYPE#84 %AND SPEC >= 0 %C
if (DCLASS != 50) goto L_01DE;
if (DECTYPE == 84) goto L_01DE;
if (SPEC < 0) goto L_01DE;
if (LEVEL == 0) goto L_01DE;
OP(70, 0);
L_01DE:;
// 1848+ %AND LEVEL # 0
// 1849 ! JUMP ROUND ROUTINE
// 1850 D(56): ! TYPE
case_D_56:;
// 1851 D(53): ! VTYPE
case_D_53:;
// 1852 DDD: DEF(X)
U_1017:;
DEF(X);
// 1853 -> CONT
goto U_100E;
// 1854 D(51): ! ARRAY DEC
case_D_51:;
// 1855 %IF DIM#0 %START; ! SET UP DOPE VECTOR
if (DIM == 0) goto L_01DF;
// 1856 OP('D'+32, DIM); DIM = 0
OP(68 + 32, DIM);
DIM = 0;
// 1857 %FINISH
L_01DF:;
// 1858 DEF(X); PUT('H'+32)
DEF(X);
PUT(72 + 32);
// 1859 PUT('C'+32) %IF DICT(X-1)&15#13; ! NO SPACE FOR FORMATS
if (DICT[X - 1] & 15 == 13) goto L_01E0;
PUT(67 + 32);
L_01E0:;
// 1860 -> CONT
goto U_100E;
// 1861 D(52): DEF(X); OUT=TYPE; ! OWNARRAY
case_D_52:;
DEF(X);
OUT = TYPE;
// 1862 BPSIZE = 1 %IF TYPE = 15; ! EXTRINSICS
if (TYPE != 15) goto L_01E1;
BPSIZE = 1;
L_01E1:;
// 1863 ->CONT
goto U_100E;
// 1864 C(49): ! BEGEND
case_C_49:;
// 1865 %IF X=15 %THEN PUT('H') %AND XX=NULL STRING %ELSE C END
if (X != 15) goto L_01E2;
PUT(72);
XX = 401;
goto L_01E3;
L_01E2:;
CEND();
L_01E3:;
// 1866 RETURN:
U_1010:;
// 1867 !
// 1868 ! DEAL WITH LABELS
// 1869 !
// 1870 OP('B',LOOP LAB) %IF LOOP LAB#0
if (LOOPLAB == 0) goto L_01E4;
OP(66, LOOPLAB);
L_01E4:;
// 1871 DEF LAB(EILAB) %IF EILAB # 0 %AND EILAB # PLAB
if (EILAB == 0) goto L_01E5;
if (EILAB == PLAB) goto L_01E5;
DEFLAB(EILAB);
L_01E5:;
// 1872 DEF LAB(P LAB) %IF P LAB#0
if (PLAB == 0) goto L_01E6;
DEFLAB(PLAB);
L_01E6:;
// 1873 %END; ! OF COMPILE SS
return;
case_C_dispatch:
if (C_index < 1 || C_index > 130)
_imp_signalf(6, 3, C_index, "->C(%d) out of bounds at %s line %d", C_index, C_file, C_line);
goto *C[C_index - 1];
case_C_missing:
_imp_signalf(8, 2, C_index, "switch jump to undefined label C(%d): at %s line %d", C_index, C_file, C_line);
case_D_dispatch:
if (D_index < 50 || D_index > 57)
_imp_signalf(6, 3, D_index, "->D(%d) out of bounds at %s line %d", D_index, D_file, D_line);
goto *D[D_index - 50];
case_D_missing:
_imp_signalf(8, 2, D_index, "switch jump to undefined label D(%d): at %s line %d", D_index, D_file, D_line);
} /* end of COMPILESS */
// 1874 %IF BLOCK TYPE=0 %START; ! RECORD FORMAT
if (BLOCKTYPE != 0) goto L_01E7;
// 1875 ANALYSE SS(-1)
ANALYSESS(-1);
// 1876 XX=X-2
XX = X - 2;
// 1877 OP('G', 2)
OP(71, 2);
// 1878 COMPILE SS %IF SS#0
if (SS == 0) goto L_01E8;
COMPILESS();
L_01E8:;
// 1879 OP('G',2); ! FORMAT END
OP(71, 2);
// 1880 -> L9
goto U_1018;
// 1881 %FINISH
L_01E7:;
// 1882 %IF BLOCKTYPE&15#15 %START; ! NOT BEGIN
if (BLOCKTYPE & 15 == 15) goto L_01E9;
// 1883 ANALYSE SS(1); ! FORMAL PARAMETERS
ANALYSESS(1);
// 1884 %IF SPEC < 0 %THEN K = 0 %ELSE K = 1
if (SPEC >= 0) goto L_01EA;
K = 0;
goto L_01EB;
L_01EA:;
K = 1;
L_01EB:;
// 1885 OP('G', K)
OP(71, K);
// 1886 COMPILE SS %IF SS # 0
if (SS == 0) goto L_01EC;
COMPILESS();
L_01EC:;
// 1887 OP('G', K)
OP(71, K);
// 1888 -> L9 %IF K = 0
if (K != 0) goto L_01ED;
goto U_1018;
L_01ED:;
// 1889 %FINISH
L_01E9:;
// 1890 ACCESS = 1
ACCESS = 1;
// 1891 %CYCLE
L_01EE:;
// 1892 ANALYSE SS(0)
ANALYSESS(0);
// 1893 XX=X-2
XX = X - 2;
// 1894 COMPILE SS %IF SS#0
if (SS == 0) goto L_01EF;
COMPILESS();
L_01EF:;
// 1895 COMPILE BLOCK(0,0,DICT(XX)) %IF DEC TYPE=84
if (DECTYPE != 84) goto L_01F0;
COMPILEBLOCK(0, 0, /*?*/ &DICT[XX]);
L_01F0:;
// 1896 %EXIT %IF DECTYPE=85 %OR DEC TYPE=EOP %C
if (DECTYPE == 85) goto L_01DD;
if (DECTYPE == 87) goto L_01DD;
if (DECTYPE != 86) goto L_01F1;
L_01DD:;
goto L_01F2;
L_01F1:;
// 1897+ %OR DEC TYPE=EOF
// 1898 %IF 7 <= DECTYPE&15 <= 10 %OR DECTYPE=15 %START
{
// Double-sided test on DECTYPE & 15 (Part I)
int tmp;
if (7 > (tmp = DECTYPE & 15)) goto L_01F3;
// Double-sided test on DECTYPE & 15 (Part II)
if (tmp <= 10) goto L_01F4;
}
L_01F3:;
if (DECTYPE != 15) goto L_01F5;
L_01F4:;
// 1899 XX=XX-1 %IF DECTYPE&X'70'=X'50'; ! RECORDMAPS
if (DECTYPE & 112 != 80) goto L_01F6;
XX = XX - 1;
L_01F6:;
// 1900 %IF LEVEL = 0 %AND DECTYPE = 15 %START
if (LEVEL != 0) goto L_01F7;
if (DECTYPE != 15) goto L_01F7;
// 1901 %IF FILE = 0 %THEN FILE = 2 %ELSE FAULT(5)
if (FILE != 0) goto L_01F8;
FILE = 2;
goto L_01F9;
L_01F8:;
FAULT(5);
L_01F9:;
// 1902 %FINISH
L_01F7:;
// 1903 %IF SPEC > 0 %AND SPREFIX > 3 %AND SPREFIX # 7 %START
if (SPEC <= 0) goto L_01FA;
if (SPREFIX <= 3) goto L_01FA;
if (SPREFIX == 7) goto L_01FA;
// 1904 %IF LEVEL # 0 %THEN FAULT(15) %ELSE FILE = 1
if (LEVEL == 0) goto L_01FB;
FAULT(15);
goto L_01FC;
L_01FB:;
FILE = 1;
L_01FC:;
// 1905 %FINISH
L_01FA:;
// 1906 COMPILE BLOCK(LEVEL+1,DECTYPE,DICT(XX))
COMPILEBLOCK(LEVEL + 1, DECTYPE, /*?*/ &DICT[XX]);
// 1907 POS=0 %AND %EXIT %C
if (DECTYPE == 87) goto L_0156;
if (DECTYPE != 86) goto L_01FD;
L_0156:;
POS = 0;
goto L_01F2;
L_01FD:;
// 1908+ %IF DEC TYPE=EOP %OR DEC TYPE=EOF;! PREMATURE END
// 1909 %FINISH
L_01F5:;
// 1910 %REPEAT
goto L_01EE;
L_01F2:;
// 1911 ! POINT TO JUMP ROUND ROUTINE
// 1912 DEF LAB(0) %UNLESS BLOCK TYPE=15 %OR LEVEL = 0
if (BLOCKTYPE == 15) goto L_01FE;
if (LEVEL == 0) goto L_01FE;
DEFLAB(0);
L_01FE:;
// 1913 L9: SPEC=1; TMAX=T BASE; T BASE=OLD T BASE
U_1018:;
SPEC = 1;
TMAX = TBASE;
TBASE = OLDTBASE;
// 1914 LABEL = OLD LABEL
LABEL = OLDLABEL;
// 1915 T LIMIT=OLD T LIMIT %IF BLOCK TYPE#0
if (BLOCKTYPE == 0) goto L_01FF;
TLIMIT = OLDTLIMIT;
L_01FF:;
// 1916 INHIBIT = INHIBIT>>1
INHIBIT = (unsigned int)INHIBIT >> 1;
// 1917 %END; ! COMPILE BLOCK
return;
} /* end of COMPILEBLOCK */
// 1918
// 1919 %ROUTINE SUMMARISE(%INTEGER STREAM)
void SUMMARISE(int STREAM) {
// 1920 SELECT OUTPUT(STREAM)
_imp_SELECTOUTPUT(STREAM);
// 1921 %IF FAULTY = 0 %START
if (FAULTY != 0) goto L_0200;
// 1922 WRITE(STATS,5); PRINT STRING(" STATEMENTS COMPILED
_imp_WRITE(STATS, 5);
_imp_PRINTSTRING(_imp_str_literal(" STATEMENTS COMPILED\n"));
// 1923+ ")
// 1924 %ELSE
goto L_0201;
L_0200:;
// 1925 PRINT STRING("PROGRAM CONTAINS"); WRITE(FAULTY,1)
_imp_PRINTSTRING(_imp_str_literal("PROGRAM CONTAINS"));
_imp_WRITE(FAULTY, 1);
// 1926 PRINT STRING(" FAULT"); PRINT SYMBOL('S') %IF FAULTY # 1
_imp_PRINTSTRING(_imp_str_literal(" FAULT"));
if (FAULTY == 1) goto L_0202;
_imp_PRINTSYMBOL(83);
L_0202:;
// 1927 NEWLINE
_imp_NEWLINE();
// 1928 %FINISH
L_0201:;
// 1929 CLOSE OUTPUT; ! TO ENSURE BUFFER FLUSHING
_imp_CLOSEOUTPUT();
// 1930 %END
return;
} /* end of SUMMARISE */
// 1931
// 1932 open input(PRIM, "interdata/prims.imp")
_imp_OPENINPUT(2, _imp_str_literal("interdata/prims.imp"));
// 1933 open input(PROG, "interdata/test.imp")
_imp_OPENINPUT(1, _imp_str_literal("interdata/test.imp"));
// 1934 open output(REPORT, "interdata/test.rpt")
_imp_OPENOUTPUT(3, _imp_str_literal("interdata/test.rpt"));
// 1935 open output(OBJ, "interdata/test.icd")
_imp_OPENOUTPUT(2, _imp_str_literal("interdata/test.icd"));
// 1936 open output(LISTING, "interdata/test.lis")
_imp_OPENOUTPUT(1, _imp_str_literal("interdata/test.lis"));
// 1937
// 1938 !!!! COMREG(0) = -1; !IN CASE IT BOMBS OUT
// 1939 SELECTOUTPUT(LISTING); SELECT INPUT(PRIM)
_imp_SELECTOUTPUT(1);
_imp_SELECTINPUT(2);
// 1940
// 1941 NEWLINE; SPACES(5)
_imp_NEWLINE();
_imp_SPACES(5);
// 1942 PRINT STRING("EDINBURGH C.S. IMP COMPILER VERSION ")
_imp_PRINTSTRING(_imp_str_literal("EDINBURGH C.S. IMP COMPILER VERSION "));
// 1943 PRINT STRING(VERSION)
_imp_PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string5) tmp = VERSION/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 1944 NEWLINES(2)
_imp_NEWLINES(2);
// 1945
// 1946 control = 0; ! **** optimise only: for supervisor maintenance
CONTROL = 0;
// 1947 {CONTROL = COMREG(14)}; CGEN(CONTROL); PUT('Z'+32)
CGEN(CONTROL);
PUT(90 + 32);
// 1948 LIST = 2
LIST = 2;
// 1949 CODE=0
CODE = 0;
// 1950 LREALS=0; ! REALSNORMAL
LREALS = 0;
// 1951 FAULTY=0
FAULTY = 0;
// 1952 OUT = 0
OUT = 0;
// 1953 SYMTYPE=0; PAPP == PHRASE(APPEP); APP = PAPP
SYMTYPE = 0;
PAPP = (short int *)/*?*/ &PHRASE[21];
APP = *PAPP;
// 1954 STATS=0; LINE NUM=0
STATS = 0;
LINENUM = 0;
// 1955 BUFFER(NULL STRING)=0
BUFFER[400] = 0;
// 1956 T LIMIT=DICT END-1; G LIMIT=GBASE; LABEL=4
TLIMIT = 2750 - 1;
GLIMIT = 426;
LABEL = 4;
// 1957 T MAX=GLOBAL; T BASE=GLOBAL
TMAX = 0;
TBASE = 0;
// 1958 X=0; ATOM1=0; LAST=0; INHIBIT = 0
X = 0;
ATOM1 = 0;
LAST = 0;
INHIBIT = 0;
// 1959 COMPILE BLOCK(0,15,DICT(TLIMIT)); ! COMPILE A BEGIN TO START
COMPILEBLOCK(0, 15, /*?*/ &DICT[TLIMIT]);
// 1960 PUT(';')
PUT(59);
// 1961 PUT(4); ! TO TERMINATE
PUT(4);
// 1962 SEND; ! CLEAR THE BUFFER
SEND();
// 1963 SUMMARISE(LISTING)
SUMMARISE(1);
// 1964 !!!! COMREG(0) = -FAULTY
// 1965 !!!! COMREG(0) = STATS %IF COMREG(0) = 0
// 1966 %signal 15,1 %if faulty # 0
if (FAULTY == 0) goto L_0203;
_imp_signal(15, 1, 0, "");
L_0203:;
// 1967 %ENDOFPROGRAM
_imp_stop(0);
return 0;
end_0:;
}