!* modified 25/05/82 !* !******************************** EXPORTS ****************************** !* %ROUTINESPEC ALLOC(%INTEGER PTR) %INTEGERFNSPEC ALLOC CHAR(%INTEGER L,AD, %HALFINTEGERNAME IIN,%INTEGERNAME DISP) %ROUTINESPEC INIT ALLOC(%INTEGER ADCOM) %ROUTINESPEC ADD DATA ITEM(%INTEGER AREA,PTR,COUNT,DISP,L,AD) %INTEGERFNSPEC TIDY GLA(%HALFINTEGER EP,IIN,%INTEGER LEN) %INTEGERFNSPEC PFORMAT(%INTEGER AINPUT,INP,J, %STRINGNAME IDENTIFIER) %INTEGERFNSPEC TO INTEGER(%INTEGER DATA AD,DATA LEN, TEXT AD,TEXT LEN,TEXT INC,MODE) %INTEGERFNSPEC TO REAL(%INTEGER DATA AD,DATA LEN,TEXT ADDRESS, INT LEN,INT PTR,DEC LEN,DEC PTR, EXP LEN,EXP PTR,DECS,SCALE,MODE) %INTEGERFNSPEC GLA SPACE(%INTEGER LEN) !* !* 25/03/82 !* !************ IMP80 version ************ !* %CONSTINTEGER TESTVERSION=1;! 0 NO 1 YES %CONSTINTEGER DICTVERSION=0;! 0 EMAS 1 VME !* !{2900C} %CONSTINTEGER W1=2 !{2900C} %CONSTINTEGER W2=4 !{2900C} %CONSTINTEGER W4=8 !{2900C} %CONSTINTEGER W6=12 {PERQC} %CONSTINTEGER W1=1 {PERQC} %CONSTINTEGER W2=2 {PERQC} %CONSTINTEGER W4=4 {PERQC} %CONSTINTEGER W6=6 !* !* !**** SYNTAX **** !* !* Syntax tables generated from file SYNTAX48 on 11/03/82 at 06.51.27 !* %CONSTHALFINTEGERARRAY SUB(0:77)= %C 0, 2, 1540, 218, 4522, 0, 4340, 4494, 38, 4282, 212, 2428, 2540, 778, 240, 266, 880, 578, 524, 350, 454, 600, 934, 1508, 1456, 1370, 1488, 1004, 1020, 1030, 1058, 1194, 1264, 1166, 1098, 1294, 1122, 1314, 1216, 1430, 3798, 3682, 2872, 2902, 2624, 2600, 2844, 2980, 3526, 4214, 3560, 3378, 3700, 4064, 3326, 3586, 4234, 2490, 2668, 2686, 2778, 2786, 2950, 3206, 3008, 3078, 3254, 3088, 3180, 3280, 3352, 3478, 3718, 3658, 3854, 3912, 4588, 4196; %CONSTHALFINTEGERARRAY LOOKUP(0:25) = %C 1542, 1570, 1594, 1756, 1812, 1960, 1970, 0, 2010, 0, 0, 2086, 0, 0, 2118, 2134, 0, 2202, 2326, 0, 0, 0, 2376, 2398, 0, 0; %CONSTBYTEINTEGERARRAY COMP(0:4700)= %C 0, 0, 1, 2, 0, 0, 1, 2, 0, 0, 1, 3, 0, 0, 1, 4, 0, 0, 1, 5, 0, 0, 1, 6, 0, 0, 1, 7, 0, 0, 1, 8, 0, 0, 0, 0, 0, 1, 4, 1, 0, 50, 21, 1, 70, 1, 0, 0, 0, 1, 4, 2, 0, 70, 21, 1, 70, 2, 3, 40, 0, 0, 1, 9, 0, 0, 0, 0, 0, 1, 4, 3, 0, 94, 21, 1, 70, 3, 2, 40, 0, 90, 1, 9, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 4, 4, 0, 114, 1, 10, 0, 108, 70, 5, 0, 0, 0, 1, 112, 0, 0, 0, 0, 1, 4, 5, 0, 146, 20, 5, 1, 11, 0, 0, 4, 2, 0, 0, 21, 1, 23, 0, 70, 2, 3, 40, 0, 0, 1, 9, 0, 0, 0, 0, 0, 1, 1, 12, 0, 202, 2, 42, 0, 180, 21, 3, 22, 0, 4, 2, 0, 0, 21, 1, 23, 0, 70, 2, 3, 40, 0, 0, 1, 9, 0, 0, 0, 0, 0, 1, 4, 2, 0, 0, 21, 1, 23, 0, 70, 2, 3, 40, 0, 0, 1, 9, 0, 0, 0, 0, 0, 1, 4, 6, 0, 0, 79, 0, 0, 0, 0, 1, 21, 7, 0, 0, 0, 1, 1, 13, 0, 0, 2, 61, 0, 0, 1, 14, 0, 0, 59, 7, 6, 0, 0, 0, 0, 0, 0, 2, 107, 0, 6, 0, 0, 254, 1, 15, 0, 0, 0, 0, 0, 17, 21, 0, 53, 0, 6, 0, 0, 0, 0, 0, 0, 20, 1, 16, 0, 0, 1, 17, 0, 0, 128, 0, 6, 0, 1, 90, 2, 42, 1, 46, 59, 2, 1, 18, 0, 0, 1, 19, 1, 42, 0, 0, 0, 23, 0, 0, 0, 35, 2, 47, 1, 82, 2, 47, 1, 64, 59, 2, 1, 18, 0, 0, 0, 0, 0, 45, 59, 2, 1, 18, 0, 0, 1, 19, 1, 78, 0, 0, 0, 52, 0, 0, 0, 64, 1, 19, 0, 0, 0, 0, 0, 74, 0, 0, 0, 82, 2, 43, 1, 108, 59, 2, 1, 20, 0, 0, 0, 0, 0, 88, 2, 45, 1, 122, 59, 2, 1, 20, 0, 0, 0, 0, 0, 93, 2, 62, 1, 142, 60, 0, 6, 0, 0, 0, 59, 3, 1, 14, 0, 0, 0, 0, 0, 98, 2, 33, 1, 156, 59, 4, 1, 14, 0, 0, 0, 0, 0, 102, 2, 38, 1, 170, 59, 4, 1, 14, 0, 0, 0, 0, 0, 106, 2, 126, 1, 184, 59, 4, 1, 14, 0, 0, 0, 0, 0, 110, 2, 35, 0, 0, 59, 4, 1, 14, 0, 0, 0, 0, 0, 116, 6, 0, 0, 0, 1, 17, 0, 0, 128, 0, 6, 0, 2, 8, 2, 42, 1, 234, 59, 2, 1, 18, 0, 0, 1, 19, 1, 230, 0, 0, 0, 122, 0, 0, 0, 135, 2, 47, 2, 0, 59, 2, 1, 18, 0, 0, 1, 19, 1, 252, 0, 0, 0, 146, 0, 0, 0, 159, 1, 19, 0, 0, 0, 0, 0, 170, 0, 0, 0, 179, 6, 0, 0, 0, 1, 17, 0, 0, 2, 42, 2, 34, 59, 2, 1, 18, 0, 0, 0, 0, 0, 186, 2, 47, 2, 62, 2, 47, 2, 52, 59, 2, 1, 18, 0, 0, 0, 0, 0, 197, 59, 2, 1, 18, 0, 0, 0, 0, 0, 206, 0, 0, 0, 217, 1, 21, 0, 0, 4, 7, 2, 84, 59, 2, 1, 17, 0, 0, 0, 0, 0, 224, 0, 0, 0, 230, 2, 40, 2, 124, 21, 6, 6, 0, 2, 108, 53, 0, 6, 0, 0, 0, 0, 0, 0, 233, 61, 0, 1, 14, 0, 0, 2, 41, 0, 0, 62, 0, 0, 0, 0, 236, 21, 0, 2, 40, 3, 0, 56, 0, 6, 0, 0, 0, 69, 0, 6, 0, 2, 224, 6, 0, 2, 194, 6, 0, 2, 166, 1, 22, 0, 0, 110, 3, 120, 0, 6, 0, 0, 0, 0, 0, 0, 241, 2, 41, 2, 180, 6, 0, 0, 0, 82, 0, 0, 0, 0, 247, 1, 23, 0, 0, 2, 41, 0, 0, 82, 0, 0, 0, 0, 249, 1, 24, 0, 0, 51, 0, 2, 40, 2, 220, 1, 22, 0, 0, 110, 3, 120, 0, 6, 0, 0, 0, 0, 0, 0, 253, 0, 0, 1, 5, 2, 41, 2, 238, 58, 0, 6, 0, 0, 0, 0, 0, 1, 10, 1, 25, 0, 0, 2, 41, 0, 0, 58, 0, 6, 0, 0, 0, 0, 0, 1, 12, 53, 0, 6, 0, 0, 0, 0, 0, 1, 18, 21, 1, 2, 40, 3, 102, 65, 0, 6, 0, 0, 0, 84, 0, 6, 0, 3, 78, 6, 0, 3, 48, 1, 22, 0, 0, 110, 1, 120, 0, 6, 0, 0, 0, 0, 0, 1, 21, 1, 24, 0, 0, 78, 0, 2, 40, 3, 74, 1, 22, 0, 0, 110, 1, 120, 0, 6, 0, 0, 0, 0, 0, 1, 27, 0, 0, 1, 35, 2, 41, 3, 88, 80, 0, 0, 0, 1, 40, 1, 26, 0, 0, 2, 41, 0, 0, 80, 0, 0, 0, 1, 43, 54, 0, 6, 0, 0, 0, 0, 0, 1, 46, 2, 43, 3, 122, 59, 6, 0, 0, 1, 49, 2, 45, 3, 132, 59, 6, 0, 0, 1, 52, 2, 92, 3, 162, 59, 5, 2, 43, 3, 148, 59, 6, 0, 0, 1, 55, 2, 45, 3, 158, 59, 6, 0, 0, 1, 58, 0, 0, 1, 61, 0, 0, 1, 64, 2, 58, 3, 202, 116, 0, 6, 0, 0, 0, 2, 41, 3, 190, 116, 0, 6, 0, 0, 0, 0, 0, 1, 67, 1, 27, 0, 0, 3, 41, 0, 0, 0, 0, 1, 69, 1, 27, 0, 0, 3, 58, 0, 0, 2, 41, 3, 224, 116, 0, 6, 0, 0, 0, 0, 0, 1, 73, 1, 27, 0, 0, 3, 41, 0, 0, 0, 0, 1, 77, 61, 0, 110, 12, 1, 14, 0, 0, 59, 7, 62, 0, 0, 0, 1, 83, 110, 12, 1, 29, 0, 0, 0, 0, 1, 88, 107, 0, 6, 0, 4, 22, 1, 30, 0, 0, 59, 7, 0, 0, 1, 91, 21, 0, 103, 0, 6, 0, 0, 0, 0, 0, 1, 96, 1, 16, 0, 0, 1, 31, 0, 0, 1, 32, 4, 62, 1, 33, 0, 0, 1, 34, 4, 58, 0, 0, 1, 99, 0, 0, 1, 111, 1, 34, 4, 70, 0, 0, 1, 121, 0, 0, 1, 129, 1, 35, 4, 86, 1, 36, 0, 0, 0, 0, 1, 135, 1, 37, 0, 0, 1, 30, 0, 0, 0, 0, 1, 140, 6, 0, 0, 0, 6, 0, 0, 0, 1, 31, 0, 0, 1, 32, 4, 130, 1, 33, 0, 0, 1, 34, 4, 126, 0, 0, 1, 145, 0, 0, 1, 158, 1, 34, 4, 138, 0, 0, 1, 169, 0, 0, 1, 178, 6, 0, 0, 0, 6, 0, 0, 0, 1, 31, 0, 0, 1, 32, 4, 166, 1, 33, 0, 0, 0, 0, 1, 185, 0, 0, 1, 196, 1, 38, 0, 0, 4, 7, 4, 188, 59, 2, 1, 31, 0, 0, 0, 0, 1, 203, 0, 0, 1, 212, 2, 40, 4, 228, 21, 6, 6, 0, 4, 212, 103, 1, 6, 0, 0, 0, 0, 0, 1, 215, 61, 0, 1, 30, 0, 0, 3, 41, 0, 0, 62, 0, 0, 0, 1, 218, 21, 0, 103, 0, 6, 0, 0, 0, 0, 0, 1, 223, 4, 8, 4, 250, 59, 2, 0, 0, 1, 226, 2, 47, 5, 4, 59, 2, 0, 0, 1, 229, 2, 42, 0, 0, 59, 2, 0, 0, 1, 232, 2, 43, 5, 24, 59, 2, 0, 0, 1, 235, 2, 45, 0, 0, 59, 2, 0, 0, 1, 238, 2, 62, 5, 50, 60, 0, 6, 0, 0, 0, 59, 3, 0, 0, 1, 241, 2, 33, 5, 60, 59, 4, 0, 0, 1, 244, 2, 38, 5, 70, 59, 4, 0, 0, 1, 247, 2, 126, 5, 80, 59, 4, 0, 0, 1, 250, 2, 35, 0, 0, 59, 4, 0, 0, 1, 253, 2, 42, 5, 118, 21, 3, 49, 0, 6, 0, 0, 0, 2, 44, 5, 114, 1, 25, 0, 0, 0, 0, 2, 0, 0, 0, 2, 5, 1, 39, 0, 0, 59, 7, 6, 0, 0, 0, 57, 0, 6, 0, 0, 0, 2, 44, 5, 146, 1, 25, 0, 0, 0, 0, 2, 8, 0, 0, 2, 19, 107, 0, 6, 0, 5, 164, 1, 15, 0, 0, 0, 0, 2, 28, 21, 0, 126, 0, 6, 0, 0, 0, 0, 0, 2, 31, 1, 14, 0, 0, 59, 7, 64, 0, 6, 0, 0, 0, 2, 44, 5, 200, 1, 24, 0, 0, 0, 0, 2, 34, 3, 41, 0, 0, 0, 0, 2, 42, 21, 1, 81, 0, 2, 44, 5, 224, 1, 26, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 14, 0, 0, 59, 7, 6, 0, 0, 0, 83, 0, 6, 0, 0, 0, 2, 44, 6, 0, 1, 23, 0, 0, 0, 0, 2, 48, 0, 0, 2, 61, 127, 0, 4, 9, 6, 34, 21, 3, 55, 1, 6, 0, 0, 0, 4, 10, 0, 0, 21, 1, 46, 0, 6, 0, 0, 0, 0, 0, 2, 72, 4, 11, 6, 58, 2, 40, 6, 50, 1, 40, 0, 0, 0, 0, 2, 78, 1, 41, 0, 0, 0, 0, 2, 84, 4, 12, 6, 118, 21, 1, 2, 40, 6, 104, 66, 0, 6, 0, 0, 0, 2, 41, 6, 86, 6, 0, 0, 0, 0, 0, 2, 93, 1, 25, 0, 0, 50, 0, 6, 0, 0, 0, 2, 41, 0, 0, 0, 0, 2, 98, 66, 0, 6, 0, 0, 0, 6, 0, 0, 0, 0, 0, 2, 106, 4, 13, 6, 126, 0, 0, 2, 111, 4, 14, 6, 138, 1, 42, 0, 0, 0, 0, 0, 1, 4, 15, 6, 152, 27, 0, 1, 43, 0, 0, 0, 0, 0, 1, 4, 16, 6, 184, 20, 3, 121, 0, 2, 42, 6, 176, 21, 3, 22, 0, 1, 44, 0, 0, 0, 0, 0, 1, 1, 45, 0, 0, 0, 0, 0, 1, 4, 5, 6, 204, 20, 5, 121, 0, 1, 11, 0, 0, 1, 44, 0, 0, 0, 0, 0, 1, 4, 17, 6, 220, 2, 40, 0, 0, 1, 40, 0, 0, 0, 0, 2, 113, 4, 18, 6, 232, 1, 46, 0, 0, 0, 0, 0, 1, 4, 19, 6, 244, 1, 47, 0, 0, 0, 0, 0, 1, 4, 20, 7, 20, 20, 6, 121, 0, 2, 42, 7, 12, 21, 3, 22, 0, 1, 44, 0, 0, 0, 0, 0, 1, 1, 45, 0, 0, 0, 0, 0, 1, 4, 21, 7, 32, 1, 48, 0, 0, 0, 0, 0, 1, 4, 22, 7, 46, 104, 1, 1, 49, 0, 0, 0, 0, 0, 1, 4, 23, 7, 60, 104, 0, 1, 49, 0, 0, 0, 0, 0, 1, 4, 24, 7, 84, 2, 40, 7, 76, 1, 40, 0, 0, 0, 0, 2, 119, 1, 41, 0, 0, 0, 0, 2, 125, 4, 25, 7, 94, 113, 3, 0, 0, 2, 134, 4, 26, 7, 104, 19, 1, 0, 0, 2, 137, 4, 27, 7, 130, 19, 0, 21, 1, 70, 4, 2, 40, 7, 126, 1, 9, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 4, 28, 7, 158, 1, 14, 0, 0, 59, 7, 6, 0, 0, 0, 2, 41, 0, 0, 4, 29, 0, 0, 113, 1, 0, 0, 2, 139, 4, 30, 7, 168, 113, 2, 0, 0, 2, 148, 4, 31, 7, 178, 88, 0, 0, 0, 0, 1, 4, 32, 7, 202, 1, 50, 0, 0, 3, 41, 0, 0, 7, 44, 0, 0, 1, 14, 0, 0, 0, 0, 2, 151, 4, 33, 7, 218, 21, 0, 55, 0, 6, 0, 0, 0, 0, 0, 2, 157, 4, 34, 7, 250, 20, 1, 121, 0, 2, 42, 7, 242, 21, 3, 22, 0, 1, 44, 0, 0, 0, 0, 0, 1, 1, 45, 0, 0, 0, 0, 0, 1, 4, 35, 8, 8, 1, 51, 0, 0, 39, 0, 0, 0, 0, 1, 4, 36, 8, 22, 104, 3, 1, 49, 0, 0, 0, 0, 0, 1, 4, 37, 8, 38, 2, 40, 0, 0, 1, 40, 0, 0, 0, 0, 2, 159, 4, 38, 8, 70, 20, 4, 121, 0, 2, 42, 8, 62, 21, 3, 22, 0, 1, 44, 0, 0, 0, 0, 0, 1, 1, 45, 0, 0, 0, 0, 0, 1, 4, 39, 8, 86, 2, 40, 0, 0, 1, 40, 0, 0, 0, 0, 2, 165, 4, 40, 8, 112, 1, 52, 0, 0, 2, 44, 8, 108, 110, 1, 1, 53, 0, 0, 0, 0, 2, 171, 0, 0, 2, 182, 4, 41, 8, 128, 3, 40, 0, 0, 1, 54, 0, 0, 0, 0, 0, 1, 4, 42, 8, 154, 89, 0, 6, 0, 8, 142, 0, 0, 2, 191, 21, 5, 48, 0, 6, 0, 0, 0, 0, 0, 2, 193, 4, 43, 8, 186, 20, 2, 121, 0, 2, 42, 8, 178, 21, 3, 22, 0, 1, 44, 0, 0, 0, 0, 0, 1, 1, 45, 0, 0, 0, 0, 0, 1, 4, 44, 8, 230, 2, 40, 8, 208, 1, 55, 0, 0, 110, 1, 1, 53, 0, 0, 0, 0, 2, 195, 1, 52, 0, 0, 2, 44, 8, 226, 110, 1, 1, 53, 0, 0, 0, 0, 2, 203, 0, 0, 2, 214, 4, 45, 8, 254, 111, 0, 6, 0, 8, 244, 0, 0, 2, 223, 110, 12, 1, 14, 0, 0, 0, 0, 2, 225, 4, 46, 9, 22, 2, 40, 9, 14, 1, 40, 0, 0, 0, 0, 2, 229, 1, 41, 0, 0, 0, 0, 2, 235, 4, 47, 9, 48, 89, 0, 6, 0, 9, 36, 0, 0, 2, 244, 21, 5, 48, 0, 6, 0, 0, 0, 0, 0, 2, 246, 4, 48, 9, 72, 121, 0, 89, 0, 6, 0, 9, 64, 0, 0, 0, 1, 1, 56, 0, 0, 0, 0, 0, 1, 4, 49, 9, 94, 2, 40, 0, 0, 1, 55, 0, 0, 110, 1, 1, 53, 0, 0, 0, 0, 2, 248, 4, 50, 9, 104, 40, 0, 0, 0, 0, 1, 4, 6, 9, 114, 79, 0, 0, 0, 0, 1, 4, 51, 0, 0, 98, 0, 0, 0, 0, 1, 2, 42, 9, 182, 2, 40, 9, 170, 2, 42, 9, 150, 3, 41, 0, 0, 123, 0, 7, 44, 0, 0, 0, 0, 0, 1, 1, 28, 0, 0, 3, 41, 0, 0, 123, 1, 22, 0, 7, 44, 0, 0, 0, 0, 0, 1, 21, 3, 22, 0, 7, 44, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 2, 42, 9, 232, 2, 40, 9, 224, 2, 42, 9, 208, 3, 41, 0, 0, 123, 2, 0, 0, 0, 1, 1, 28, 0, 0, 3, 41, 0, 0, 123, 1, 24, 0, 0, 0, 0, 1, 21, 3, 24, 0, 0, 0, 0, 1, 0, 0, 0, 1, 4, 34, 9, 246, 20, 1, 0, 0, 0, 1, 4, 43, 10, 0, 20, 2, 0, 0, 0, 1, 4, 16, 10, 10, 20, 3, 0, 0, 0, 1, 4, 38, 10, 20, 20, 4, 0, 0, 0, 1, 4, 20, 10, 30, 20, 6, 0, 0, 0, 1, 4, 5, 0, 0, 20, 5, 0, 0, 0, 1, 21, 1, 23, 0, 1, 58, 0, 0, 2, 44, 10, 60, 1, 45, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 21, 1, 23, 0, 1, 58, 0, 0, 1, 57, 10, 92, 2, 44, 10, 88, 1, 44, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 2, 44, 10, 104, 1, 44, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 2, 40, 10, 122, 25, 0, 1, 59, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 2, 42, 10, 142, 114, 0, 3, 41, 0, 0, 35, 0, 0, 0, 0, 1, 1, 60, 0, 0, 26, 0, 2, 44, 10, 160, 1, 59, 0, 0, 0, 0, 0, 1, 2, 41, 10, 170, 35, 0, 0, 0, 0, 1, 3, 58, 0, 0, 2, 42, 10, 190, 114, 1, 3, 41, 0, 0, 35, 0, 0, 0, 0, 1, 1, 60, 0, 0, 26, 1, 2, 44, 10, 208, 1, 59, 0, 0, 0, 0, 0, 1, 3, 41, 0, 0, 35, 0, 0, 0, 0, 1, 1, 28, 0, 0, 0, 0, 3, 0, 21, 5, 2, 42, 11, 4, 36, 0, 21, 5, 37, 0, 2, 44, 10, 250, 1, 61, 0, 0, 0, 0, 0, 1, 3, 47, 0, 0, 38, 0, 0, 0, 0, 1, 37, 0, 2, 44, 11, 18, 1, 61, 0, 0, 0, 0, 0, 1, 3, 47, 0, 0, 38, 0, 0, 0, 0, 1, 21, 1, 2, 40, 0, 0, 25, 0, 1, 59, 0, 0, 2, 44, 11, 52, 1, 46, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 2, 47, 11, 70, 27, 0, 1, 43, 0, 0, 0, 0, 0, 1, 21, 1, 28, 0, 3, 47, 0, 0, 1, 43, 0, 0, 0, 0, 0, 1, 21, 1, 29, 0, 1, 58, 0, 0, 2, 44, 11, 118, 2, 47, 11, 110, 1, 42, 0, 0, 0, 0, 0, 1, 1, 43, 0, 0, 0, 0, 0, 1, 2, 47, 11, 130, 1, 42, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 21, 1, 30, 0, 1, 63, 0, 0, 3, 47, 0, 0, 1, 61, 0, 0, 122, 0, 7, 44, 0, 0, 1, 47, 0, 0, 0, 0, 0, 1, 30, 0, 1, 64, 0, 0, 2, 47, 0, 0, 1, 61, 0, 0, 122, 0, 7, 44, 0, 0, 1, 47, 0, 0, 0, 0, 0, 1, 2, 40, 11, 216, 1, 65, 0, 0, 2, 44, 11, 212, 1, 64, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 21, 1, 2, 40, 11, 244, 32, 0, 1, 66, 0, 0, 2, 44, 11, 240, 1, 64, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 31, 0, 2, 44, 12, 2, 1, 64, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 41, 0, 1, 67, 0, 0, 0, 0, 0, 1, 2, 40, 12, 36, 1, 65, 0, 0, 3, 44, 0, 0, 1, 67, 0, 0, 0, 0, 0, 1, 21, 1, 2, 40, 12, 60, 41, 1, 1, 68, 0, 0, 3, 44, 0, 0, 1, 67, 0, 0, 0, 0, 0, 1, 3, 61, 0, 0, 41, 2, 21, 0, 41, 3, 3, 44, 0, 0, 21, 0, 41, 4, 2, 44, 12, 96, 21, 0, 41, 5, 3, 41, 0, 0, 41, 6, 0, 0, 0, 1, 3, 41, 0, 0, 41, 7, 41, 6, 0, 0, 0, 1, 21, 0, 41, 8, 2, 44, 12, 124, 1, 68, 0, 0, 0, 0, 0, 1, 3, 41, 0, 0, 41, 9, 0, 0, 0, 1, 2, 40, 12, 162, 32, 0, 1, 66, 0, 0, 2, 44, 12, 158, 21, 1, 1, 63, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 31, 0, 2, 44, 12, 178, 21, 1, 1, 63, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 32, 1, 6, 0, 12, 200, 1, 22, 0, 0, 118, 0, 31, 1, 0, 0, 0, 1, 1, 69, 0, 0, 0, 0, 0, 1, 1, 28, 0, 0, 118, 0, 33, 0, 2, 44, 12, 228, 1, 69, 0, 0, 0, 0, 0, 1, 3, 41, 0, 0, 2, 40, 12, 248, 1, 22, 0, 0, 118, 0, 34, 1, 0, 0, 0, 1, 34, 0, 0, 0, 0, 1, 1, 70, 0, 0, 118, 0, 2, 44, 13, 16, 1, 54, 0, 0, 0, 0, 0, 1, 3, 41, 0, 0, 0, 0, 0, 1, 21, 1, 3, 61, 0, 0, 102, 0, 6, 0, 0, 0, 1, 29, 0, 0, 120, 0, 6, 0, 0, 0, 0, 0, 3, 5, 1, 12, 0, 0, 2, 42, 13, 126, 2, 40, 13, 98, 1, 28, 0, 0, 3, 41, 0, 0, 123, 1, 22, 0, 2, 40, 0, 0, 1, 71, 0, 0, 2, 44, 13, 94, 1, 51, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 21, 3, 22, 0, 2, 40, 0, 0, 1, 71, 0, 0, 2, 44, 13, 122, 1, 51, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 2, 40, 0, 0, 1, 71, 0, 0, 2, 44, 13, 146, 1, 51, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 42, 0, 2, 45, 13, 178, 43, 0, 2, 44, 13, 170, 1, 71, 0, 0, 0, 0, 0, 1, 3, 41, 0, 0, 0, 0, 0, 1, 2, 44, 13, 190, 1, 71, 0, 0, 0, 0, 0, 1, 3, 41, 0, 0, 0, 0, 0, 1, 3, 40, 0, 0, 21, 1, 30, 0, 1, 63, 0, 0, 3, 41, 0, 0, 44, 0, 2, 44, 13, 228, 1, 48, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 21, 3, 49, 0, 2, 44, 13, 248, 1, 50, 0, 0, 0, 0, 3, 10, 50, 0, 6, 0, 0, 0, 0, 0, 3, 13, 1, 72, 14, 26, 2, 44, 14, 18, 1, 73, 0, 0, 0, 0, 3, 16, 3, 41, 0, 0, 0, 0, 3, 21, 1, 41, 0, 0, 2, 44, 14, 66, 1, 73, 14, 42, 0, 0, 3, 24, 1, 52, 0, 0, 2, 44, 14, 58, 1, 73, 0, 0, 0, 0, 3, 32, 3, 41, 0, 0, 0, 0, 3, 45, 3, 41, 0, 0, 0, 0, 3, 56, 1, 72, 0, 0, 2, 44, 14, 90, 1, 73, 0, 0, 0, 0, 3, 62, 3, 41, 0, 0, 0, 0, 3, 67, 2, 42, 14, 106, 0, 0, 3, 70, 110, 1, 1, 14, 0, 0, 0, 0, 3, 73, 2, 42, 14, 124, 0, 0, 3, 76, 110, 1, 1, 14, 0, 0, 0, 0, 3, 79, 4, 52, 14, 146, 1, 41, 0, 0, 0, 0, 3, 82, 4, 53, 14, 158, 1, 52, 0, 0, 0, 0, 3, 88, 4, 54, 14, 172, 110, 1, 1, 14, 0, 0, 0, 0, 3, 94, 4, 55, 14, 186, 21, 0, 6, 0, 0, 0, 0, 0, 3, 100, 4, 56, 14, 200, 21, 0, 6, 0, 0, 0, 0, 0, 3, 104, 4, 57, 0, 0, 110, 1, 1, 14, 0, 0, 0, 0, 3, 108, 1, 72, 14, 238, 2, 44, 14, 230, 1, 74, 0, 0, 0, 0, 3, 114, 3, 41, 0, 0, 0, 0, 3, 119, 1, 74, 14, 246, 0, 0, 3, 122, 1, 41, 0, 0, 2, 44, 15, 6, 1, 74, 0, 0, 0, 0, 3, 125, 3, 41, 0, 0, 0, 0, 3, 133, 110, 1, 1, 72, 15, 40, 2, 44, 15, 32, 1, 74, 0, 0, 0, 0, 3, 139, 3, 41, 0, 0, 0, 0, 3, 144, 1, 75, 0, 0, 3, 61, 0, 0, 1, 14, 0, 0, 2, 44, 15, 64, 1, 74, 0, 0, 0, 0, 3, 147, 3, 41, 0, 0, 0, 0, 3, 156, 4, 58, 15, 80, 0, 0, 3, 163, 4, 59, 15, 88, 0, 0, 3, 166, 4, 60, 15, 96, 0, 0, 3, 169, 4, 61, 15, 104, 0, 0, 3, 172, 4, 62, 15, 112, 0, 0, 3, 175, 4, 63, 15, 120, 0, 0, 3, 178, 4, 64, 15, 128, 0, 0, 3, 181, 4, 65, 15, 136, 0, 0, 3, 184, 4, 66, 15, 144, 0, 0, 3, 187, 4, 67, 15, 152, 0, 0, 3, 190, 4, 68, 15, 160, 0, 0, 3, 193, 4, 69, 15, 168, 0, 0, 3, 196, 4, 70, 15, 176, 0, 0, 3, 199, 4, 71, 15, 184, 0, 0, 3, 202, 4, 72, 15, 192, 0, 0, 3, 205, 4, 73, 15, 200, 0, 0, 3, 208, 4, 74, 15, 208, 0, 0, 3, 211, 4, 75, 15, 216, 0, 0, 3, 214, 4, 76, 0, 0, 0, 0, 3, 217, 2, 40, 16, 52, 73, 0, 1, 53, 0, 0, 2, 61, 16, 38, 76, 0, 6, 0, 0, 0, 1, 76, 0, 0, 3, 44, 0, 0, 1, 76, 0, 0, 2, 44, 16, 20, 1, 76, 0, 0, 3, 41, 0, 0, 1, 77, 0, 0, 0, 0, 3, 220, 47, 1, 6, 0, 0, 0, 3, 41, 0, 0, 1, 77, 0, 0, 0, 0, 3, 235, 3, 41, 0, 0, 93, 0, 1, 77, 0, 0, 0, 0, 3, 248, 125, 0, 6, 0, 16, 84, 6, 0, 16, 66, 0, 0, 0, 1, 21, 1, 53, 0, 72, 0, 6, 0, 0, 0, 1, 77, 0, 0, 0, 0, 3, 253, 110, 1, 1, 14, 0, 0, 59, 7, 1, 77, 0, 0, 0, 0, 4, 2, 2, 44, 16, 114, 68, 0, 1, 53, 0, 0, 0, 0, 4, 9, 0, 0, 0, 1, 21, 1, 67, 0, 2, 44, 16, 134, 1, 49, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 2, 47, 16, 166, 21, 1, 124, 1, 3, 47, 0, 0, 2, 44, 16, 162, 1, 56, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 21, 1, 124, 0, 2, 44, 16, 182, 1, 56, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 2, 41, 16, 194, 0, 0, 0, 1, 2, 42, 16, 220, 74, 0, 2, 44, 16, 212, 1, 9, 0, 0, 0, 0, 0, 1, 3, 41, 0, 0, 0, 0, 0, 1, 21, 1, 75, 0, 2, 44, 16, 236, 1, 9, 0, 0, 0, 0, 0, 1, 3, 41, 0, 0, 0, 0, 0, 1, 4, 77, 0, 0, 1, 14, 0, 0, 59, 7, 6, 0, 0, 0, 3, 41, 0, 0, 63, 0, 6, 0, 17, 56, 18, 0, 21, 3, 55, 0, 17, 0, 6, 0, 0, 0, 2, 44, 0, 0, 21, 3, 55, 0, 17, 0, 6, 0, 0, 0, 2, 44, 0, 0, 21, 3, 55, 0, 17, 0, 6, 0, 0, 0, 0, 0, 4, 12, 4, 77, 17, 124, 1, 14, 0, 0, 59, 7, 6, 0, 0, 0, 2, 41, 0, 0, 63, 0, 6, 0, 0, 0, 18, 0, 21, 3, 55, 0, 17, 0, 6, 0, 0, 0, 2, 44, 0, 0, 21, 3, 55, 0, 17, 0, 6, 0, 0, 0, 2, 44, 0, 0, 21, 3, 55, 0, 17, 0, 6, 0, 0, 0, 0, 0, 4, 19, 4, 29, 17, 134, 113, 0, 0, 0, 4, 32, 1, 2, 0, 0, 0, 0, 4, 41, 4, 77, 0, 0, 1, 14, 0, 0, 59, 7, 6, 0, 0, 0, 3, 41, 0, 0, 77, 0, 1, 3, 0, 0, 0, 0, 4, 51, 2, 68, 0, 0, 3, 79, 0, 0, 21, 3, 45, 0, 6, 0, 0, 0, 7, 44, 0, 0, 21, 1, 46, 1, 6, 0, 0, 0, 3, 61, 0, 0, 1, 76, 0, 0, 3, 44, 0, 0, 1, 76, 0, 0, 2, 44, 17, 226, 1, 76, 0, 0, 0, 0, 4, 61, 47, 1, 6, 0, 0, 0, 0, 0, 4, 69, 110, 9, 1, 14, 0, 0, 59, 7, 0, 0, 4, 75, 0(101); !{2900C}%CONSTSTRING(9)%ARRAY SUBNAMES(0:82)= %C !{2900C}"" ,"STAT" ,"SS" ,"ASS" ,"DO" , !{2900C}"IFL" ,"IFA" ,"IFAS" ,"SSS" ,"DARL" , !{2900C}"IDEN" ,"CHLEN" ,"TYPE" ,"VAR" ,"EX" , !{2900C}"EXP" ,"ADOP" ,"F" ,"T" ,"EXT" , !{2900C}"ET" ,"U" ,"SUBSTRG" ,"SFPAR" ,"SSLIST" , !{2900C}"APLIST" ,"SFLST" ,"INTEXP" ,"CINTEXP" ,"CNSTEXP" , !{2900C}"CEX" ,"CF" ,"CMULDIV" ,"CT" ,"CEXT" , !{2900C}"CADSUB" ,"CET" ,"CLOGREL" ,"CU" ,"PEX" , !{2900C}"AIOLIST" ,"UNIT" ,"CLIS1" ,"CLIS2" ,"CHLIST" , !{2900C}"LIST" ,"DLIST" ,"DATLI" ,"ELIST" ,"FLIST" , !{2900C}"LLIST" ,"ILIST" ,"FMT" ,"IOLIST" ,"PLIST" , !{2900C}"CILIST" ,"SAVLIST" ,"CHLEN2" ,"DIMS" ,"DIMLI" , !{2900C}"DBEXP" ,"DAT" ,"ODATLI" ,"VLIST" ,"DALIST" , !{2900C}"IMPDO" ,"INTORSS" ,"IMPDOL" ,"IMPDSL" ,"INTLI" , !{2900C}"PITEM" ,"LETLI" ,"CIKEY" ,"CILIST2" ,"AIOLST2" , !{2900C}"CIKEY2" ,"DOEX" ,"JLIST" ,"" ,"" , !{2900C}"" ,"" ,"" !* !*** ENDSYNTAX *** !* !*********************************************************************** !* !%INCLUDE "ERCS06.PERQ_PDICTFMTS" !*********************************************************************** !* !* !*********************************************************************** !* Formats for accessing dictionary records * !*********************************************************************** !* %RECORDFORMAT PRECF( %C %BYTEINTEGER CLASS,TYPE,X0,X1, %C %INTEGER LINK1, LINK2, LINK3, ADDR4, %C %HALFINTEGER DISP,LEN,IDEN,IIN, %C %INTEGER LINE,XREF,CMNLENGTH, CMNREFAD) !* %RECORDFORMAT SRECF(%INTEGER INF0, LINK1, INF2, INF3, INF4) !* %RECORDFORMAT RESF((%INTEGER W %OR %HALFINTEGER H0, (%HALFINTEGER H1 %OR %BYTEINTEGER FORM,MODE))) !* %RECORDFORMAT DORECF( %C %INTEGER LABEL, LINK1, LOOPAD, ENDREF, %RECORD(RESF) INDEXRD, INCRD, FINALRD, ICRD, %INTEGER LABLIST,LINE) !* %RECORDFORMAT BFMT(%INTEGER L,U,M) !* %RECORDFORMAT ARRAYDVF(%HALFINTEGER DIMS, ADDRDV, %C %INTEGER ZEROTOFIRST, ADFIRST, NUMELS, ELLENGTH, %C %RECORD(BFMT) %ARRAY B(1 : 7)) !* !* %RECORDFORMAT LRECF(%INTEGER NOTFLAG,LINK1,ORLIST,ANDLIST,RELOP) !* %RECORDFORMAT IFRECF(%INTEGER TYPE,LINK1,ENDIFJUMP,FALSELIST, %C LABLIST,LINE) !* %RECORDFORMAT LABRECF(%BYTEINTEGER CLASS,TYPE,X0,X1, %C %INTEGER LINK1,LINK2,LINK3,ADDR4,LINK5,LAB,LINE, %C %HALFINTEGER DOSTART,DOEND,IFSTART,IFEND) !* %RECORDFORMAT PLABF(%INTEGER INDEX,CODEAD,REF,REFCHAIN) !* %RECORDFORMAT IMPDORECF(%INTEGER VAL,LINK,IDEN) !* %RECORDFORMAT CONRECF(%INTEGER MODE,LINK1,DADDR,CADDR) !* %RECORDFORMAT TMPF(%BYTEINTEGER REG,MODE,%HALFINTEGER INDEX, %C %INTEGER LINK1,ADDR) !* %RECORDFORMAT CHARF(%INTEGER ADESC,LINK,LEN) !* %RECORDFORMAT FNRECF(%INTEGER FPTR,LINK1,HEAD,PCT) !* !* !*********************************************************************** !* Constants defining the size of DICT records * !*********************************************************************** !* %CONSTINTEGER IDRECSIZE = 14;! size of dict entry reserved for a new identifier %CONSTINTEGER CONRECSIZE = 8 %CONSTINTEGER CNSTRECMIN = 2 %CONSTINTEGER IMPDORECSIZE = 6;! size of DATA-implied-DO list item %CONSTINTEGER LABRECSIZE = 20 %CONSTINTEGER PLABRECSIZE = 8 %CONSTINTEGER XREFSIZE = 4 %CONSTINTEGER CMNRECEXT = 8;! extra space on iden record for common block name %CONSTINTEGER TMPRECSIZE = 6 %CONSTINTEGER DVRECSIZE = 10 !* !*********************************************************************** !* TRIAD record format * !*********************************************************************** !* %RECORDFORMAT TRIADF( %C %BYTEINTEGER OP, (%BYTEINTEGER USE %OR %BYTEINTEGER VAL2), %HALFINTEGER CHAIN, (%RECORD(RESF) RES1 %OR %C (%HALFINTEGER OPD1,%BYTEINTEGER QOPD1,MODE %OR %C (%INTEGER SLN %OR %INTEGER VAL1))), (%RECORD(RESF) RES2 %OR %C %HALFINTEGER OPD2,%BYTEINTEGER QOPD2,MODE2)) !* !* !*********************************************************************** !*********************************************************************** !* !%INCLUDE "ERCS06.PERQ_COMFMT" !* %RECORDFORMAT COMFMT(%INTEGER CONTROL,OPTIONS,OPTIONS1,OPTIONS2,PTRACE, ADICT,ANAMES,ADOUTPUT,ADBLKDTAID,DICLEN,DPTR, MAXTRIADS,NEXTPLAB,ALABH,ADLHEAD, SUBPROGTYPE,SFPTR,EXTERNALS,CBNPTR,SCPTR,CHECKLIST, RESCOM1,RESCOM2,GLACA,FNO,FAULTY,LINEST,CMNIIN,SFMK, LISTL,LISTSTREAM,DIAGSTREAM,LISTPOINT,XREF, PACKCMN,ITSMODE,PATHANAL,CHARACTER CODE,SPACE CHAR, HEADINGS,ARRAYCHECKS,JBRMODE,MESSLEN,NAMESLEN, NEXTCH,FUNRESDISP,WARNCOUNT,INP,MAXINP,MESSCOUNT, UNASSPATTERN,LISTCODE,PI21INT,DOPTR,SUBPROGPTR, FNLST,LAB,NAMESFREE,ALGOLREF,FIRSTSTATNUM,CEXPDICT, COMMONBASE,FASTPROLOGUE,STATEMENT,IFPTR, CNSTCA,COMMENTCNT,ADIDENT,ADERRIDEN, ADEXT,MAXDICT,MAXNAMES,MAXOUTPUT,MAXEXT, ACOMP,ASUBNAMES,MAXPSTACK, ATRIADS,TRFILEID,TRBLOCK,CMNCNT,SCANONLY,NOISY) !* %EXTERNALREALFNSPEC FLOATLONG(%INTEGER VAL) %EXTERNALROUTINESPEC QPUT(%INTEGER L1, L2, L3, L4) !!%ROUTINESPEC QPUT(%INTEGER L1,L2,L3,L4) !* %EXTERNALINTEGERFNSPEC FORMATCD(%INTEGER INSTART,DISP,ARYADR, INLEN,OUTLEN,LEVEL,RUNCOMP, %INTEGERNAME TABLE,ATFMTLEN) !* %EXTERNALROUTINESPEC LFAULT(%INTEGER ER) %EXTERNALROUTINESPEC FAULT(%INTEGER ER) %EXTERNALROUTINESPEC IFAULT(%INTEGER ER,I) %EXTERNALROUTINESPEC TFAULT(%INTEGER I,STRINGAD,DUM) !* %RECORDFORMAT CMFMT(%HALFINTEGER IIN,INIT,%INTEGER LEN, %STRING(7) ID) %OWNRECORD(CMFMT)%ARRAY CM(0:64) !* %OWNINTEGER COMAD !* !* %CONSTBYTEINTEGERARRAY NUMBYTES(0:7)=0(3),1,2,4,8,16 %CONSTINTEGERARRAY ROND(0 : 3) = %C X'FFFFFFFF',X'FFFFFFFE',0,X'FFFFFFFC' %CONSTSTRING(2)%ARRAY ICLFNTYPE(0:8)="","","","1","2","4","1C","2C","4C" !* %CONSTINTEGER YES=1 %CONSTINTEGER NO =0 %CONSTINTEGER FULL=2 %CONSTINTEGER MAX AREA SIZE=X'20000' %CONSTINTEGER OPT AREA SIZE=X'2000' %CONSTSTRING(5) LOCID="F_LOC" !* %OWNHALFINTEGERARRAY GLABUFF(0 : 135) !* %EXTERNALINTEGER GLACA %OWNINTEGER GLACURR,GLABASE,LOC IIN,LOC CUR %OWNINTEGER FILLER !* %RECORDFORMAT HHF(%HALFINTEGER L,R) %OWNRECORD(HHF) HH !* %ROUTINE GLAOUT %IF GLACURR=0 %THEN %RETURN QPUT(42,GLACURR<<1,GLABASE+GLABASE,ADDR(GLABUFF(0))) GLABASE=GLABASE+GLACURR GLACURR=0 %END;! GLAOUT !* %ROUTINE PUTGLA(%HALFINTEGER H) GLABUFF(GLACURR)<-H GLACURR=GLACURR+1 GLACA=GLACA+1 GLAOUT %IF GLACURR>=128 %END;! PUTGLA !* %ROUTINE PUTGLA2(%HALFINTEGER H1,H2) GLABUFF(GLACURR)<-H1 GLABUFF(GLACURR+1)<-H2 GLACURR=GLACURR+2 GLACA=GLACA+2 GLAOUT %IF GLACURR>=128 %END;! PUTGLA2 !* %ROUTINE PUTGLAW(%INTEGER W) GLABUFF(GLACURR)<-W&X'FFFF' GLABUFF(GLACURR+1)<-W>>16 GLACURR=GLACURR+2 GLACA=GLACA+2 GLAOUT %IF GLACURR>=128 %END;! PUTGLAW !* %ROUTINE PLUGGLA(%INTEGER AT,WITH) %HALFINTEGER I I<-WITH %IF AT>=GLABASE %THENSTART GLABUFF(AT-GLABASE)<-I %FINISHELSESTART QPUT(42,2,AT<<1,ADDR(I)) %FINISH %END;! PLUGGLA !* %ROUTINE PLUGGLAW(%INTEGER AT,WITH) %HALFINTEGER I,J I<-WITH&X'FFFF' J<-WITH>>16 PLUGGLA(AT,I) PLUGGLA(AT+1,J) %END;! PLUGGLAW !* %EXTERNALROUTINE INIT ALLOC(%INTEGER ADCOM) %RECORD(COMFMT)%NAME COM %INTEGER I COMAD=ADCOM COM==RECORD(ADCOM) QPUT(0,1,0,0) GLACURR=0 GLABASE=0 GLACA=0 LOC IIN=COM_CMNIIN COM_CMNIIN=COM_CMNIIN+1 LOC CUR=0 PUTGLA2(M'F7',M'7 ') PUTGLA2(M'GL',M'A ') PUTGLA2(X'0A01',1) %CYCLE I=1,1,39;! include space for 3 fixup words at front PUTGLA2(0,0);! reserving space for io transfer control table %REPEAT COM_ACOMP=ADDR(COMP(0)) !{2900C} COM_ASUBNAMES=ADDR(SUBNAMES(0)) %IF COM_CONTROL&X'10'=0 %THEN FILLER=X'8080' %ELSE FILLER=0 %END;! INIT ALLOC !* %EXTERNALINTEGERFN TIDY GLA(%HALFINTEGER EP,IIN,%INTEGER LEN) %RECORD(COMFMT)%NAME COM %INTEGER I,II %STRING(7) S COM==RECORD(COMAD) %IF EP=1 %THENSTART;! ENTER A COMMON LENGTH %IF COM_CMNCNT#0 %THENSTART %CYCLE I=1,1,COM_CMNCNT %IF CM(I)_IIN=IIN %THENSTART %IF LEN>CM(I)_LEN %THEN CM(I)_LEN=LEN %RESULT=0 %FINISH %REPEAT %FINISH %RESULT=0 %FINISH %IF EP=2 %THENSTART;! DEFINE COMMONS %IF COM_CMNCNT#0 %THENSTART %CYCLE I=1,1,COM_CMNCNT II=CM(I)_IIN II=II<<16!X'9' %IF FILLER#0 %THEN II=II!X'10' %IF CM(I)_INIT#0 %THEN II=II!4 S=CM(I)_ID QPUT(16,II,CM(I)_LEN,ADDR(S)) %REPEAT %FINISH %RESULT=0 %FINISH %IF LOC CUR#0 %THENSTART I=LOC IIN I=I<<16!X'C' %IF FILLER#0 %THEN I=I!X'10';! unassigned checks QPUT(16,I,LOC CUR,ADDR(LOCID)) LOC CUR=0 LOC IIN=COM_CMNIIN COM_CMNIIN=COM_CMNIIN+1 %FINISH %IF GLACA&1#0 %THEN PUTGLA(0) GLAOUT %RESULT=GLACA %END;! TIDY ALLOC !* %EXTERNALINTEGERFN GLA SPACE(%INTEGER LEN) !* LEN in bytes %INTEGER I I=GLACA %WHILE LEN>0 %CYCLE GLABUFF(GLACURR)<-FILLER GLABUFF(GLACURR+1)<-FILLER GLACURR=GLACURR+2 GLACA=GLACA+2 GLAOUT %IF GLACURR>=128 LEN=LEN-4 %REPEAT %RESULT=I %END;! GLA SPACE !* %INTEGERFN CHAR REF(%HALFINTEGER IIN,%INTEGER DISP,LEN) %HALFINTEGER I,J J=GLACA I=J<<1 PUTGLAW(DISP>>1) PUTGLA2(DISP&1,LEN) PUTGLA2(LEN,0);! total length which may be modified for substring QPUT(19,2,I,IIN) %RESULT=J %END;! CHAR REF !* %INTEGERFN SCALAR REF(%HALFINTEGER IIN,%INTEGER DISP) %HALFINTEGER I %INTEGER J,K,L L=GLACA I=GLACA<<1;! bytes J=I;! 32 bit value required for param K=IIN PUTGLAW(DISP>>1) QPUT(19,2,J,K) %RESULT=L %END;! SCALAR REF !* %ROUTINE SET ARRAY HEAD(%INTEGER ADV,%HALFINTEGER IIN,%INTEGER DISP) PLUGGLAW(ADV,DISP>>1) %IF DISP&1#0 %THEN PLUGGLA(ADV+2,1) QPUT(19,2,ADV+ADV,IIN) %END;! SET ARRAY HEAD !* %INTEGERFN LOCAL SPACE(%INTEGER LEN {BYTES},%HALFINTEGERNAME IIN) %RECORD(COMFMT)%NAME COM %INTEGER AD,I LEN=(LEN+1)&X'FFFFE' %IF LEN >MAX AREA SIZE %THENSTART LFAULT(316);! require > permitted area size IIN=LOC IIN %RESULT=0 %FINISH %IF LOC CUR>= OPT AREA SIZE %THENSTART I=LOC IIN I=I<<16!X'C' %IF FILLER#0 %THEN I=I!X'10';! unassigned checks QPUT(16,I,LOC CUR,ADDR(LOCID)) COM==RECORD(COMAD) LOC IIN=COM_CMNIIN COM_CMNIIN=COM_CMNIIN+1 LOC CUR=0 %FINISH AD=LOC CUR LOC CUR=LOC CUR+LEN IIN=LOC IIN %RESULT=AD %END !* %EXTERNALINTEGERFN ALLOC CHAR(%INTEGER L,AD, %C %HALFINTEGERNAME IIN,%INTEGERNAME DISP) !*********************************************************************** !* ALLOCATE SPACE FOR CHAR VAR OR CONST IN GLA * !* AD = 0 VAR - FILL WITH UNASS * !* AD # 0 CONST - DICT DISPLACEMENT OF CONSTANT VALUE * !* SET DESCRIPTOR ON STACK, ADDRESS AS RESULT * !*********************************************************************** %RECORD(COMFMT)%NAME COM %INTEGER I COM==RECORD(COMAD) DISP=LOCAL SPACE(L,IIN) I=CHAR REF(IIN,DISP,L) %IF AD#0 %THENSTART %IF AD<0 %THEN AD=-AD QPUT(100+IIN,L,DISP,COM_ADICT+AD) %FINISH %RESULT=I %END;! ALLOC CHAR !* !* %EXTERNALROUTINE ALLOC(%INTEGER PTR) !*********************************************************************** !* ON ENTRY PTR POINTS AT RECORD FOR AN IDENTIFIER FOR WHICH * !* STORAGE MUST BE ALLOCATED. THIS MAY REQUIRE ALLOCATION OF A COMPLETE* !* COMMON BLOCK, OR ALL ITEMS INVOLVED IN EQUIVALENCE CHAINS. * !*********************************************************************** !* %ROUTINESPEC DV(%INTEGER DVADDR) %HALFINTEGERFNSPEC NEWCMN !* %RECORD(COMFMT)%NAME COM %RECORD(ARRAYDVF) %NAME DVREC !* %HALFINTEGER I, T, IIN %INTEGER J, K, L, M, N, P, Q, U, V, W, TEMP,CHAR,CMNBLKAD %HALFINTEGER SAVEPTR, DATAMODE %INTEGER CLASS,SZTYPE,DR1 %HALFINTEGER BOUND, BEND, ER %RECORD(PRECF) %NAME PP %RECORD(PRECF) %NAME QQ %RECORD(SRECF) %NAME WW %RECORD(SRECF) %NAME SS %RECORD(PRECF) %NAME CMNBLK %SWITCH SW(0 : 6) %SWITCH TW(8 : 14) !* COM==RECORD(COMAD) PP == RECORD(COM_ADICT+PTR) I = PP_X1 %RETURNIF I&1 # 0; ! ALREADY ALLOCATED DATAMODE = I&2 SAVEPTR = PTR CLASS = PP_CLASS&X'1F' SZTYPE=PP_TYPE L = PP_ADDR4 N = NUMBYTES(SZTYPE>>4) %IF SZTYPE=5 %THEN N=PP_LEN %IF N>0 %THEN T=N-1;! NO OF BYTES IN ELEMENT-1 %IF SZTYPE&15 = 3 %THEN N=N+N;! complex -> SW(CLASS&3!(PP_X1&4)); ! EQUIV FROM:COMMON:PARAM !*** LOCAL SCALARS OR ARRAYS SW(0): PP_X1=PP_X1!1; ! SET ALLOCATED BIT %IF CLASS&4 # 0 %THENSTART; ! ARRAY PP_LINK2=COM_SCPTR;! ADD TO DIAGS LIST COM_SCPTR=PTR DV(PP_ADDR4) DVREC_ADFIRST = LOCAL SPACE(N,IIN) PP_IIN=IIN SET ARRAY HEAD(DVREC_ADDRDV,IIN,DVREC_ADFIRST) %FINISHELSESTART; ! SCALAR LOC SCALAR: PP_LINK2 = COM_SCPTR; ! LINK THROUGH SCALARS FOR DIAGNOSTICS COM_SCPTR = PTR ALLOC GLA: %IF SZTYPE=5 %THENSTART PP_DISP=ALLOC CHAR(N,0,IIN,J) PP_ADDR4=J PP_IIN=IIN %RETURN %FINISHELSESTART PP_ADDR4 = GLA SPACE(N); !address in GLA PP_IIN=2 %FINISH %FINISH %RETURN !* !*** PARAM SW(1):PP_X1=PP_X1!1; ! SET ALLOCATED BIT %IF PP_CLASS=9 %THENSTART;! SUBPROG N=8;! SPACE FOR PARAM IN GLA ->ALLOC GLA %FINISH %IF CLASS = 5 %THENSTART; ! PARAMETER ARRAY PP_LINK2=COM_SCPTR;! FOR DIAGNOSTICS COM_SCPTR=PTR DV(PP_ADDR4); ! CONSTRUCT REST OF DOPE VECTOR %FINISHELSESTART; ! SCALAR I=COM_CHECKLIST;! OF ITEMS WHICH SHOULD APPEAR AS PARAMS %WHILE I#0 %CYCLE SS==RECORD(COM_ADICT+I) %IF SS_INF0=PTR %THEN SS_INF2=0;! ENTRY TO BE IGNORED I=SS_LINK1 %REPEAT %IF PP_X0&1 # 0 %AND SZTYPE#5 %THENSTART;! 'VALUE' PARAM SCALAR PP_CLASS=0; ! TO TREAT AS LOCAL SCALAR FOR ALLOCATION -> LOC SCALAR %FINISHELSESTART;! 'NAME' PARAM SCALAR - only char in F77 PP_LINK2=COM_SCPTR;! FOR DIAGNOSTICS COM_SCPTR=PTR PP_X0=PP_X0&X'FE' PP_DISP=GLA SPACE(12);! for desc %FINISH %FINISH %RETURN !*** COMMON SW(2):CMNBLK == RECORD(COM_ADICT+PP_LINK3); ! RECORD DESCRIBING COMMON BLOCK M=CMNBLK_CMNLENGTH CHAR=0 %IF COM_SUBPROGTYPE = 5 %THENSTART; ! BLOCKDATA - SPACE WILL BE ALLOCATED !!# LFAULT(12) %IF M > 0;! ALREADY DEFINED AND ALLOCATED M=0 IIN=NEWCMN CMNBLK_IIN=IIN CMNBLK_CMNREFAD = IIN %FINISHELSESTART %IF CMNBLK_CMNREFAD=0 %THENSTART IIN=NEWCMN CMNBLK_IIN=IIN CMNBLK_CMNREFAD=GLACA QPUT(19,2,2*GLACA,IIN) PUTGLA2(0,0);! for reference %FINISHELSE IIN=CMNBLK_IIN %FINISH ER = 304; ! ALLIGNMENT PTR = CMNBLK_LINK2; ! FIRST ITEM IN THIS COMMON AREA %WHILE PTR # 0 %CYCLE PP == RECORD(COM_ADICT+PTR) %IF PP_X1&1 = 0 %THENSTART; ! NOT YET ALLOCATED PP_IIN=IIN %IF PP_TYPE=5 %THENSTART N=PP_LEN CHAR=CHAR!1 %FINISHELSESTART N = NUMBYTES(PP_TYPE>>4) CHAR=CHAR!2 %IF PP_TYPE&15=3 %THEN N=N+N;! COMPLEX %IF N>2 %THEN T=3 %ELSE T=N-1 ! NO. OF BYTES IN ELEMENT - 1 ! (PER PART IF COMPLEX) %UNLESS M = (M+T)&ROND(T) %OR ER = 0 %THENSTART ! UNLESS ALLIGNMENT O.K. OR FAULT ALREADY REPORTED LFAULT(ER) ER = 0 %FINISH %FINISH PP_X1=PP_X1!1; ! SET ALLOCATED BIT %IF PP_CLASS&4 # 0 %THENSTART;! ARRAY SZTYPE=PP_TYPE DV(PP_ADDR4); ! SET DOPE VECTOR(UNLESS BLOCK DATA) ! CALCULATE TOTAL ARRAY SIZE DVREC_ADFIRST=M !* N.B. RELOCATION BY COMMON BASE AS FOR LOCAL ARRAYS %UNLESS COM_SUBPROGTYPE=5 %THENSTART SET ARRAY HEAD(DVREC_ADDRDV,IIN,M) %FINISH %FINISHELSESTART %IF PP_TYPE=5 %THENSTART PP_ADDR4=M;! bytes %IF COM_SUBPROGTYPE#5 %THENSTART PP_DISP=CHAR REF(CMNBLK_IIN,M,N) %FINISH %FINISHELSE PP_ADDR4 = M>>1;! words %FINISH M = M+N %FINISH PTR = PP_LINK2; ! NEXT ITEM ON THE LIST %REPEAT %IF CHAR=3 %THENSTART TFAULT(183,COM_ANAMES+CMNBLK_IDEN,0) %FINISH CMNBLK_CMNLENGTH = M %IF M>MAX AREA SIZE %THENSTART TFAULT(317,COM_ANAMES+CMNBLK_IDEN,0) %FINISH %RETURN !*** ITEM IS ON AN EQUIVALENCE LIST SW(4): SW(6): W = N; ! ITEM LENGTH K = 0; ! FOR DISPLACEMENT T = 0 M = 0; ! MAX VALUE OF N DISPL J = PTR; ! STARTING POINT P = PTR V = PP_LINK2; ! CORRESPONDING EQUIV CHAIN ENTRY CHAR=0 SS == RECORD(COM_ADICT+V) !* !* STAGE 1 CHOOSE AN ELEMENT WHOSE @ WILL BE FIXED. COMMON ELSE !* ARRAY EL WITH GREATEST DISPLACEMENT ELSE ARRAYNAME ELSE !* SCALAR !* V POINTS TO LIST & P POINTS TO ELEMENT !* %UNTIL P = J %CYCLE PP==RECORD(COM_ADICT+P) %IF PP_TYPE=5 %THENSTART N=PP_LEN CHAR=CHAR!1 %FINISHELSESTART N = NUMBYTES(PP_TYPE>>4) CHAR=CHAR!2 ER=SS_INF3 %FINISH U = SS_INF2; ! DISPL OF EQUIVALENCED ITEM FROM BASE %IF PP_X1&1 # 0 %THENSTART; ! ALLOCATED K = U PTR = P; ! SET TO POINT AT ITEM TO BE USED AS ROOT T = 3; ! ALLOCATED (MAY BE COMMON ITEM IN CHAIN) %FINISHELSESTART %IF PP_TYPE&15=3 %THEN N=N+N;! COMPLEX %IF PP_CLASS&4 # 0 %THENSTART;! ARRAY %UNLESS K > U %OR T = 3 %THENSTART ! WILL BE ROOT UNLESS ALLOCATED OR COMMON ITEM, OR ! ARRAY WITH BIGGER DISPLACEMENT IS FOUND K = U PTR = P %FINISH SZTYPE=PP_TYPE DV(PP_ADDR4); ! SET UP DOPE VECTOR, N TOTAL SIZE IN BYTES %FINISHELSESTART %IF PP_TYPE=5 %THENSTART %UNLESS K>U %OR T=3 %THENSTART K=U PTR=P %FINISH %FINISH %FINISH %IF N-U > M %THEN M = N-U; ! MAX LENGTH REQUIRED BEYOND ALLIGNMENT POINT %FINISH SS == RECORD(COM_ADICT+SS_LINK1); ! NEXT ITEM DESCRIPTOR IN EQUIV CHAIN P = SS_INF0 %REPEAT; ! UNTIL P=J %IF CHAR=3 %THENSTART IFAULT(182,ER);! equivalence of char and non-char items %FINISH CHAR=CHAR&1 PP == RECORD(COM_ADICT+PTR); ! ITEM WHOSE ADDRESS IS TO BE FIXED FIRST P = PP_ADDR4 DVREC == RECORD(COM_ADICT+PP_ADDR4) !* !* STAGE 2 ALLOCATE @ OF THE CHOSEN ELEMENT !* %UNLESS T > 0 %THENSTART; ! NOT YET ALLOCATED PP_X1=(PP_X1&X'F0')!1; ! CLEAR EQUIV FLAGS & SET ALLOC BIT T=2;! will indicate local space later Q=LOCAL SPACE(M+K,IIN) %IF PP_CLASS&4#0 %THENSTART T=4 DVREC==RECORD(COM_ADICT+PP_ADDR4) DVREC_ADFIRST=Q PP_IIN=IIN SET ARRAY HEAD(DVREC_ADDRDV,IIN,Q) %FINISHELSESTART %IF PP_TYPE=5 %THENSTART PP_DISP=CHAR REF(IIN,Q,PP_LEN) PP_IIN=IIN PP_ADDR4=Q %FINISHELSESTART PP_X0=PP_X0!X'10' PP_ADDR4=Q>>1 PP_DISP=SCALAR REF(IIN,Q) %FINISH %FINISH %FINISHELSESTART; ! COMMON ELEMENT (ALREADY ALLOCATED) T=3;! indicates common later %IF PP_CLASS&4=0 %THENSTART;! NOT AN ARRAY P=PTR Q=PP_ADDR4 %IF PP_TYPE#5 %THEN Q=Q+Q;! to give bytes %FINISHELSE Q=DVREC_ADFIRST CMNBLKAD=PP_LINK3 CMNBLK==RECORD(COM_ADICT+CMNBLKAD);! common block record %IF M+K+Q>CMNBLK_CMNLENGTH %THEN CMNBLK_CMNLENGTH=M+K+Q IIN=CMNBLK_IIN %FINISH !*********** STAGE 3 BOUND = K+Q; ! DISPL. OF EQUIVALENCING POINT FROM START OF FIRST ITEM ! +DISPL. OF FIRST ITEM FROM AREA BASE ! W = V; ! POINTS TO FIRST ITEM IN LIST ! %UNTIL W = V %CYCLE ! WW == RECORD(COM_ADICT+W) ! QQ == RECORD(COM_ADICT+WW_INF0) ! %UNLESS QQ_TYPE=5 %THENSTART ! L = NUMBYTES(QQ_TYPE>>4)-1 ! %IF L>3 %THEN L=3 ! Q = WW_INF2; ! DISPLACEMENT ! %IF BOUND-Q # (BOUND-Q+L)&ROND(L) %THENSTART ! ! WRONG ALLIGNMENT !ALLIGNERROR: FAULT(304) ! %EXIT ! %FINISH ! %FINISH ! W = WW_LINK1 ! %REPEAT; ! UNTIL W=V I.E. COMPLETE LIST PROCESSED !* K = V; ! POINTER TO LIST SS == RECORD(COM_ADICT+K) PTR = J %UNTIL PTR = J %CYCLE PP == RECORD(COM_ADICT+PTR) %IF PP_X1&1 = 0 %THENSTART; ! NOT USED/ALLOCATED PP_X1=PP_X1!DATAMODE!1; ! SET DATA IF NEC. AND ALLOCATED BIT M = BOUND-SS_INF2; ! START OF THIS ITEM RELATIVE TO THE BASE %IF PP_TYPE=5 %THENSTART %IF PP_LINK2=0 %THENSTART PP_LINK2=COM_SCPTR COM_SCPTR=PTR %FINISH PP_ADDR4=M;! bytes PP_DISP=CHAR REF(IIN,M,PP_LEN) ->MEET3 %FINISH W = T; ! FIXED ITEM IS: 2 SCALAR 3 COMMON 4 ARRAY -> TW(T+6+PP_CLASS&4); ! 8 SCALAR:SCALAR 12 SCALAR:ARRAY ! 9 COMMON:SCALAR 13 COMMON:ARRAY !10 ARRAY :SCALAR 14 ARRAY :ARRAY TW(13): ! ARRAY EQUIV COMMON W = 4; ! TO INDICATE THAT ADDRESS IS TO GO IN DOPE VECTOR TW(9): !SCALAR EQUIV COMMON %IF M < 0 %THEN FAULT(268);! ATTEMPT TO EXTEND BACKWARDS PP_LINK2=CMNBLK_LINK2 CMNBLK_LINK2=PTR PP_LINK3 = CMNBLKAD; ! ADDRESS OF COMMON BLOCK RECORD PP_X0=PP_X0!4 PP_CLASS=PP_CLASS!2; ! COMMON MARKER ?? -> MEET2 TW(8): ! SCALAR EQUIV SCALAR TW(10): ! SCALAR EQUIV ARRAY PP_LINK2 = COM_SCPTR; ! LINK TO SCALAR LIST FOR DIAGNOSTICS COM_SCPTR = PTR PP_X0=PP_X0!X'10';! mark as local array area !! PP_CLASS=PP_CLASS!2;! pseudo common %IF PP_TYPE=5 %THENSTART PP_ADDR4=M;! bytes PP_DISP=CHAR REF(IIN,M,PP_LEN) %FINISHELSESTART PP_ADDR4=M>>1;! words PP_DISP=SCALAR REF(IIN,M) %FINISH -> MEET3 TW(12): ! ARRAY EQUIV SCALAR %MONITOR TW(14): ! ARRAY EQUIV ARRAY PP_LINK2=COM_SCPTR COM_SCPTR=PTR MEET2: %IF W = 3 %THENSTART; ! COMMON OR SCALAR IN ARRAY AREA %IF PP_TYPE=5 %THENSTART;! CHAR PP_ADDR4=M;! bytes PP_DISP=CHAR REF(IIN,M,PP_LEN) %FINISHELSE PP_ADDR4=M>>1;! words %FINISHELSESTART; ! ARRAY DVREC == RECORD(COM_ADICT+PP_ADDR4) !* N.B RELOCATE ARRAY BASE BY START OF AREA DVREC_ADFIRST = M %IF COM_SUBPROGTYPE#5 %THENSTART;! EXCEPT BLOCKDATA SET ARRAY HEAD(DVREC_ADDRDV,IIN,M) %FINISH %FINISH %FINISH MEET3: PTR = K PP_IIN=IIN K = SS_LINK1; ! TO POINT AT NEXT ITEM DESCRIPTOR !! SS_LINK1=ASL(3) !! ASL(3)=PTR ! temporarily conceeding this list space SS == RECORD(COM_ADICT+K) PTR = SS_INF0 %REPEAT; ! UNTIL PTR=J %RETURN !* %ROUTINE DV(%INTEGER DVADDR); ! GENERATE DOPE VECTOR FOR ARRAY %INTEGER I,J,K,L,D DVREC == RECORD(COM_ADICT+DVADDR) DVREC_ELLENGTH = N %IF COM_SUBPROGTYPE # 5 %THENSTART; ! EXCEPT FOR BLOCK DATA DVREC_ADDRDV = GLACA;! word address of dope vector in GLA PUTGLA2(0,0);! for base @ %IF SZTYPE=5 %THENSTART PUTGLA2(0,N);! element size PUTGLAW(DVREC_NUMELS*N) %FINISH PUTGLAW(DVREC_NUMELS) %IF PP_CLASS&X'C0'#0 %OR COM_CONTROL&X'20'=0 %THENSTART;! adjustable dimensions PUTGLAW(DVREC_ZEROTOFIRST) %CYCLE I=1,1,DVREC_DIMS %UNLESS I=1 %THEN PUTGLAW(DVREC_B(I)_M) PUTGLAW(DVREC_B(I)_L) PUTGLAW(DVREC_B(I)_U) %REPEAT %FINISH %FINISH N = DVREC_NUMELS*N %END; ! DV !* %HALFINTEGERFN NEWCMN %STRING(6) T %HALFINTEGER I,J,K T<-STRING(COM_ANAMES+CMNBLK_IDEN) %IF COM_CMNCNT#0 %THENSTART %CYCLE I=1,1,COM_CMNCNT %IF CM(I)_ID=T %THENSTART %IF COM_SUBPROGTYPE=5 %THEN CM(I)_INIT=1 %RESULT=CM(I)_IIN %FINISH %REPEAT %FINISH COM_CMNCNT=COM_CMNCNT+1 %IF COM_CMNCNT>64 %THENSTART LFAULT(322);! too many COM_CMNCNT=1 %FINISH J=COM_CMNCNT I=COM_CMNIIN COM_CMNIIN=I+1 CM(J)_IIN=I CM(J)_ID=T %IF COM_SUBPROGTYPE=5 %THEN K=1 %ELSE K=0 CM(J)_INIT=K %RESULT=I %END;! NEWCMN !* !* %END; ! ALLOC !* !* %EXTERNALROUTINE ADD DATA ITEM(%INTEGER AREA,PTR,COUNT,DISP,L,AD) %RECORD(PRECF)%NAME PP %RECORD(PRECF)%NAME CMNBLK %RECORD(ARRAYDVF)%NAME DVREC %RECORD(COMFMT)%NAME COM %INTEGER BASE COM==RECORD(COMAD) %IF L>255 %AND COUNT>1 %THENSTART %WHILE COUNT>1 %CYCLE ADD DATA ITEM(AREA,PTR,1,DISP,L,AD) DISP=DISP+L COUNT=COUNT-1 %REPEAT %FINISH !* ALLOC(PTR) PP==RECORD(COM_ADICT+PTR) %IF PP_CLASS&4#0 %THENSTART;! array DVREC==RECORD(COM_ADICT+PP_ADDR4) BASE=DVREC_ADFIRST %FINISHELSESTART;! scalar BASE=PP_ADDR4 %IF PP_TYPE#5 %THEN BASE=BASE+BASE %FINISH BASE=BASE+DISP AD=AD+COM_ADICT %IF AREA=6 %THENSTART;! common block CMNBLK==RECORD(COM_ADICT+PP_LINK3) AREA=CMNBLK_CMNREFAD %FINISH %IF AREA=2 %THENSTART GLAOUT QPUT(42,L,BASE,AD) %FINISHELSESTART QPUT(100+AREA,COUNT<<16!L,BASE,AD) %FINISH %END;! ADD DATA ITEM !* %EXTERNALINTEGERFN PFORMAT(%INTEGER AINPUT,INP,LEN, %STRINGNAME IDENTIFIER) %HALFINTEGER I,ER !{2900C}%INTEGER L {PERQC}%HALFINTEGER L %INTEGER TABLEN,AD,FMTLEN %RECORD(COMFMT)%NAME COM %INTEGERARRAY FMT(0:LEN) %BYTEINTEGERARRAYFORMAT INPUTF(0:1400) %BYTEINTEGERARRAYNAME INPUT ER=FORMATCD(AINPUT,INP,ADDR(FMT(0)),LEN,LEN*4,0,0,TABLEN,FMTLEN) %IF ER=0 %THENSTART %IF TABLEN&1#0 %THEN TABLEN=TABLEN+1 COM==RECORD(COMAD) L=TABLEN {PERQC} L=L>>1 AD=ADDR(FMT(0)) %WHILE L>0 %CYCLE !{2900C} %IF L>=400 %THEN I=400 %ELSE I=L {PERQC} %IF L>=200 %THEN I=400 %ELSE I=L+L QPUT(46,I,COM_CNSTCA,AD) COM_CNSTCA=COM_CNSTCA+I !{2900C} AD=AD+400 !{2900C} L=L-400 {PERQC} AD=AD+200 {PERQC} L=L-200 %REPEAT %FINISHELSESTART INPUT==ARRAY(AINPUT,INPUTF) %IF FMTLEN>32 %THEN FMTLEN=32 %CYCLE I=1,1,FMTLEN INPUT(I)=INPUT(TABLEN+I-1) %REPEAT INPUT(0)=FMTLEN;! this fiddle is to ensure word allignment IDENTIFIER=STRING(AINPUT) %FINISH %RESULT=ER %END;! PFORMAT !* ! Modified 21/ 3/81 15.00 ! ! ! ! ! ! ! ! !*********************************************************************** !*********************************************************************%C %C %C A SET OF NUMBER CONVERSION ROUTINES (version 1.0) %C %C FOR THE FORTRAN COMPILER AND RUN-TIME SYSTEM %C %C when running on ICL PERQs %C %C %C !*********************************************************************%C !*********************************************************************** !*********************************************************************** ! ! CONSTANTS ! !*********************************************************************** ! %CONSTHALFINTEGER NONE= 0 %CONSTHALFINTEGER NULL= 0 %CONSTHALFINTEGER TRUE= 1 %CONSTHALFINTEGER A MINUS= 0 ; !values used internally %CONSTHALFINTEGER A PLUS = 1 ; ! to indicate a positive or negative value is reqd ! ! Modes of operation ! !CONSTHALFINTEGER FIO MODE= 0; !the mode determines !CONSTHALFINTEGER COMPILER MODE= 1; ! the action to be !CONSTHALFINTEGER DEBUG MODE= 2; ! taken when a constant !CONSTHALFINTEGER FIO PLUS MODE= 3; ! is out of range {---and errors given} %CONSTHALFINTEGERARRAY ERROR NO (1:3) %C = 20 , 338 , 188 !these numbers are a function of MODE and correspond ! to a message of the form: CONSTANT OUT OF RANGE ! ! EMAS Floating Point Constants ! !{2900C} %CONSTREAL LARGEST REAL= R'60FFFFFF' ! ! PERQ Floating Point Constants ! {PERQC} %CONSTREAL LARGEST REAL= R'3F7FFFFF' {=3.4028234E+38} !*********************************************************************** ! ! UTILITY PROCEDURES ! !*********************************************************************** ! %INTEGERFN COMPARE ( %INTEGER LENGTH, THIS BASE , %HALFINTEGER THIS DISP , %INTEGER THAT BASE , %HALFINTEGER THAT DISP ) ! ! ! ! ! A Utility Procedure to lexographically compare two texts ! ! of equal length and to return a value which ! ! represents the result of the comparision. ! ! ! At Exit: RESULT= 0 if Text(THIS BASE)=Text(THAT BASE) or LENGTH<=0 ! RESULT= -1 if Text(THIS BASE)Text(THAT BASE) ! ! ! !{2900C} THIS BASE= THIS BASE + THIS DISP !{2900C} THAT BASE= THAT BASE + THAT DISP !{2900C} !{2900C}%WHILE LENGTH>0 %CYCLE !{2900C} ! !{2900C} %RESULT= 1 {greater than} %C !{2900C} %IF BYTEINTEGER(THIS BASE)>BYTEINTEGER(THAT BASE) !{2900C} !{2900C} %RESULT=-1 { less than} %C !{2900C} %IF BYTEINTEGER(THIS BASE) 9 %THENSTART {chance of Integer Overflow later} ! ! Skip any Leading Spaces or Zeros ! A: I=TEXT(PTR) %IF I=' ' %OR I='0' %THEN PTR= PTR + 1 %AND -> A LEN= MAX PTR - PTR -> INTEGER OVERFLOW %IF LEN> 10 -> SIMPLE APPROACH %IF LEN< 10 ! ! Now Test for Integer Overflow (when there are 10 digits) ! I=COMPARE(10,TEXT ADDRESS,PTR,ADDR(LARGEST INTEGER),1) -> INTEGER OVERFLOW %C %IF I+SIGN> 0 %FINISH SIMPLE APPROACH: SUM=0; %IF LEN>0 %THENSTART ! ! Now Convert the Text into Binary ! MULT=-BASE10 ** ** (LEN-1) %WHILE MULT< 0 %CYCLE ! SUM = SUM + (MULT * (TEXT(PTR) - '0')) PTR = PTR + 1 MULT= MULT//10 %REPEAT SUM = -SUM %UNLESS SIGN=A MINUS %FINISH %IF DATA LEN= 1 {word} %THENSTART ! ! ! Assign the Value to an INTEGER*2 ! ! %IF SIGN=A MINUS %THENSTART %IF SUM<-32768 %THEN -> INTEGER OVERFLOW %FINISH %ELSE %IF SUM> 32767 %THEN -> INTEGER OVERFLOW ! ! {Perform the Assignment} HALFINTEGER(DATA AD)= SUM %FINISHELSESTART ! ! ! Assign the Value to an INTEGER*4 ! ! INTEGER(DATA AD)= SUM ! %FINISH %RESULT= 0 {return with no errors} INTEGER OVERFLOW: !check if this is a fault ! %IF MODE\= 0 %THENRESULT= ERROR NO (MODE) {if it is a fault} ! ! Set Data Item to Maximum Permitted Value ! SUM= MAXIMUM OF (DATA LEN) SUM=-(SUM+1) %IF SIGN=A PLUS ! %IF DATA LEN= 1 %THEN HALFINTEGER(DATA AD)= SUM %C %ELSE INTEGER(DATA AD)= SUM ! %RESULT= 0 %END; !of TO INTEGER %EXTERNALINTEGERFN TO REAL (%INTEGER DATA AD , DATA LEN , %INTEGER TEXT ADDRESS , %INTEGER INT LEN , INT PTR , %INTEGER DEC LEN , DEC PTR , %INTEGER EXP LEN , EXP PTR , DECS , %INTEGER SCALE FACTOR , MODE ) ! ! ! ! ! THIS PROCEDURE CONVERTS A STRING OF CHARACTERS (which have been ! ! analysed syntactically) INTO A FLOATING POINT NUMBER. ! ! !The character string is assumed to be in an area addressed by TEXT !ADDRESS, and is defined by the set of parameters INT LEN, INT PTR, !DEC LEN, DEC PTR, EXP LEN, EXP PTR which identify the length and !start (relative to TEXT ADDRESS) of the characters: ! %C (a) before the decimal point %C (b) after the decimal point %C and (c) which make up the value of the exponent ! !Should any of these parts not exist in the number then the relevant !LEN (length) parameter will be set to zero. The parameter DECIMALS !defines the implied positioning of the decimal point should no decimal !point be specified: while the parameter SCALE FACTOR defines the !exponentiation to be applied to the result if an exponent was not !specified. The result is saved in the location defined by DATA AD and !DATA LEN which specify its address and length (in {16 bit} words) !respectively. ! ! !NOTE1: There are no embedded or trailing blanks !NOTE2: It is assumed that there are no leading spaces !NOTE3: The character string is assumed to represent a ! valid floating point number ! ! ! At Exit: RESULT= 0 if the constant was within range ! RESULT= 20 if the constant was out of range and MODE=1 ! RESULT=338 if the constant was out of range and MODE=2 ! RESULT=188 if the constant was out of range and MODE=3 !Compiler only RESULT= -1 if DATA LEN is too small for precision specified ! ! ! %CONSTSTRING(8) LARGEST POSSIBLE= "34028234" ! !---a representation, in ISO digits of ! the 8 most significant digits of ! the largest possible real value %INTEGER RESULT {of this routine if no fault was detected} ;!%C RESULT may take one of the values: ! %CONSTINTEGER NO COMMENT= 0 , {or} LOST SIGNIFICANCE= -1 ! ! Variables used to Address the Digits ! %BYTEINTEGERARRAYNAME TEXT %BYTEINTEGERARRAYFORMAT TEXT FORMAT (0:32767) %HALFINTEGER PTR {scanning ptr through TEXT } %HALFINTEGER MAX PTR { maximum value PTR may have} %INTEGER LEN ;!%C LEN is the actual number %C of significant digits in the TEXT ! ! Variables associated with the Scale of the Number ! {PERQC} %HALFINTEGER VAL SIZE; !scale of the leftmost significant digit {PERQC} %HALFINTEGER EXP ; !scale of the rightmost significant digit !{2900C}%INTEGER VAL SIZE,EXP %HALFINTEGER SIGN; ! sign of the value, either=A MINUS, or=A PLUS ! ! Variables used in Numeric Conversion ! %INTEGER MULT ; !scaling to be applied to the next digit %INTEGER SUM ; ! binary integer value of the digits bar scaling %INTEGER BASE10 %REAL X ; ! actual Real result %HALFINTEGER I {a utility variable} BASE10=10 TEXT== ARRAY(TEXT ADDRESS, TEXT FORMAT) ! !Initialise addressibility %UNLESS EXP LEN=NONE %THENSTART ! ! Examine the Exponent Specified ! %IF EXP LEN> 9 %THENSTART ! !Use the Integer Conversion Routine for Large Exponents ! I= TO INTEGER (ADDR(EXP),2,TEXT ADDRESS, EXP LEN,EXP PTR,0) %FINISHELSESTART ! ! Look for an Exponent Sign ! SIGN= TEXT(EXP PTR) %IF SIGN<'0' %THENSTART %IF SIGN='+' %THEN SIGN=A PLUS %C %ELSE SIGN=A MINUS ! EXP PTR=EXP PTR+1 EXP LEN=EXP LEN-1 %FINISH %ELSE SIGN=A PLUS ! ! Now Convert the Exponent into Binary ! EXP = 0 MULT=BASE10 ** ** (EXP LEN-1) %WHILE MULT> 0 %CYCLE ! EXP = EXP + (MULT * (TEXT(EXP PTR) - '0')) EXP PTR = EXP PTR + 1 MULT= MULT//10 %REPEAT EXP=-EXP %IF SIGN=A MINUS %FINISH %FINISHELSE EXP=-SCALE FACTOR {only if no exponent was specified} ! EXP=EXP-DECS %IF DEC LEN=0 !invoke implied decimal point if none was given ! ! ! Examine the Number ! ! SIGN=A PLUS {guess} ! %IF INT LEN>0 %THENSTART ! ! Look for a Numeric Sign ! SIGN= TEXT(INT PTR) %IF SIGN<'0' %THENSTART %IF SIGN='-' %THEN SIGN=A MINUS INT LEN=INT LEN-1 INT PTR=INT PTR+1 ! %FINISH %FINISH PTR= INT PTR; MAX PTR= PTR +INT LEN - 1 ! ! Ignore Leading and Trailing Zeros ! PTR= PTR+1 %WHILE MAX PTR>=PTR %AND TEXT(PTR)='0' !ignore any leading zeros MAX PTR=MAX PTR-1 %AND %C EXP= EXP+1 %WHILE MAX PTR>=PTR %AND TEXT(MAX PTR)='0' !ignore any trailing zeros ! ! Determine the Magnitude of the Value ! LEN=MAX PTR - (PTR-1) %IF LEN> 8 %THENSTART ! ! Ignore any digits which have no bearing on the result ! EXP= EXP + (LEN-8) LEN= 8 RESULT=LOST SIGNIFICANCE ! %FINISHELSE RESULT=NO COMMENT VAL SIZE=EXP + (LEN-1); !NOTE: LEN=number of significant digits ! ! EXP= scale of rightmost digit ! ! VAL SIZE= scale of leftmost digit %IF VAL SIZE> 37 %OR %C VAL SIZE<-36 %THEN -> FURTHER EXAMINATION !Jump if ! the value is around or beyond ! the capabilities of the code below FORM RESULT: ! ! ! Perform the Conversion ! ! %IF LEN<= 0 %THEN X=0.0 %C %ELSESTART ! ! Convert the Value First into an Integer ! SUM = 0 MULT=BASE10 ** ** (LEN-1) %WHILE MULT> 0 %CYCLE ! SUM = SUM + (MULT * (TEXT(PTR) - '0')) PTR = PTR + 1 MULT= MULT//10 %REPEAT ! !---Now Convert into a Real and Apply Scaling ! X= FLOATLONG(SUM) * 10.0 ** (EXP); %FINISH RETURN RESULT: {!assign the value to the variable} X=-X %IF SIGN=A MINUS ! REAL (DATA AD)= X %RESULT=RESULT FURTHER EXAMINATION: !required for very large or for very small ! values before conversion can be ! attempted ! %IF VAL SIZE< -37 %THEN -> VALUE TOO SMALL %IF VAL SIZE>= 38 %THENSTART %IF VAL SIZE = 38 %THENSTART ! ! Compare Digits with the Largest Possible Real ! -> VALUE TOO LARGE %C %IF COMPARE (LEN,TEXT ADDRESS,PTR, ADDR(LARGEST POSSIBLE),1)>0 %FINISHELSE %C {!} %C %IF LEN=0 %THEN -> VALUE TOO SMALL %C %ELSE -> VALUE TOO LARGE %FINISH %IF EXP< -37 %THENSTART ! ! Ignore digit which will have no effect on the Result ! LEN = LEN + (37+EXP) EXP = -37 %FINISH -> FORM RESULT ! ! HANDLE NUMBERS OUT OF THE PERMITTED RANGE ! VALUE TOO SMALL: X= 0.0 ; -> CHECK MODE VALUE TOO LARGE: X=LARGEST REAL; ! CHECK MODE : %IF MODE\=0 %THENRESULT=ERROR NO (MODE) !=> it is a fault -> RETURN RESULT ! ! ! %END; !of TO REAL %ENDOFFILE