| 1 | /OS8 FORTRAN II COMPILER OVERLAY V5 ***FPATCH.05*** |
| 2 | / |
| 3 | / |
| 4 | / |
| 5 | / |
| 6 | / |
| 7 | / |
| 8 | / |
| 9 | // |
| 10 | / |
| 11 | / |
| 12 | / |
| 13 | / |
| 14 | /COPYRIGHT (C) 1974, 1975 |
| 15 | /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. |
| 16 | / |
| 17 | / |
| 18 | / |
| 19 | /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A |
| 20 | /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- |
| 21 | /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER |
| 22 | /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE |
| 23 | /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO |
| 24 | /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE |
| 25 | /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. |
| 26 | / |
| 27 | / |
| 28 | /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT |
| 29 | /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL |
| 30 | /EQUIPMRNT COROPATION. |
| 31 | / |
| 32 | /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS |
| 33 | /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. |
| 34 | / |
| 35 | / |
| 36 | / |
| 37 | / |
| 38 | / |
| 39 | / |
| 40 | \f/ |
| 41 | /FIXES TO FPATCH FOR V4 J.K. 1975 |
| 42 | / |
| 43 | / .CHANGED USE OF 17645 SO /N CAN BE PASSED TO LOADER |
| 44 | / BIT 0 OF 17645 INDICATES THAT SABR WAS CHAINED |
| 45 | / TO FORM FORT INSTEAD OF WHOLE WORD |
| 46 | / |
| 47 | / .VERSION NUMBER VIA /V--OPTION |
| 48 | / WILL BE PASSED ONTO SABR |
| 49 | / |
| 50 | / |
| 51 | / |
| 52 | FIELD 0 |
| 53 | JSBITS=7746 |
| 54 | MOFILE=7600 |
| 55 | MPARAM=7643 |
| 56 | LLUNCH=7001 /TAKE OUT WHEN MERGING WITH COMPILER |
| 57 | DO=7173 /" |
| 58 | ELIST=1162 /" |
| 59 | EMSG1=1270 /" |
| 60 | EMSG14=1520 /" |
| 61 | FLST=242 /" |
| 62 | FORST=5362 /" |
| 63 | FPROP=144 /" |
| 64 | GOOON=5455 /" |
| 65 | KOUNT=113 /" |
| 66 | LPTRIN=545 /" |
| 67 | LPUNCH=5333 /" |
| 68 | LTTYPE=3372 /" |
| 69 | L75=75 /" |
| 70 | OSTOP=4052 /" |
| 71 | XFINI=5354 /" |
| 72 | \f *200 |
| 73 | START, CLA CMA |
| 74 | DCA FCHFLG |
| 75 | CIF 10 |
| 76 | JMS I (7700 |
| 77 | 10 /ESCAPE |
| 78 | ISZ FCHFLG |
| 79 | JMP .+5 |
| 80 | CIF 10 |
| 81 | JMS I (200 |
| 82 | 5 /COMMAND DECODE |
| 83 | 0624 /.FT ASSUMED EXTENSION |
| 84 | CDF 10 |
| 85 | TAD I (MPARAM+1 |
| 86 | CDF 0 |
| 87 | AND (4 |
| 88 | SZA CLA |
| 89 | JMS VERNUM |
| 90 | CLA IAC |
| 91 | CIF 10 |
| 92 | JMS I (200 |
| 93 | 4 /CLOSE OPERATOR USED AS DELETE |
| 94 | OUSNAME /DELETE FORTRN.TM IF IT EXISTS |
| 95 | 0 |
| 96 | CLA /IT DIDN'T EXIST |
| 97 | CLA IAC /ENTER A FILE ON "SYS" - MAXIMUM SIZE |
| 98 | CIF 10 |
| 99 | JMS I (200 |
| 100 | 3 /ENTER |
| 101 | OUSREC, OUSNAME |
| 102 | HOLSIZ, 0 |
| 103 | JMP I (OUERR /WHATS GOING ON HERE? |
| 104 | CLA IAC /DEVICE "SYS" |
| 105 | CIF 10 |
| 106 | JMS I (200 |
| 107 | 2 |
| 108 | PTSABR, SABR |
| 109 | FCHFLG, 0 /USELESS LENGTH WORD |
| 110 | JMP I (BIGGIE |
| 111 | TAD PTSABR |
| 112 | DCA I (CLSABR |
| 113 | TAD OUSREC |
| 114 | DCA I (OUTREC |
| 115 | TAD HOLSIZ |
| 116 | DCA I (OURCNT |
| 117 | TAD (1000 |
| 118 | TAD I (JSBITS |
| 119 | DCA I (JSBITS /SET "UNSTARTABLE" STATUS BIT |
| 120 | JMS I (FNEWF /INITIALIZE FIRST INPUT FILE WHILE I/O MON IS IN CORE |
| 121 | CDF 10 |
| 122 | TAD OUSREC |
| 123 | DCA I (7620 |
| 124 | CLA IAC |
| 125 | DCA I (7617 |
| 126 | CLA CLL CML RTL |
| 127 | AND I (MPARAM |
| 128 | TAD I (MOFILE+5 |
| 129 | SNA CLA |
| 130 | DCA I (FLST |
| 131 | TAD I (7600 |
| 132 | SNA CLA |
| 133 | TAD I (MPARAM |
| 134 | AND (41 |
| 135 | SNA CLA /DID HE SPECIFY A "L" OR "G" OPTION WITHOUT A |
| 136 | JMP FCDF0-3 /RELOCATABLE OUTPUT FILE? |
| 137 | FTADNM, TAD BDFALT /YES - GIVE HIM ONE |
| 138 | DCA I B7600 /NAMED "FORTRL.TM" |
| 139 | ISZ FTADNM |
| 140 | ISZ B7600 |
| 141 | ISZ B7773 |
| 142 | JMP FTADNM |
| 143 | CLA CLL CML RAR |
| 144 | TAD I (7645 |
| 145 | DCA I (7645 /SABR IT WAS CHAINED TO BY FORT |
| 146 | FCDF0, CDF 0 |
| 147 | JMP I (1003 /START COMPILATION |
| 148 | |
| 149 | BDFALT, 1 /DEVICE "SYS" |
| 150 | TEXT /FORTRLTM/ |
| 151 | B7600, 7600 |
| 152 | B7773, 7773 |
| 153 | / |
| 154 | VERNUM, 0 |
| 155 | TAD I POINT |
| 156 | CDF CIF 10 |
| 157 | JMS I VPRINT |
| 158 | ISZ POINT |
| 159 | ISZ COUNT |
| 160 | JMP .-5 |
| 161 | JMP I VERNUM |
| 162 | / |
| 163 | POINT, VERN |
| 164 | COUNT, -12 |
| 165 | VERN, 306 |
| 166 | 317 |
| 167 | 322 |
| 168 | 324 |
| 169 | 240 |
| 170 | 326 |
| 171 | 265 |
| 172 | 301 |
| 173 | 215 |
| 174 | 212 |
| 175 | / |
| 176 | VPRINT, VERPRT |
| 177 | |
| 178 | \f /ADDITIONS TO FORTRAN ERROR MESSAGES |
| 179 | |
| 180 | *ELIST+1 |
| 181 | NUMSG1 |
| 182 | *EMSG1-2 |
| 183 | -ERR61-1; EMSG15 |
| 184 | -ERR62-1; EMSG16 |
| 185 | -ERR63-1; EMSG17 |
| 186 | -ERR64-1; EMSG20 |
| 187 | 0 ; EMSG14 |
| 188 | /DUMMY PAGES TO CONSOLIDATE CORE IMAGE |
| 189 | *1600 |
| 190 | 0 |
| 191 | *2000 |
| 192 | 0 |
| 193 | *2400 |
| 194 | 0 |
| 195 | *3000 |
| 196 | 0 |
| 197 | *5600 |
| 198 | 0 |
| 199 | \f *5400 |
| 200 | FNEWF, 0 |
| 201 | CDF 10 |
| 202 | TAD I FILPTR |
| 203 | SNA |
| 204 | JMP EOFERR /END OF INPUT REACHED BEFORE END STATEMENT |
| 205 | DCA INWCNT |
| 206 | TAD I FILPTR |
| 207 | AND (7760 |
| 208 | SZA |
| 209 | TAD (17 |
| 210 | CLL CML RTR |
| 211 | RTR |
| 212 | DCA INRCNT |
| 213 | ISZ FILPTR |
| 214 | TAD I FILPTR |
| 215 | DCA INREC |
| 216 | ISZ FILPTR |
| 217 | TAD (5001 /FORTRAN ALLOWS TWO-PAGE HANDLERS |
| 218 | DCA INHNDL |
| 219 | TAD INWCNT |
| 220 | CDF 0 |
| 221 | CIF 10 |
| 222 | JMS I (200 |
| 223 | 1 /ASSIGN AND FETCH HANDLER |
| 224 | INHNDL, 5000 /LOCATIONS 5000-5377 ARE FREE |
| 225 | JMP IOERR /SOMETHINGS SCREWY |
| 226 | CLA CMA |
| 227 | DCA INWCNT |
| 228 | DCA INEOF |
| 229 | JMS MOUCOR |
| 230 | JMP I FNEWF |
| 231 | FILPTR, 7617 |
| 232 | GETCH, 0 |
| 233 | KSF |
| 234 | JMP .+5 |
| 235 | KRS |
| 236 | TAD (-203 |
| 237 | SNA CLA |
| 238 | JMP I (7600 |
| 239 | ISZ JMPGET |
| 240 | ISZ INWCNT |
| 241 | JMPG, JMP JMPGET |
| 242 | TAD INEOF |
| 243 | SNA CLA |
| 244 | JMP JUSTRD |
| 245 | GETNXT, CIF 10 |
| 246 | JMS I G7700 |
| 247 | 10 /ESCAPE |
| 248 | JMS FNEWF |
| 249 | JUSTRD, JMS I INHNDL /INHNDL CONTAINS LOCN OF DEVICE HANDLER |
| 250 | 0200 /READ 2 HALF-RECORDS INTO FIELD 0 |
| 251 | INBFPT, INBUF |
| 252 | INREC, 0 |
| 253 | JMP RERROR |
| 254 | ISZ INREC |
| 255 | ISZ INRCNT |
| 256 | SKP |
| 257 | ENDFIL, ISZ INEOF |
| 258 | TAD (-601 |
| 259 | DCA INWCNT |
| 260 | TAD JMPG |
| 261 | DCA JMPGET |
| 262 | TAD INBFPT |
| 263 | DCA INPTR |
| 264 | JMP GETCH+1 |
| 265 | JMPGET, JMP . |
| 266 | JMP INCHR1 |
| 267 | JMP INCHR2 |
| 268 | INCHR3, TAD JMPG |
| 269 | DCA JMPGET |
| 270 | TAD I INPTR |
| 271 | AND (7400 |
| 272 | CLL RTR |
| 273 | RTR |
| 274 | TAD INTMP |
| 275 | RTR |
| 276 | RTR |
| 277 | ISZ INPTR |
| 278 | JMP GCHCOM |
| 279 | INCHR2, TAD I INPTR |
| 280 | AND (7400 |
| 281 | DCA INTMP |
| 282 | ISZ INPTR |
| 283 | INCHR1, TAD I INPTR |
| 284 | GCHCOM, AND (377 |
| 285 | TAD (-232 |
| 286 | SNA |
| 287 | JMP GETNXT |
| 288 | TAD (232 |
| 289 | CIF 10 |
| 290 | ISZ GETCH |
| 291 | JMP I GETCH |
| 292 | RERROR, SMA CLA |
| 293 | G7700=RERROR |
| 294 | JMP ENDFIL |
| 295 | IOERR, JMS I (SFATAL |
| 296 | CIF 10 |
| 297 | ERR62, JMS I (LLUNCH |
| 298 | INPTR, 0 |
| 299 | INWCNT, 0 |
| 300 | INTMP, 0 |
| 301 | INRCNT, 0 |
| 302 | INEOF, 0 |
| 303 | EOFERR, JMS MOUCOR /KICK MONITOR OUT |
| 304 | JMS I (SFATAL |
| 305 | CIF 10 |
| 306 | ERR61, JMS I (LLUNCH |
| 307 | MOUCOR, 0 |
| 308 | CDF 0 |
| 309 | CIF 10 |
| 310 | JMS I (200 |
| 311 | 11 |
| 312 | JMP I MOUCOR |
| 313 | \f *3200 |
| 314 | P377, 377 |
| 315 | P7400, 7400 /WARNING ***DO NOT MOVE THIS*** |
| 316 | |
| 317 | PUTCH, 0 |
| 318 | DCA PUTMP |
| 319 | RAL |
| 320 | DCA PUTLNK |
| 321 | PUTCHX, ISZ JMPPUT |
| 322 | ISZ OUWDCT |
| 323 | JMPP, JMP JMPPUT |
| 324 | CLA CLL CML RTL |
| 325 | TAD OURCNT |
| 326 | SZL |
| 327 | JMP OUERR+1 |
| 328 | DCA OURCNT |
| 329 | ISZ CLOSCT |
| 330 | ISZ CLOSCT |
| 331 | JMS I (7607 |
| 332 | 4400 |
| 333 | OUBFPT, OUBUF |
| 334 | OUTREC, 0 |
| 335 | JMP I (IOERR |
| 336 | ISZ OUTREC |
| 337 | ISZ OUTREC |
| 338 | TAD (-1401 |
| 339 | DCA OUWDCT |
| 340 | TAD OUBFPT |
| 341 | DCA OUPTR |
| 342 | TAD JMPP |
| 343 | DCA JMPPUT |
| 344 | JMP PUTCHX |
| 345 | JMPPUT, JMP . |
| 346 | JMP PUTCH1 |
| 347 | JMP PUTCH2 |
| 348 | PUTCH3, TAD PUTMP |
| 349 | RTL |
| 350 | RTL |
| 351 | DCA PUTMP |
| 352 | TAD JMPP |
| 353 | DCA JMPPUT |
| 354 | TAD PUTMP |
| 355 | AND P7400 |
| 356 | TAD I OUPOLD |
| 357 | DCA I OUPOLD |
| 358 | TAD PUTMP |
| 359 | RTL |
| 360 | RTL |
| 361 | P201, AND P7400 |
| 362 | TAD I OUPTR |
| 363 | DCA I OUPTR |
| 364 | ISZ OUPTR |
| 365 | JMP PCHCOM |
| 366 | PUTCH2, TAD OUPTR |
| 367 | DCA OUPOLD |
| 368 | ISZ OUPTR |
| 369 | PUTCH1, TAD PUTMP |
| 370 | P200, AND P377 |
| 371 | DCA I OUPTR |
| 372 | PCHCOM, CIF 10 |
| 373 | TAD PUTLNK |
| 374 | CLL RAR |
| 375 | JMP I PUTCH |
| 376 | |
| 377 | EOFORT, SZA CLA /ANY ERRORS? |
| 378 | JMP I SF7600 /YES, DO NOT ASSEMBLE |
| 379 | DCA PCHCOM |
| 380 | TAD (232 |
| 381 | JMS PUTCH |
| 382 | TAD OUWDCT |
| 383 | TAD (1400 |
| 384 | SZA CLA |
| 385 | JMP .-5 /FILL BUFFER WITH ^Z |
| 386 | TAD I (JSBITS |
| 387 | RAR |
| 388 | CLL CML RAL |
| 389 | DCA I (JSBITS /NO NEED TO SAVE CORE ON THIS MONITOR CALL |
| 390 | CIF 10 |
| 391 | JMS I (7700 |
| 392 | 10 /ESCAPE |
| 393 | CLA IAC /DEVICE "SYS" |
| 394 | CIF 10 |
| 395 | JMS I P200 |
| 396 | 4 /CLOSE |
| 397 | OUSNAM |
| 398 | CLOSCT, 0 /CLOSING LENGTH |
| 399 | JMP OUERR-3 |
| 400 | CIF 10 |
| 401 | JMS I P200 |
| 402 | 6 /RUN |
| 403 | CLSABR, 0 |
| 404 | BIGGIE, JMS I (MOUCOR |
| 405 | JMS SFATAL |
| 406 | CIF 10 |
| 407 | ERR63, JMS I (LLUNCH |
| 408 | CLA CLL CMA RTL |
| 409 | AND I (JSBITS |
| 410 | DCA I (JSBITS /WHOOPS - GUESS WE SHOULD RESTORE CORE AFTER ALL |
| 411 | OUERR, JMS I (MOUCOR |
| 412 | JMS SFATAL |
| 413 | CIF 10 |
| 414 | ERR64, JMS I (LLUNCH |
| 415 | INBUF=1600 |
| 416 | OUBUF=3600 |
| 417 | OURCNT, 0 |
| 418 | OUPTR, OUBUF |
| 419 | OUWDCT, -1401 |
| 420 | PUTMP, 0 |
| 421 | OUPOLD, 0 |
| 422 | SFATAL, 0 |
| 423 | PUTLNK=SFATAL |
| 424 | SF7600, 7600 /CLEAR AC |
| 425 | CDF 10 |
| 426 | TAD SCDIF0 |
| 427 | DCA I (177 |
| 428 | TAD (5601 |
| 429 | DCA I P200 |
| 430 | TAD SF7600 |
| 431 | DCA I P201 |
| 432 | SCDIF0, CDF CIF 0 |
| 433 | JMP I SFATAL |
| 434 | \f *2200 /CANNOT GO PAST 2373 |
| 435 | SABR, TEXT /SABR/ |
| 436 | TEXT /SV/ |
| 437 | OUSNAM, TEXT /FORTRNTM/ |
| 438 | NUMSG1, TEXT /ILLEGAL CONTINUATION/ |
| 439 | EMSG15, TEXT /NO END STATEMENT/ |
| 440 | EMSG16, TEXT #I/O ERROR# |
| 441 | EMSG17, TEXT /SABR.SV NOT FOUND/ |
| 442 | EMSG20, TEXT /NO ROOM FOR OUTPUT/ |
| 443 | \f FIELD 1 |
| 444 | /THESE ARE THE PATCHES OVER THE COMPILER. |
| 445 | |
| 446 | |
| 447 | *FORST /HEADER PRINTER |
| 448 | NOP |
| 449 | NOP |
| 450 | NOP |
| 451 | |
| 452 | *FORST+5 /LEADER OUTPUT |
| 453 | CLA CLL CMA RTL /3 CHARACTERS OF LEADER |
| 454 | |
| 455 | *LPTRIN+1 /HIGH-SPEED READER ROUTINE |
| 456 | CIF 0 |
| 457 | JMS I .+1 |
| 458 | GETCH |
| 459 | |
| 460 | *OSTOP+1 |
| 461 | JMS I FPROP /PUNCH 'CALL 0,EXIT' |
| 462 | 6253 |
| 463 | JMP I OSTOP |
| 464 | |
| 465 | *LPUNCH+1 /PUNCH ROUTINE |
| 466 | CIF 0 |
| 467 | JMS I .+2 |
| 468 | CLA SKP |
| 469 | PUTCH |
| 470 | |
| 471 | *XFINI-3 /TRAILER PRINTER |
| 472 | CLA CLL CMA RTL /3 CHARACTERS OF TRAILER |
| 473 | |
| 474 | *XFINI-1 /ENDING SEQUENCE |
| 475 | CDF CIF 0 |
| 476 | TAD L75 /PICK UP ERROR FLAG |
| 477 | JMP I .+1 |
| 478 | EOFORT |
| 479 | |
| 480 | *GOOON+4 /TRAILER AFTER "END" STATEMENT |
| 481 | CLA CLL CMA RTL /3 CHARS ETC. |
| 482 | |
| 483 | |
| 484 | *LTTYPE+1 /REVERSE TTY WAIT MODE |
| 485 | TLS |
| 486 | TSF |
| 487 | JMP .-1 |
| 488 | |
| 489 | / |
| 490 | *4753 |
| 491 | VERPRT, 0 |
| 492 | JMS I VPUNCH |
| 493 | CDF CIF 0 |
| 494 | JMP I VERPRT |
| 495 | VPUNCH, 3372 |
| 496 | / |
| 497 | $ |
| 498 | \f |