!** * ****** ****** ** ** ** ** ****** !** * * ** ** ** ** ** ** ** ** ** !** * * ** ** ** ** ** ** ** ** ** !** ** ** ****** ** ******* ** ** ****** !** ******* ** ** ** ** ** ** ** ** ** !** ** ** ** ** ** ** ** ** ** ** ** !** ** ** ** ** ** ** ** ***** ** ** !** !***************** FULLY WORKING VERSION ********************** %ENDOFLIST %CONTROL 0 %CONTROL 0 %ENDOFLIST %CONSTSHORTINTEGERARRAY MAIN(1: 174) = %C 1, 0, 4, 9, 16, 20, 24, 31, 36, 40, 46, 51, 56, 61, 66, 70, 74, 85, 89, 93, 97, 100, 108, 112, 116, 117, 119, 0, 121, 125, 0, 127, 130, 0, 134, 137, 138, 141, 0, 144, 147, 150, 153, 156, 159, 0, 165, 165, 170, 174, 0, 177, 181, 185, 192, 0, 194, 199, 0, 202, 206, 210, 213, 0, 216, 219, 222, 0, 225, 228, 231, 234, 0, 238, 241, 244, 247, 250, 0, 253, 256, 0, 259, 262, 265, 0, 268, 0, 271, 275, 0, 277, 280, 283, 286, 289, 0, 295, 299, 302, 305, 308, 311, 0, 313, 318, 0, 320, 323, 326, 0, 329, 333, 337, 0, 341, 344, 0, 346, 349, 0, 352, 358, 0, 360, 363, 0, 365, 0, 370, 373, 376, 0, 378, 384, 0, 386, 390, 0, 397, 405, 409, 0, 413, 416, 0, 419, 422, 0, 424, 429, 0, 431, 0, 434, 439, 0, 441, 444, 0, 446, 452, 0, 454, 459, 0, 461, 464, 467, 470, 473, 476, 479, 0 %CONSTSHORTINTEGERARRAY SUB(2: 482) = %C 4098,-32768, 0, 8207, 4248, 1, 4098, 0, 8194, 4143, 4121, 4152, 4217, 4220, 0, 8193, 16385, 4256, 0, 8195, 4207, 4211, 0, 3, 8196, 4175, 8192, 4182, 4200, 0, 8197, 4203, 20481, 4217, 0, 8198, 4135, 20480, 0, 8199, 4132, 20480, 4223, 4229, 0, 8, 8216, 16384, 4124, 0, 13, 8200, 16384, 4124, 0, 18, 8201, 16384, 24576, 0, 22, 8202, 4232, 4245, 0, 29, 8203, 16384, 0, 37, 8204, 4253, 0, 41, 8206, 16384, 48, 4178, 50, 4178, 50, 4178, 52, 0, 54, 8208, 16384, 0, 65, 8210, 12288, 0, 73, 79, 8213, 0, 83, 8214, 0, 87, 8215, 16384, 48, 12288, 4130, 52, 0, 97, 8217, 12288, 0, 103, 8218, 16385, 4217, 0, 110, 0, 113, 0, 48, 4127, 52, 0, 8192, 0, 8193, 16384, 0, 8194, 12288, 4130, 0, 50, 12288, 4130, 0, 115, 8195, 0, 122, 8205, 0, 126, 8194, 0, 131, 8201, 0, 137, 8202, 0, 143, 8203, 0, 150, 8204, 0, 155, 8193, 0, 79, 8217, 0, 159, 8192, 16385, 161, 0, 8193, 16385, 4147, 0, 8194, 163, 0, 167, 8193, 4262, 0, 169, 8194, 12288, 0, 171, 8195, 12288, 1, 12288, 173, 0, 8192, 0, 48, 8208, 4155, 175, 0, 8192, 4155, 0, 8193, 4160, 4182, 0, 8194, 4182, 4164, 0, 8195, 12288, 0, 8196, 4143, 0, 179, 8195, 0, 181, 8197, 0, 184, 8198, 0, 187, 8197, 0, 190, 8198, 0, 193, 8199, 0, 8192, 4169, 4182, 0, 196, 8200, 0, 198, 8201, 0, 200, 8202, 0, 202, 8203, 0, 205, 8204, 0, 207, 8193, 0, 213, 8194, 0, 8192, 4193, 0, 219, 8194, 0, 224, 8193, 0, 16385, 4184, 0, 167, 8193, 4262, 0, 8192, 0, 228, 8201, 0, 232, 8202, 0, 235, 8204, 0, 238, 8203, 0, 163, 8193, 171, 12288, 173, 0, 8192, 4182, 4200, 0, 241, 8202, 0, 246, 8204, 0, 255, 8203, 0, 264, 8201, 0, 4187, 0, 171, 8193, 12288, 173, 0, 8192, 0, 273, 8195, 0, 73, 8196, 0, 277, 8197, 0, 288, 8192, 16384, 0, 291, 8193, 8192, 0, 298, 8194, 8192, 0, 4214, 4193, 0, 8192, 0, 303, 8193, 0, 306, 8194, 0, 313, 8193, 4203, 20481, 4217, 0, 8192, 0, 317, 8194, 0, 8192, 0, 48, 12288, 4225, 52, 0, 328, 9216, 0, 330, 8193, 0, 8193, 0, 50, 8193, 20480, 4223, 4229, 0, 8192, 0, 16384, 113, 4235, 0, 16385, 167, 8196, 4239, 113, 4178, 0, 8193, 8192, 4182, 171, 8193, 12288, 173, 0, 8192, 16385, 4147, 0, 163, 8195, 4200, 0, 332, 8192, 0, 336, 8193, 0, 1, 12288, 0, 8192, 0, 50, 8193, 4232, 4245, 0, 8192, 0, 16384, 4250, 0, 48, 8200, 12288, 52, 0, 8206, 0, 340, 8193, 0, 8192, 0, 48, 8193, 28672, 4259, 52, 0, 8192, 0, 50, 8193, 28672, 4259, 0, 8192, 0, 347, 8210, 0, 330, 8211, 0, 349, 8213, 0, 352, 8214, 0, 355, 8218, 0, 358, 8219, 0, 362, 8223, 0 %CONSTBYTEINTEGERARRAY LITERAL(1: 368) = %C 1, 58, 4, 119, 97, 105, 116, 4, 98, 114, 101, 103, 4, 116, 114, 101, 103, 3, 115, 112, 109, 6, 100, 101, 102, 105, 110, 101, 7, 114, 111, 117, 116, 105, 110, 101, 3, 101, 110, 100, 6, 98, 114, 97, 110, 99, 104, 1, 40, 1, 44, 1, 41, 10, 98, 114, 101, 97, 107, 112, 111, 105, 110, 116, 7, 99, 111, 110, 116, 114, 111, 108, 5, 99, 108, 101, 97, 114, 3, 98, 117, 115, 3, 110, 111, 112, 9, 114, 101, 103, 102, 111, 114, 109, 97, 116, 5, 114, 97, 100, 105, 120, 6, 101, 110, 97, 98, 108, 101, 2, 60, 45, 1, 61, 6, 109, 101, 109, 111, 114, 121, 3, 114, 111, 109, 4, 102, 108, 97, 103, 5, 103, 112, 105, 110, 116, 5, 105, 110, 105, 110, 116, 6, 111, 117, 116, 105, 110, 116, 4, 115, 105, 110, 116, 3, 103, 112, 97, 1, 91, 1, 93, 3, 66, 85, 83, 1, 95, 1, 35, 1, 60, 1, 62, 3, 41, 47, 50, 1, 92, 2, 50, 42, 2, 49, 43, 2, 42, 50, 2, 43, 49, 2, 45, 49, 1, 43, 1, 45, 1, 38, 2, 33, 33, 1, 33, 5, 119, 104, 105, 108, 101, 5, 117, 110, 116, 105, 108, 4, 104, 105, 103, 104, 3, 108, 111, 119, 3, 79, 86, 70, 2, 68, 90, 2, 68, 80, 2, 68, 78, 4, 90, 69, 82, 79, 8, 80, 79, 83, 73, 84, 73, 86, 69, 8, 78, 69, 71, 65, 84, 73, 86, 69, 8, 79, 86, 69, 82, 70, 76, 79, 87, 3, 115, 101, 116, 10, 99, 111, 109, 112, 108, 101, 109, 101, 110, 116, 2, 45, 62, 6, 114, 101, 116, 117, 114, 110, 4, 115, 116, 111, 112, 2, 105, 102, 6, 117, 110, 108, 101, 115, 115, 3, 97, 110, 100, 10, 97, 110, 100, 115, 97, 118, 101, 111, 118, 102, 1, 75, 1, 66, 3, 76, 83, 73, 3, 82, 83, 73, 6, 111, 102, 102, 105, 108, 101, 1, 65, 2, 75, 70, 2, 80, 70, 2, 73, 78, 3, 79, 85, 84, 6, 79, 86, 69, 82, 85, 78 %LIST %CONSTSTRING (31) VERSION = ' ARTHUR : VERSION 4.1' ! ! EXTERNAL SPECS ! %SYSTEMROUTINESPEC CLEARUSE(%STRING (15) S, %INTEGERNAME FLAG) %SYSTEMROUTINESPEC OUTFILE(%STRING (15) X, %INTEGER LENGTH,MAXBYTES,%C PROTECTION,%INTEGERNAME CONAD,FLAG) %EXTERNALROUTINESPEC PROMPT(%STRING (15) S) %EXTERNALSTRINGFNSPEC DATE %EXTERNALSTRINGFNSPEC TIME %EXTERNALROUTINESPEC DEFINE(%STRING (63) X) %EXTERNALROUTINESPEC DESTROY(%STRING (63) X) %EXTERNALROUTINESPEC RENAME(%STRING (63) X) %EXTERNALINTEGERFNSPEC EXIST(%STRING (24) S) ! ! TABLES FOR PARSER ! ! ! TABLE OF FAULT MESSAGES ! %CONSTBYTEINTEGERARRAY FAULT TEXT(0 : 491) = %C 4, 'N', 'A', 'M', 'E', 9, 'D', 'U', 'P', 'L', 'I', 'C', 'A', 'T', 'E', 16, 'D', 'U', 'P', 'L', 'I', 'C', 'A', 'T', 'E', ' ', 'B', 'R', 'A', 'N', 'C', 'H', 11, 'L', 'A', 'B', 'E', 'L', ' ', 'E', 'R', 'R', 'O', 'R', 7, 'C', 'O', 'N', 'T', 'E', 'X', 'T', 11, 'I', 'N', 'V', 'A', 'L', 'I', 'D', ' ', 'B', 'I', 'T', 15, 'I', 'L', 'L', 'E', 'G', 'A', 'L', ' ', 'S', 'U', 'B', 'N', 'A', 'M', 'E', 13, 'I', 'L', 'L', 'E', 'G', 'A', 'L', ' ', 'I', 'N', 'D', 'E', 'X', 18, 'I', 'L', 'L', 'E', 'G', 'A', 'L', ' ', 'E', 'X', 'T', 'R', 'A', 'C', 'T', 'I', 'O', 'N', 12, 'S', 'P', 'U', 'R', 'I', 'O', 'U', 'S', ' ', 'E', 'N', 'D', 19, 'N', 'O', 'T', ' ', 'A', ' ', 'R', 'O', 'U', 'T', 'I', 'N', 'E', '/', 'M', 'A', 'C', 'R', 'O', 22, 'I', 'N', 'C', 'O', 'M', 'P', 'A', 'T', 'A', 'B', 'L', 'E', ' ', 'R', 'E', 'G', 'I', 'S', 'T', 'E', 'R', 'S', 19, 'N', 'O', 'T', ' ', 'A', 'N', ' ','''', 'A','''', ' ', 'R', 'E', 'G', 'I', 'S', 'T', 'E', 'R', 18, 'N', 'O', 'T', ' ', 'A', ' ', '''', 'B','''', ' ', 'R', 'E', 'G', 'I', 'S', 'T', 'E', 'R', 14, 'N', 'O', 'T', ' ', 'A', ' ', 'R', 'E', 'G', 'I', 'S', 'T', 'E', 'R', 14, 'N', 'O', 'T', ' ', 'A', 'N', ' ', 'A', 'D', 'D', 'R', 'E', 'S', 'S', 10, 'N', 'O', 'T', ' ', 'A', ' ', 'F', 'L', 'A', 'G', 17, 'R', 'E', 'C', 'U', 'R', 'S', 'I', 'V', 'E', ' ', 'C', 'A', 'L', 'L', ' ', 'O', 'N', 11, 'E', 'N', 'D', ' ', 'M', 'I', 'S', 'S', 'I', 'N', 'G', 10, 'I', 'N', 'V', 'A', 'L', 'I', 'D', ' ', '/', '2', 6, 'A', 'C', 'C', 'E', 'S', 'S', 13, 'L', 'A', 'B', 'E', 'L', ' ', 'M', 'I', 'S', 'S', 'I', 'N', 'G', 22, 'I', 'N', 'V', 'A', 'L', 'I', 'D', ' ', 'F', 'L', 'A', 'G', ' ', 'O', 'P', 'E', 'R', 'A', 'T', 'I', 'O', 'N', 21, 'D', 'E', 'C', 'L', 'A', 'R', 'A', 'T', 'I', 'O', 'N', ' ', 'M', 'I', 'S', 'P', 'L', 'A', 'C', 'E', 'D', 17, 'N', 'O', 'T', ' ', 'A', ' ', 'D', 'E', 'S', 'T', 'I', 'N', 'A', 'T', 'I', 'O', 'N', 12, 'N', 'O', 'T', ' ', 'A', ' ', 'S', 'O', 'U', 'R', 'C', 'E', 11, 'N', 'O', 'T', ' ', 'A', ' ', 'L', 'I', 'G', 'H', 'T', 17, 'T', 'O', 'O', ' ', 'M', 'A', 'N', 'Y', ' ', 'S', 'P', ' ', 'N', 'A', 'M', 'E', 'S', 15, 'N', 'O', 'T', ' ', 'E', 'N', 'O', 'U', 'G', 'H', ' ', 'P', 'I', 'N', 'S', 15, 'N', 'O', 'T', ' ', 'A', ' ', 'R', 'E', 'G', 'F', 'O', 'R', 'M', 'A', 'T', 13, 'N', 'O', 'T', ' ', 'A', ' ', 'R', 'E', 'G', ' ', 'P', 'I', 'N', 13, 'T', 'O', 'O', ' ', 'M', 'A', 'N', 'Y', ' ', 'P', 'I', 'N', 'S', 14, 'N', 'O', 'T', ' ', 'A', ' ', 'G', 'P', 'A', ' ', 'N', 'A', 'M', 'E' %CONSTBYTEINTEGERARRAY FAULT ACTION(1 : 33) = %C 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 2, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1 %CONSTSHORTINTEGERARRAY FAULT NO(1 : 32) = %C 0, 5, 15, 32, 44, 52, 64, 80, 94, 113, 126, 146, 169, 189, 208, 223, 238, 249, 267, 279, 290, 297, 311,334, 356, 374, 387, 399, 417, 433, 449, 463 %CONSTBYTEINTEGERARRAY OPUSE(0 : 11) = %C 15,16,0,17,20,19,0,0,0,18,0,21 %CONSTSTRING (5) %ARRAY MNAMES(0 : 21) = %C 'NULL ', 'GPA ', 'BSENS', 'GPI ', 'OI ', 'II ', 'SI ', 'CGEN ', 'CGEN*', 'ROM ', 'TREG ', 'BREG ', 'SPM ', 'MEM ', 'FLAG ', 'NOP ', 'EVOKE', '2-BR ', '8-BR ', 'S-RET', 'MERGE','BREAK' %CONSTSHORTINTEGERARRAY MTYPE(0 : 40) = %C 0, 1, 14, 13, 12, 7, 11, 10, 0, 3, 5, 4, 6, 9, 0(10), 12, 2, 0(15) %CONSTBYTEINTEGERARRAY ACC(0 : 23) = %C 0,1,1,1,1,1,0(8),1,0,1,0,0,0,0,1,1,1 %CONSTBYTEINTEGERARRAY DEST(0 : 40) = %C 0, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0(10) %CONSTBYTEINTEGERARRAY SNAME(0 : 40) = %C 1, 0(17), 1, 1, 0, 12, 12, 0(3), 9, 9, 0(3), 12, 0(9) %CONSTBYTEINTEGERARRAY BITS(0 : 40) = %C 1, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0(3), 0(10) ! %OWNINTEGER RADIX = 10; ! DEFAULT RADIX FOR CONSTANTS %OWNINTEGER EXTERNAL LENGTH = 100 %CONSTSHORTINTEGER HEADER LENGTH = 80 %CONSTINTEGER PERCC = 99; ! 'C'+32 %OWNINTEGER MAX NAMES = 200 %CONSTINTEGER MAX TEXT = 1500 %CONSTINTEGER LINE SIZE = 200 %CONSTINTEGER TABLE SIZE = 50 %CONSTINTEGER LIST SIZE = 100 %CONSTINTEGER AREC SIZE = 100 %CONSTINTEGER CODE LIMIT = 2000 %CONSTINTEGER CONST SIZE = 50 %CONSTINTEGER ONE SEGMENT=65536 ! ! OPERATION CODES ! %CONSTINTEGER NOP CODE = 0 %CONSTINTEGER EVOKE CODE = 1 %CONSTINTEGER BUS CODE = 2 %CONSTINTEGER COND CODE = 3 %CONSTINTEGER MERGE CODE = 4 %CONSTINTEGER CALL CODE = 5 %CONSTINTEGER RETURN CODE = 6 %CONSTINTEGER JUMP CODE = 7 %CONSTINTEGER STOP CODE = 8 %CONSTINTEGER BRANCH CODE = 9 %CONSTINTEGER TEST CODE = 10 %CONSTINTEGER BREAK CODE = 11 %CONSTINTEGER C EVOKE CODE = 12 %CONSTINTEGER C MERGE CODE = 13 %CONSTINTEGER FLAG CODE = 14 %CONSTINTEGER EXTRA EVOKE CODE = 15 ! %CONSTINTEGER REG FORMAT = 32 ! ! %CONSTINTEGER INSTREAM = 40; ! INPUT STREAM NUMBER %CONSTINTEGER OUTSTREAM = 41; ! OUTPUT STREAM NUMBER ! ! ! %CONSTSTRING (3) TTY = '.TT' %OWNSTRING (4) SAFETY FILE = '+.TT'; ! TO PREVENT INPUT FILE ENDED %CONSTSTRING (8) DEFAULT LIST = 'SS#LIST'; ! LISTING FILE %CONSTSTRING (8) DEFAULT IN = '.TT'; ! SOURCE FILE %CONSTSTRING (8) DEFAULT OBJECT = 'SS#ARTH'; ! OBJECT FILE %CONSTSTRING (7) SAFETY OBJ = 'AA#CODE'; ! TEMPORARY OUTPUT CODE FILE ! ! ! ! %EXTERNALROUTINE ARTHUR(%STRING (63) FILES) ! ! RECORD FORMATS ! %RECORDFORMAT HEADERFM( %C %INTEGER IDEN, USEAGE, NNAMES, NAMES, TEXT, CODE, %C CONSTANTS, OLD FILE, TXTLNG, STARTAD, EXTERNS, TABS) ! %RECORDFORMAT EXTERNFM(%BYTEINTEGER FROM, FBITS, TO, TOBITS) ! %RECORDFORMAT SYSHEADFM(%INTEGER SIZE, HEADSIZE, MAX, LD, %C EXTRA, FOR, SYSTEM, USE) ! %RECORDFORMAT CODEFM(%BYTEINTEGER CODE, NAME, OPRN, MODULE, %C %SHORTINTEGER ADDR, STAT) ! %RECORDFORMAT TAGFM(%INTEGER MASTER, %SHORTINTEGER TYPE, %C %BYTEINTEGER USED, BITS, %INTEGER USE, DEFN, SIZE, WHERE) ! %RECORDFORMAT NAMEFM(%STRINGNAME TEXT,%RECORD TAGS(TAGFM)) ! %RECORDFORMAT TABFM(%SHORTINTEGERARRAY W(0 : 7)) ! ! %BYTEINTEGERARRAY SYMS, LINE(0 : LINE SIZE); ! BUFFERS FOR INPUT LINE %SHORTINTEGERARRAY CONSTS(1 : CONST SIZE); ! TABLE OF CONSTANTS %RECORDARRAY TABLES(1 : TABLE SIZE)(TABFM) ! TABLES FOR BRANCH & REGFORMAT %INTEGERARRAY INFO, LINK(1 : LIST SIZE);! LABEL LISTS %SHORTINTEGERARRAY REC(0 : AREC SIZE); ! ANALYSIS RECORD ARRAY ! ! %SHORTINTEGERARRAYNAME MODUSEAGE; ! TABLE OF MODULE USEAGES %BYTEINTEGERARRAYNAME TEXT; ! BUFFER FOR DICTIONARY ! ! %INTEGERNAME LAB LIST; ! CURRENT LAB LIST HEAD %INTEGERNAME NNAMES; ! NUMBER OF DECLARED NAMES %INTEGERNAME TEXTPT; ! CURRENT FREE SPACE IN DICT ! ! %INTEGER WHERE, FILE END, HEAD ADDR %BYTEINTEGER LIST FLAG, OUT FLAG, ACCESS, DECLARATIONS, ROUTINES %INTEGER NAMEFAULT, NAME FLAG, OVF %INTEGER ASL, RT PENDING %BYTEINTEGER CONTROL, START FLAG, LAB ACTIVE %INTEGER CODEIN, FLAG, TP, MARKER, FSTART, LINE MAX %INTEGER LP, RP, J, K, SM, PP, CONS %INTEGER FAULTS, CONNECT, LINES, TABCOUNT, STATS ! ! ARRAY FORMATS ! %RECORDARRAYFORMAT EXTARFM(1 : EXTERNAL LENGTH)(EXTERNFM) %RECORDARRAYFORMAT CFM(0 : CODE LIMIT)(CODEFM) %RECORDARRAYFORMAT NAFM(1 : MAX NAMES)(NAMEFM) %BYTEINTEGERARRAYFORMAT TXT1(0 : MAX TEXT) %SHORTINTEGERARRAYFORMAT MUFM(0 : 21) ! ! RECORD NAMES ! ! ! %RECORDNAME HEADER(HEADERFM); ! ARTHUR FILE HEADER %RECORDNAME SYS HEADER(SYSHEADFM); ! SYSTEM FILE HEADER %RECORDNAME V, RTDEFN(NAMEFM) ! ! %RECORDARRAYNAME EXTERNALS(EXTERNFM) %RECORDARRAYNAME OBJECT(CODEFM) %RECORDARRAYNAME NAME(NAMEFM) ! ! %RECORD FLAG INFO(NAMEFM) %RECORD DESTN, TEMPLATE(TAGFM) ! ! %STRINGNAME CURRENT %STRING (63) IN FILE, OBJECT FILE, LIST FILE ! ! %ROUTINESPEC RECONSTRUCT(%BYTEINTEGER MODE) %ROUTINESPEC ABORT(%INTEGER B) %ROUTINESPEC NOP %ROUTINESPEC DUMP(%BYTEINTEGER A, B, C, D, %SHORTINTEGER Z) %ROUTINESPEC COMPILE BLOCK %ROUTINESPEC FAULT(%INTEGER NUMBER) ! ! %ROUTINE PINDEF %SHORTROUTINE ! ! CREATE THE TABLE FOR TRANSFER REGS ETC ! %INTEGER L, J L = ADDR(TABLES(TABCOUNT)_W(0)); ! ADDRESS OF TABLE ENTRY %CYCLE J = L+15, -1, L RP = RP+1 FAULT(29) %AND %RETURN %IF REC(RP) < 0 BYTEINTEGER(J) <- REC(RP); ! FILL IN ENTRY FAULT(31) %UNLESS 0 <= REC(RP) <= 15 %REPEAT FAULT(32) %IF REC(RP+1) >= 0 %END %ROUTINE SHOW LISTS %ROUTINESPEC SHOW(%RECORDNAME V) %INTEGER J %RECORDNAME V(NAMEFM) %RETURN %IF NNAMES = 0 %CYCLE J = 1, 1, NNAMES V == NAME(J) SHOW(V) %IF V_TAGS_TYPE = 14 %OR V_TAGS_TYPE = 8 %REPEAT NEWLINE %ROUTINE SHOW(%RECORDNAME V) %RECORDSPEC V(NAMEFM) %INTEGER LIST LIST = V_TAGS_SIZE; %RETURN %IF LIST = 0 PRINTSTRING(V_TEXT.':') %UNTIL LIST = 0 %CYCLE V == NAME(INFO(LIST)) PRINTSTRING(' '.V_TEXT) LIST = LINK(LIST) %REPEAT NEWLINE %END %END %ROUTINE DISPLAY ! OUTPUT NAME INFO (TESTING ONLY) %INTEGER J %RECORDNAME T(TAGFM) %RECORDNAME V(NAMEFM) %STRING (8) TEXT J = NNAMES %WHILE J > 0 %CYCLE V == NAME(J) T == V_TAGS TEXT <- V_TEXT PRINTSTRING(TEXT) SPACES(10-LENGTH(TEXT)) WRITE(T_MASTER, 5) WRITE(T_TYPE, 3) WRITE(T_USED,3) WRITE(T_BITS,3) WRITE(T_USE, 3) WRITE(T_DEFN, 3) WRITE(T_SIZE, 3) WRITE(T_WHERE, 3) NEWLINE J = J-1 %REPEAT %END %ROUTINE STOP %SHORTROUTINE ! ! COMPLETE THE COMPILATION BY TIDYING UP ANY LOOSE ENDS ! AND OUTPUTING ALL TABLES ETC. ! %STRING (7) ITEM %INTEGER J, K, N %BYTEINTEGERNAME US %RECORDNAME ON(CODEFM) %RECORDNAME NN(NAMEFM) %RECORDNAME TWORK(TABFM) DUMP(STOPCODE, 0, 0, 0, 0); ! GIVE A STOP AT THE END ROUTINES = ROUTINES-1 %AND FAULT(19) %WHILE ROUTINES > 0 ! ! TIDY UP NAMES ! J = NNAMES; ! NUMBER OF NAMES DECLARED %WHILE J > 0 %CYCLE NN == NAME(J); ! LOOK AT TAGS ! ! CHECK UNUSED NAMES ! %IF (NN_TAGS_TYPE = 14 %AND NN_TAGS_DEFN = 0) %C %OR (NN_TAGS_TYPE = 8 %AND NN_TAGS_USE = 0 %C %AND NN_TAGS_DEFN = 1) %START CURRENT == NN_TEXT; FAULT(22); ! LABEL MISSING %FINISH %IF NN_TAGS_USED = 0 %AND NN_TAGS_TYPE # 0 %START %IF NN_TAGS_TYPE = 14 %THEN ITEM = 'LABEL' %C %ELSE ITEM = 'NAME ' PRINTSTRING('? UNUSED '.ITEM.' '.NN_TEXT.' ') %FINISH %ELSE %START ! ! FILL IN MERGE INPUT COUNT FOR !LABELS ! %UNLESS 14 # NN_TAGS_TYPE # 15 %C %THEN OBJECT(NN_TAGS_WHERE)_OPRN = NN_TAGS_USE K = NN_TAGS_MASTER %IF J # K %AND K # 0 %START ! NOT THE BUS US == NAME(K)_TAGS_USED US = 1 %IF US = 0 ! MASTER USED IF 'DEFINED' NAME IS %FINISH %FINISH J = J-1; ! BACK FOR NEXT NAME %REPEAT ! ! WORK OUT NUMBER OF MODULES ! %CYCLE J = 1, 1, CODEIN-1; ! SCAN THROUGH CODE ON == OBJECT(J) K = ON_CODE; ! LOOK AT OP-CODE %IF 0 <= K <= 11 %C %THEN K = OPUSE(K) %AND MODUSEAGE(K) = MODUSEAGE(K)+1 %REPEAT K = MODUSEAGE(15); ! ACTUAL NUMBER OF NOPS MODUSEAGE(16) = MODUSEAGE(16)+K; ! ADD EVOKES FOR NOPS MODUSEAGE(15) = K; ! NUMBER OF NOPS ! ! WARN ABOUT USE OF TWO GPAS + OVERFLOW ! %IF OVF = 1 %AND MODUSEAGE (1) > 1 %THEN %C PRINTSTRING('* OVERFLOW MEANINGLESS WITH TWO GPAS ON BUS ') ! ! FILL IN CONSTANT TABLE ! K = CONS; MODUSEAGE(7) = K; ! NUMBER OF CONSTANTS J = ADDR(OBJECT(CODEIN+1)); ! FREE SPACE HEADER_CONSTANTS = J-ADDR(HEADER) SHORTINTEGER(J) <- K; ! NUMBER OF CONSTANTS ABORT(8) %IF J+K*2 > FILE END %WHILE K > 0 %CYCLE SHORTINTEGER(K<<1+J) <- CONSTS(K) K = K-1 %REPEAT J = J+CONS<<1+2 ! ! DUMP BRANCH & REGFORMAT TABLES ! HEADER_TABS = J-ADDR(HEADER) %UNLESS TABCOUNT = 0 %START ABORT(8) %IF J+TABCOUNT*16 > FILE END %CYCLE N = 1, 1, TABCOUNT TWORK == RECORD(J); J = J+16 TWORK = TABLES(N); ! COPY TABLES INTO OBJECT FILE %REPEAT %FINISH CODEIN = J; ! ADDRESS OF END OF OBJECT FILE ! ! OUTPUT MODULE USEAGE ! MODUSEAGE(20) = 0; ! IGNORE MERGES N = 5; ! COUNTER FOR NEWLINES %CYCLE J = 1, 1, 21 K = MODUSEAGE(J) %IF K # 0 %START PRINTSTRING(' '.MNAMES(J)); WRITE(K, 3) N = N-1; N = 5 %AND NEWLINE %IF N <= 0 %FINISH %REPEAT ! ! COMPLETE HEADER INFO AS NOTHING CATASTROPHIC CAN HAPPEN NOW ! SYS HEADER_HEADSIZE = HEADER LENGTH SYS HEADER_SIZE = CODEIN-ADDR(SYS HEADER)+32 %IF FAULTS = 0 HEADER_IDEN = M'ARTH'; ! SHOW AN 'ARTHUR OBJECT FILE' NEWLINES(2) ! HAND OVER TO TRUE OBJECT FILE CLEARUSE(SAFETY OBJ, FLAG) %IF FLAG = 0 %START %IF CHARNO(OBJECT FILE,1) # '.' %START ! IGNORE DEVICES OR NULL DESTROY (OBJECT FILE) %IF EXIST (OBJECT FILE) # 0 RENAME (SAFETY OBJ.','.OBJECT FILE) %FINISHELSE DESTROY (SAFETY OBJ) %FINISH ! ! OUTPUT THE TERMINATION MESSAGE FOR USER INFO ! THIS IS DONE TO THE LISTING FILE FIRST AND THEN IF ! IT IS NOT THE CONSOLE THE MESSAGE IS THERE REPEATED ! %CYCLE %IF FAULTS = 0 %START PRINTSTRING('NO PROGRAM ENTRY POINT ') %IF START FLAG = 0 WRITE(STATS-1, 8) PRINTSTRING(' STATEMENTS COMPILED') %FINISH %ELSE %START PRINTSTRING(' PROGRAM CONTAINS') WRITE(FAULTS, 1) PRINTSTRING(' FAULT') PRINTSYMBOL('S') %UNLESS FAULTS = 1 %FINISH NEWLINE %EXIT %IF OUT FLAG = 0 OUTFLAG = 0 SELECTOUTPUT(0) %REPEAT %END %ROUTINE WARNING(%STRING (7) TYPE) PRINTSTRING('* WARNING: '.TYPE.' INSERTED ') NOP RT PENDING = 0; LAB ACTIVE = 0 %END %ROUTINE ABORT(%INTEGER N) %SHORTROUTINE ! ! SOME TABLE OR OTHER HAS BEEN FILLED ! SHOW WHAT HAS FAILED AND THEN GET OUT ! %SWITCH BOOB(1 : 9) ! SELECTOUTPUT(0) PRINTSYMBOL('*') WRITE(LINES&X'7FFF', 5) PRINTSTRING(' TOO MANY ') CLEARUSE (SAFETY OBJ, FLAG) DESTROY (SAFETY OBJ) -> BOOB(N) BOOB(1): PRINTSTRING('BRANCHES/REGFORMATS') %MONITORSTOP BOOB(2): PRINTSTRING('CONSTANTS') %MONITORSTOP BOOB(3): PRINTSTRING('INSTRUCTIONS') %MONITORSTOP BOOB(5): PRINTSTRING('LARGE ') BOOB(4): PRINTSTRING('NAMES') %MONITORSTOP BOOB(6): PRINTSTRING('SYMBOLS ON LINE') %MONITORSTOP BOOB(7): PRINTSTRING('CONJUNCTS IN STATEMENT') %MONITORSTOP BOOB(8): PRINTSTRING('STATEMENTS: OBJECT FILE FULL') %MONITORSTOP BOOB(9): PRINTSTRING('LABEL REFERENCES'); %MONITORSTOP %END %ROUTINE FAULT(%INTEGER NUMBER) %SHORTROUTINE %STRING (15) MESS %ROUTINESPEC LINE OUT(%INTEGER SYM) %SWITCH ACTION(0 : 2) %INTEGER J, K, SPCOUNT %BYTEINTEGER TIME TIME = 1 ! ! GIVE THE FAULT MESSAGE ON THE CONSOLE AS WELL IF THAT IS ! NOT THE LISTING FILE ! K = LINE MAX; MARKER = 0 %CYCLE ! ! OUTPUT SOURCE LINE ONTO THE CONSOLE UNLESS IT CAME ! FROM THERE IN THE FIRST PLACE ! %IF TIME = 1 %AND LINES < X'8000' %START %IF NUMBER # 0 %THEN SM = 1000 %ELSE %START %IF SM = NAME FLAG %C %THEN MESS = 'NAME ' %AND SM = NAME FAULT %C %ELSE MESS = 'SYNTAX ' %FINISH TP = 0 LP = 0 FSTART = 1 RECONSTRUCT(1) %FINISH %IF K # LP %OR TIME = 2 %START LINE OUT(' ') %CYCLE J = FSTART, 1, TP PRINTSYMBOL(SYMS(J)) %REPEAT NEWLINE %IF SYMS(TP) # NL SPCOUNT = 0 %FINISH %ELSE SPCOUNT = ROUTINES<<2+2 %IF NUMBER = 0 %START PRINTSTRING('* '.MESS) SPACES(SPCOUNT+MARKER-FSTART) PRINTSYMBOL('!'); -> OUT %FINISH LINE OUT('*') PRINTSTRING(STRING(ADDR(FAULT TEXT(FAULT NO(NUMBER))))) -> ACTION(FAULT ACTION(NUMBER)) ACTION(1): PRINTSTRING(' '.CURRENT); -> OUT ACTION(2): ACCESS = 1; -> DONE ACTION(0): OUT: FAULTS = FAULTS+1 %IF TIME = 1 DONE: NEWLINE %EXIT %IF TIME = 2 %OR OUTFLAG = 0 SELECTOUTPUT(0); TIME = 2; ! OUT TO CONSOLE %REPEAT SELECTOUTPUT(OUTSTREAM) %IF TIME = 2; ! BACK TO LISTING FILE LINES = LINES!X'8000'; ! SHOW THE LINE IS FAULTY %ROUTINE LINE OUT(%INTEGER SYM) PRINTSYMBOL(SYM) WRITE(LINES&X'5FFF', 5) PRINTSTRING(' ') %END %END %INTEGERFN NEWCELL(%INTEGER VAL) %INTEGER R ABORT(9) %IF ASL <= 0; ! NO SPACE LEFT R = ASL; ASL = LINK(R) INFO(R) = VAL; LINK(R) = 0 %RESULT = R %END %ROUTINE PUSH RT(%INTEGERNAME LIST, %INTEGER RT) LIST == LINK(LIST) %WHILE LIST # 0; ! FIND THE END LIST = NEWCELL(RT); ! ADD A NEW CELL %END %INTEGERFN FIND RT(%INTEGERNAME LIST, %INTEGER RT) %INTEGER J J = LIST %WHILE J # 0 %CYCLE; ! LOOK FOR 'RT' %RESULT = 1 %IF INFO(J) = RT; ! FOUND J = LINK(J) %REPEAT %RESULT = 0; ! NOT FOUND %END %INTEGERFN COPY LIST(%INTEGER HEAD) %INTEGER NEW, J NEW = 0 %WHILE HEAD # 0 %CYCLE J = NEWCELL(INFO(HEAD)) HEAD = LINK(HEAD) LINK(J) = NEW NEW = J %REPEAT %RESULT = NEW %END %ROUTINE UPDATE(%INTEGERNAME LIST, %INTEGER VALUE) %INTEGER J %INTEGERNAME PT PT == LIST PT == LINK(PT) %WHILE PT # 0 PT = ASL ASL = LIST J = 0 J = NEWCELL(VALUE) %UNLESS VALUE = 0 LIST = J %END ! ! I WISH THERE WERE PREDICATES IN THE IMPS COMPILERS ! %INTEGERFN LETTER(%INTEGER N) %RESULT = 1 %IF 'A' <= N <= 'Z' %RESULT = 0 %END %ROUTINE RECONSTRUCT(%BYTEINTEGER MODE) %SHORTROUTINE ! ! READ IN A SOURCE LINE AND PERFORM UNDERLINING (%) AND ! SPACE DELETION, AND CONTINUATION CHECKING. ! %INTEGER S %ROUTINESPEC TEST %ROUTINE SYMBOL(%INTEGERNAME N) ! ! INPUTS A SYMBOL AND OUTPUTS IT TO THE LISTING FILE ! IF NESC. ! %IF MODE = 0 %START READSYMBOL(N) TP = TP+1; SYMS(TP) = N PRINTSYMBOL(N) %UNLESS N = NL %OR LIST FLAG = 0 %FINISH %ELSE %START TP = TP+1; N = SYMS(TP) %FINISH %END -> CONT1 %IF MODE # 0 GO: LINES = (LINES)&X'7FFF'+1; ! LOOSE TOP BIT (SET BY FAULT) %IF LIST FLAG # 0 %START; ! NOT GOING TO THE CONSOLE WRITE(LINES, 6); ! GIVE LINE NUMBER SPACES(ROUTINES<<2+4); ! ROUTINE MARGINS %FINISH LP = 0; TP = 0; ! START OF LINE BUFFER PROMPT(' :'); ! DATA PROMPT FOR CONSOLE INPUT CONT1: %CYCLE SYMBOL(S); ! GET A SYMBOL 2: -> CONT1 %IF S = ' '; ! IGNORE SPACES %IF S = '%' %START; ! UNDERLINE MARKER %CYCLE SYMBOL(S); ! NEXT SYMBOL IN -> 2 %IF LETTER(S) = 0; ! NOT A LETTER LP = LP+1 LINE(LP) = S+32; ! CONVERT TO LOWER CASE TEST %IF MODE # 0 %REPEAT %FINISH %IF S = NL %START; ! END OF THIS LINE NEWL: %IF LINE(LP) = PERCC %START; ! CONTINUATION MARKER PRINTSTRING(' C') %AND SPACES(ROUTINES<<2+4) %C %IF LIST FLAG # 0 %AND MODE = 0 LP = LP-1; ! BACK TO DELETE '%C' ABORT(6) %IF LP >= LINE SIZE;! LINE TOO LONG PROMPT('C:'); ! CONTINUATION PROMPT %RETURN %IF MODE # 0 %AND LP >= SM FSTART = TP+1 %IF MODE # 0 -> CONT1; ! LEAVE LINE NUMBER %FINISH -> CONT1 %IF LP = 0; ! BLANK LINE LP = LP+1 LINE(LP) = NL; ! FILL IN TERMINATOR TEST %IF MODE # 0 LINE MAX = LP NEWLINE %IF LIST FLAG # 0 %AND MODE = 0 ! TIDY THE LISTING %RETURN; ! ALL DONE %FINISH %IF S = '$' %START; ! COMMENT MARKER SYMBOL(S) %UNTIL S = NL; ! DRAIN THE LINE %IF LP = 0 %START; ! BLANK LINE (EFFECTIVELY) NEWLINE %IF LIST FLAG # 0 %AND MODE = 0 -> GO %FINISH -> NEWL %FINISH LP = LP+1 LINE(LP) = S; ! SAVE THE SYMBOL TEST %IF MODE # 0 %REPEAT; ! AROUND FOR MORE %ROUTINE TEST MARKER = TP %IF LP = SM %END %END %INTEGERFN DIGIT(%INTEGER N) %RESULT = 1 %IF '0' <= N <= '9' %RESULT = 0 %END %INTEGERFN NAME FOUND(%BYTEINTEGER OLD) %SHORTROUTINE %INTEGER P, R, L SAVE %RESULT = 0 %UNLESS LETTER(LINE(LP)) # 0 ! MUST START WITH A LETTER L SAVE = LP; ! REMEMBER NAME START FOR ERRORS P = TEXTPT; ! SPACE FOR LENGTH OF TEXT %UNTIL (LETTER(LINE(LP)) = 0 %AND DIGIT(LINE(LP)) = 0) %CYCLE P = P+1 TEXT(P) = LINE(LP); ! PUT NAME IN DICT PER TEM LP = LP+1 %REPEAT ABORT(5) %IF P > MAX TEXT TEXT(TEXTPT) = P-TEXTPT; ! FILL IN LENGTH R = NNAMES CURRENT == STRING(ADDR(TEXT(TEXTPT)));! POINT TO THE NAME ! ! SEE IF THE NAME'S ALREADY IN ! %WHILE R > 0 %CYCLE %EXIT %IF NAME(R)_TEXT = CURRENT; ! FOUND IT R = R-1 %REPEAT %IF R = 0 %START ! ! IT'S A NEW NAME ! %IF OLD # 0 %START; ! OLD NAME WANTED 1: NAMEFLAG = LP NAMEFAULT = L SAVE %RESULT = 0; ! FAILURE %FINISH ! ! INSERT THE NEW NAME ! R = NNAMES+1 ABORT(4) %IF R > MAX NAMES; ! TOO MANY NAMES NNAMES = R NAME(NNAMES)_TEXT == CURRENT TEXTPT = P+1; ! ON TO FREE DICTIONARY SPACE %FINISH %ELSE %START -> 1 %IF OLD # 0 %AND NAME(R)_TAGS_TYPE = 0 %FINISH RP = RP+1 REC(RP) <- R; ! DUMP NAME INDEX IN AREC NAME(R)_TAGS_USED = 1 %IF OLD # 0 %RESULT = 1; ! SUCCESS %END %INTEGERFN CONSTANT FOUND %SHORTROUTINE %INTEGER F, S, BASE, N %BYTEINTEGER PERMIT PERMIT = 0 S = LINE(LP); ! FIRST CHAR OF CONSTANT F = 0; ! FLAG TO DISALLOW '_123' !WITHOUT ANY BASE BASE = RADIX; ! DEFAULT (ALSO BASE BASE !) N = 0; ! FINAL VALUE IN HERE %IF S = '''' %START S = LINE(LP+1) N = S; ! TRANSPARENT TO ALL S = LINE(LP+2) LP = LP+3 PERMIT = 1 %IF S = '''' %FINISH %ELSE %START %CYCLE %IF DIGIT(S) # 0 %THEN S = S-'0' %ELSE %START -> 3 %UNLESS LETTER(S) # 0 S = S+10-'A'; ! CONVERT EXTRA DIGITS %FINISH %IF S < BASE %START; ! VALID DIGIT PERMIT = 1 N = N*BASE+S; ! ADD IT IN LP = LP+1 %FINISH %ELSE %START 3: %EXIT %IF S # '_'; ! N CONTAINS THE NEW BASE %RESULT = 0 %IF F = LP; ! '__' FOUND %EXIT %IF F # 0; ! NO BASE GIVEN LP = LP+1 BASE = N; ! RESET BASE N = 0; ! RESET NUMBER F = LP; ! REMEMBER '_' FOUND %FINISH S = LINE(LP) %REPEAT %FINISH %RESULT = 0 %IF PERMIT = 0 RP = RP+1 REC(RP) <- N; ! DUMP CONSTANT INTO ANALYSIS !RECORD %RESULT = 1; ! SUCCESS %END %INTEGERFN PARSE(%INTEGER ENTRY) %SHORTROUTINE ! ! ENTRY IS A POINTER INTO 'MAIN' WHICH ITSELF POINTS TO ! THE LIST OF COMPONENTS OF THIS PHRASE IN 'SUB'. ! IF THE POINTER IN 'MAIN' IS ZERO THERE ARE NO ALTERNATIVES ! LEFT, SO THE PARSE HAS FAILED (%RESULT=0). ! THE LIST OF ENTRIES IN 'SUB' IS OF THE FORM ! BIP<<12 ! INDEX ! IF THE ENTRY IS ZERO THE END OF THE LIST HAS BEEN FOUND ! AND HENCE THE PARSE IS SUCCESSFUL (%RESULT = 1) ! FOR BIP = 0, INDEX POINTS INTO 'LITERAL' WHERE A LITERAL ! IS STORED IN STRING FORMAT (LENGTH, CHAR1,CHAR2,.....) ! %SWITCH BIP(0 : 15) %INTEGER SP, S, TRP, TLP, P, N, ON TRP = RP; ! SAVE INITIAL VALUE OF RP TLP = LP; ! SAVE INITIAL VALUE OF LP ! UNUSED BIPS: ALL GIVE FAILURE BIP(9): BIP(10): BIP(11): BIP(12): BIP(13): BIP(14): BIP(15): FAILURE: SM = LP %IF LP > SM; ! UPDATE SYNTAX MARKER RP = TRP; ! RESET ANALYSIS RECORD POINTER LP = TLP; ! RESET LINE POINTER ENTRY = ENTRY+1; ! NEXT ALTERNATIVE SP = MAIN(ENTRY); ! PICK IT UP %RESULT = 0 %IF SP = 0; ! NO MORE ALTERNATIVES SUCCESS: ! ALL OK SO FAR SP = SP+1; ! NEXT COMPONENT S = SUB(SP); ! BIP<<12!INDEX %RESULT = 1 %IF S = 0; ! END OF LIST -> BIP(S>>12&15); ! GO TO BUILT-IN PHRASE BIP(1): ! SUB-PHRASE -> SUCCESS %IF PARSE(S&X'FFF') # 0 -> FAILURE BIP(0): ! LITERAL P = LITERAL(S); ! HOLDS TEXT IN STRING FORMAT %CYCLE P = S+1, 1, S+P; ! CYCLE THROUGH SYMBOLS -> FAILURE %IF LINE(LP) # LITERAL(P) LP = LP+1; ! ONTO NEXT SYMBOL IN LINE %REPEAT -> SUCCESS; ! ALL FOUND BIP(4): ! [NAME] -> SUCCESS %IF NAME FOUND(S&7) # 0 -> FAILURE BIP(3): ! [CONSTANT] -> SUCCESS %IF CONSTANT FOUND # 0 -> FAILURE BIP(6): ! [SPDEFN'] -> SUCCESS %IF LINE(LP) = NL; ! NO SUB NAMES -> FAILURE %IF LINE(LP) # '='; ! THIS IS WANTED LP = LP+1 %CYCLE %IF LINE(LP) = '?' %START; ! DON'T CARE LP = LP+1 -> FAILURE %IF LINE(LP) # '('; ! MISSING COUNT LP = LP+1 RP = RP+1 REC(RP) = 1 -> FAILURE %IF CONSTANT FOUND = 0 -> FAILURE %IF LINE(LP) # ')' LP = LP+1 %FINISH %ELSE %START RP = RP+1 REC(RP) = 0 -> FAILURE %IF NAME FOUND(0) = 0 %FINISH %EXIT %IF LINE(LP) = NL; ! END OF LIST -> FAILURE %IF LINE(LP) # ',';! LIST SEPARATOR IS A COMMA LP = LP+1 ! ! BRING IN ANOTHER LINE IF NESC ! RECONSTRUCT(0) %AND LP = 1 %IF LINE(LP) = NL %REPEAT -> SUCCESS BIP(7): ![TEXT] ! ! THIS WILL BE USED FOR MACROS !IN FUTURE ! -> FAILURE BIP(5): ! [NAMELIST] RP = RP+1; ! LEAVE A P = RP; ! HOLE FOR NUMBER OF NAMES ON = S&7; ! OLD/NEW NAME WANTED N = 0; ! COUNTER FOR NUMBER OF NAMES -> FAILURE %UNLESS NAME FOUND(ON) = 1 %CYCLE N = N+1; ! ANOTHER NAME FOUND %EXIT %IF LINE(LP) # ','; ! END OF LIST LP = LP+1; ! PAST COMMA LP = LP-1 %AND %EXIT %UNLESS NAME FOUND(ON) = 1 %REPEAT REC(P) = N; ! FILL IN NUMBER OF NAMES -> SUCCESS BIP(8): ! [SEPARATOR] -> FAILURE %UNLESS LINE(LP) = NL ABORT(7) %IF RP > AREC SIZE; ! LONG ANALYSIS RECORD RP = RP+1; ! NEXT ANALYSIS RECORD SLOT REC(RP) = -1; ! ANALYSIS RECORD TERMINATOR -> SUCCESS BIP(2): ! <> RP = RP+1 REC(RP) = S&X'FFF'; ! FILL IN INDEX -> SUCCESS %END %ROUTINE DUMP(%BYTEINTEGER C, N, OP, D, %SHORTINTEGER AD) %RECORDNAME WORK(CODEFM) ! ! OUTPUT AN INSTRUCTION, PREFIXED BY THE STATEMENT NUMBER ! RT PENDING = 0 %IF C = 1; ! EVOKE WORK == RECORD(ADDR(C)); ! QUICK AND DIRTY TO COPY INFO WORK_STAT <- LINES; ! PLUG IN STATEMENTS LINE NUMBER DUMMY: ! TO STOP THE COMPILER ABORTING OBJECT(CODEIN) = WORK; ! COPY INTO THE OBJECT FILE CODEIN = CODEIN+1; ! ONTO NEXT FREE SLOT ! ! TESTING FOR TOO MANY INSTRUCTIONS IS NOT DONE HERE ! TO SAVE TIME IT IS DONE AT 'NEXT:' IN COMPILE BLOCK ! AT THE START OF EACH NEW STATEMENT. ! ANY OVERWRITING DONE HERE WILL BE NEGLIGIBLE ! %END %ROUTINE DECLARE(%INTEGER NAMES) %SHORTROUTINE ! ! DECLARE 'NAMES' NAMES AS DEFINED BY 'TEMPLATE' ! %RECORDNAME NAMEP(NAMEFM) %INTEGER J, N, T T = MTYPE(TEMPLATE_TYPE) MODUSEAGE(T) = MODUSEAGE(T)+NAMES %UNLESS T = 0 %CYCLE J = 1, 1, NAMES; ! CYCLE THROUGH THE NAMES RP = RP+1 N = REC(RP); ! NAME INDEX NAMEP == NAME(N); ! POINTER TO NAME SLOT TEMPLATE_MASTER = N; ! SHOW WHERE MASTER DEFN IS %IF NAMEP_TAGS_TYPE # 0 %START; ! DEFINED TWICE CURRENT == NAMEP_TEXT; ! POINTER TO TEXT FOR FAULT FAULT(2); ! FAULT 2 => DUPLICATE %FINISH %ELSE NAMEP_TAGS = TEMPLATE %REPEAT %END %ROUTINE FQUAL(%RECORDNAME V) %SHORTROUTINE %RECORDSPEC V(NAMEFM) %CONSTBYTEINTEGERARRAY REG PERMIT(0 : 4) = %C 1, 3, 1, 3, 2 ! ! 2**0 = BREG ALLOWED ! 2**1 = TREG ALLOWED ! %INTEGER N, M %SWITCH FQ(0 : 3) RP = RP+1; -> FQ(REC(RP)) FQ(1): !'_' RP = RP+1; N = REC(RP); ! PREDEFINED NAME INDEX %IF V_TAGS_TYPE # SNAME(N) %START; ! WRONG SUBNAME FAULT(7); ! NO SUBNAME PERMITTED %RETURN %FINISH V_TAGS_BITS = N-17 %IF 18 <= N <= 19; ! _A & _B V_TAGS_TYPE = N; ! UPDATE TYPE %RETURN FQ(2): ! '#' RP = RP+1; N = REC(RP); ! REGISTER WANTED FAULT(8) %UNLESS V_TAGS_TYPE = 4 %AND 0 <= N <= 15 V_TAGS_BITS = N; ! SHOW WHICH ONE V_TAGS_TYPE = 24; ! SHOW A REGISTER %RETURN FQ(3): ! ! FIELD EXTRACTION ! ONLY VALID FIELDS (+ CODE) ARE :- ! 0 : 3 4 BREG ONLY ! 0 : 7 5 ! 0 : 11 6 BREG ONLY ! 0 : 16 7 ! 8 : 16 8 TREG ONLY ! N = REC(RP+1); M = REC(RP+2); ! RP = RP+2 M = 0 %UNLESS 6 <= V_TAGS_TYPE <= 7; ! MUST BE T/B REG %IF N = 0 %START; ! 0 - ?? N = M>>2; ! EXAMINE UPPER M = 0 %UNLESS M&3 = 3 %AND 0 <= N <= 3 %FINISH %ELSE %START; ! ONLY CAN BE 8-15 M = 0 %UNLESS N = 8 %AND M = 15 N = 4 %FINISH FAULT(9) %IF M = 0 %OR REG PERMIT(N)&(V_TAGS_TYPE-1) = 0 V_TAGS_BITS = N+4; ! SAVE FIELD CODE IN 'BITS' FQ(0): ! NULL %END %ROUTINE GPA(%RECORDNAME V) %RECORDSPEC V(NAMEFM) %INTEGER N RP = RP+1; V = NAME(REC(RP)); ! REGISTER NAME RP = RP+1 %IF REC(RP) # 0 %START; ! SUBNAME GIVEN RP = RP+1; N = REC(RP); ! SUBNAME INDEX FAULT(7) %IF SNAME(N) = 0 %OR V_TAGS_TYPE # SNAME(N) V_TAGS_TYPE = N; ! UPDATE TYPE V_TAGS_BITS <- N-17 %FINISH %END %ROUTINE LOCATION(%RECORDNAME V) %SHORTROUTINE %RECORDSPEC V(NAMEFM) %INTEGER N RP = RP+1; N = REC(RP); ! TYPE OF LOCATION %IF N = 2 %START; ! 'BUS' V_TAGS = 0; ! CLEAR IT JUST IN CASE V_TAGS_TYPE = 25; ! SHOW THE BUS %RETURN %FINISH RP = RP+1; V = NAME(REC(RP)); ! PICK UP THE NAME NAME(V_TAGS_MASTER)_TAGS_USED = 1 %IF V_TAGS_TYPE = 24 %IF N = 0 %START; ! [MEMORY] CURRENT == V_TEXT %AND FAULT(16) %IF 13 # V_TAGS_TYPE # 3 V_TAGS_BITS = 9; ! SHOW MEMORY ACCESS %FINISH %ELSE %START FQUAL(V); ! GET QUALIFIERS CURRENT == V_TEXT %AND FAULT(16) %IF DEST(V_TAGS_TYPE) = 0 %FINISH %END %ROUTINE AND FLAGS %SHORTROUTINE %RECORDNAME V(NAMEFM) %INTEGER J, N, OP ! ! OPERATIONS 4 - %CLEAR ! 5 - %SET ! 6 - %COMPLEMENT ! LAB ACTIVE = 0; RT PENDING = 0 %WHILE REC(RP+1) = 1 %CYCLE RP = RP+2; OP = REC(RP); ! CLEAR, SET, COMP RP = RP+1; N = REC(RP); ! NUMBER OF NAMES %CYCLE J = 1, 1, N; ! CYCLE THROUGH NAMES RP = RP+1; V == NAME(REC(RP)); ! GET THE NAME CURRENT == V_TEXT %AND FAULT(17) %IF V_TAGS_TYPE # 2 DUMP(FLAG CODE, V_TAGS_MASTER, OP, 2, 0) %REPEAT %REPEAT %END %ROUTINE CGEN(%INTEGERNAME N,P) ! ! PUTS NEW CONSTANTS INTO 'CONSTS' AND RETURNS THEIR POSITION ! ALLOWS FOR BYTE CONSTANTS ! RETURNS ADRESS AND TYPE ! %INTEGER B %SHORTINTEGERNAME CON P = CONS; ! NUMBER OF CONSTANTS DEFINED %IF 0 0 %CYCLE CON == CONSTS(P) N = 3+B %ANDRETURNIF CON = N %IF B = 1 %START N = 4 %ANDRETURNIF CON&255 = N N = 5 %ANDRETURNIF CON>>8 = N %IF 0 CONST SIZE; ! TOO MANY CONSTANTS CONSTS(CONS) <- N; ! SAVE IT N = 3+B P = CONS; ! RETURN INDEX %END %ROUTINE EXPRN %SHORTROUTINE %SWITCH XT(1 : 4) %RECORD LHS, RHS, TEMP(NAMEFM) %INTEGER OP, XTYPE, T, DIV, SOP, OPR, TO, C OPR = C EVOKE CODE; ! CONTINUE EVOKE SOP = 37; ! STORE BY DEFAULT TO = 3; ! BUS BY DEFAULT RP = RP+1; DIV = REC(RP); ! =20 IF (??)/2 RP = RP+1; XTYPE = REC(RP); -> XT(X TYPE) XT(1): ! 'UNARY' OPERATION RP = RP+1; OP = REC(RP); ! TYPE OF OP GPA(LHS); ! GET REGISTER %IF LHS_TAGS_TYPE # 18 %START; ! NOT AN 'A' REG CURRENT == LHS_TEXT %AND FAULT(13) %UNLESS OP = 3 OP = 4; ! CHANGE B VERSION %FINISH DD: OP = OP+DIV; ! SHOW IF RESULT TO BE HALVED %IF LHS_TAGS_MASTER = DESTN_MASTER %C %AND 18 <= DESTN_TYPE <= 19 %THEN TO = DESTN_TYPE-17 DUMP(EVOKE CODE, LHS_TAGS_MASTER, OP, LHS_TAGS_TYPE, TO) -> STORE XT(2): ! A+B, A&B ETC GPA(LHS); ! GET LEFT OPERAND RP = RP+1; OP = REC(RP); ! OPERATOR %IF OP = 0 %START; ! NON-PSEUDO UNARY RP = RP+1; OP = REC(RP); ! 'REAL' OPERATION GPA(RHS); ! RIGHT OPERAND %IF LHS_TAGS_TYPE = 19 %AND RHS_TAGS_TYPE = 18 %C %AND OP # 9 %START TEMP = LHS; LHS = RHS; RHS = TEMP; ! COMMUTATIVE %FINISH %IF RHS_TAGS_TYPE # 19 %START;! RIGHT MUST BE 'B' REG CURRENT == RHS_TEXT; FAULT(14) %FINISH %ELSE %START CURRENT == LHS_TEXT %AND FAULT(13) %IF LHS_TAGS_TYPE # 18 ! ! BOTH OPERANDS MUST BE FROM THE SAME GPA ! FAULT(12) %IF LHS_TAGS_MASTER # RHS_TAGS_MASTER %FINISH %FINISH %ELSE %START CURRENT == LHS_TEXT %AND FAULT(13) %IF LHS_TAGS_TYPE # 18 %FINISH -> DD XT(3): ! CONSTANT RP = RP+1; T = REC(RP); ! PICK UP CONSTANT %IF T # 0 %START CGEN(T,C) DUMP(EVOKE CODE, C, 36, 5, T) %FINISH %ELSE OPR = C EVOKE CODE %C %AND DUMP(EVOKE CODE, 0, 13, 25, 0) ! CLEAR BUS FIRST -> NOD XT(4): ! MEMORY ETC. OP = 0 LOCATION(LHS); T = LHS_TAGS_TYPE OPR = EXTRA EVOKE CODE %AND -> STORE %IF T = 25 ! FROM 'BUS' FAULT(26) %C %IF ((T = 3 %OR T = 13) %AND LHS_TAGS_BITS # 9) %OR T = 27 %C %OR T = 11 OP = T-17 %AND -> DD %UNLESS 18 # T # 19 T = 26 %IF T = 9; ! GPI_IN DUMP(EVOKE CODE, LHS_TAGS_MASTER, 36, T, LHS_TAGS_BITS) %IF T = 24 %AND DESTN_MASTER = LHS_TAGS_MASTER %START ! ! SPR#1 = SPR#2 MUST BE SPLIT INTO TWO EVOKES ! ! DUMP(C EVOKE CODE, 0, 37, 25, 0) SOP = 37 OPR = EXTRA EVOKE CODE WARNING('EVOKE'); CODEIN = CODEIN-1 %FINISH NOD: ! NO DIVISION ALLOWED FAULT(20) %IF DIV # 0 STORE: ! COMPLETE ANY TWO STAGE EXPRESSIONS T = DESTN_TYPE T = 27 %IF T = 9; ! GPI_OUT %IF TO = 3 %THEN DUMP(OPR, DESTN_MASTER, SOP, T, DESTN_BITS) %END %INTEGERFN FLAG NAME(%RECORDNAME V) %SHORTROUTINE %INTEGER R, B, T %RECORDSPEC V(NAMEFM) RP = RP+1; R = REC(RP); ! TYPE OF FLAG %IF R = 0 %START; ! %FLAG OR A BIT GPA(V); ! DEAL WITH NAME RP = RP+1; B = 0 T = 2 T = 4 %IF SNAME(V_TAGS_TYPE) = 12 %IF 30 > V_TAGS_TYPE > 27 %START T = V_TAGS_TYPE-23 %UNLESS V_TAGS_DEFN&X'FF' # 0 %FINISH %IF REC(RP) # 0 %START; ! BIT EXTRACTION GIVEN RP = RP+1; B = REC(RP); ! GIVE BIT FAULT(6) %UNLESS 0 <= B <= 15 %AND BITS(V_TAGS_TYPE) # 0 FAULT(6) %IF V_TAGS_TYPE = 19 %AND B # 0 %AND B # 15 T = 3; T = 1 %IF V_TAGS_TYPE = 25; ! %BUS %FINISH CURRENT == V_TEXT %AND FAULT(17) %IF T = 2 # V_TAGS_TYPE %IF V_TAGS_WHERE = 0 %OR 6 <= V_TAGS_TYPE <= 7 %C %THEN R = (((V_TAGS_MASTER)<<8+V_TAGS_TYPE)<<8+T)<<8+B %C %ELSE R = V_TAGS_WHERE ! FROM 'DEFINE' %FINISH %ELSE %START %IF R = 1 %START ! ! BUS BIT REFERENCE ! RP = RP+1; B = REC(RP) FAULT(6) %UNLESS 0 <= B <= 15 R = X'190300'+B %FINISH %ELSE %START OVF = 1 %IF R = 9 ! SET FLAG TO INDICATE THE USE OF OVERFLOW SO WARNING CAN BE ! GIVEN ABOUT MULTIPLE GPAS R = R<<8 %FINISH %FINISH %RESULT = R %END %ROUTINE COND(%INTEGER FLAG, MASK) ! ! MASK : 1 - IF ! 2 - UNLESS ! 3 - WHILE ! 4 - UNTIL ! DUMP(COND CODE, FLAG>>24, MASK, FLAG>>16&255, FLAG&X'FFFF') %END %ROUTINE NOP %RECORDNAME CC(CODEFM) CC == OBJECT(CODEIN); ! WHERE IT'S GOING CC = 0; CC_STAT <- LINES; ! CLEAR BUT FOR LINES CODEIN = CODEIN+1; ! ALWAYS ONTO FREE SPACE %END %ROUTINE SET BRANCH(%RECORDNAME V) %SHORTROUTINE %RECORDSPEC V(NAMEFM) %IF V_TAGS_USED = 0 %START; ! TABLE NOT YET OUTPUT V_TAGS_USED = 1; ! SHOW TABLE OUTPUT TABCOUNT = TABCOUNT+1; ! GET A NEW TABLE ENTRY V_TAGS_WHERE = TABCOUNT; ! POINT TO IT TABLES(TABCOUNT) = 0; ! CLEAR THE TABLE %FINISH %END %ROUTINE DUMP MERGE(%INTEGER MASTER, USE, ACCESS) %OWNINTEGER LAST MERGE %INTEGER CODE ! ! DUMP A 'C MERGE' IF THE LAST INSTRUCTION ! WAS ANY FORM OF MERGE (FOR THE BENEFIT OF WOMBLE) ! %IF LAST MERGE = CODEIN %THEN CODE = C MERGE CODE %C %ELSE CODE = MERGE CODE DUMP(CODE, MASTER, USE, ACCESS, 0) LAST MERGE = CODEIN; ! REMEMBER WHERE THIS IS %END %ROUTINE COMPILE BLOCK %ROUTINESPEC GET PINS %RECORDNAME TC(CODEFM) %RECORD DV(NAMEFM) %INTEGERNAME NN %SHORTINTEGERNAME SN %INTEGER EN %INTEGER LCOD %INTEGER T, B, N, J, MI, RTLINK %SWITCH PHRASE(-1 : 26) ! ! TOP OF LOOP. TEST HERE FOR TOO MUCH CODE ! NEXT: ABORT(3) %IF CODEIN > CODE LIMIT ! PHRASE(-1): ! RECONSTRUCT(0); ! READ IN THE NEXT LINE LP = 1; ! THE LINE STARTS AT 'LINE(1)' SM = 0; ! ZERO SYNTAX MARKER RP = 0; ! ONTO START OF ANALYSIS RECORD REC(1) = -1; ! IN CASE OF COMMENTS NAME FAULT = 0; NAME FLAG = 0; ! FOR 'NAME NOT DECLARED' FAULT(0) %AND -> NEXT %IF PARSE(0) = 0; ! SYNTAX REC(0) = RP -> NEXT %IF RP = 0; ! NULL ANALYSIS RECORD ! ! OUTPUT THE ANALYSIS RECORD IF WANTED ! %UNLESS CONTROL = 0 %START K = 12; ! COUNTER FOR ITEMS OUTPUT %CYCLE J = 1, 1, RP K = 0 %AND NEWLINE %IF K >= 12 WRITE(REC(J), 5) K = K+1 %REPEAT NEWLINE %UNLESS K = 0 %FINISH RP = 1; ! ANALYSIS RECORD STARTS AT !'REC(1)' PP = REC(1); ! ALTERNATIVE OF SS FOUND STATS = STATS+1 %UNLESS PP = -1; ! IGNORE COMMENTS ETC FAULT(21) %IF ACCESS = 0 %AND ACC(PP) = 1 LCOD = CODEIN; ! REMEMBER CURRENT CODE POINTER -> PHRASE(PP); ! COMPILE THE STATEMENT ! PHRASE(1): ! [NAME] (ACTP') ! DECLARATIONS = 0 RP = RP+1; V == NAME(REC(RP)); ! GET THE NAME TAGS ! NOT A ROUTINE ? %IF 15 # V_TAGS_TYPE # 16 %C %THEN CURRENT == V_TEXT %AND FAULT(11) %AND -> NEXT V_TAGS_USE = V_TAGS_USE+1; ! ONE MORE INPUT TO MERGE CURRENT == V_TEXT %AND FAULT(18) %C %IF ROUTINES > 0 %AND ADDR(V) = ADDR(RTDEFN) ! ! THE SAME ROUTINE MAY NOT BE CALLED TWICE WITHOUT (AT LEAST) ! A NOP INBETWEEN THE CALLS, SO PUT A NOP IN IF NESC. ! AND INFORM THE USER ! %IF LAB ACTIVE # 0 %START %IF LABACTIVE # 8 %C %AND FIND RT(LAB LIST, V_TAGS_MASTER) # 0 %C %THEN WARNING('%NOP') UPDATE(LAB LIST, V_TAGS_MASTER) LAB ACTIVE = 0 %FINISH WARNING('%NOP') %IF RT PENDING = V_TAGS_MASTER RT PENDING = V_TAGS_MASTER T = V_TAGS_DEFN; ! ROUTINE ENTRY POINT DUMP(CALL CODE, RT PENDING, T>>8, T&255, V_TAGS_WHERE) -> DEC ! PHRASE(2): ! (LOCATION) <- (EXPRN) (AND') ! DECLARATIONS = 0 LOCATION(DV); DESTN = DV_TAGS; ! GET DESTINATION FAULT(25) %C %IF DEST N_TYPE = 26 %OR DEST N_TYPE = 10 %OR (DEST N_ %C TYPE = 13 %AND DEST N_BITS = 9) %OR %C (DEST N_TYPE = 6 %AND 4 <= DEST N_BITS <= 6) EXPRN; ! GET EXPRESSION AND FLAGS; ! DEAL WITH AND FLAG OPS DUMP(FLAG CODE, 0, 0, 0, 1) %IF REC(RP+2) = 2 ! %AND %SAVE %OVF -> DEC ! PHRASE(3): ! (CONTROL TRANSFER) ! (OPTIONAL CONDITION) ! N = 0; ! SHOW NO COND YET DECLARATIONS = 0 %IF REC(RP+3) # 0 %START T = RP; RP = RP+3; ! SKIP THE TRANSFER N = REC(RP); ! IF - UNLESS EN = FLAG NAME(FLAG INFO); ! GET THE FLAG RP = T; ! RESET RP FOR THE TRANSFER COND(EN, N); ! DUMP THE CONDITION %FINISH %ELSE ACCESS = 0; ! MUST JUMP AWAY RP = RP+1 %IF REC(RP) = 0 %START; ! -> LABEL RP = RP+1; J = REC(RP) V == NAME(J); ! NAME TAGS V_TAGS_USED = 1; ! SHOW USED V_TAGS_TYPE = 14 %IF V_TAGS_TYPE = 0; ! SHOW A LABEL %IF V_TAGS_TYPE # 14 %THEN FAULT(4) %ELSE %START %IF RT PENDING # 0 %START %IF V_TAGS_DEFN = 0 %START PUSH RT(V_TAGS_SIZE, RT PENDING) %FINISH %ELSE %START %IF FIND RT(V_TAGS_SIZE, RT PENDING) # 0 %START %IF N # 0 %START CODEIN = CODEIN-1 OBJECT(CODEIN+1) = OBJECT(CODEIN) WARNING('%NOP') CODEIN = CODEIN+1 %FINISH %ELSE WARNING('%NOP') %FINISH %FINISH %FINISH CURRENT == V_TEXT; ! ONTO NAME FOR FAULTS %IF V_TAGS_DEFN = 0 %START;! UNDEFINED LABEL V_TAGS_MASTER = J %IF V_TAGS_WHERE = 0 WARNING('%NOP') %C %IF N # 0 %AND V_TAGS_WHERE = CODEIN-1 DUMP(JUMP CODE, V_TAGS_MASTER, 0, 0, V_TAGS_WHERE) V_TAGS_WHERE = CODEIN-1;! CHAIN ONTO LABEL LIST %FINISH %ELSE DUMP(JUMP CODE, V_TAGS_MASTER, 0, 0, V_ %C TAGS_WHERE) %FINISH RT PENDING = 0 %IF ACCESS = 0 V_TAGS_USE = V_TAGS_USE+1; ! ANOTHER USE %FINISH %ELSE %START RT PENDING = 0; LAB ACTIVE = 0 %IF REC(RP) = 1 %START; ! %RETURN FAULT(5) %AND -> NEXT %IF ROUTINES = 0 J = CODEIN; ! REMEMBER FOR CHAINING DUMP(JUMP CODE, RTDEFN_TAGS_MASTER, 0, 0, RTLINK) RTLINK = J; ! NEW TOP OF RETURN CHAIN -> NEXT %FINISH DUMP(STOP CODE, 0, 1, 0, 0); ! %STOP %FINISH -> DEC ! PHRASE(4): ! %WAIT (WHILE-UNTIL) (FLAGNAME) ! DECLARATIONS = 0 RP = RP+1; N = REC(RP)+2; ! WHILE/UNTIL EN = FLAG NAME(FLAG INFO); ! GET TEST FLAG T = CODEIN; ! REMEMBER FOR THE JUMP DUMP MERGE(0, 2, ACCESS); ! INTERNAL 'LABEL' NOP; ! WAIT LOOPS MUST HAVE AN EVOKE COND(EN, N); ! SET THE CONDITION DUMP(JUMP CODE, 0, 0, 0, T); ! JUMP BACK -> DEC ! PHRASE(5): ! (FLAG OPERATION) [NAMELIST] ! DECLARATIONS = 0 NOP; ! ALL FLAGS MUST BE EVOKED RP = RP-1; AND FLAGS; ! DEAL WITH THE FLAGS -> DEC ! PHRASE(6): ! (TYPE) [NAMELIST] ! TEMPLATE = 0 RP = RP+1 TEMPLATE_TYPE = REC(RP); ! DEFINE TYPE RP = RP+1 DECLARE(REC(RP)); ! DECLARE THE NAMES -> NEXT ! PHRASE(7): ! (ROM-MEMORY) [NAMELIST] (SIZE) ! ! TEMPLATE = 0 %UNTIL REC(RP) = 0 %CYCLE RP = RP+1; TEMPLATE_TYPE = REC(RP); ! ROM-MEMORY RP = RP+1; N = REC(RP); ! SIZE OF MEMORY TEMPLATE_SIZE = REC(RP+N+1)*REC(RP+N+2) DECLARE(N) RP = RP+3; ! ONTO NEXT NAME %REPEAT -> NEXT ! PHRASE(8): ! %TREG [NAME] (PIN DEFINITION) ! TEMPLATE = 0; TEMPLATE_TYPE = 7; DECLARE(1) GETPINS; -> NEXT ! PHRASE(9): ! %SPR [NAME] [SPDEFN'] ! TEMPLATE = 0; TEMPLATE_TYPE = 4; DECLARE(1) MI = 0; ! NAMES DEFINED %CYCLE RP = RP+1 %IF REC(RP) < 0 %START; ! END OF LIST FAULT(28) %IF MI > 16; ! TOO MANY NAMES -> NEXT %FINISH %IF REC(RP) # 0 %START; ! A DON'T CARE RP = RP+1 MI = MI+REC(RP); ! INCREASE BY (N) %FINISH %ELSE %START; ! NAME GIVEN RP = RP+1 V == NAME(REC(RP)); ! GET THE NAME %IF V_TAGS_TYPE # 0 %START;! ALREADY EXISTS CURRENT == V_TEXT; ! ONTO NAME TEXT FAULT(2); ! DUPLICATE %FINISH %ELSE %START; ! A VALID NEW NAME V_TAGS_MASTER = TEMPLATE_MASTER; ! COPY INFO V_TAGS_TYPE = 24; ! SHOW A REGISTER V_TAGS_BITS <- MI&X'F'; ! SHOW ITS ADDRESS FAULT(28) %IF MI > 16; ! TOO MANY NAMES MI = MI+1; ! ONE MORE FOUND %FINISH %FINISH %REPEAT ! PHRASE(10): ! %DEFINE (EQITEM) (RDEFINE') ! FAULT(24) %IF ROUTINES > 0 %BEGIN %SHORTROUTINE %SWITCH EQ(0 : 4) %UNTIL REC(RP) = 0 %CYCLE; ! CYCLE THROUGH DEFINITION LIST RP = RP+1; V == NAME(REC(RP)); ! GET NEW NAME CURRENT == V_TEXT %AND FAULT(2) %IF V_TAGS_TYPE # 0 %C %AND REC (RP+1) # 4 RP = RP+1; MI = REC(RP); ! TYPE OF EQITEM -> EQ(MI) EQ(0): ! [OLD NAME](FQUAL') RP = RP+1 EN = REC(RP); ! OLD NAME DV = NAME(EN); ! OLD NAME INFO CURRENT == DV_TEXT %AND FAULT(1) %IF DV_TAGS_TYPE = 0 NAME(EN)_TAGS_USED = 0; !NOT ACTUALLY USED FQUAL(DV); ! GET ANY EXTRAS V_TAGS = DV_TAGS; ! COPY TAGS FAULT(4) %IF DV_TAGS_TYPE = 8 %OR 14 <= DV_TAGS_TYPE <= 15 -> CONT EQ(1): ! FLAG MI = FLAG NAME(DV); ! FLAG DEFN FOR 'AND FLAGS' DV_TAGS_WHERE = MI DV_TAGS_TYPE = 2; ! TYPE = FLAG V_TAGS = DV_TAGS; ! COPY INFO -> CONT EQ(2): ! '*' SOMETHING - NOW REMOVED FROM SYNTAX ! RP = RP+1; MI = REC(RP) ! V_TAGS_TYPE = MI ! RP = RP+1 ! %IF MI = 30 %START ! V_TAGS_WHERE = REC(RP) ! FAULT(27) %UNLESS 0 <= REC(RP) <= 7 %OR REC(RP) = 9 ! RP = RP+1 ! %FINISH ! FAULT(6) %UNLESS 0 <= REC(RP) <= 15 ! ! INVALID BIT ! V_TAGS_DEFN = REC(RP)<<8 ! RP = RP+1 ! FAULT(6) %UNLESS 0 <= REC(RP) <= 15 ! ! INVALID BIT ! FAULT(6) %IF REC(RP) # 0 %AND REC(RP) <= V_TAGS_DEFN>>8 ! V_TAGS_DEFN = V_TAGS_DEFN+REC(RP) -> CONT EQ(3): ! BUS DV_TAGS = 0; ! CLEAR IT FIRST DV_TAGS_TYPE = 25; ! SHOW IT'S A BUS RP = RP+1 %IF REC(RP) # 0 %START; ! BIT DEFINED RP = RP+1; MI = REC(RP); ! GET THE BIT MI = 0 %AND FAULT(6) %UNLESS 0 <= MI <= 15 DV_TAGS_TYPE = 2; ! IT'S A FLAG NOW DV_TAGS_WHERE = X'190300'+MI %FINISH V_TAGS = DV_TAGS ->CONT EQ(4): ! SI CURRENT == V_TEXT %AND FAULT(33) %IF V_TAGS_TYPE # 1 RP = RP+1 EN = REC(RP); !GET L OR R SI RP = RP+1 MI = REC(RP) %IF MI = 0 %THEN MI = FLAGNAME(DV) %ELSE MI = (MI-1)!!1 ! FLAG OR L OR %HIGH OR %LOW %IF EN = 0 %THEN V_TAGS_USE = MI %ELSE V_TAGS_DEFN = MI CONT: RP = RP+1 V_TAGS_USED = 0; ! MAKE SURE UNUSED %REPEAT %END -> NEXT ! PHRASE(11): ! %ROUTINE [NAME] ! RTLINK = 0; ! LINK TO CHAIN RETURN CALL !TOGETHER ACCESS = 1; ! CALL MUST GIVE ACCESS ROUTINES = ROUTINES+1; ! INCREASE ROUTINE LEVEL (ONLY !ONE ALLOWED) FAULT(24) %IF DECLARATIONS = 0 %AND ROUTINES = 1 FAULT(5) %IF ROUTINES > 1 TEMPLATE = 0 TEMPLATE_TYPE = 15 TEMPLATE_WHERE = CODEIN; ! ENTRY ADDRESS DECLARE(1) RTDEFN == NAME(REC(RP)) RTDEFN_TAGS_DEFN = 0 DUMP MERGE(RTDEFN_TAGS_MASTER, 0, 0) -> NEXT ! PHRASE(12): ! %END (FILE') ! NEWLINE RT PENDING = 0; LAB ACTIVE = 0 DECLARATIONS = 1; ! ALLOW DECLARATIONS AFTER !ROUTINES %IF REC(RP+1) # 0 %THEN STOP %AND %RETURN; ! ENDOFFILE %IF ROUTINES = 0 %THEN FAULT(10) %AND -> NEXT ROUTINES = ROUTINES-1; ! DOWN A LEVEL RTDEFN_TAGS_SIZE = RTDEFN_TAGS_SIZE+1 J = ACCESS; ! IMMEDIATE WAYS HERE (FOR !MERGE) %WHILE RTLINK # 0 %CYCLE J = J+1; ! INCREASE MERGE COUNT TC == OBJECT(RTLINK); ! POINTER TO '%RETURN' RTLINK = TC_ADDR; ! DOWN THE CHAIN TC_ADDR = CODEIN; ! FILL IN ADDRESS OF HERE %REPEAT DUMP MERGE(0, J, ACCESS) %IF J > 1 ! MERGE THE JUMPS NN == RTDEFN_TAGS_DEFN; ! POINTER TO CALL LIST DUMP(RETURN CODE, 0, NN>>8, NN&255, RTDEFN_TAGS_MASTER) NN = CODEIN-1; ! LINK ONTO CALL LIST ACCESS = 1; ! YOU CAN'T GET HERE !!! -> NEXT ! PHRASE(13): ! %MACRO [NAME] (MACRO !PARAMETERS') PRINTSTRING('**IGNORED** ') FAULT(24) %IF DECLARATIONS = 0 %AND ROUTINES = 1 -> NEXT ! PHRASE(14): ! %BRANCH [NAME] ( (LEVEL) , ! !(LEVEL),(LEVEL) ) DECLARATIONS = 0; ! ALLOW NO MORE DECS ACCESS = 0; ! IT CAN'T FALL THROUGH RP = RP+1; V == NAME(REC(RP)); ! GET BRANCH NAME V_TAGS_MASTER = REC(RP) %IF V_TAGS_TYPE = 0 %THEN V_TAGS_TYPE = 8 CURRENT == V_TEXT %AND FAULT(2) %IF V_TAGS_TYPE # 8 %IF RT PENDING # 0 %START %IF FIND RT(V_TAGS_SIZE, RT PENDING) # 0 %C %THEN WARNING('%NOP') %C %ELSE PUSH RT(V_TAGS_SIZE, RT PENDING) RT PENDING = 0; LAB ACTIVE = 0 %FINISH SET BRANCH(V); ! DEFINE BRANCH TABLE %IF V_TAGS_DEFN # 0 %START CURRENT == V_TEXT FAULT(3) %FINISH V_TAGS_DEFN = 1 DUMP(BRANCH CODE, V_TAGS_MASTER, 0, 0, V_TAGS_WHERE) %CYCLE J = 1, 1, 3; ! PICK UP LEVELS RP = RP+1; B = REC(RP)<<8; ! LEVEL TYPE B = FLAG NAME(FLAG INFO) %IF B = 0 ! FLAG, NOT '%HIGH' OR '%LOW' DUMP(TEST CODE, B>>24, 0, B>>16&255, B&X'FFFF') %REPEAT -> DEC ! PHRASE(15): ! (LABEL) : (SS) ! DECLARATIONS = 0 RP = RP+1; J = REC(RP); ! LABEL NAME V == NAME(J); ! POINTER TO LABEL INFO RP = RP+1; T = REC(RP); ! LABEL - BRANCH V_TAGS_TYPE = T %IF V_TAGS_TYPE = 0 K = V_TAGS_WHERE %IF V_TAGS_TYPE # T %START DUPL: CURRENT == V_TEXT; FAULT(2); -> NEXT %FINISH V_TAGS_MASTER = J; ! DEFINE MASTER TAGS %IF T = 8 %START; ! BRANCH LABEL RP = RP+1; N = REC(RP); ! INDEX B = 1< NEXT %C %UNLESS 0 <= N <= 7 %AND V_TAGS_BITS&B = 0 V_TAGS_BITS = V_TAGS_BITS!B; ! SHOW THIS INDEX USED SET BRANCH(V); ! OUTPUT TABLE (IF NESC.) TABLES(V_TAGS_WHERE)_W(N) = CODEIN;! SET ADDRESS %FINISH %ELSE %START; ! ORDINARY LABEL -> DUPL %IF V_TAGS_DEFN # 0 V_TAGS_DEFN = 1; ! SHOW DEFINED J = V_TAGS_WHERE; ! GET PREV USE LIST %WHILE J # 0 %CYCLE; ! FILL IN ADDRESSES SN == OBJECT(J)_ADDR; ! POINTER TO JUMP J = SN; ! DOWN CHAIN SN = CODEIN; ! SET ADDRESS OF HERE %REPEAT V_TAGS_WHERE = CODEIN; ! DEFINE ADDRESS MI = V_TAGS_USE+ACCESS; ! WAYS TO GET HERE %FINISH DUMP MERGE(V_TAGS_MASTER, MI, ACCESS) V_TAGS_USE = MI; ! SHOW HOW MANY ENTRIES %IF K = 0 %START %IF LAB ACTIVE # 0 %C %THEN V_TAGS_SIZE = COPY LIST(LAB LIST) %C %ELSE V_TAGS_SIZE = 0 %FINISH LAB LIST == V_TAGS_SIZE LAB ACTIVE = T ACCESS = 1; ! YOU CAN GET HERE RP = RP+1 -> PHRASE(REC(RP)); ! ON TO REST OF STATEMENT ! PHRASE(16): ! %BREAKPOINT [NAME] ! DECLARATIONS = 0 TEMPLATE = 0 TEMPLATE_TYPE = 17 TEMPLATE_USED = 1 DECLARE(1) DUMP(BREAK CODE, REC(RP), 0, 0, 0) -> DEC ! PHRASE(17): ! EXTERNAL ! -> NEXT ! PHRASE(18): ! CONTROL ! RP = RP+1; N <- REC(RP) DISPLAY %AND -> NEXT %IF N = 7 SHOW LISTS %AND -> NEXT %IF N = 100 CONTROL <- N -> NEXT ! PHRASE(19): ! CGEN ! ! PHRASE(20): ! MODULE ! -> NEXT ! PHRASE(21): ! %CLEAR BUS ! DECLARATIONS = 0 DUMP(EVOKE CODE, 0, 13, 25, 0) DUMP(C EVOKE CODE, 0, 37, 25, 0) RT PENDING = 0; LAB ACTIVE = 0 -> DEC ! PHRASE(22): ! %NOP ! DECLARATIONS = 0 NOP RT PENDING = 0; LAB ACTIVE = 0 -> DEC ! PHRASE(23): !%REGFORMAT [NAME] ( [CONSTANT] ! !(PINLIST') ) TEMPLATE = 0 TABCOUNT = TABCOUNT+1 ABORT(1) %IF TABCOUNT > TABLE SIZE TEMPLATE_WHERE = TABCOUNT TEMPLATE_TYPE = REG FORMAT DECLARE(1) PINDEF -> NEXT ! PHRASE(24): !%BREG [NAME] (PINDEFINITION) ! TEMPLATE = 0 TEMPLATE_TYPE = 6 DECLARE(1) GET PINS; -> NEXT ! PHRASE(25): ! %RADIX [CONSTANT] ! RP = RP+1; N <- REC(RP) %IF N > 0 %THEN RADIX = N %ELSE FAULT(8) -> NEXT ! PHRASE(26): ! %ENABLE ! RP = RP+1; V == NAME(REC(RP)) CURRENT == V_TEXT %AND FAULT(17) %UNLESS V_TAGS_TYPE = 12 ! SI DUMP(EVOKE CODE, V_TAGS_MASTER, 35, 12, 0) AND FLAGS DEC: %IF ROUTINES = 0 %START DECLARATIONS = 0 STARTFLAG = 1 %AND HEADER_STARTAD = LCOD %IF STARTFLAG = 0 %FINISH -> NEXT %ROUTINE GET PINS %SHORTROUTINE RP = RP+1 %UNLESS REC(RP) = 0 %START %IF REC(RP) = 1 %START RP = RP+1 V == NAME(REC(RP)) CURRENT == V_TEXT %AND FAULT(30) %C %UNLESS V_TAGS_TYPE = REG FORMAT TEMPLATE_WHERE = V_TAGS_WHERE V_TAGS_USED = 1 %FINISH %ELSE %START TABCOUNT = TABCOUNT+1 PINDEF TEMPLATE_WHERE = TABCOUNT %FINISH %FINISH NAME(TEMPLATE_MASTER)_TAGS_WHERE = TEMPLATE_WHERE %END %END ! !******************* START HERE BY INITIALIZING ********************* ! LIST FLAG = 0; OUT FLAG = 0 ! ! UNTANGLE PARAMETERS ! LIST FILE = '' OBJECT FILE = '' INFILE = '' %IF FILES # '' %START INFILE = FILES %IF FILES -> INFILE.('/').OBJECT FILE %START LIST FILE = '' %C %UNLESS OBJECT FILE -> OBJECT FILE.(',').LIST FILE %FINISH %FINISH INFILE = DEFAULT IN %IF INFILE = '' OBJECT FILE = DEFAULT OBJECT %IF OBJECT FILE = '' LIST FILE = DEFAULT LIST %IF LIST FILE = '' OUT FLAG = 1 %IF LIST FILE # TTY LIST FLAG = 1 %IF IN FILE # TTY PRINTSTRING('PARAMS:'.FILES.' ? ') %AND %RETURN %C %IF (IN FILE = LIST FILE %AND INFILE # TTY ) %C %OR IN FILE = OBJECT FILE %OR OBJECT FILE = LIST FILE ! ! SET UP THE RELEVANT STREAMS ! SAFETY FILE = '' %IF INFILE = TTY DEFINE('STREAM40,'.INFILE.SAFETY FILE) DEFINE('STREAM41,'.LISTFILE) ! ! CREATE THE OBJECT FILE & CONNECT IT ! OUTFILE(SAFETY OBJ,ONE SEGMENT,ONE SEGMENT,3,CONNECT,FLAG) %IF FLAG # 0 %START; ! OUTFILE HAS FAILED PRINTSTRING('CANNOT CREATE '.SAFETY OBJ) WRITE(FLAG, 1) NEWLINE %RETURN %FINISH SELECTINPUT(INSTREAM); ! SOURCE FILE SELECTOUTPUT(OUT STREAM); ! LISTING FILE %IF OUTFLAG = 1 %START PRINTSTRING(' SOURCE FILE: '.INFILE.' COMPILED: '. %C DATE.' '.TIME) PRINTSTRING(' OBJECT FILE: '.OBJECT FILE.' ') %FINISH PRINTSTRING(VERSION.' ') ! ! NOW SET UP THE MAPPING TO THE SYSTEM STANDARD OBJECT FILE ! THIS CODE IS DUPLICATED IN ALL PROGRAMS WORKING ON ! ARTHUR FILES IN ORDER TO SIMPLIFY MODIFYING ! THE FORMAT OF THE OBJECT FILE, AS THEN ALL THAT ! NEEDS TO BE ALTERED IS THE FORMAT 'HEADERFM' ! FILE END = CONNECT+4095*16; ! 1 SEGMENT FILE SYS HEADER == RECORD(CONNECT); ! SYSTEM FILE HEADER HEADER == RECORD(CONNECT+32); ! ARTHUR FILE HEADER HEADER = 0; ! CLEAR IT TO REMOVE RUBBISH SYSHEADER_SIZE = 0; ! FAULTY MARKER SYSHEADER_LD = -1; ! SHOW IT'S A WIERD FILE ! MAX NAMES = (MAX NAMES+3)&(\3); ! MUST BE MULTIPLE OF 4 NNAMES == HEADER_NNAMES; ! POINTER FOR NUMBER OF NAMES HEADER_OLD FILE = CONNECT; ! OLD FILE HEAD FOR 'TRANS' CONNECT = CONNECT+HEADER LENGTH; ! PAST ARTHUR FILE HEADER MODUSEAGE == ARRAY(CONNECT, MUFM); ! MODULE USEAGE COUNTERS HEAD ADDR = ADDR(HEADER) HEADER_USEAGE = CONNECT-HEAD ADDR CONNECT = CONNECT+64; ! SPACE FOR MODUSEAGE NAME == ARRAY(CONNECT, NAFM); ! NAME TAGS ARRAY HEADER_NAMES = CONNECT-HEAD ADDR; ! START OF NAMES J = CONNECT+24*MAX NAMES; ! PAST NAME TABLE TEXT == ARRAY(J, TXT1); ! DICTIONARY FOR NAMES HEADER_TEXT = J-HEAD ADDR; ! POINTER TO DICTIONARY WHERE = (MAX TEXT+3)&(\3)+J; ! PAST DICTIONARY EXTERNALS == ARRAY(WHERE, EXTARFM); ! EXTERNAL EVENT INFO HEADER_EXTERNS = WHERE-HEAD ADDR; ! START OF EXTERNALS EXTERNAL LENGTH = (EXTERNAL LENGTH+3)&(\3) WHERE = WHERE+4*EXTERNAL LENGTH OBJECT == ARRAY(WHERE, CFM); ! START OF OBJECT CODE HEADER_CODE = WHERE-HEAD ADDR ! ! INITIALIZE NAME TABLE ! %CYCLE J = 1, 1, MAX NAMES NAME(J) = 0 %REPEAT OBJECT(0) = 0; ! SPECIAL FOR LABELS CONS = 0; ! COUTER FOR NUMBER OF CONSTANTS HEADER_STARTAD = 0; ! PROGRAM ENTRY POINT TABCOUNT = 0; ! NUMBER OF TABLES CODEIN = 1; ! WHERE TO START DUMPING CODE LINES = 0; ! LINES COMPILED STATS = 0; ! STATEMENTS COMPILED FAULTS = 0; ! FAULTY STATEMENT COUNTER HEADER_TXTLNG = 0; ! DICTIONARY SIZE TEXTPT == HEADER_TXTLNG; ! FREE DICTIONARY SPACE NNAMES = 0; ! NUMBER OF NAMES DECLARED FLAG = 0; ! FUNNY FLAG STARTFLAG = 0; ! SHOWS IF AN ENTRY POINT HAS !BEEN DEFINED CONTROL = 0; ! DYNAMIC COMPILER OPTIONS DECLARATIONS = 1; ! FLAG FOR DECLARATIONS !MISPLACED ROUTINES = 0; ! ROUTINE LEVEL COUNTER ACCESS = 1; ! FLAG FOR ACCESS INDICATION RT PENDING = 0; LAB ACTIVE = 0 OVF = 0; ! FLAG FOR USE OF OVERFLOW %CYCLE J = 0, 1, 20; MODUSEAGE(J) = 0 %REPEAT %CYCLE ASL = 1, 1, LIST SIZE LINK(ASL) = ASL-1 %REPEAT COMPILE BLOCK; ! OFF TO THE WARS %END %ENDOFFILE