Edinburgh IMP77 Compiler - Version 8.4 1 ! compiles OK with imp2021 but lots of work to be done. Look for ARRAY() maps. 2 ! and commented machine code sections. (Search for !! in both cases) 3 ! Next, fix file parameters and I/O 4 ! Then worry about shorts and byte sex assumptions. 5 6 ! May need to convert to C and compile in big-endian MIPS environment 7 8 %CONSTSHORTINTEGERARRAY MAIN(1 : 217) = %C 9+ 1, 5, 14, 20, 26, 38, 43, 48, 54, 61, 68, 74, 10+ 79, 82, 84, 89, 96, 102, 108, 115, 122, 126, 0, 129, 11+ 133, 137, 142, 145, 152, 156, 161, 164, 168, 0, 171, 0, 12+ 178, 184, 185, 189, 190, 193, 196, 199, 0, 202, 205, 206, 13+ 208, 0, 211, 213, 215, 216, 219, 222, 225, 0, 228, 231, 14+ 236, 241, 244, 249, 0, 253, 259, 260, 264, 266, 267, 270, 15+ 271, 274, 277, 279, 280, 283, 286, 289, 292, 295, 298, 302, 16+ 305, 308, 311, 314, 317, 320, 324, 328, 332, 336, 340, 344, 17+ 348, 352, 355, 358, 0, 361, 363, 365, 373, 0, 381, 0, 18+ 385, 392, 393, 396, 397, 400, 403, 405, 406, 410, 0, 413, 19+ 418, 425, 432, 0, 435, 437, 0, 440, 445, 446, 450, 453, 20+ 456, 0, 459, 462, 463, 0, 469, 472, 473, 475, 0, 477, 21+ 489, 499, 506, 0, 509, 511, 512, 517, 0, 520, 0, 530, 22+ 534, 535, 538, 539, 0, 543, 546, 547, 0, 558, 565, 566, 23+ 571, 572, 576, 579, 0, 585, 587, 588, 591, 0, 594, 597, 24+ 0, 600, 602, 603, 608, 609, 614, 615, 618, 0, 620, 622, 25+ 623, 627, 628, 631, 634, 637, 0, 640, 646, 0, 651, 656, 26+ 657, 660, 661, 665, 0, 667, 0, 670, 674, 675, 678, 681, 27+ 683 28 %CONSTSHORTINTEGERARRAY SUB(2 : 684) = %C 29+ 4119, 4288, -8192, 0, 4149, 4168, 4197, 4166, 4286, 30+ 4119, 4230, -8192, 0, 1, 8200, 24576, 4230, -8192, 31+ 0, 8, 8221, 24576, 16384, -8192, 0, 15, 8204, 32+ 20480, 16384, 4202, 21, 8244, 4168, 4197, 4166, -8192, 33+ 0, 4154, 4246,-20480, -8192, 0, 4290, 4154, 4295, 34+ -20480, 0, 23, 8223, 4255, -8192,-20480, 0, 4208, 35+ 4271, 4212, -4096, 4261, -8192, 0, 30, 8197, -4096, 36+ 4261, -8192,-20480, 0, 35, 8196, 20480, -8192,-16384, 37+ 0, 41, 8198, 4215, -8192, 0, 4130, 4096, 0, 38+ 4225, 0, 45, 8199, -8192,-20480, 0, 4309, 50, 39+ 8201, 4239, -8192,-20480, 0, 57,-20480, 8202, 12288, 40+ -8192, 0, 65, 8203, 4232, -8192,-20480, 0, 71, 41+ 77, 8193, 8205, -8192,-20480, 0, 85, 93, 8206, 42+ 8207, -8192,-20480, 0, 101, 8257,-32768, 0,-12288, 43+ -8192, 0, 4202, 4134, 4141, 0, 103, 8246, 4143, 44+ 0, 106, 8208, 12288, 4141, 0, 116, 8209, 0, 45+ 123, 8210, 4136, 4168, 4197, 4166, 0, 130, 8211, 46+ 20480, 0, 15, 8204, 20480, 16384, 0, 136, 8212, 47+ 0, 141, 8213, 4146, 0, 149, 8214, 0, 8292, 48+ 4220, 154, 8245, 8192, 4132, 0, 8292, 4220, 154, 49+ 8245, 8192, 4132, 0, 4136, 4168, 4197, 4166, 0, 50+ 156, 8247, 0, 21, 8244, 0, 159, 8248, 0, 51+ 103, 8246, 0, 162, 8215, 4119, 0, 12288, 0, 52+ -4096, 4204, 0, 12288, 0, 136, 8212, 0, 166, 53+ 8216, 0, 169, 8218, 0, 175, 8217, 0, 182, 54+ 8219, 0, 188, 8220, 0, 196, 188, 8194, 8220, 55+ 0, 71, 188, 8193, 8220, 0, 201, 8222, 0, 56+ 206, 201, 8195, 8222, 0, 211, 8224, 4161, 0, 57+ 218, 8249, 12288, 220, 8250, 8271, 0, 222, 8225, 58+ 8226, 0, 232, 8226, 0, 4172, 4197, 4166, 0, 59+ 237, 8251, 0, 239, 8252, 0, 241, 8253, 0, 60+ 237, 8251, 0, 103, 8246, 0, 239, 8252, 0, 61+ 243, 8254, 0, 245, 8255, 0, 248, 8256, 0, 62+ 250, 8257, 8257, 0, 101, 8257, 0, 253, 8258, 63+ 0, 256, 8259, 0, 258, 8260, 0, 260, 8261, 64+ 0, 263, 8262, 0, 21, 8244, 4168, 0, 266, 65+ 8263, 4168, 0, 269, 8264, 4168, 0, 271, 8267, 66+ 4168, 0, 273, 8265, 4168, 0, 276, 8266, 4168, 67+ 0, 278, 8268, 4168, 0, 281, 8272, 4168, 0, 68+ 162, 8215, 0, 283, 8227, 0, 154, 8245, 0, 69+ 12288, 0, 4202, 0, 218, 8249, 4168, 4197, 4166, 70+ 220, 8250, 0, 248, 8256, 4168, 4197, 4166, 248, 71+ 8256, 0, -4096, 4204, 4206, 0, 218, 8249, 4168, 72+ 4197, 4166, 220, 8250, 0, 286, 8270, 4202, 0, 73+ 288, 8231, 0, 297, 8232, 0, 304, 8233, 0, 74+ 30, 8197,-20480, 0, 20480,-16384, 0, 312, 8234, 75+ 8199,-20480, 0, 319, 8234, 8207, 28672, 24576, 20480, 76+ 0, 329, 8234, 8235, 28672, 24576, 20480, 0, 24576, 77+ 28672, 0, 12288, 0, -4096, 4223, 0, 218, 8249, 78+ 12288, 220, 8250, 0, 248, -8191,-28672, 0, 336, 79+ -24576, 0, 248,-28672, 0, 339,-28672, 0, 347, 80+ 8237, 4119, 0, 12288, 103, 8246, 4236, 4234, 0, 81+ 281, 8269, 4232, 0, 12288, 0, -4096, 0, 352, 82+ 8238, -4096, 218, 8249, 4283, 4246, 4279, 4281, 220, 83+ 8250, 0, 30, 8197, -4096, 4253, 218, 8249, -4096, 84+ 220, 8250, 0, 4246, 218, 8249, -4096, 220, 8250, 85+ 0, 232, 8226, 0, 352, 8238, 0, 359, 8225, 86+ 4244, 4249, 0, 4163, 4305, 0, 4305, 218, 8249, 87+ 4168, 4197, 4166, 220, 8250, 4251, 0, 281, 8269, 88+ 4249, 4251, 0, 286, 8270, -4096, 0, 4305, 4259, 89+ 4257, 0, 281, 8269, 4255, 0, 218, 8249, 4168, 90+ 12288, 154, 8245, 4168, 12288, 220, 8250, 0, 218, 91+ 8249, 4265, 4305, 4263, 220, 8250, 0, 281, 8269, 92+ 4265, 4305, 4263, 0, 4271, 232, 8226, 0, 4154, 93+ 4163, 0, 50, 8201, 4269, 232, 8226, 0, 359, 94+ 8225, 0, 77, 8205, 0, 4154, 4274, 0, 365, 95+ 8239, 0, 368, 8240, 0, 281, 8269, 0, 218, 96+ 8249, -4096, 220, 8250, 0, 4277, 4283, 4246, 4279, 97+ 4281, 0, 50, 8201, 0, 4154, 0, 372, 8241, 98+ 0, 4149, 4168, 4197, 4166, 0, 377, 8228, 0, 99+ 381, 8229, 0, 387, 8230, 0, 288, 8231, 0, 100+ 359, 8225, -4096, 4259, 4302, 0, 4305, 4300, 4298, 101+ -8192, 0, 281, 8269, 4305, 4300, 4298, 0, 21, 102+ 8244, 12288, 0, 21, 8244,-32768, 0, -8192, 0, 103+ -4096, 4307, 0, 281, 8269, -4096, 4307, 0, 377, 104+ 8228, 0, 288, 8231, 0, 387, 8230, 0 105 %CONSTBYTEINTEGERARRAY LITERAL(1 : 396) = %C 106+ 6, 102, 105, 110, 105, 115, 104, 6, 114, 101, 112, 101, 107+ 97, 116, 5, 99, 121, 99, 108, 101, 1, 61, 6, 115, 108+ 119, 105, 116, 99, 104, 4, 115, 112, 101, 99, 5, 98, 109+ 101, 103, 105, 110, 3, 101, 110, 100, 4, 108, 105, 115, 110+ 116, 6, 114, 101, 99, 111, 114, 100, 7, 99, 111, 110, 111+ 116, 114, 111, 108, 5, 102, 97, 117, 108, 116, 5, 115, 112+ 104, 111, 114, 116, 7, 114, 111, 117, 116, 105, 110, 101, 113+ 7, 116, 114, 117, 115, 116, 101, 100, 7, 112, 114, 111, 114+ 103, 114, 97, 109, 1, 42, 2, 45, 62, 9, 112, 114, 115+ 105, 110, 116, 116, 101, 120, 116, 6, 114, 101, 116, 117, 116+ 114, 110, 6, 114, 101, 115, 117, 108, 116, 5, 115, 116, 117+ 97, 114, 116, 4, 115, 116, 111, 112, 7, 109, 111, 110, 118+ 105, 116, 111, 114, 4, 101, 120, 105, 116, 1, 58, 2, 119+ 61, 61, 2, 60, 45, 3, 97, 110, 100, 2, 105, 102, 120+ 5, 119, 104, 105, 108, 101, 6, 117, 110, 108, 101, 115, 121+ 115, 5, 117, 110, 116, 105, 108, 7, 105, 110, 116, 101, 122+ 103, 101, 114, 4, 98, 121, 116, 101, 4, 114, 101, 97, 123+ 108, 4, 108, 111, 110, 103, 6, 115, 116, 114, 105, 110, 124+ 103, 1, 40, 1, 41, 9, 97, 114, 114, 97, 121, 110, 125+ 97, 109, 101, 4, 110, 97, 109, 101, 1, 43, 1, 45, 126+ 1, 92, 1, 38, 2, 33, 33, 1, 33, 2, 42, 42, 127+ 2, 47, 47, 1, 47, 1, 46, 2, 60, 60, 2, 62, 128+ 62, 2, 60, 61, 1, 60, 1, 35, 2, 62, 61, 1, 129+ 62, 2, 92, 61, 1, 44, 2, 111, 114, 1, 95, 8, 130+ 101, 120, 116, 101, 114, 110, 97, 108, 6, 115, 121, 115, 131+ 116, 101, 109, 7, 100, 121, 110, 97, 109, 105, 99, 6, 132+ 111, 102, 108, 105, 115, 116, 9, 111, 102, 112, 114, 111, 133+ 103, 114, 97, 109, 6, 111, 102, 102, 105, 108, 101, 2, 134+ 33, 42, 7, 99, 111, 109, 109, 101, 110, 116, 4, 101, 135+ 108, 115, 101, 6, 102, 111, 114, 109, 97, 116, 5, 97, 136+ 114, 114, 97, 121, 2, 102, 110, 3, 109, 97, 112, 4, 137+ 116, 104, 101, 110, 3, 111, 119, 110, 5, 99, 111, 110, 138+ 115, 116, 9, 101, 120, 116, 114, 105, 110, 115, 105, 99 139 %CONSTBYTEINTEGERARRAY SFLAGS(1 : 80) = %C 140+ 3, 3, 3, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 1, 141+ 1, 1, 1, 4, 0, 4, 0, 4, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 142+ 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 143+ 0, 0, 0, 0, 0, 0, 0, 0 144 {%CONST}%OWNBYTEINTEGERARRAY KEYSYMS(1 : 381) = %C 145+ 5, 83, 72, 79, 82, 84, 4, 66, 89, 84, 69, 4, 76, 79, 78, 71, 5, 66, 146+ 69, 71, 73, 78, 4, 83, 80, 69, 67, 3, 69, 78, 68, 4, 76, 73, 83, 84, 147+ 6, 70, 73, 78, 73, 83, 72, 6, 82, 69, 67, 79, 82, 68, 7, 67, 79, 78, 148+ 84, 82, 79, 76, 5, 70, 65, 85, 76, 84, 5, 67, 89, 67, 76, 69, 7, 82, 149+ 79, 85, 84, 73, 78, 69, 7, 84, 82, 85, 83, 84, 69, 68, 7, 80, 82, 79, 150+ 71, 82, 65, 77, 9, 80, 82, 73, 78, 84, 84, 69, 88, 84, 6, 82, 69, 84, 151+ 85, 82, 78, 6, 82, 69, 83, 85, 76, 84, 5, 83, 84, 65, 82, 84, 4, 83, 152+ 84, 79, 80, 7, 77, 79, 78, 73, 84, 79, 82, 4, 69, 88, 73, 84, 3, 65, 153+ 78, 68, 2, 73, 70, 6, 85, 78, 76, 69, 83, 83, 5, 87, 72, 73, 76, 69, 154+ 5, 85, 78, 84, 73, 76, 7, 73, 78, 84, 69, 71, 69, 82, 6, 82, 69, 80, 155+ 69, 65, 84, 4, 82, 69, 65, 76, 6, 83, 87, 73, 84, 67, 72, 6, 83, 84, 156+ 82, 73, 78, 71, 5, 65, 82, 82, 65, 89, 4, 78, 65, 77, 69, 2, 79, 82, 157+ 3, 79, 87, 78, 5, 67, 79, 78, 83, 84, 9, 69, 88, 84, 82, 73, 78, 83, 158+ 73, 67, 8, 69, 88, 84, 69, 82, 78, 65, 76, 6, 83, 89, 83, 84, 69, 77, 159+ 7, 68, 89, 78, 65, 77, 73, 67, 2, 79, 70, 4, 70, 73, 76, 69, 7, 67, 160+ 79, 77, 77, 69, 78, 84, 4, 69, 76, 83, 69, 6, 70, 79, 82, 77, 65, 84, 161+ 2, 70, 78, 3, 77, 65, 80, 4, 84, 72, 69, 78, 5, 82, 69, 65, 76, 83, 162+ 6, 78, 79, 82, 77, 65, 76, 1, 61, 1, 58, 2, 45, 62, 2, 61, 61, 2, 163+ 60, 45, 1, 40, 1, 41, 1, 43, 1, 45, 1, 92, 1, 38, 2, 33, 33, 1, 164+ 33, 1, 42, 2, 47, 47, 1, 47, 1, 46, 2, 60, 60, 2, 62, 62, 2, 60, 165+ 61, 1, 60, 2, 62, 61, 1, 62, 1, 35, 2, 92, 61, 1, 44, 1, 95, 1, 166+ 32, 1, 44 167 %CONSTSHORTINTEGERARRAY KEYWORD(1 : 80) = %C 168+ 0, 6, 11, 16, 22, 27, 31, 36, 43, 50, 58, 64, 70, 78, 169+ 86, 94, 104, 111, 118, 124, 129, 137, 142, 146, 149, 156, 162, 168, 170+ 176, 183, 188, 195, 202, 208, 213, 216, 220, 226, 236, 245, 252, 260, 171+ 263, 268, 276, 281, 288, 291, 295, 300, 306, 313, 315, 317, 320, 323, 172+ 326, 328, 330, 332, 334, 336, 338, 341, 343, 345, 348, 350, 352, 355, 173+ 358, 361, 363, 366, 368, 370, 373, 375, 377, 379 174 %CONSTBYTEINTEGERARRAY KFLAGS(1 : 80) = %C 175+ 144, 144, 144, 128, 129, 128, 128, 128, 128, 128, 128, 128, 128, 144, 176+ 128, 128, 128, 128, 128, 128, 144, 128, 160, 130, 130, 130, 130, 128, 177+ 128, 128, 128, 128, 145, 129, 128, 144, 144, 144, 144, 144, 144, 145, 178+ 128, 128, 162, 129, 129, 129, 160, 144, 128, 8, 8, 8, 8, 8, 179+ 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 180+ 8, 8, 8, 8, 8, 8, 64, 0, 0, 0 181 %OWNBYTEINTEGER ISOLATE BRACKETS = 0; ! 'IB' 182 %OWNBYTEINTEGER LEAVE BLANKS = 0; ! 'LB' 183 %OWNBYTEINTEGER SEP BLOCKS = 1; ! 'SB' 184 %OWNBYTEINTEGER INDENT BLOCKS = 1; ! 'TB' 185 %OWNBYTEINTEGER SPLIT KEYWORDS = 0; ! 'SK' 186 %OWNBYTEINTEGER PACK NAMES = 0; ! 'PN' 187 %OWNBYTEINTEGER SPLIT STATS = 0; ! 'SS' 188 %OWNBYTEINTEGER COMMENTS NORMAL = 0; ! 'CN' 189 %OWNBYTEINTEGER BREAK COMMENTS = 1; ! 'BC' 190 %OWNBYTEINTEGER LEAVE STARS = 1; ! 'LS' 191 %OWNBYTEINTEGER JUSTIFY ALL = 0; ! 'JA' 192 %OWNBYTEINTEGER LABELS RELATIVE = 0; ! 'LR' 193 %OWNBYTEINTEGER SPLIT CONDS = 1; ! 'SC' 194 %OWNBYTEINTEGER DECS RELATIVE = 1; ! 'DR' 195 %OWNBYTEINTEGER SPACE LISTS = 1; ! 'SL' 196 %OWNBYTEINTEGER SPACE EQUALS = 1; ! 'SE' 197 %OWNBYTEINTEGER ISOLATE LOOPS = 1; ! 'IL' 198 %OWNBYTEINTEGER EXTRA MARGIN = 0; ! 'EM' 199 %OWNBYTEINTEGER LEAVE OWNS = 0; ! 'LO' 200 %OWNBYTEINTEGER COMMENTS RELATIVE = 1; ! 'CR' 201 %OWNBYTEINTEGER EXTEND COMMENTS = 1; ! 'EC' 202 %OWNBYTEINTEGER MI = 3; ! MARGIN INCREMENT 203 %OWNBYTEINTEGER LL = 72; ! LINE LENGTH 204 %OWNBYTEINTEGER CT = 40; ! COMMENT TAB 205 %OWNBYTEINTEGER ML = 40; ! MARGIN LIMIT 206 %OWNBYTEINTEGER COMMENT EXTENSION = 5; ! 'CE' 207 %OWNBYTEINTEGER EXT NUM = 2; ! 'XN' 208 %OWNBYTEINTEGER INITIAL MARGIN = 7; ! 'IM' 209 %OWNBYTEINTEGER SECONDARY MARGIN = 3; ! 'SM' 210 %OWNBYTEINTEGER COMMENT LIMIT = 20; ! 'CL' 211 %OWNBYTEINTEGER COMMENT LINE = 120; ! 'LC' 212 %OWNSHORTINTEGER SAFETY FACTOR = 5 213 %OWNINTEGER DELTA MARGIN = 3 214 %OWNINTEGER LINE LENGTH = 70 215 %OWNINTEGER COMMENT TAB = 40 216 %OWNINTEGER LEVEL = 1, MLIMIT = 0, SEC MARGIN = 3 217 %OWNBYTEINTEGER COMMENT FLAG 218 %OWNBYTEINTEGER CMODE, LOOP FLAG 219 %OWNINTEGER LINESIZE, CS, DISP, D, RMARGIN, FIRST DISP 220 %OWNINTEGER SIZE, CSTART, LINE BASE, FULL LINE 221 %EXTERNALROUTINE PROMPT(%STRING (63) S) 222 PRINT STRING(S) 223 %END 224 225 !%EXTERNALROUTINESPEC DEFINE(%STRING (63) S) 226 %EXTERNALROUTINESPEC SEND(%STRING (63) S) 227 %EXTERNALROUTINESPEC LIST(%STRING (63) S) 228 %EXTERNALROUTINESPEC DESTROY(%STRING (63) S) 229 %EXTERNALROUTINESPEC RENAME(%STRING (63) S) 230 %INTEGERFNSPEC PARSE(%INTEGER EP) 231 %OWNSTRING (255) INPUT, OUTPUT, OPTION FILE, ST, OPLIST 232 %OWNINTEGER SPT, SAD, S 233 %OWNBYTEINTEGER SPACES, MODE 234 %OWNBYTEINTEGER OK, THIS SEP 235 %CONSTINTEGER LAST TEXT = 51 236 %OWNINTEGER HEADER, SEGS 237 %OWNINTEGERARRAY STRINGS(1 : 100); !(-100 : -1) 238 %OWNINTEGER COMMENT LENGTH 239 %OWNSHORTINTEGERARRAY REM(1 : 4) 240 %OWNBYTEINTEGERARRAY SYMFILE(0 : 300) 241 %OWNBYTEINTEGERARRAY TLENGTH(1 : 100);!(-100 : -1) 242 %OWNINTEGERARRAY REC(1 : 100) 243 %OWNBYTEINTEGER STATUS, OPTIONS, LAST SEP, FLAG, PMODE 244 %OWNBYTEINTEGER QUOTES = 0, OWNFLAG = ';' 245 %OWNINTEGER NVAL 246 !%REGISTER CURRIN(14) 247 %OWNINTEGER CURRIN 248 %OWNINTEGER CURROUT, SLENGTH, LIMIT, MARGIN, INBASE, STATSIZE 249 %OWNINTEGER STAT, KEYBASE, TEXTBASE, J, SN, RP, RPLIM, RPINC 250 %OWNINTEGER MAXMARGIN, ENDOFFILE 251 %CONSTINTEGER CCC = X'2025430A' 252 %CONSTINTEGER CONNEKTEP = 1 253 %CONSTINTEGER CREATEEP = 162 254 %CONSTINTEGER READEP = 7 255 %CONSTINTEGER INFOEP = 5 256 %CONSTINTEGER CHANGEEP = 6 257 %ROUTINESPEC SET UP FILES(%STRING(*)%NAME S) 258 %ROUTINESPEC CLOSE FILES 259 %ROUTINESPEC SET OPTIONS 260 261 %DYNAMICROUTINESPEC CHERISH(%STRING(63) S) 262 263 264 %ROUTINE CONTINUE 265 !%SHORTROUTINE 266 %ROUTINESPEC ADJUST 267 %INTEGERARRAY HOLD(1 : 4) 268 %INTEGER J, K, L, M, N, Z, LIM, XES 269 !!%BYTEINTEGERARRAYFORMAT NFM(1 : 4) 270 %BYTEINTEGERARRAYNAME NEST 271 %BYTEINTEGER S, CFLAG 272 !!NEST == ARRAY(ADDR(NVAL),NFM) 273 THIS SEP = NL; LIM = MARGIN+SAFETY FACTOR+SEC MARGIN 274 Z = SLENGTH+CURROUT 275 %RETURN %IF Z < LIMIT %OR (Z-SAFETY FACTOR-LIMIT < -4 %C 276+ %AND REC(RP+1) = 0) 277 ! LEAVE TWO SPACES FOR " %" IF NESC. 278 XES = Z-LIMIT; ! EXCESS LINE LENGTH 279 280 %CYCLE J = 1,1,4; HOLD(J) = NEST(J)+CURROUT-LINE BASE 281 %REPEAT 282 283 %IF LAST SEP = ';' %THEN %START 284 N = CURROUT; QUOTES = 0 285 286 %CYCLE 287 N = N-1; S = BYTEINTEGER(N) 288 QUOTES = QUOTES!!1 %IF S = '''' 289 %REPEAT %UNTIL S = ';' %AND QUOTES = 0 290 291 BYTEINTEGER(N) = NL; LIMIT = N+LINELENGTH 292 LINE BASE = N 293 K = CURROUT+80; M = K 294 295 %CYCLE L = N+3,1,CURROUT 296 K = K+1; BYTEINTEGER(K) = BYTEINTEGER(L) 297 %REPEAT 298 299 %CYCLE L = 1,1,MARGIN 300 N = N+1; BYTEINTEGER(N) = ' ' 301 %REPEAT 302 303 %CYCLE L = M+1,1,K 304 N = N+1; BYTEINTEGER(N) = BYTEINTEGER(L) 305 %REPEAT 306 307 CURROUT = N 308 LAST SEP = NL 309 ADJUST 310 %RETURN %IF CURROUT+SLENGTH < LIMIT 311 %FINISH 312 NEST(3) = 0 %IF NEST(4) # 0 %AND REC(REM(4)-1) >= 4 313 CFLAG = 0 314 315 %CYCLE J = 1,1,4 316 N = NEST(J) 317 %IF N > LIM %START 318 N = N+LINE BASE 319 CFLAG = 1 %AND %EXIT %IF N < CURROUT 320 %FINISH 321 %REPEAT 322 323 %IF CFLAG # 0 %START 324 %IF NEST(J)-MARGIN-SEC MARGIN-SAFETY FACTOR < XES %START 325 K = J 326 327 %WHILE K < 4 %CYCLE 328 K = K+1 329 CFLAG = 0 %AND %EXIT %IF NEST(K) # 0 330 %REPEAT 331 332 %IF CFLAG = 0 %START 333 L = NEST(K)+LINE BASE 334 J = K %AND N = L %C 335+ %IF NEST(K) > LIM %AND L < CURROUT 336 %FINISH 337 %FINISH 338 J = 3 %AND N = NEST(3)+LINE BASE %C 339+ %IF J = 4 %AND REM(3) = REM(4)-1 340 LIM = NEST(J)+SAFETY FACTOR+SEC MARGIN 341 K = CURROUT+80; M = K 342 343 %CYCLE L = N+1,1,CURROUT 344 K = K+1; BYTEINTEGER(K) = BYTEINTEGER(L) 345 %REPEAT 346 347 !!*L_1,N 348 !!*MVC_1(4,1),CCC 349 !!*LA_1,4(1) 350 !!*ST_1,CURROUT 351 !!*ST_1,LINEBASE 352 353 %CYCLE J = 1,1,MARGIN+SEC MARGIN 354 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = ' ' 355 %REPEAT 356 357 M = M+1 %IF BYTEINTEGER(M+1) = ' ' 358 %IF BYTEINTEGER(M+1) # '%' %START 359 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = '%' 360 %FINISH 361 362 %CYCLE L = M+1,1,K 363 CURROUT = CURROUT+1 364 BYTEINTEGER(CURROUT) = BYTEINTEGER(L) 365 %REPEAT 366 367 !?? ADJUST 368 %FINISH %ELSE %START 369 LIM = CURROUT-LINEBASE+SAFETY FACTOR 370 !!*L_1,CURROUT 371 !!*MVC_1(4,1),CCC 372 !!*LA_1,4(1) 373 !!*ST_1,CURROUT 374 !!*ST_1,LINE BASE 375 376 %CYCLE J = 1,1,MARGIN+SEC MARGIN 377 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = ' ' 378 %REPEAT 379 380 PMODE = 128; ! NO LONGER IN RANGE OF '%' 381 %FINISH 382 LIMIT = LINEBASE+LINE LENGTH 383 STATSIZE = STATSIZE-LINELENGTH+MARGIN 384 RPLIM = RPLIM+RPINC %IF STATSIZE+MARGIN >= LINE LENGTH 385 NVAL = 0 386 387 %ROUTINE ADJUST 388 389 %CYCLE J = 1,1,4 ?Non-local 390 %IF NEST(J) <= LIM %THEN NEST(J) = 0 %C 391+ %ELSE NEST(J) = HOLD(J)-CURROUT+LINE BASE 392 %REPEAT 393 394 %END 395 %END 396 397 %ROUTINE BREAK 398 !%SHORTROUTINE 399 CURROUT = CURROUT-2 %UNLESS BYTEINTEGER(CURROUT) = ';' 400 BYTEINTEGER(CURROUT) = NL 401 SIZE = 0; LINE BASE = CURROUT 402 LIMIT = LINE BASE+LINE SIZE 403 NVAL = 0 404 %END 405 406 %EXTERNALROUTINE SOAP(%STRING (128) FILES) 407 !%SHORTROUTINE 408 %OWNINTEGER MOVEX = X'D2002001', MOVEY = X'10010000' 409 %ROUTINESPEC PERCENT 410 %ROUTINESPEC SPACE 411 %INTEGERNAME MID MARGIN 412 %INTEGER N, P, K, M, Z 413 !!%BYTEINTEGERARRAYFORMAT NFM(1 : 4) 414 %BYTEINTEGERARRAYNAME NEST 415 PRINT STRING( "SOAP"); {PRINTCH(7);} NEWLINE 416 !!NEST == ARRAY(ADDR(NVAL),NFM) 417 SET UP FILES(FILES); %RETURN %IF OK = 0 418 SET OPTIONS; %RETURN %IF OK = 0 419 MID MARGIN == MARGIN 420 MID MARGIN == RMARGIN %IF COMMENTS RELATIVE = 0 421 !* 32 16 8 4 2 1 422 !* STATUS: SPECIAL COMMENT : COMMENT : OWN : END : DOWN : UP 423 TOP: ! HEAD OF MAIN LOOP 424 425 %CYCLE 426 NVAL = 0 427 LOOP FLAG = 0 428 RP = 0; SPT = 0; MODE = 0; STATUS = 0 429 SAD = TEXTBASE 430 LIMIT = CURROUT+LINELENGTH %IF LAST SEP # ';' 431 INBASE = CURRIN 432 %IF PARSE(0) # 0 %THEN %START 433 ! SYNTAX ?? 434 OWNS: J = CURRIN; QUOTES = 0; K = 0 435 436 %CYCLE 437 K = K+1 438 J = J+1; S = BYTEINTEGER(J) 439 QUOTES = QUOTES!!1 %IF S = '''' 440 %REPEAT %UNTIL (S = NL %OR S = ';') %AND (QUOTES = 0 %OR K > 300) 441 442 SLENGTH = J-CURRIN 443 %IF CURROUT+SLENGTH > LIMIT %AND LAST SEP = ';' %C 444+ %THEN %START 445 BREAK 446 STAT = CURROUT+MARGIN 447 448 %CYCLE J = 1,1,MARGIN ?Non-local 449 CURROUT = CURROUT+1 450 BYTEINTEGER(CURROUT) = ' ' 451 %REPEAT 452 453 %FINISH 454 %IF OWNFLAG = 0 %THEN %START 455 OWNFLAG = ';' 456 %IF CURROUT+SLENGTH+SAFETY FACTOR > LIMIT %C 457+ %THEN %START 458 !!*L_1,CURROUT 459 !!*MVC_1(4,1),CCC; ! PUSH IN CONTINUATION 460 !!*LA_1,4(1) 461 !!*ST_1,CURROUT 462 !!*ST_1,LINE BASE 463 %FINISH 464 %FINISH 465 466 %CYCLE J = 1,1,SLENGTH ?Non-local 467 CURRIN = CURRIN+1; CURROUT = CURROUT+1 468 BYTEINTEGER(CURROUT) = BYTEINTEGER(CURRIN) 469 %REPEAT 470 471 LAST SEP = BYTEINTEGER(CURRIN) 472 %IF LAST SEP = ';' %THEN %START 473 BYTEINTEGER(CURROUT+1) = ' ' 474 BYTEINTEGER(CURROUT+2) = ' ' 475 CURROUT = CURROUT+2 476 %FINISH %ELSE LINE BASE = CURROUT 477 %FINISH %ELSE %START 478 PMODE = 128 479 STATSIZE = CURRIN-INBASE 480 %IF STATSIZE+MARGIN > LINE LENGTH %START 481 RPINC = RP//(STATSIZE//(LINE LENGTH-MARGIN)) 482 RPLIM = RPINC 483 %FINISH %ELSE RPLIM = RP 484 %IF STATUS&11 # 0 %AND LAST SEP = ';' %THEN %START 485 LAST SEP = NL 486 BREAK 487 %FINISH 488 %IF STATUS&136 # 0 %THEN %START 489 ! BLANK LINE OR BLOCK 490 %IF (LEAVE BLANKS # 0 %AND THIS SEP # ';') %C 491+ %OR (STATUS&128 # 0 %AND SEP BLOCKS # 0) %C 492+ %THEN %START 493 NULL: 494 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL 495 LINE BASE = CURROUT 496 %FINISH 497 -> TOP %IF STATUS&8 # 0 %AND RP <= 1 498 ! IN CASE OF LONELY LABELS 499 %FINISH 500 RP = 0 501 %IF LOOP FLAG # 0 %AND STATUS&1 # 0 %C 502+ %AND BYTEINTEGER(CURROUT-1) # NL %START 503 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL 504 LINE BASE = CURROUT 505 LIMIT = LIMIT+1 506 %FINISH 507 %IF STATUS&2 # 0 %THEN %START 508 ! DOWN 509 STATUS = STATUS!64 %C 510+ %IF EXTRA MARGIN # 0 %AND STATUS&4 # 0 511 LEVEL = LEVEL>>1 512 LEVEL = 1 %IF LEVEL = 0 513 MARGIN = MARGIN-DELTA MARGIN %IF MLIMIT&1 = 0 514 MLIMIT = MLIMIT>>1 515 MARGIN = 0 %IF MARGIN < 0 516 %FINISH 517 STAT = CURROUT+MARGIN %IF LAST SEP # ';' 518 519 %WHILE REC(RP+1) = 100 %CYCLE 520 ! DEAL WITH LABELS 521 RP = RP+1 522 %IF LAST SEP = ';' %OR LAST SEP = ':' %THEN %START 523 N = -2; N = 1 %IF LAST SEP = ':' 524 CURROUT = CURROUT+N; BYTEINTEGER(CURROUT) = NL 525 LINE BASE = CURROUT 526 LIMIT = CURROUT+LINELENGTH 527 STAT = CURROUT+MARGIN 528 LAST SEP = NL 529 %FINISH 530 %IF LABELS RELATIVE # 0 %AND LAST SEP # ':' %C 531+ %THEN %START 532 N = LEVEL; M = MARGIN 533 M = M+FIRST DISP %C 534+ %IF EXTRA MARGIN # 0 %AND LEVEL = 1 535 536 %CYCLE 537 M = M-DELTA MARGIN 538 %EXIT %IF N&1 # 0 539 N = N>>1 540 %REPEAT 541 542 %WHILE M > 0 %CYCLE 543 M = M-1 544 CURROUT = CURROUT+1 545 BYTEINTEGER(CURROUT) = ' ' 546 %REPEAT 547 548 %FINISH 549 550 %CYCLE 551 RP = RP+1; N = REC(RP); %EXIT %IF N = 0 552 %IF N < 0 %THEN SN = STRINGS(-N) %C 553+ %ELSE SN = KEYWORD(N)+KEYBASE 554 555 %CYCLE J = SN+1,1,SN+BYTEINTEGER(SN) ?Non-local 556 CURROUT = CURROUT+1 557 BYTEINTEGER(CURROUT) = BYTEINTEGER(J) 558 %REPEAT 559 560 %REPEAT 561 562 %IF CURROUT > STAT %AND STATUS&16 = 0 %THEN %START 563 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL 564 LINE BASE = CURROUT 565 LIMIT = CURROUT+LINELENGTH 566 STAT = CURROUT+MARGIN 567 %FINISH 568 LAST SEP = ':' 569 %REPEAT 570 571 RP = 0 %AND -> NULL %IF STATUS&8 # 0 572 ! NOW DEAL WITH COMMENTS 573 %IF STATUS&16 # 0 %THEN %START 574 RP = RP+1; DISP = REC(RP) 575 ! STARTING DISP OF INPUT 576 ! COMMENT 577 D = 0; CMODE = 0 578 J = CURRIN; ! FIND THE END OF THE COMMENT 579 J = J+1 %WHILE BYTEINTEGER(J) # NL %C 580+ %AND BYTEINTEGER(J) # ';' 581 CS = J-CURRIN; ! COMMENT SIZE 582 %IF COMMENT FLAG = 0 %C 583+ %THEN CSTART = COMMENT TAB %ELSE %START 584 %IF COMMENTS NORMAL # 0 %START 585 CMODE = 1; CSTART = MARGIN 586 %FINISH %ELSE %START 587 %IF LAST SEP = ';' %C 588+ %THEN CSTART = COMMENT TAB %ELSE %START 589 %IF DISP = 0 %THEN CSTART = 0 %ELSE %START 590 %IF DISP <= MID MARGIN %C 591+ %AND STATUS&32 = 0 %C 592+ %THEN CSTART = MARGIN %C 593+ %ELSE CSTART = COMMENT TAB 594 %FINISH 595 %FINISH 596 %FINISH 597 %FINISH 598 CSTART = 0 %IF STATUS&32 # 0 %AND LEAVE STARS # 0 599 SIZE = CURROUT-LINE BASE 600 %IF LAST SEP = ';' %START 601 %IF BYTEINTEGER(CURROUT) = NL %START 602 ! COMMENT AFTER REPEAT+NL 603 LOOP FLAG = 1 604 LINE BASE = LINE BASE-1 %C 605+ %UNTIL BYTEINTEGER(LINE BASE) = NL 606 SIZE = CURROUT-LINE BASE 607 %FINISH 608 CURROUT = CURROUT-2; SIZE = SIZE-2 609 ! TO REMOVE SPACES AFTER SEMI"S 610 %IF EXTEND COMMENTS # 0 %AND CSTART < SIZE %START 611 P = CSTART; ! REMEMBER IT JUST IN CASE 612 N = EXT NUM; ! NUMBER OF EXTENSION TRIES 613 614 %CYCLE 615 %EXIT %IF N <= 0 616 CSTART = CSTART+COMMENT EXTENSION 617 %EXIT %IF CSTART >= SIZE 618 N = N-1 619 %REPEAT 620 621 CSTART = P %IF N <= 0 %C 622+ %OR CS+CSTART > COMMENT LINE 623 ! RESTORE IT IF TOO LONG 624 %FINISH 625 %IF CSTART < SIZE %START 626 %IF CMODE # 0 %THEN CSTART = 0 %ELSE BREAK 627 %FINISH %ELSE %START 628 D = COMMENT LINE-CSTART-CS 629 %IF D < 0 %AND BREAK COMMENTS = 0 %START 630 CSTART = LINE SIZE-CS 631 BREAK 632 D = 0 633 %FINISH 634 %FINISH 635 %FINISH %ELSE %START 636 D = COMMENT LINE-CSTART-CS 637 %IF D < 0 %AND BREAKCOMMENTS = 0 %THEN %START 638 CSTART = COMMENT LINE-CS 639 D = 0 640 %FINISH 641 %FINISH 642 643 %CYCLE 644 N = CSTART-SIZE 645 646 %WHILE N > 0 %CYCLE 647 N = N-1; CURROUT = CURROUT+1 648 BYTEINTEGER(CURROUT) = ' ' 649 %REPEAT 650 651 CURROUT = CURROUT+1 652 BYTEINTEGER(CURROUT) = '!' 653 CURROUT = CURROUT+1 %C 654+ %AND BYTEINTEGER(CURROUT) = '*' %C 655+ %IF STATUS&32 # 0 656 P = J 657 %IF D < 0 %START 658 P = J+D 659 P = P-1 %WHILE BYTEINTEGER(P) # ' ' %C 660+ %AND BYTEINTEGER(P) # ',' %C 661+ %AND BYTEINTEGER(P) # '.' %AND P > CURRIN 662 P = P-1 663 P = J+D %IF P = CURRIN 664 %FINISH 665 666 %CYCLE K = CURRIN+1,1,P 667 CURROUT = CURROUT+1 668 BYTEINTEGER(CURROUT) = BYTEINTEGER(K) 669 %REPEAT 670 671 CURRIN = P 672 %EXIT %IF D >= 0 673 CURROUT = CURROUT+1 674 BYTEINTEGER(CURROUT) = NL 675 SIZE = 0; D = LINE LENGTH-MARGIN+D 676 %REPEAT 677 678 BYTEINTEGER(CURROUT) = NL 679 %IF LOOP FLAG # 0 %START 680 LOOP FLAG = 0 681 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL 682 %FINISH 683 SIZE = 0; LINE BASE = CURROUT; LAST SEP = NL 684 ! END OF COMMENT HANDLING 685 %FINISH %ELSE %START 686 N = 0 687 %IF STATUS&64 # 0 %START 688 N = DELTA MARGIN 689 N = MARGIN %IF EXTRA MARGIN # 0 690 %FINISH 691 STAT = STAT-N 692 CURROUT = CURROUT+1 %C 693+ %AND BYTEINTEGER(CURROUT) = ' ' %C 694+ %WHILE CURROUT < STAT 695 LIMIT = CURROUT+LINELENGTH-MARGIN+N %C 696+ %IF LAST SEP # ';' 697 698 %CYCLE 699 RP = RP+1; N = REC(RP); %EXIT %IF N = 0 700 %IF N > 0 %THEN %START 701 SN = KEYWORD(N)+KEYBASE 702 FLAG = KFLAGS(N) 703 Z = SFLAGS(N) 704 SLENGTH = BYTEINTEGER(SN) 705 %FINISH %ELSE %START 706 SN = STRINGS(-N) 707 FLAG = 0; Z = 0 708 SLENGTH = TLENGTH(-N) 709 %FINISH 710 %IF RP >= RPLIM %C 711+ %OR (SLENGTH+CURROUT > LIMIT %C 712+ %AND N <= LAST TEXT) %THEN CONTINUE 713 %IF Z # 0 %START 714 NEST(Z) = CURROUT-LINE BASE 715 REM(Z) = RP 716 %FINISH 717 SPACE %IF FLAG&OPTIONS&15 # 0 %C 718+ %OR (PMODE!!FLAG)&128 = 0 719 PERCENT %IF FLAG&PMODE # 0 720 %CYCLE J=SN+1, 1, SN+BYTEINTEGER(SN) ?Non-local 721 CURROUT=CURROUT+1 722 BYTEINTEGER(CURROUT)=BYTEINTEGER(J) 723 %REPEAT 724 SPACE %IF FLAG&OPTIONS&120 # 0 725 PMODE = 128 %UNLESS 0 < N <= LAST TEXT 726 %REPEAT 727 728 -> OWNS %IF OWNFLAG = 0 729 CURROUT = CURROUT+1 730 BYTEINTEGER(CURROUT) = THIS SEP 731 LAST SEP = THIS SEP 732 %IF LOOP FLAG # 0 %AND STATUS&2 # 0 %START 733 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL 734 %FINISH 735 %IF STATUS&1 # 0 %THEN %START 736 ! UP 737 LEVEL = LEVEL<<1 738 LEVEL = LEVEL!1 %IF STATUS&128 # 0 739 MLIMIT = MLIMIT<<1 740 MLIMIT = MLIMIT!1 %C 741+ %IF MARGIN >= MAX MARGIN %OR ( %C 742+ INDENT BLOCKS = 0 %AND STATUS&128 # 0) 743 %IF MARGIN = 0 %AND EXTRA MARGIN # 0 %C 744+ %THEN MARGIN = INITIAL MARGIN %ELSE %START 745 MARGIN = MARGIN+DELTA MARGIN %IF MLIMIT&1 = 0 746 %FINISH 747 %FINISH 748 %IF LAST SEP = ';' %THEN %START 749 BYTEINTEGER(CURROUT+1) = ' ' 750 CURROUT = CURROUT+2 751 BYTEINTEGER(CURROUT) = ' ' 752 %FINISH %ELSE LINE BASE = CURROUT 753 %EXIT %IF CURRIN >= ENDOFFILE %OR STATUS&7 = 7 754 %FINISH 755 %FINISH 756 %REPEAT 757 758 CLOSE FILES 759 %RETURN 760 761 %ROUTINE SPACE 762 %IF ' ' # BYTEINTEGER(CURROUT) # NL %C 763+ %AND BYTEINTEGER(CURROUT) # '(' %THEN %START 764 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = ' ' 765 PMODE = 128 766 %FINISH 767 %END 768 769 %ROUTINE PERCENT 770 %IF PMODE # 0 %THEN %START 771 %IF ' ' # BYTEINTEGER(CURROUT) # NL %C 772+ %AND BYTEINTEGER(CURROUT) # '(' %THEN %START 773 CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = ' ' 774 %FINISH 775 CURROUT = CURROUT+1 776 BYTEINTEGER(CURROUT) = '%' 777 PMODE = 0 778 %FINISH 779 %END 780 %END ?MOVEY unused ?MOVEX unused 781 782 %ROUTINE CONNEKT(%STRING (17) FILE, %INTEGERNAME MODE, FLAG) 783 %INTEGER J 784 J = 0 785 !FDP(CONNEKTEP,FILE,MODE,ADDR(J),FLAG) 786 MODE = J 787 FLAG = 0 %IF FLAG = 5 788 %END ?FILE unused 789 790 %INTEGERFN PARSE(%INTEGER ENTRY) 791 !%SHORTROUTINE 792 %INTEGER SS, SP, TRP, TPT, L 793 %BYTEINTEGER MODES 794 795 %INTEGERFN PUT 796 SPT = SPT-1 797 RP = RP+1 798 REC(RP) = SPT 799 TLENGTH(-SPT) = SLENGTH 800 STRINGS(-SPT) = SAD 801 STRING(SAD) = ST 802 SAD = SAD+1+BYTEINTEGER(ADDR(ST)) 803 %RESULT = SPT 804 %END 805 806 %ROUTINE SYM 807 808 %CYCLE 809 CURRIN = CURRIN+1; S = BYTEINTEGER(CURRIN) 810 MODE = 0 %UNLESS 'A' <= S <= 'Z' 811 %IF S = '%' %THEN MODE = 32 %ELSE %START 812 %IF S # ' ' %THEN %START 813 S = S+MODE 814 %RETURN %IF S # 'C'+32 %C 815+ %OR BYTEINTEGER(CURRIN+1) # NL 816 CURRIN = CURRIN+1 817 MODE = 0 818 %FINISH 819 SPACES = PACK NAMES 820 %FINISH 821 %REPEAT 822 823 %END 824 825 %INTEGERFN CONSTANT 826 %INTEGER T, LIM 827 %INTEGER CS 828 SLENGTH = 0 829 ST = "" 830 SYM 831 CS = CURRIN %AND ST = ST.TOSTRING(S) %AND SYM %C 832+ %WHILE '0' <= S <= '9' %OR S = '.' %OR S = '@' 833 CURRIN = CS %AND %RESULT = PUT %IF ST # "" 834 %IF S = 'M' %OR S = 'X' %OR S = 'B' %THEN %START 835 ST = TOSTRING(S) 836 T = CURRIN 837 SYM 838 CURRIN = T %AND %RESULT = 0 %IF S # '''' 839 %FINISH 840 LIM = CURRIN+255 841 842 %WHILE S = '''' %CYCLE 843 844 %CYCLE 845 SLENGTH = BYTEINTEGER(ADDR(ST)) %C 846+ %IF S = NL %AND SLENGTH = 0 847 ST = ST.TOSTRING(S) 848 CURRIN = CURRIN+1 849 S = BYTEINTEGER(CURRIN) 850 %REPEAT %UNTIL S = '''' %OR CURRIN > LIM 851 852 ST = ST."'" 853 CS = CURRIN 854 SYM 855 %REPEAT 856 857 SLENGTH = BYTEINTEGER(ADDR(ST)) %IF SLENGTH = 0 858 CURRIN = CS %AND %RESULT = PUT %IF ST # "" 859 %RESULT = 0 860 %END 861 862 %INTEGERFN NAME 863 %INTEGER Z 864 SYM 865 %RESULT = 0 %UNLESS 'A' <= S <= 'Z' 866 ST = "" 867 868 %CYCLE 869 SPACES = 1 870 ST = ST.TOSTRING(S) 871 Z = CURRIN 872 SYM 873 SLENGTH = BYTEINTEGER(ADDR(ST)) %AND CURRIN = Z %C 874+ %AND %RESULT = PUT %C 875+ %UNLESS 'A' <= S <= 'Z' %OR '0' <= S <= '9' 876 ST = ST." " %IF SPACES = 0 877 %REPEAT 878 879 %END 880 %SWITCH BIP(0 : 15) 881 ! 882 TRP = RP 883 TPT = CURRIN 884 MODES = MODE 885 FAILURE: 886 RP = TRP 887 CURRIN = TPT 888 MODE = MODES 889 ENTRY = ENTRY+1 890 SP = MAIN(ENTRY) 891 %RESULT = 1 %IF SP = 0 892 SUCCESS: 893 SP = SP+1 894 SS = SUB(SP) 895 %RESULT = 0 %IF S S = 0 896 -> BIP(SS>>12&15) 897 BIP(1): ! SUB-PHRASE 898 -> SUCCESS %IF PARSE(SS&X'FFF') = 0 899 -> FAILURE 900 BIP(0): ! LITERAL 901 SS = SS&X'FFF' 902 L = LITERAL(SS); ! LENGTH 903 904 %CYCLE SS = SS+1,1,SS+L 905 SYM 906 -> FAILURE %UNLESS S = LITERAL(SS) 907 %REPEAT 908 909 -> SUCCESS 910 BIP(15): ! (NAME) 911 -> SUCCESS %IF NAME # 0 912 -> FAILURE 913 BIP(3): ! CONSTANT 914 -> SUCCESS %IF CONSTANT # 0 915 -> FAILURE 916 BIP(4): ! (*LOOP) 917 LOOP FLAG = 1 %IF ISOLATE LOOPS # 0 918 -> SUCCESS 919 BIP(5): ! (UP) 920 STATUS = STATUS!1; -> SUCCESS 921 BIP(6): ! (DOWN) 922 STATUS = STATUS!2; -> SUCCESS 923 BIP(7): ! (END) 924 STATUS = STATUS!4; -> SUCCESS 925 BIP(8): ! (OWN) 926 -> FAILURE %IF LEAVE OWNS # 0 %C 927+ %AND BYTEINTEGER(CURRIN) # '*' 928 ! MACHINE CODE 929 OWN FLAG = 0 930 RP = RP+1; REC(RP) = 0 931 ! TO FIDDLE THE END OF STAT. 932 THIS SEP = NL 933 -> SUCCESS 934 BIP(10): ! (SPECIAL COMMENT) 935 INBASE = INBASE+1; ! TO SET DISP PROPERLY 936 STATUS = STATUS!32 937 BIP(9): ! (COMMENT) 938 STATUS = STATUS!16 939 RP = RP+1; REC(RP) = CURRIN-INBASE-1 940 -> SUCCESS 941 BIP(11): ! (*DEC) 942 STATUS = STATUS!64 %IF DECS RELATIVE # 0; -> SUCCESS 943 BIP(12): ! (*BLOCK) 944 STATUS = STATUS!64 %IF EXTRA MARGIN # 0 945 STATUS = STATUS!128; -> SUCCESS 946 BIP(13): ! (*NULL) 947 STATUS = STATUS!8; -> SUCCESS 948 BIP(14): ! (S) 949 SYM 950 -> FAILURE %UNLESS S = NL %OR S = ';' 951 THIS SEP = S 952 THISSEP = NL %IF SPLIT STATS # 0 953 RP = RP+1 954 REC(RP) = 0 955 -> SUCCESS 956 BIP(2): ! <> 957 RP = RP+1 958 REC(RP) = SS&X'FFF' 959 -> SUCCESS 960 %END 961 962 %ROUTINE CREATE(%STRING (8) FILE, %INTEGERNAME SIZE, FLAG) 963 !FDP(CREATEEP,FILE,SIZE,0,FLAG) 964 SIZE = 3 965 %IF FLAG = 0 %OR FLAG = 3 %THEN CONNEKT(FILE,SIZE,FLAG) 966 %END 967 968 %ROUTINE COMPRESS(%STRING (8) FILE) 969 %END ?FILE unused 970 971 %ROUTINE SET UP FILES(%STRING(*)%NAME S) 972 !%SHORTROUTINE 973 %INTEGER FLAG, SIZE 974 OK = 0 975 INPUT = "" 976 OUTPUT = "" 977 OPTION FILE = "" 978 INPUT = S %UNLESS S -> INPUT.("/").OUTPUT 979 OPTION FILE = "" %UNLESS INPUT -> INPUT.(",").OPTION FILE 980 OUTPUT = INPUT %IF OUTPUT = "" 981 SIZE = 0 982 !FDP(7, INPUT, 0, ADDR(SIZE), FLAG) 983 CURRIN = SIZE 984 %IF FLAG # 0 %THEN %START 985 PRINTSTRING("CANNOT CONNECT ".INPUT.": "); WRITE(FLAG,1) 986 NEWLINE 987 %RETURN 988 %FINISH 989 %IF INTEGER(CURRIN+12) # 0 %THEN %START 990 PRINTSTRING(INPUT." IS NOT A SOURCE FILE\n") 991 %RETURN 992 %FINISH 993 SIZE = INTEGER(CURRIN) 994 %IF SIZE < 10 %THEN %START 995 PRINTSTRING(INPUT." IS A NULL FILE\n") 996 %RETURN 997 %FINISH 998 ENDOFFILE = CURRIN+SIZE 999 ENDOFFILE = ENDOFFILE-1 %WHILE BYTEINTEGER(ENDOFFILE) # NL 1000 CURROUT = ((SIZE*6)+4095)>>12;! I HOPE IT"S BIG ENOUGH 1001 SEGS = (CURROUT+15)>>4 1002 CREATE("SP#WORK",CURROUT,FLAG) 1003 %IF FLAG # 0 %THEN %START 1004 PRINT STRING( "CANNOT CREATE WORK FILE"); WRITE(FLAG,1) 1005 NEWLINE 1006 %RETURN 1007 %FINISH 1008 HEADER = CURROUT 1009 CURROUT = CURROUT+16 1010 BYTEINTEGER(CURROUT) = NL 1011 CURRIN = CURRIN+15 1012 INTEGER(HEADER) = 1<<16; ! JUST FOR TESTING 1013 INTEGER(HEADER+4) = 16 1014 INTEGER(HEADER+8) = SEGS 1015 INTEGER(HEADER+12) = 0 1016 OK = 1 1017 %END 1018 1019 %ROUTINE CLOSE FILES 1020 %ROUTINE NEWGENS 1021 %END 1022 %END ?NEWGENS unused 1023 1024 %ROUTINE SET OPTIONS 1025 !%SHORTROUTINE 1026 %STRING (255) S, T 1027 %INTEGER J 1028 %BYTEINTEGER OPT FLAG 1029 !!%BYTEINTEGERARRAYFORMAT FM(1 : 31) 1030 %BYTEINTEGERARRAYNAME WORD 1031 1032 %ROUTINE LINE(%STRING(*)%NAME S) 1033 %INTEGER J 1034 %RETURN %IF OPT FLAG = 0 1035 S = "" 1036 1037 %CYCLE 1038 1039 %CYCLE 1040 READSYMBOL(J) %UNTIL J # ' ' 1041 %EXIT %IF J = NL 1042 S = S.TOSTRING(J) 1043 %REPEAT 1044 1045 %REPEAT %UNTIL S # "" 1046 1047 %END 1048 1049 %ROUTINE SET(%STRING(*)%NAME S) 1050 %STRING (255) N, OPT 1051 %INTEGER V, K, C, NUM 1052 %BYTEINTEGER NOT 1053 %CONSTSTRING (2) %ARRAY PARAM(1 : 31) = %C 1054+ "IB", "LB", "SB", "TB", "SK", "PN", "SS", "CN", "BC", 1055+ "LS", "JA", "LR", "SC", 1056+ "DR", "SL", "SE", "IL", "EM", 1057+ "LO", "CR", "EC", 1058+ "MI", "LL", "CT", "ML", 1059+ "CE", "XN", "IM", "SM", 1060+ "CL", "LC" 1061 %OWNINTEGER PARAMS = 31, BOOLS = 21 1062 OPT = S 1063 NOT = 1; NUM = 0 1064 %IF S -> S.("=").N %THEN %START 1065 NUM = -1; V = 0; J = ADDR(N) 1066 1067 %CYCLE J = J+1,1,J+LENGTH(N) ?Non-local 1068 C = BYTEINTEGER(J)-'0' 1069 %UNLESS 0 <= C <= 9 %THEN %START 1070 PRINTSTRING(N." ?\n") 1071 %RETURN 1072 %FINISH 1073 V = V*10+C 1074 %REPEAT 1075 1076 %IF V > 255 %THEN %START 1077 PRINTSTRING(N." ?\n") 1078 %RETURN 1079 %FINISH 1080 %FINISH 1081 NOT = 0 %IF NUM = 0 %AND S -> ("\").S 1082 1083 %CYCLE J = 1,1,PARAMS ?Non-local 1084 %IF PARAM(J) = S %THEN %START 1085 %IF (BOOLS-J)!!NUM < 0 %THEN %START 1086 PRINTSTRING(S."= ?\n") 1087 %RETURN 1088 %FINISH 1089 K = NOT; K = V %IF NUM < 0 1090 WORD(J) = K 1091 OPLIST = OPLIST." ".OPT 1092 %RETURN 1093 %FINISH 1094 %REPEAT 1095 1096 PRINTSTRING(S." ?\n") 1097 %END 1098 OPLIST = "\n!! OPTIONS:" 1099 !!WORD == ARRAY(ADDR(ISOLATE BRACKETS),FM) 1100 OK = 1 1101 %IF OPTIONFILE # "" %THEN %START 1102 OK = 0 1103 OPT FLAG = 0 1104 %IF OPTIONFILE -> ("[").S %THEN %START 1105 OPT FLAG = 0 %IF S -> S.("]") 1106 S = S.",*" 1107 %FINISH %ELSE %START 1108 OPT FLAG = 1 1109 PROMPT("OPTIONS:") 1110 !DEFINE("ST76,".OPTION FILE) 1111 SELECTINPUT(76) 1112 %FINISH 1113 1114 %CYCLE 1115 LINE(S) 1116 SET(T) %WHILE S -> T.(",").S 1117 %EXIT %IF S = "*" 1118 SET(S) 1119 %REPEAT 1120 1121 %IF CHARNO(OUTPUT,1) = '.' %START 1122 ! SHOW OPTIONS 1123 STRING(CURROUT) = OPLIST."\n\n" 1124 BYTEINTEGER(CURROUT) = NL 1125 CURROUT = CURROUT+LENGTH(OPLIST)+2 1126 %FINISH 1127 %FINISH 1128 DELTA MARGIN = MI 1129 LINE LENGTH = LL 1130 COMMENT TAB = CT 1131 MAXMARGIN = ML 1132 SEC MARGIN = SECONDARY MARGIN 1133 %UNLESS 40 < LINELENGTH < 133 %THEN %START 1134 PRINT STRING( "INVALID LINE LENGTH\n") 1135 %RETURN 1136 %FINISH 1137 %UNLESS 0 < COMMENT TAB < LINE LENGTH-20 %THEN %START 1138 PRINT STRING( "INVALID COMMENT MARGIN\n") 1139 %RETURN 1140 %FINISH 1141 %UNLESS MAX MARGIN < LINE LENGTH-20 %THEN %START 1142 PRINT STRING( "INVALID MAX MARGIN\n") 1143 %RETURN 1144 %FINISH 1145 %UNLESS DELTA MARGIN <= MAX MARGIN<<1 %START 1146 PRINT STRING( "INVALID MARGIN INCREMENT\n") 1147 %RETURN 1148 %FINISH 1149 %IF SEC MARGIN > DELTA MARGIN<<1+SAFETY FACTOR %START 1150 PRINT STRING( "INVALID SECONDARY MARGIN\n") 1151 %RETURN 1152 %FINISH 1153 %IF INITIAL MARGIN > 30 %THEN %START 1154 PRINT STRING( "INVALID INITIAL MARGIN\n") 1155 %RETURN 1156 %FINISH 1157 MARGIN = 1 %IF DELTA MARGIN = 0 %AND SEC MARGIN = 0 %C 1158+ %AND INITIAL MARGIN = 0 1159 MARGIN = INITIAL MARGIN %IF EXTRA MARGIN # 0 1160 SPLIT CONDS = 1 %IF SPLIT KEYWORDS # 0 1161 COMMENT LENGTH = LINE LENGTH-COMMENT TAB 1162 TEXTBASE = ADDR(SYMFILE(0)) 1163 KEYBASE = ADDR(KEYSYMS(1)) 1164 RMARGIN = COMMENT LIMIT 1165 FULL LINE = LINE LENGTH 1166 LINE LENGTH = LINE LENGTH-SAFETY FACTOR 1167 OPTIONS = 17*SPLIT KEYWORDS+34*SPLIT CONDS+SPACE LISTS<<6 %C 1168+ +ISOLATE BRACKETS<<2+SPACE EQUALS<<3+128 1169 LINE BASE = CURROUT; SIZE = 0 1170 COMMENT FLAG = JUSTIFY ALL<<1!COMMENTSNORMAL 1171 COMMENT FLAG = COMMENT FLAG!!B'010' 1172 FIRST DISP = DELTA MARGIN-INITIAL MARGIN 1173 COMMENT LINE = FULL LINE %IF COMMENT LINE = 0 1174 OK = 1 1175 %END 1176 1177 %BEGIN 1178 SOAP("test.imp") ;! need CLIPARAM ... 1179 %ENDOFPROGRAM 853 Statements compiled