Edinburgh IMP77 Compiler - Version 8.4 1 !!! %option stack=40 2 !! 17/1/78 3 {Modified 25-Feb-82 to run on new subsystem} 4 5 !!!! %CONTROL 1; ! CHECK SWITCHES ONLY 6 7 ! PASS 3 OF 7/32 IMP COMPILER - VERSION FOR MOUSES AND OS-32MT SUBSYSTEM 8 9 %CONSTINTEGER MAX PERM = 54 10 %CONSTINTEGERARRAY PERMS(1: 733) = %C 11+ X'0037',X'018E',X'019A',X'01A4',X'01B8',X'024B',X'01EE',X'01FB',X'01CF', 12+ X'0000',X'0084',X'00A3',X'00C6',X'0046',X'00DB',X'0000',X'0000',X'02C4', 13+ X'02B5',X'02A6',X'029E',X'0298',X'0292',X'0282',X'0210',X'003C',X'005E', 14+ X'0059',X'0218',X'0141',X'0184',X'0050',X'004B',X'0077',X'0070',X'0069', 15+ X'0063',X'007F',X'0041',X'0169',X'0220',X'0225',X'022A',X'022F',X'024E', 16+ X'0055',X'0057',X'0235',X'023A',X'023F',X'0245',X'016E',X'017A',X'026F', 17+ X'0004',X'2440',X'583D',X'0004',X'0303',X'0004',X'2441',X'583D',X'0004', 18+ X'0303',X'0004',X'2445',X'583D',X'0004',X'0303',X'0004',X'2442',X'583D', 19+ X'0004',X'0303',X'0004',X'2443',X'583D',X'0004',X'0303',X'0004',X'2444', 20+ X'583D',X'0004',X'0303',X'0001',X'0000',X'0001',X'0000',X'0004',X'2449', 21+ X'583D',X'0004',X'0303',X'0004',X'244A',X'583D',X'0004',X'0303',X'0005', 22+ X'246A',X'2445',X'583D',X'0004',X'0303',X'0006',X'0856',X'246A',X'2447', 23+ X'583D',X'0004',X'0303',X'0006',X'C860',X'0020',X'2445',X'583D',X'0004', 24+ X'0303',X'0007',X'0856',X'C860',X'0020',X'2447',X'583D',X'0004',X'0303', 25+ X'0004',X'2446',X'583D',X'0004',X'0303',X'001E',X'4801',X'0000',X'C500', 26+ X'8080',X'2135',X'2401',X'2410',X'8888',X'0001',X'9400',X'9330',X'1001', 27+ X'2188',X'D301',X'4300',X'0000',X'D202',X'4300',X'0000',X'2308',X'2731', 28+ X'4801',X'4300',X'0000',X'4002',X'4300',X'0000',X'2732',X'2217',X'0308', 29+ X'0022',X'4801',X'0000',X'C500',X'8080',X'2135',X'2401',X'2410',X'8888', 30+ X'0001',X'9400',X'9300',X'D352',X'0000',X'0865',X'0A62',X'0A50',X'C550', 31+ X'00FF',X'2325',X'2405',X'241C',X'8888',X'0001',X'D252',X'0000',X'2701', 32+ X'0218',X'2661',X'2611',X'D331',X'0000',X'D236',X'0000',X'2208',X'0014', 33+ X'0862',X'D301',X'0000',X'D352',X'0000',X'0B50',X'2318',X'0A05',X'2306', 34+ X'D336',X'0000',X'D431',X'0000',X'0238',X'2611',X'2661',X'2701',X'2218', 35+ X'0855',X'0308',X'005D',X'D0B7',X'0100',X'08B2',X'48D1',X'0000',X'C5D0', 36+ X'8080',X'2338',X'94DD',X'93DD',X'4802',X'0000',X'C500',X'8080',X'2135', 37+ X'2401',X'2410',X'8888',X'0001',X'9400',X'9300',X'0B0D',X'4210',X'8022', 38+ X'08CB',X'08E1',X'08FD',X'27F1',X'4210',X'801E',X'26C1',X'26E1',X'D33C', 39+ X'0000',X'D43E',X'0000',X'2239',X'26B1',X'2701',X'4300',X'FFDA',X'D1B7', 40+ X'0100',X'0801',X'0308',X'0866',X'2135',X'05B2',X'2037',X'4300',X'801C', 41+ X'083B',X'0B32',X'D236',X'0000',X'08CC',X'05BC',X'2338',X'2661',X'26C1', 42+ X'D336',X'0000',X'D23C',X'0000',X'2208',X'0855',X'2136',X'0800',X'4230', 43+ X'FFC6',X'4300',X'8022',X'0ABD',X'D302',X'0000',X'0A02',X'0830',X'0B3B', 44+ X'D235',X'0000',X'05B0',X'2338',X'26B1',X'2651',X'D335',X'0000',X'D23B', 45+ X'0000',X'2208',X'D1B7',X'0000',X'05DD',X'0308',X'0007',X'0827',X'C810', 46+ X'0100',X'9261',X'4012',X'0000',X'0308',X'0027',X'4836',X'0000',X'C530', 47+ X'8080',X'2135',X'2401',X'2410',X'8888',X'0001',X'9433',X'9333',X'0855', 48+ X'2328',X'5807',X'002C',X'0503',X'2124',X'0B05',X'2601',X'2315',X'2405', 49+ X'2419',X'8888',X'0001',X'C837',X'002C',X'0813',X'D203',X'0000',X'0A65', 50+ X'2701',X'0218',X'2631',X'D326',X'0000',X'D223',X'0000',X'2661',X'2208', 51+ X'0004',X'2448',X'583D',X'0004',X'0303',X'000B',X'6827',X'002C',X'5867', 52+ X'0030',X'5857',X'0034',X'C840',X'0016',X'583D',X'0004',X'0303',X'0009', 53+ X'6827',X'002C',X'5867',X'0030',X'C840',X'0017',X'583D',X'0004',X'0303', 54+ X'0009',X'5867',X'002C',X'5857',X'0030',X'C840',X'0015',X'583D',X'0004', 55+ X'0303',X'000B',X'0830',X'0A33',X'2734',X'0218',X'5801',X'4300',X'0000', 56+ X'5002',X'4300',X'0000',X'2208',X'0009',X'0830',X'0A33',X'2400',X'2734', 57+ X'0218',X'5002',X'4300',X'0000',X'2205',X'0013',X'0831',X'4932',X'0002', 58+ X'212B',X'4B32',X'0000',X'2118',X'0A33',X'7333',X'4200',X'0004',X'2333', 59+ X'0A3E',X'0233',X'0821',X'2405',X'2414',X'8888',X'0001',X'0016',X'5016', 60+ X'0008',X'5036',X'0004',X'5056',X'0000',X'CB35',X'FFFF',X'2125',X'2405', 61+ X'2416',X'8888',X'0001',X'1C21',X'1C05',X'2400',X'0B01',X'C813',X'0003', 62+ X'C410',X'FFFC',X'0308',X'001E',X'5073',X'0000',X'5103',X'0000',X'5063', 63+ X'0004',X'0827',X'0A71',X'583D',X'0000',X'C973',X'FE00',X'2327',X'0B71', 64+ X'0821',X'2402',X'2410',X'8888',X'0001',X'585E',X'0010',X'F550',X'8080', 65+ X'8080',X'0238',X'5051',X'42FF',X'FFFC',X'2714',X'2035',X'000C',X'0833', 66+ X'2316',X'0823',X'2405',X'241A',X'8888',X'0001',X'2411',X'2731',X'0218', 67+ X'1C02',X'2203',X'000D',X'2401',X'2F00',X'0801',X'2316',X'2D02',X'2820', 68+ X'2400',X'CB01',X'0001',X'0338',X'2C02',X'2701',X'2203',X'0002',X'0816', 69+ X'0308',X'0003',X'0816',X'0A15',X'0308',X'0007',X'C817',X'002C',X'C840', 70+ X'0011',X'583D',X'0004',X'0303',X'0007',X'C817',X'002C',X'C840',X'0012', 71+ X'583D',X'0004',X'0303',X'0004',X'244D',X'583D',X'0004',X'0303',X'0004', 72+ X'244E',X'583D',X'0004',X'0303',X'0004',X'244F',X'583D',X'0004',X'0303', 73+ X'0005',X'C840',X'0010',X'583D',X'0004',X'0303',X'0004',X'244B',X'583D', 74+ X'0004',X'0303',X'0004',X'244C',X'583D',X'0004',X'0303',X'0005',X'C840', 75+ X'0013',X'583D',X'0004',X'0303',X'0005',X'C840',X'0014',X'583D',X'0004', 76+ X'0303',X'0002',X'2F01',X'0308',X'0008',X'581D',X'0000',X'0B17',X'0318', 77+ X'2402',X'2410',X'8888',X'0001',X'000B',X'6807',X'002C',X'F810',X'4080', 78+ X'0000',X'5017',X'002C',X'6A07',X'002C',X'2E10',X'0308',X'0004',X'6807', 79+ X'002C',X'2E10',X'0308',X'0006',X'6807',X'002C',X'2E10',X'2F21',X'2B02', 80+ X'0308',X'0012',X'5817',X'002C',X'C460',X'000F',X'1164',X'C660',X'E101', 81+ X'4067',X'0000',X'2460',X'4067',X'0002',X'C860',X'0308',X'4067',X'0004', 82+ X'4307',X'0000',X'000F',X'0822',X'233A',X'0B10',X'0801',X'EE00',X'001F', 83+ X'1D02',X'2611',X'2113',X'0800',X'0338',X'2405',X'2411',X'8888',X'0001', 84+ X'0005',X'0338',X'2406',X'2411',X'8888',X'0001',X'0005',X'0348',X'2406', 85+ X'2411',X'8888',X'0001',X'0007',X'D401',X'0000',X'0388',X'2406',X'2411', 86+ X'8888',X'0001',X'000E',X'5912',X'0000',X'2117',X'5912',X'0004',X'2124', 87+ X'5C02',X'0008',X'0308',X'0821',X'2406',X'2412',X'8888',X'0001',X'000E', 88+ X'4A78',X'0000',X'580D',X'0000',X'C507',X'0200',X'4388',X'0002',X'4B78', 89+ X'0000',X'2402',X'2410',X'8888',X'0001',X'0019',X'0847',X'4A48',X'0000', 90+ X'4A78',X'0002',X'580D',X'0000',X'C507',X'0200',X'2387',X'4B78',X'0002', 91+ X'2402',X'2410',X'8888',X'0001',X'580E',X'0010',X'5004',X'0000',X'2644', 92+ X'0547',X'2224',X'4308',X'0004' 93 ! 94 ! FAULT MESSAGES 95 ! 1 - NO CODE REFS LEFT 96 ! 2 - TOO MANY LABELS 97 ! 3 - SPURIOUS PERM CALL 98 ! 4 - TOO MANY PATCHES 99 ! 5 - CORRUPT JUMP 100 ! 6 - CORRUPT PERM ROUTINE 101 ! 7 - PHASE ERROR 102 ! 8 - CORRUPT PERM ADDRESS 103 ! 9 - CODE INCOMPLETE 104 ! 10 - GLAP INCOMPLETE 105 ! 106 %CONSTINTEGER PSEUDO OBJ = 2, DIRECT = 3;! INPUT STREAMS 107 %CONSTINTEGER REPORT = 0, OBJECT = 2; ! OUTPUT 108 109 %CONSTINTEGERARRAY NOT(0:12) = 1,0,5,4,3,2,7,6,11,10,9,8,12 110 %CONSTINTEGERARRAY SB(0:12) = 111+ X'2230', X'2030', X'2010', X'2020', X'2220', X'2210', 112+ X'2230', X'2030', X'2020', X'2010', X'2210', X'2220', X'2200' 113 %CONSTINTEGERARRAY SF(0:12) = 114+ X'2330', X'2130', X'2110', X'2120', X'2320', X'2310', 115+ X'2330', X'2130', X'2120', X'2110', X'2310', X'2320', X'2300' 116 %CONSTINTEGERARRAY LJ(0:12) = 117+ X'433E', X'423E', X'421E', X'422E', X'432E', X'431E', 118+ X'433E', X'423E', X'422E', X'421E', X'431E', X'432E', X'430E' 119 %CONSTINTEGER MAX PATCH = 450 120 %CONSTINTEGER MAX JUMPS = 3000 121 %CONSTINTEGER MAX LABELS= 2000 122 %BEGIN 123 124 %RECORDFORMAT PFM(%INTEGER WHAT, WHERE) 125 %RECORDFORMAT LFM(%INTEGER LAB, CA) 126 ! LAB = MODE(3)+LABEL(12) 127 ! MODE= LONG+CONDITIONAL+PERM+RT 128 %RECORD(LFM)%ARRAY JUMP(1 : MAXJUMPS+1) 129 %RECORD(PFM)%ARRAY PATCH(1 : MAX PATCH) 130 %INTEGERARRAY LAB(0 : MAXLABELS) 131 %INTEGERARRAY LTEMP(0:9) 132 %INTEGERARRAY PEP, PADDR(1:MAX PERM) 133 %INTEGER CA, GA, LA, DA 134 %INTEGER LINE SIZE 135 %INTEGER CODE SIZE, GLA SIZE, LOAD SIZE, PERM SIZE, DIAG SIZE 136 %CONSTINTEGER EMARK = X'8888' 137 %CONSTINTEGER NEVER = X'7FFF' 138 %CONSTINTEGER LONG = X'800000' 139 %CONSTINTEGER COND = X'400000' 140 %CONSTINTEGER PERM = X'200000' 141 %CONSTINTEGER RT = X'100000' 142 %CONSTINTEGER VERY = X'080000' 143 %CONSTINTEGER LABEL= X'FFFF' 144 %OWNINTEGER MAX LABEL = 1 145 %OWNINTEGER INIT GLA = 0 146 %INTEGER REF EXTRA, IGNORE, FLAG 147 %INTEGER REFS, CURRENT LINE 148 %INTEGER J,K,L,z 149 %INTEGER CP, GP, CODE, TAG, EXTRA 150 %RECORD(PFM)%NAME PAT 151 %INTEGER CTAG, CCA, UCA, DEFMOD, LAST 152 %INTEGER MODE, CADDR, CVAL, GADDR, GVAL 153 %SWITCH D(1:8), C(2:11) 154 %RECORD(LFM)%NAME UREF, CREF 155 %RECORD(LFM)%NAME R,B 156 %INTEGERNAME V 157 %INTEGER PHASE 158 %INTEGER RX1,RX2,RX3,SJ; RX1=0; RX2=0; RX3=0; SJ=0 159 %INTEGER RTNCALLS, PERMCALLS; RTNCALLS=0; PERMCALLS=0 160 ! 161 ! 162 ! 163 %SHORTINTEGER CBP, GBP, LBP, DBP, TBP 164 165 ! N.B. 'GLABUFFSIZE' MUST BE A POWER OF 2 -- SEE LINE 562 ISH 166 %CONSTINTEGER CODEBUFFSIZE=200, GLABUFFSIZE=256, LD BUFF SIZE=200 167 %CONSTINTEGER DIAG BUFF SIZE = 256 168 %SHORTINTEGERARRAY TBUFF,DBUFF(1:DIAG BUFF SIZE) 169 %SHORTINTEGERARRAY CBUFF(1:CODE BUFFSIZE), GBUFF(1:GLA BUFFSIZE) 170 %SHORTINTEGERARRAY LBUFF(1:LD BUFFSIZE); ! ... LD = 'LOADER DATA' 171 ! 172 ! -------OBJECT BLOCK TYPE CODES------- 173 %CONSTINTEGER END OF FILE BLOCK = 0 174 %CONSTINTEGER NONDIAG CODE BLOCK = 1 175 %CONSTINTEGER DIAG CODE BLOCK = 2 176 %CONSTINTEGER STATIC DATA BLOCK = 3; ! ...'GLA' IN IMP CONTEXT 177 %CONSTINTEGER DIAGS DATA BLOCK = 4 178 %CONSTINTEGER DIAG TABLE = 5 179 %CONSTINTEGER ENTRY POINT BLOCK = 6 180 %CONSTINTEGER EXTERNAL REF BLOCK = 7 181 %CONSTINTEGER SEGMENT SIZE BLOCK = 15 182 ! 183 %ROUTINE GET(%INTEGERNAME N) 184 %INTEGER S 185 READSYMBOL(N); READSYMBOL(S) 186 N = N<<8!S 187 %END 188 ! 189 %ROUTINE PUT HALF(%SHORTINTEGER N) 190 PRINT SYMBOL((N>>8)&255) 191 PRINT SYMBOL(N&255) 192 %END 193 ! 194 %ROUTINE PUT BLOCK(%SHORTINTEGER HEADER, %SHORTINTEGERARRAYNAME BLOCK) 195 %SHORTINTEGER I,J 196 PUT HALF(HEADER) 197 %CYCLE I = 1,1,(HEADER>>4)&X'0FFF'; ! ...EXTRACT LENGTH 198 J = BLOCK(I) 199 HEADER = HEADER+J; ! ...ACCUMULATE CHECKSUM 200 PUT HALF(J) 201 %REPEAT 202 PUT HALF(-HEADER-1); ! ...CHECKSUM 203 %END 204 ! 205 %ROUTINE COPY BLOCK(%SHORTINTEGER HEADER) 206 %SHORTINTEGER I; %INTEGER N 207 PUT HALF(HEADER) 208 %CYCLE I = 1,1,(HEADER>>4)&X'0FFF' 209 GET(N); HEADER = HEADER+N 210 PUT HALF(N) 211 %REPEAT 212 PUT HALF(-HEADER-1) 213 %END 214 %ROUTINE CFLUSH 215 ! OUTPUT BUFFER IF THERE IS ANYTHING IN IT -- OTHERWISE JUST 216 ! INITIALISE. BUFFER IS EMPTY IF CBP=1 217 PUT BLOCK( (CBP<<4)!DIAG CODE BLOCK, CBUFF ) %IF CBP # 1 218 CBP = 1; CBUFF(1) = CURRENT LINE 219 %END 220 ! 221 %ROUTINE GFLUSH 222 PUT BLOCK( (GBP<<4)!STATIC DATA BLOCK, GBUFF) %UNLESS GBP = 0 223 GBP = 0 224 %END 225 ! 226 %ROUTINE LFLUSH 227 PUT BLOCK( (LBP<<4)!EXTERNAL REF BLOCK, LBUFF) %IF LBP # 0 228 LBP = 0 229 %END 230 ! 231 %ROUTINE DFLUSH 232 %RETURN %IF DBP = 0 233 PUT BLOCK(DBP<<4+DIAGS DATA BLOCK, DBUFF) 234 DBP = 0 235 %END 236 %ROUTINE T FLUSH 237 PUT BLOCK((TBP<<4)!DIAG TABLE, T BUFF) %UNLESS TBP = 0 238 TBP = 0 239 %END 240 %ROUTINE CPUT(%SHORTINTEGER N) 241 CBP = CBP+1; CBUFF(CBP) = N 242 CA = CA+2 243 %END 244 ! 245 %ROUTINE GPUT(%SHORTINTEGER N) 246 GFLUSH %IF GBP = GLA BUFF SIZE 247 GBP = GBP+1; GBUFF(GBP) = N 248 GA = GA+2 249 %END 250 ! 251 %ROUTINE LPUT(%SHORTINTEGER N) 252 LFLUSH %IF LBP = LD BUFFSIZE 253 LBP = LBP+1; LBUFF(LBP) = N 254 LA = LA+2 255 %END 256 ! 257 %ROUTINE LSYM(%SHORTINTEGER N) 258 %OWNINTEGER FLAG,V 259 FLAG = \FLAG 260 %IF FLAG = 0 %START 261 LPUT(N<<8+V) 262 %ELSE 263 V = N 264 %FINISH 265 %END 266 ! 267 %ROUTINE DPUT(%SHORTINTEGER N) 268 DBP = DBP+1; DBUFF(DBP) = N 269 DFLUSH %IF DBP = DIAG BUFF SIZE 270 DA = DA+2 271 %END 272 %ROUTINE DIAG LINE 273 %OWNINTEGER HERE = 0 274 %RETURN %IF HERE = CURRENT LINE 275 HERE = CURRENT LINE 276 DPUT(CURRENT LINE); DPUT(CA) 277 %END 278 %ROUTINE T PUT(%SHORTINTEGER V) 279 TBP = TBP+1; TBUFF(TBP) = V 280 T FLUSH %IF TBP = DIAG BUFF SIZE 281 %END 282 %ROUTINE CLOSE OBJECT FILE 283 CFLUSH; GFLUSH; LFLUSH 284 DPUT(0); DPUT(0); D FLUSH ; ! ... MARK END OF TABLE THEN FLUSH 285 TPUT(X'8800'); TPUT(CA+2) 286 TPUT(0); TPUT(0) 287 TPUT(0); TPUT(0) 288 TPUT(0); TPUT(0); T FLUSH; ! .... DITTO .... 289 PUT HALF( (0<<4)!END OF FILE BLOCK ); ! ...ZERO DATA CONTENT 290 PUT HALF(-END OF FILE BLOCK-1); ! ...CHECK SUM 291 %END 292 ! 293 ! 294 ! 295 ! 296 ! 297 %ROUTINE MONITOR(%INTEGER N) 298 SELECTOUTPUT(REPORT) 299 PRINTSTRING("FAULT"); WRITE(N, 1) 300 PRINTSTRING(" PHASE"); WRITE(PHASE, 1); NEWLINE 301 WRITE(REFS, 1); PRINTSTRING(" REFS"); NEWLINE 302 PRINTSTRING("MAX LABEL"); WRITE(MAX LABEL, 1); NEWLINE 303 %SIGNAL 15,15 304 %END 305 ! 306 %ROUTINE SORT(%INTEGER FROM, TO) 307 %INTEGER FLAG, J, T 308 %RECORD(PFM)%NAME A, B 309 %WHILE TO > FROM %CYCLE 310 FLAG = 0 311 A == PATCH(FROM) 312 %CYCLE J = FROM+1, 1, TO 313 B == PATCH(J) 314 %IF A_WHERE > B_WHERE %START 315 T = A_WHERE; A_WHERE = B_WHERE; B_WHERE = T 316 T = B_WHAT; B_WHAT = A_WHAT; A_WHAT = T 317 FLAG = 1 318 %ELSE %IF A_WHERE = B_WHERE 319 FLAG = 1 320 A_WHERE = -10 321 %FINISH 322 A == B 323 %REPEAT 324 %EXIT %IF FLAG = 0 325 TO = TO-1 326 %REPEAT 327 %END 328 %ROUTINE NEXT CODE 329 %OWNINTEGER P = 1, J = 1 330 %INTEGER C, BV 331 %RECORD(PFM)%NAME PP 332 C = NEVER; BV = NEVER; MODE = NEVER 333 %IF P <= CP %START;! CODE PATCHES LEFT 334 %CYCLE 335 PP == PATCH(P) 336 %EXIT %IF PP_WHERE # -10 337 P = P+1 338 %REPEAT 339 C = PP_WHERE>>1 340 %FINISH 341 %IF J < REFS %START;! JUMPS LEFT 342 B == JUMP(J) 343 BV = B_CA>>1 344 %FINISH 345 CADDR = NEVER 346 %RETURN %IF BV = NEVER = C 347 %IF BV > C %START 348 P = P+1 349 CADDR = PP_WHERE; CVAL = PP_WHAT 350 %RETURN 351 %FINISH 352 %IF C > BV %START 353 J = J+1 354 MODE = 0; CADDR = B_CA 355 %RETURN 356 %FINISH 357 MONITOR(1) 358 %END 359 %ROUTINE NEXT GLA 360 GADDR = NEVER %AND %RETURN %IF GP > MAX PATCH 361 PAT == PATCH(GP) %AND GP = GP+1 %UNTIL PAT_WHERE >= 0 362 GADDR = PAT_WHERE; GVAL = PAT_WHAT 363 %END 364 %ROUTINE SET PERM(%INTEGER N) 365 %INTEGER J,K 366 %RETURN %UNLESS PEP(N) = 1 367 PEP(N) = 2 368 K = PERMS(N) 369 %IF K = 0 %START 370 SELECTOUTPUT(REPORT) 371 PRINTSTRING("NO ENTRY FOR PERM"); WRITE(N, 1); NEWLINE 372 PEP(N) = 0 373 SELECTOUTPUT(OBJECT) 374 %RETURN 375 %FINISH 376 %CYCLE J = 1, 1, PERMS(K) 377 K = K+1 378 %IF PERMS(K) = EMARK %START 379 N = PERMS(K+1) 380 %IF PEP(N) # 2 %START 381 PEP(N) = 1; SET PERM(N) 382 %FINISH 383 %FINISH 384 %REPEAT 385 %END 386 387 %ROUTINE PLANT LONG JUMP 388 %INTEGER N 389 ! PLANT A BRANCH OR BAL INSTRUCTION WHICH IS ASSUMED TO BE DESCRIBED 390 ! BY 'L'(OP CODE + BASE REG), 'TAG'(DESTINATION ADDRESS), 391 ! 'B'(NAME OF RECORD CONTAINING FLAG BITS) AND 'CA'(CURRENT CODE 392 ! ADDRESS). 393 %IF B_LAB&VERY = 0 %START; ! ...CAN USE A 32 BIT FORM 394 N = TAG-(CA+4) 395 %IF -16*1024 <= N < 16*1024 %START; ! USE PC RELATIVE 396 L = L&X'FFF0'; ! STRIP OFF BASE REGISTER 397 CPUT(L); CPUT(N!X'8000' ) 398 RX2 = RX2+1 399 %ELSE; !USE BASE+DISP 400 CPUT(L); CPUT(TAG) 401 RX1 = RX1+1 402 %FINISH 403 %ELSE; ! ...48 BIT ADDRESS REQ'D 404 CPUT(L) 405 CPUT((TAG>>16&X'FF')+X'4000') 406 CPUT(TAG); ! ...N.B. 'CPUT' ONLY PUTS 16 BITS 407 RX3 = RX3+1 408 %FINISH 409 %END 410 411 412 413 ! 414 ! PHASE 1 - INPUT PROGRAM & GENERATE JUMP TABLES + PATCH TABLES 415 ! 416 PHASE = 1 417 PEP(J) = 0 %AND PADDR(J) = 0 %FOR J = 1, 1, MAX PERM 418 CP = 0; GP = MAX PATCH+1 419 REFS = 0; DEFMOD = 0; UCA = 0; CCA = 0; CTAG = 0 420 LAB(J) = 0 %FOR J = 1,1,MAX LABELS 421 SELECTINPUT(DIRECT) 422 READ SYMBOL(INIT GLA); ! MINIMUM POSSIBLE SIZE OF GLA - FROM PASS 2 423 %CYCLE 424 READSYMBOL(CODE); ->D(CODE) 425 D(1):! TAG DEF , 426 GET(TAG); GET(CA) 427 MONITOR(2) %IF TAG > MAX LABELS 428 MAX LABEL = TAG %IF TAG > MAX LABEL 429 %IF TAG = CTAG %AND CCA = CA %AND UCA = CA %START 430 DEFMOD = DEFMOD+2 431 UREF_LAB = UREF_LAB!PERM!COND 432 CREF_LAB = CREF_LAB!VERY!RT 433 CTAG = UREF_LAB&LABEL 434 CREF == UREF 435 CCA = CA+2 436 %ELSE 437 CTAG = 0 438 %FINISH 439 LAB(TAG) = CA 440 %CONTINUE 441 D(2):! CREF , 442 FLAG = COND; ->CURP 443 D(3):! UREF , 444 FLAG = 0; ->CURP 445 D(4):! RREF , 446 FLAG = RT+LONG 447 RTNCALLS = RTNCALLS+1 448 -> CURP 449 450 D(5):! PREF , 451 FLAG = PERM+LONG 452 PERMCALLS = PERMCALLS+1 453 454 CURP: GET(TAG); GET(CA) 455 REFS = REFS+1; R == JUMP(REFS) 456 MONITOR(1) %IF REFS > MAX JUMPS 457 R_LAB = TAG+FLAG 458 R_CA = CA 459 %IF FLAG = 0 %START; ! UNCONDITIONAL 460 UCA = CA+2; UREF == R 461 %ELSE %IF FLAG = COND; ! CONDITIONAL 462 CCA = CA+4; CTAG = TAG; CREF == R 463 %FINISH 464 %IF FLAG&PERM # 0 %START 465 %IF TAG > MAX PERM %OR PERMS(TAG) = 0 %START 466 SELECTOUTPUT(REPORT) 467 PRINTSTRING("NO PERM"); WRITE(TAG, 1); NEWLINE 468 SELECTOUTPUT(OBJECT) 469 %ELSE 470 PEP(TAG) = 1 471 %FINISH 472 %FINISH 473 %CONTINUE 474 D(6):! GPATCH , 475 GP = GP-1; PAT == PATCH(GP); ->PWW 476 D(7):! CPATCH , 477 CP = CP+1; PAT == PATCH(CP) 478 PWW: GET(TAG); GET(CA) 479 PAT_WHAT = TAG; PAT_WHERE = CA 480 MONITOR(4) %IF CP = GP 481 %REPEAT 482 D(8):! END MARKER 483 GET(CODE SIZE); GET(GLA SIZE); GET(LINE SIZE); GET(DIAG SIZE) 484 CODE SIZE = CODE SIZE-DEF MOD 485 REFS = REFS+1; JUMP(REFS) = 0 486 %IF DEF MOD # 0 %START 487 REF EXTRA = 0 488 %CYCLE L = 1, 1, REFS-1 489 R == JUMP (L) 490 R_CA = R_CA-REF EXTRA 491 %IF R_LAB&COND # 0 %AND R_LAB&RT # 0 %START 492 REF EXTRA = REF EXTRA+2 493 %CYCLE K = 1, 1, CP 494 PAT == PATCH(K) 495 PAT_WHERE = PAT_WHERE-2 %IF PAT_WHERE > R_CA 496 %REPEAT 497 %IF GP <= MAX PATCH %START 498 %CYCLE K = GP, 1, MAX PATCH 499 PAT == PATCH(K) 500 PAT_WHAT = PAT_WHAT-2 %IF PAT_WHAT > R_CA 501 PAT_WHERE = PAT_WHERE-2 %IF PAT_WHERE&1 # 0 %AND %C 502+ PAT_WHERE > R_CA 503 %REPEAT 504 %FINISH 505 %CYCLE K = 1, 1, MAX LABEL 506 LAB(K) = LAB(K)-2 %IF LAB(K) > R_CA 507 %REPEAT 508 DEFMOD = DEFMOD-2 509 %FINISH 510 %REPEAT 511 MONITOR(5) %IF DEFMOD # 0 512 %FINISH 513 514 515 ! IDENTIFY THOSE PERM ROUTINES WHICH ARE REQUIRED. 516 PERM SIZE = 0 517 SET PERM(J) %FOR J = 1,1,MAX PERM 518 %CYCLE J = 1,1,MAX PERM 519 %IF PEP(J) # 0 %START 520 PADDR(J) = CODE SIZE 521 L = PERMS(PERMS(J))*2 522 CODE SIZE = CODE SIZE + L 523 PERM SIZE = PERM SIZE + L 524 %FINISH 525 %REPEAT 526 527 528 ! PHASE 2 - IDENTIFY LONG JUMPS 529 ! 530 PHASE = 2 531 %IF REFS > 1 %START 532 %CYCLE 533 FLAG = 0; REF EXTRA = 0 534 %CYCLE L = 1, 1, REFS-1 535 R == JUMP(L);! JUMP REFERENCE 536 R_CA = R_CA+REF EXTRA 537 %CONTINUE %IF R_LAB&VERY # 0;! ALREADY VERY LONG 538 EXTRA = 0 539 J = R_LAB&LABEL 540 %IF R_LAB&PERM = 0 %OR R_LAB&COND # 0 %C 541+ %THEN K = LAB(J) %ELSE K = PADDR(J) 542 %UNLESS -30 <= K-R_CA <= 30 %START; ! ...CAN'T BE SHORT 543 %IF R_LAB&LONG=0 %START; ! ...BUT IT IS... 544 %IF K < 16*1024 %OR -16*1024<=K-(R_CA+4)<16*1024 %START 545 ! 32 BIT FORM: BASE+DISPLACEMENT OR PC RELATIVE 546 EXTRA = 2; R_LAB = R_LAB!LONG; ! SHORT -> LONG 547 %ELSE 548 ! 48 BIT FORM REQ'D: BASE+DISP 549 EXTRA = 4; R_LAB = R_LAB!VERY; ! SHORT -> VERY 550 %FINISH 551 %ELSE 552 %UNLESS K<16*1024 %OR -16*1024<=K-(R_CA+4)<16*1024 %START 553 EXTRA = 2; R_LAB = R_LAB!!(LONG!VERY); ! LONG -> VERY 554 %FINISH 555 %FINISH 556 %CONTINUE %IF EXTRA = 0; ! ...NO CHANGES REQ'D 557 FLAG = 1 558 ! ADJUST PATCHES 559 %IF CP > 0 %START 560 %CYCLE K = 1, 1, CP 561 PAT == PATCH(K) 562 PAT_WHERE = PAT_WHERE+EXTRA %IF PAT_WHERE > R_CA 563 %REPEAT 564 %FINISH 565 %IF GP <= MAX PATCH %START 566 %CYCLE K = GP, 1, MAX PATCH 567 PAT == PATCH(K) 568 PAT_WHAT = PAT_WHAT+EXTRA %IF PAT_WHAT > R_CA 569 %REPEAT 570 %FINISH 571 ! ADJUST REMAINING REFS 572 %CYCLE K = 1, 1, MAX LABEL 573 V == LAB(K) 574 V = V+EXTRA %IF V > R_CA 575 %REPEAT 576 %CYCLE K = 1, 1, MAX PERM 577 PADDR(K) = PADDR(K)+EXTRA %IF PADDR(K) # 0 578 %REPEAT 579 REF EXTRA = REF EXTRA+EXTRA 580 CODE SIZE = CODE SIZE+EXTRA 581 %FINISH 582 %REPEAT 583 %REPEAT %until flag = 0 584 %FINISH 585 ! 586 ! PHASE 3 - GENERATE OBJECT FILE 587 ! 588 PHASE = 3 589 J = MAX PATCH+1; K = J 590 %WHILE J > GP %CYCLE 591 J = J-1 592 PAT == PATCH(J) 593 %IF PAT_WHERE&1 # 0 %START 594 PAT_WHERE = PAT_WHERE&(\1) 595 CP = CP+1; PATCH(CP) = PAT 596 %ELSE 597 K = K-1; PATCH(K) = PAT 598 %FINISH 599 %REPEAT 600 GP = K 601 SORT(1, CP) 602 SORT(GP, MAX PATCH) 603 ! 604 ! 605 SELECT OUTPUT(OBJECT); PUT HALF(X'8282') 606 ! 607 ! OUTPUT A CONTROL BLOCK GIVING CODE AND GLA SEGMENT SIZES(IN 608 ! HALF-WORDS). OTHER PARAMETERS MAY BE ADDED AS REQ'D. 609 ! USES 'GBUFF' AS WORKSPACE. 610 GBUFF(1) = (CODE SIZE + 1)>>1 611 GBUFF(2) = (GLA SIZE + 1)>>1 612 GBUFF(3) = (DIAG SIZE+16)>>1; ! ... +16 FOR EXTRA WORD AS TERMINATOR 613 GBUFF(4) = (LINE SIZE+16)>>1 614 ! -------REQUIRES LOADER DATA SIZE----------- 615 PUT BLOCK((4<<4)!SEGMENT SIZE BLOCK,GBUFF) 616 ! 617 SELECT INPUT(PSEUDO OBJ) 618 CA = 0; GA = INITGLA; LA = 0; DA = 0 619 CURRENT LINE = 0; CBP = 1; CFLUSH 620 GBP = INIT GLA>>1; LBP = 0; DBP = 0; TBP = 0 621 NEXT CODE; NEXT GLA 622 623 READSYMBOL(CODE);! = 1 624 IGNORE = 0; LAST = 0 625 %CYCLE 626 READ SYMBOL(CODE); -> C(CODE+IGNORE) 627 C(2):! CODE 628 GET(L) 629 %IF CA = CADDR %START 630 %IF MODE # 0 %START;! CODE PATCH 631 CPUT(CVAL) 632 %ELSE;! JUMP+PERM+RT 633 TAG = LAB(B_LAB&LABEL) 634 %IF B_LAB&(PERM!RT) = 0 %OR B_LAB&COND # 0 %START;! JUMP 635 %IF B_LAB&(PERM!RT) # 0 %START 636 %IF B_LAB&RT # 0 %START 637 LAST = L %IF LAST = 0 638 LAST = NOT(LAST&15)!X'8000' 639 NEXT CODE 640 %CONTINUE 641 %FINISH 642 L = LAST; LAST = 0 643 %FINISH 644 L = L&15 645 %IF B_LAB&(LONG!VERY) = 0 %START;! LEAVE IT SHORT 646 J = (TAG-CA)//2 647 MONITOR(5) %UNLESS -15 <= J <= 15 648 %IF J < 0 %THEN CPUT(SB(L)-J) %C 649+ %ELSE CPUT(SF(L)+J) 650 SJ = SJ+1 651 %ELSE; ! MAKE IT LONG 652 L = LJ(L); PLANT LONG JUMP 653 %FINISH 654 %ELSE;! PERM OR ROUTINE 655 DIAG LINE 656 IGNORE = 5 657 TAG = PADDR(B_LAB&LABEL) %IF B_LAB&PERM # 0 658 PLANT LONG JUMP 659 %FINISH 660 %FINISH 661 NEXT CODE 662 %FINISH %ELSE CPUT(L) 663 %CONTINUE 664 C(11):GET(J) 665 %IF J = X'FFFF' %START 666 GET(J) 667 TPUT(X'4000'); TPUT(CA) 668 %CONTINUE 669 %FINISH 670 TPUT(J) 671 GET(K) 672 K = CA %IF J&X'8000' # 0 673 TPUT(K) 674 GET(K); TPUT(K) 675 GET(K); TPUT(K) 676 GET(K); TPUT(K) 677 GET(K); TPUT(K) 678 %CONTINUE 679 C(10): DIAG LINE; %CONTINUE 680 C(4): 681 C(9):CURRENT LINE = CURRENT LINE+1; CFLUSH 682 %CONTINUE;! LINE FLAG 683 C(7):IGNORE = 0; GET(L); %CONTINUE 684 C(6):L = NL 685 J = 0 686 %CYCLE K = 1, 1, 9 687 %IF L # 0 %START 688 READSYMBOL(L) 689 J = J+1; LTEMP(J) = L 690 %FINISH 691 %REPEAT 692 READSYMBOL(L) %WHILE L # 0 693 J = J-1; LTEMP(0) = J 694 LSYM(LTEMP(J)) %FOR J = 0, 1, 8 695 GET(K); READSYMBOL(L) 696 LSYM(L); LPUT(K) 697 %CONTINUE 698 C(8): 699 C(3):! GLA -- SWITCH VECTOR ELEMENT 700 GET(L) 701 %IF GA = GADDR %START 702 L = GVAL 703 NEXT GLA 704 %FINISH 705 GPUT(L) 706 %REPEAT 707 C(5):! END 708 %CYCLE J = 1, 1, MAX PERM 709 %IF PEP(J) # 0 %START 710 K = PERMS(J); MONITOR(6) %IF K = 0 711 L = PADDR(J) 712 MONITOR(7) %IF CA # L 713 CFLUSH %IF CBP+PERMS(K) > CODE BUFF SIZE 714 { %CYCLE L = K+1, 1, K+PERMS(K) L is corrupted below!! } 715 l = k; z = k + perms(k) 716 %while l # z %cycle 717 l = l+1 718 TAG = PERMS(L) 719 %IF TAG = EMARK %START 720 ! USE PC RELATIVE UNCONDITIONAL BRANCH FOR INTERNAL 721 ! LINKING BETWEEN PERM ROUTINES. 722 CPUT(X'4300') 723 L = L+1; CPUT((PADDR(PERMS(L))-CA-2)!X'8000') 724 %ELSE 725 CPUT(TAG) 726 %FINISH 727 %REPEAT 728 %FINISH 729 %REPEAT 730 ! 731 CLOSE OBJECT FILE 732 ! 733 MONITOR(9) %UNLESS CADDR = NEVER 734 MONITOR(10) %UNLESS GADDR = NEVER 735 SELECTOUTPUT(REPORT) 736 DA = DA+DIAG SIZE 737 PRINTSTRING("CODE"); WRITE(CODE SIZE-PERM SIZE, 1) 738 PRINTSTRING(" + GLA"); WRITE(GLA SIZE, 1) 739 PRINTSTRING(" + PERM"); WRITE(PERM SIZE, 1) 740 PRINTSTRING(" + DIAGS"); WRITE(DA, 1) 741 PRINTSTRING(" =") 742 WRITE(CODE SIZE+GLA SIZE+DA, 1) 743 PRINTSTRING(" BYTES") 744 NEWLINE 745 746 747 !%ENDOFPROGRAM; !**REMOVE FOR EXTRA MONITORING** 748 749 ! ------TEMPORARY EXTRA MONITORING------- 750 NEWLINE 751 PRINT STRING("JUMPS:") 752 WRITE(SJ,1); PRINT STRING(" SHORT,") 753 WRITE(RX1,1); PRINT STRING(" RX1,") 754 WRITE(RX2,1); PRINT STRING(" RX2,") 755 WRITE(RX3,1); PRINT STRING(" RX3") 756 NEWLINE 757 PRINT STRING("...INCLUDING") 758 WRITE(PERMCALLS,1); PRINT STRING(" PERMCALLS AND") 759 WRITE(RTNCALLS,1); PRINT STRING(" CALLS ON USER-DEFINED ROUTINES") 760 NEWLINES(2) 761 %ENDOFPROGRAM ?COPYBLOCK unused ?ENTRYPOINTBLOCK unused ?NONDIAGCODEBLOCK unused ?LOADSIZE unused 678 Statements compiled