| 1 | /OS8 SABR ASSEMBLER OVERLAY ***SPATCH.07*** |
| 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 SPATCH FOR V18 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 FROM FORT |
| 46 | / .ALLOW TWO PAGE OUTPUT HANDLER |
| 47 | / |
| 48 | / |
| 49 | /SABR ASSEMBLER, LIKE 8K FORTRAN UNDER OS/8, RUNS |
| 50 | /IN FIELD 1 WITH ITS TABLES IN FIELD 0. |
| 51 | / OCTOBER 26,1971 |
| 52 | / |
| 53 | /MODIFIED SO THAT SABR WILL, AT RUN TIME, DETERMINE IF THE USER |
| 54 | /SPECIFIED I/O DEVICES REQUIRE TWO PAGE HANDLERS, AND IF SO |
| 55 | /SABR WILL ALLOCATE SPACE FOR THEM. ALSO IF ALL I/O IS DONE VIA THE |
| 56 | /SYSTEM DEVICE, SABR WILL NOT RESERVE ANY SPACE FOR I/O HANDLERS |
| 57 | /SPACE FOR TWO PAGE HANDLERS IS MADE BY SHRINKING THE INPUT |
| 58 | /BUFFERS-CURRENTLY 4 PAGES-TO 2 PAGES. B.CLOGHER 10/71 |
| 59 | / |
| 60 | |
| 61 | FIELD 0 |
| 62 | SDVHND=772 |
| 63 | MPARAM=7643 |
| 64 | DVHNDL=7647 |
| 65 | JSBITS=7746 |
| 66 | MOFILE=7600 |
| 67 | CORE1=6200 /UPPER CORE LIMIT OF OCCURRENCE TABLE(VARIES WITH I/O HANDLERS NEEDED!!) |
| 68 | SABR=201 /SABR V17 FIRST LOC AFTER "JMS I IOINIT" |
| 69 | PASS=110 /SABR V17 |
| 70 | SERROR=JMS I 177/SABR V17 |
| 71 | ERRE=2701 /SABR V17 |
| 72 | PRSYMP=41 /SABR V17 |
| 73 | TEM1=123 /SABR V17 |
| 74 | TEM2=124 /" |
| 75 | M4=3704 /" |
| 76 | CLOC1=6 /" |
| 77 | CLOC2=3162 /" |
| 78 | CLOC3=4356 /" |
| 79 | CTYPE=23 /" |
| 80 | CRLF=24 |
| 81 | CHR=61 /" |
| 82 | SYMBOL=3 /" |
| 83 | LLFS=5364 /" |
| 84 | LINE=67 /" |
| 85 | L64=4772 /" |
| 86 | TYPE=54 /" |
| 87 | PUNCH=42 /" |
| 88 | INBUF=6200 /6200-7177 OR 6600-7177 |
| 89 | PRJ5=4051 |
| 90 | PRNOP=4136 |
| 91 | PRJ2=4170 |
| 92 | PRS2=4025 |
| 93 | PRS5=4101 |
| 94 | \f *30 /CCL PATCH; GOES HERE AS A HACK |
| 95 | CCLKLG, TAD [SKP |
| 96 | DCA I [CCLSKP |
| 97 | CDF 10 |
| 98 | TAD I [7645 |
| 99 | SMA CLA |
| 100 | JMP I [NOTFRT |
| 101 | TAD I [7645 |
| 102 | AND P3777 |
| 103 | DCA I [7645 |
| 104 | CDF |
| 105 | JMP I [SETCOR |
| 106 | P3777, 3777 |
| 107 | |
| 108 | *200 /INITIALIZATION - GETS DESTROYED DURING SABR EXECUTION |
| 109 | |
| 110 | START, ISZ I [FSWITC /SKIPS SINCE FSWITC=-1. ENTRY FROM "R SABR" |
| 111 | FSTART, JMP CCLKLG /ENTRY FROM 8K FORTRAN VIA "RUN SABR" MONITOR CALL |
| 112 | CLA CMA /USED AS TEM. BY SUBR. DNUM |
| 113 | DCA I [FSWITC /USED AS TEM. BY SUBR. DNUM |
| 114 | PTEM1, CIF 10 |
| 115 | JMS I [7700 /CALL I/O MONITOR |
| 116 | 10 /AND ASK IT TO STICK AROUND |
| 117 | CIF 10 |
| 118 | JMS I [200 |
| 119 | 5 /COMMAND DECODE |
| 120 | 2302 /.SB ASSUMED EXTENSION |
| 121 | NOTFRT, CDF 10 |
| 122 | TAD I [MPARAM |
| 123 | AND [100 |
| 124 | CDF 0 |
| 125 | SNA CLA /IS /F SWITCH ON? |
| 126 | DCA I [FSWITC /NO - ZERO OUT FSWITC |
| 127 | TAD I [JSBITS |
| 128 | TAD [1000 |
| 129 | DCA I [JSBITS |
| 130 | CCLSKP, JMP .+5 |
| 131 | SETCOR, ISZ I [FDSW /SET DELETE SWITCH |
| 132 | CIF 10 |
| 133 | JMS I [7700 /CALL I/O MONITOR--LOCK IT IN |
| 134 | 10 |
| 135 | CDF 10 |
| 136 | TAD I [MOFILE /CHECK FIRST TWO OUT DEV. SPECS.--NEED 2 PAGE HNDLR? |
| 137 | OUTL, JMS DNUM |
| 138 | JMP OSYS /NO OUTPUT OR SYS DEV. |
| 139 | JMP TWOPAG /NEED TWO-PAGE HANDLER |
| 140 | DONE, TAD I [MOFILE+5 /1 PAGE HNDLR-LOOK AT 2ND OUT DEV. |
| 141 | ISZ CNT /DONE BOTH? |
| 142 | JMP OUTL /NO-GO ON |
| 143 | CLA /YES- |
| 144 | TAD PTEM2 /ARE BOTH OUT DEVS. SYS: OR NOT THERE? |
| 145 | SZA CLA /IF SO-ALLOT 0 PAGES FOR OUTPUT HANDLER |
| 146 | TAD [-200 /NO-ALLOT 1 PAGE FOR HANDLER |
| 147 | DONE1, DCA OPGES /-SIZE OF OUT HANDLER NEEDED |
| 148 | INLP, TAD I TEM /NOW LOOP THRU 9 POSSIBLE INPUT SPECS. |
| 149 | JMS DNUM |
| 150 | JMP ISYS /INPUT NOT THERE OR SYS DEV. |
| 151 | JMP TWOPG /TWO PAGE HANDLER NEEDED |
| 152 | ILP1, ISZ TEM /ONE-MOVE PTR TO NEXT |
| 153 | ISZ TEM |
| 154 | ISZ CNT1 /DONE ALL 9? |
| 155 | JMP INLP /NO |
| 156 | TAD TEM3 /YES-ARE ALL INPUTS FROM SYS OR NOT THERE? |
| 157 | SZA CLA /IF SO-DON'T SAVE ROOM FOR INPUT HANDLER |
| 158 | TAD [-200 /NO-NEED ONE PAGE FOR HANDLER |
| 159 | IDONE, DCA IPGES /STORE AS SIZE OF INPUT HANDLER |
| 160 | TAD IPGES |
| 161 | TAD OPGES |
| 162 | TAD [400 /NEED MORE THAN A TOTAL OF 2 PAGES FOR HANDLERS? |
| 163 | CDF 00 /BACK TO DF 0 |
| 164 | SMA CLA |
| 165 | JMP NOTWO /NO-GO ON |
| 166 | DCA I [INREC1 /YES-ADJUST INPUT ROUTINE FOR ONLY 2 PAGE BUFFERS |
| 167 | TAD [200 |
| 168 | DCA I [INBFPT-1 |
| 169 | DCA I [INRD1 |
| 170 | DCA I [INRD1+1 |
| 171 | TAD [6600 /RESET ADDRESS OF INPUT BUFFER |
| 172 | DCA I [INBFPT |
| 173 | TAD [400 |
| 174 | NOTWO, TAD [6200 /RESET UPPER CORE LIM. OF OCCURRANCE TABLE |
| 175 | TAD IPGES |
| 176 | TAD OPGES |
| 177 | DCA [CORE1 |
| 178 | TAD OPGES |
| 179 | TAD [200 |
| 180 | SPA CLA /MORE THAN ONE PAGE OUT HNDLR NEEDED? |
| 181 | IAC /YES |
| 182 | TAD OPGES |
| 183 | TAD I [INBFPT /ADJUST HANDLER FETCH FOR TWO PAGE HANDLER |
| 184 | CDF 10 /BACK TO DATA FIELD 1 |
| 185 | DCA I [OUHND |
| 186 | CMA /PROPAGATE CHANGES INTO MAIN PART OF SABR |
| 187 | TAD [CORE1 |
| 188 | DCA I [CLOC1 |
| 189 | TAD I [CLOC1 |
| 190 | DCA I [CLOC3 |
| 191 | TAD [CORE1 |
| 192 | DCA I [CLOC2 |
| 193 | TAD IPGES |
| 194 | TAD [200 |
| 195 | SPA CLA /MORE THAN ONE PAGE FOR INPUT HNDLR? |
| 196 | IAC /YES-ADJUST IN HNDLR FETCH ROUTINE |
| 197 | TAD I [CLOC2 /(CONTAINS START ADDRESS OF CORE FOR IN HNDLR.) |
| 198 | CDF 00 |
| 199 | DCA I [ADEVN /STORE FOR HNDLR FETCH ROUTINE |
| 200 | CDF 10 |
| 201 | JMP I [LCHK |
| 202 | ISYS, ISZ TEM3 |
| 203 | IPGES, 0 |
| 204 | JMP ILP1 /INPUT SPEC. NOT THERE OR SYS DEV. |
| 205 | TWOPG, TAD [-200 /INPUT SPEC-NEEDS TWO PAGES |
| 206 | JMP IDONE-1 |
| 207 | TWOPAG, TAD [-200 /OUT HNDLR NEEDS TWO PAGES |
| 208 | JMP DONE1-1 |
| 209 | OSYS, ISZ PTEM2 /OUT HNDLR NOT NEEDED OR SYS. DEVICE |
| 210 | OPGES, 0 |
| 211 | JMP DONE |
| 212 | / |
| 213 | /ROUTINE TO CHECK DEVICE SPECS. LEFT BY COMMAND DECODER AND SEE |
| 214 | /IF WE NEED ANY TWO PAGE HANDLERS. ALSO CHECK IF ALL I/O IS FROM |
| 215 | /SYS DEVICE IN WHICH WE DON'T HAVE TO SAVE ROOM FOR ANY HANDLERS |
| 216 | /RETN. TO CALL + 1 IF DON'T NEED ROOM FOR ANY HANDLER |
| 217 | /RETN. TO CALL + 2 IF NEED 2 PAGES FOR HANDLER |
| 218 | /RETN. TO CALL + 3 IF NEED 1 PAGE FOR HANDLER |
| 219 | / |
| 220 | DNUM, 0 |
| 221 | AND [17 /MASK DEV. # |
| 222 | DCA FSTART+1 /STORE |
| 223 | TAD FSTART+1 |
| 224 | CLL |
| 225 | SNA /ANYTHING THERE? |
| 226 | JMP I DNUM /NO-TREAT LIKE SYS. DEV |
| 227 | TAD [DVHNDL-1 /CHECK IF THIS HANDLER CO-RESIDENT WITH SYS.(TD8/E--UNIT 1) |
| 228 | DCA FSTART+2 |
| 229 | TAD I FSTART+2 |
| 230 | TAD [200 |
| 231 | SZL CLA /IS ENTRY PT. ABOVE 7600?? |
| 232 | JMP I DNUM /YES-JUST LIKE SYS DEV. |
| 233 | TAD FSTART+1 |
| 234 | TAD [SDVHND-1 /NO-PICK UP TABLE WD WHICH TELLS IF 2 PAGE HNDLR. |
| 235 | DCA FSTART+2 |
| 236 | TAD I FSTART+2 |
| 237 | ISZ DNUM /BUMP RETN. |
| 238 | SMA CLA /BIT 0=1? I.E. DOES IT NEED TWO PAGES? |
| 239 | ISZ DNUM /NO-NORMAL RETN. TO CALL+3--NEED 1 PAGE |
| 240 | \f JMP I DNUM /YES-RETN. TO CALL+2--NEED 2 PAGES |
| 241 | TEM3, -11 |
| 242 | CNT, -2 |
| 243 | CNT1, -11 |
| 244 | PTEM2, -2 |
| 245 | TEM, MOFILE+17 |
| 246 | \f*400 |
| 247 | LCHK, TAD I [MPARAM+1 |
| 248 | AND (4 |
| 249 | SNA CLA |
| 250 | ISZ STSABR |
| 251 | TAD I [MPARAM+1 |
| 252 | AND [40 |
| 253 | SNA CLA /IF /S IS ON |
| 254 | TAD I [MOFILE+5 |
| 255 | SZA CLA /OR IF THERE IS NO LISTING OUTPUT FILE |
| 256 | JMP NSPEED |
| 257 | TAD [PRS5&177+5200 /SPEED UP SYMBOL TABLE SORT |
| 258 | DCA I [PRJ5 |
| 259 | DCA I [PRNOP |
| 260 | DCA I [SYMXX /AND PRINT "U" MESSAGE FOR UNDEFINEDS |
| 261 | TAD [PRS2-1&177+5200 |
| 262 | DCA I [PRJ2 |
| 263 | NSPEED, CDF 10 |
| 264 | TAD I [MOFILE+4 /GET EXTENSION OF BINARY OUTPUT |
| 265 | SNA /IS IT THERE? |
| 266 | TAD [2214 /NO - SET TO .RL |
| 267 | DCA I [MOFILE+4 |
| 268 | TAD I [MOFILE+11 |
| 269 | SNA |
| 270 | TAD [1423 /SIMILIARLY SET LISTING EXTENSION TO .LS |
| 271 | DCA I [MOFILE+11 |
| 272 | DCA I [OUTINH |
| 273 | TAD I [MOFILE |
| 274 | SNA CLA /BINARY OUTPUT? |
| 275 | JMP NOBNOT /NO |
| 276 | CDF CIF 10 |
| 277 | JMS I [TSTNTR /YES - OPEN IT |
| 278 | CDF 10 |
| 279 | JMP YESBOT |
| 280 | NOBNOT, TAD [MOFILE+1 |
| 281 | DCA I [PFILE |
| 282 | ISZ I [OUTINH /INHIBIT OUTPUT |
| 283 | YESBOT, TAD I [MOFILE+5 |
| 284 | CDF 0 |
| 285 | SZA CLA |
| 286 | DCA I [LSTFLG |
| 287 | CDF 10 |
| 288 | TAD I [MPARAM |
| 289 | AND [41 /"L" OR "G" FLAGS ON? |
| 290 | CDF 0 |
| 291 | SNA CLA |
| 292 | JMP NOLOAD |
| 293 | JMS I [MINCOR |
| 294 | CLA IAC /DEVICE "SYS" |
| 295 | CIF 10 |
| 296 | JMS I [200 |
| 297 | 2 /LOOKUP |
| 298 | ALOAD, LOADER |
| 299 | 0 /LENGTH GOES HERE AND IS IGNORED |
| 300 | JMP NOLODR /COULDN'T FIND IT |
| 301 | TAD ALOAD |
| 302 | DCA I [LDRBLK |
| 303 | CDF 10 |
| 304 | TAD I [OUTREC |
| 305 | CDF 0 |
| 306 | DCA I [REMEMB |
| 307 | NOLOAD, JMS I [OPENFL /OPEN FIRST INPUT FILE WHILE MONITOR STILL IN CORE |
| 308 | CDF CIF 10 |
| 309 | JMP I .+1 |
| 310 | STSABR, SABR /FIRST LOC IN SABR AFTER "INITIAL DIALOGUE" |
| 311 | NOLODR, TAD [1200 |
| 312 | JMP I [ERROR |
| 313 | LOADER, TEXT /LOADERSV/ |
| 314 | \f *1100 /FILE OPENER - RESIDES IN PART OF THE OLD SABR INPUT BUFFER |
| 315 | O7760, 7760 |
| 316 | OPENFL, 0 |
| 317 | CDF 10 |
| 318 | TAD I FILPTR |
| 319 | SNA /IS THERE ANOTHER INPUT FILE? |
| 320 | JMP I (ERROR+1 /ERROR - NO END STATEMENT IN PROGRAM |
| 321 | DCA OTEMP |
| 322 | TAD OTEMP |
| 323 | AND (17 /EXTRACT DEVICE NUMBER |
| 324 | TAD (DVHNDL-1 |
| 325 | DCA OTEMP2 |
| 326 | TAD I OTEMP2 |
| 327 | DCA OTEMP2 |
| 328 | ISZ FILPTR |
| 329 | TAD I FILPTR /GET STARTING BLOCK # |
| 330 | CDF 0 |
| 331 | DCA I (INREC /STORE IT AWAY |
| 332 | ISZ FILPTR |
| 333 | TAD OTEMP |
| 334 | AND (7760 /EXTRACT LENGTH |
| 335 | SZA /LENGTH OF 256 IMPLIES MAY BE LARGER |
| 336 | TAD (17 |
| 337 | CLL CML RTR |
| 338 | RTR /GET LENGTH AS A NORMAL NEGATIVE NUMBER |
| 339 | DCA I (INCNT /STORE THAT AWAY TOO |
| 340 | TAD OTEMP2 |
| 341 | SZA |
| 342 | JMP GOTIT |
| 343 | JMS I (MINCOR /GET MONITOR |
| 344 | TAD ADEVN /THIS LOC. SET UP BY INITIALIZATION ROUTINE |
| 345 | DCA ADEVNO |
| 346 | TAD OTEMP |
| 347 | CIF 10 |
| 348 | JMS I O200 |
| 349 | 1 /ASSIGN |
| 350 | ADEVNO, 5600 /FORCE HANDLER INTO PAGE 5600 |
| 351 | JMP I (DELERR /GIVE S ERROR |
| 352 | TAD ADEVNO |
| 353 | GOTIT, DCA I (INDEV |
| 354 | JMS I (MOUCOR /GET MONITOR OUT |
| 355 | CLA CMA |
| 356 | DCA I (INCHCT /FORCE BUFFER LOAD ON FIRST READ |
| 357 | JMP I OPENFL |
| 358 | OTEMP, 0 |
| 359 | OTEMP2, 0 |
| 360 | FILPTR, 7617 |
| 361 | O200, 200 |
| 362 | ADEVN, 0 /SET UP BY INIT. ROUTINE-PAGE ADDR. OF IN HNDLR |
| 363 | \f *1600 |
| 364 | MINCOR, 0 |
| 365 | RDF |
| 366 | TAD MINCIF |
| 367 | DCA MINXIT |
| 368 | MINCIF, CDF CIF 0 |
| 369 | CIF 10 |
| 370 | JMS I SYSTEM |
| 371 | 10 /ESCAPE |
| 372 | TAD MIN200 |
| 373 | DCA SYSTEM |
| 374 | MINXIT, 0 /RESTORE CALLING FIELDS |
| 375 | JMP I MINCOR |
| 376 | MOUCOR, 0 |
| 377 | CDF 0 |
| 378 | TAD SYSTEM |
| 379 | E7500, SMA |
| 380 | CIF 10 |
| 381 | MN7700, SMA CLA |
| 382 | JMS I SYSTEM |
| 383 | 11 /GET OUT |
| 384 | TAD MN7700 |
| 385 | DCA SYSTEM |
| 386 | JMP I MOUCOR |
| 387 | SYSTEM, 200 |
| 388 | MIN200, 200 |
| 389 | ERROR, TAD E7500 /MAKE SABR ERROR "B" |
| 390 | DCA MINCOR |
| 391 | JMS MOUCOR /KICK MONITOR OUT |
| 392 | CDF CIF 10 |
| 393 | DCA I EPASS /SET PASS=0 SO ERROR WILL PRINT |
| 394 | TAD EL64 |
| 395 | DCA I ETYPE |
| 396 | TAD MINCOR |
| 397 | JMP I .+1 |
| 398 | ERRE |
| 399 | EPASS, PASS |
| 400 | EL64, L64 |
| 401 | ETYPE, TYPE |
| 402 | \f *7200 |
| 403 | SPAUSE, 0 /"PAUSE" STATEMENT PATCH |
| 404 | TAD FSWITC |
| 405 | CLL RAL |
| 406 | TAD I (FILPTR |
| 407 | DCA I (FILPTR /RESET FILE POINTER IF CALLED FROM FORTRAN |
| 408 | JMS I (OPENFL /OPEN NEXT FILE |
| 409 | CDF CIF 10 |
| 410 | JMP I SPAUSE |
| 411 | FSWITC, -1 /AS ADVERTISED |
| 412 | |
| 413 | DELETE, TAD I (MPARAM |
| 414 | RTR /PUT "K" SWITCH IN LINK |
| 415 | D7600, 7600 |
| 416 | CDF 0 |
| 417 | TAD I (JSBITS |
| 418 | RAR |
| 419 | CLL CML RAL |
| 420 | DCA I (JSBITS /MARK "DON'T CARE IF MONITOR AREA DESTROYED" BITS |
| 421 | TAD FDSW |
| 422 | SZL SNA CLA /DELETE ONLY IF CALLED FROM FORTRAN WITH |
| 423 | JMP NODLET /"K" SWITCH(IN LINK) ZERO |
| 424 | JMS I (MINCOR |
| 425 | CLA IAC /DEVICE "SYS" |
| 426 | CIF 10 |
| 427 | JMS I (200 |
| 428 | 4 /CLOSE - USED AS DELETE |
| 429 | NAME /NAME FOR CLOSE PROCESSOR |
| 430 | 0 /NO BLOCKS - WILL BE DELETED |
| 431 | JMP DELERR /ERROR |
| 432 | NODLET, TAD LDRBLK |
| 433 | SNA CLA /WAS A LOADER BLOCK STORED |
| 434 | JMP GETOUT |
| 435 | CDF 10 |
| 436 | TAD I (L64 |
| 437 | CDF 0 |
| 438 | SZA CLA /IF WE USED THE TELETYPE ROUTINE, |
| 439 | JMP GETOUT /THEN THERE WAS AN ERROR |
| 440 | TAD REMEMB |
| 441 | CDF 10 |
| 442 | DCA I (MOFILE+1 |
| 443 | CLL CML CLA RAR |
| 444 | TAD I (MPARAM+2 |
| 445 | DCA I (MPARAM+2 |
| 446 | CDF 0 |
| 447 | JMS I (MINCOR |
| 448 | CIF 10 |
| 449 | JMS I (200 |
| 450 | 6 /RUN |
| 451 | LDRBLK, 0 |
| 452 | REMEMB, 0 |
| 453 | FDSW, 0 |
| 454 | GETOUT, TAD I (SYSTEM |
| 455 | CDF 10 |
| 456 | D7700, SMA CLA |
| 457 | CMA |
| 458 | DCA I D7700 |
| 459 | CDF 0 |
| 460 | JMP I .+1 |
| 461 | 7605 |
| 462 | DELERR, TAD (1700 /GIVE A "S" ERROR |
| 463 | DELER2, TAD (200 |
| 464 | CDF CIF 0 |
| 465 | JMP I (ERROR |
| 466 | NAME, 0617;2224;2216;2415 |
| 467 | |
| 468 | INREAD, 0 |
| 469 | AND D7700 |
| 470 | SNA CLA |
| 471 | JMS I POPNFL |
| 472 | JMS I INDEV |
| 473 | 400 /OR 200 IF NEED TWO PAGE HANDLERS-REDUCE BUFFER SIZE TO MAKE ROOM |
| 474 | INBFPT, INBUF |
| 475 | INREC, 0 |
| 476 | JMP INERR |
| 477 | ISZ INREAD |
| 478 | ISZ INREC |
| 479 | INREC1, ISZ INREC /OR 0000 IF TWO PAGE HANDLERS-SINCE IN BUFFER IS 1/2 SIZE |
| 480 | JMP I INREAD |
| 481 | INDEV, 0 |
| 482 | INERR, SPA CLA |
| 483 | JMP DELER2 |
| 484 | JMP INREC+3 |
| 485 | POPNFL, OPENFL |
| 486 | |
| 487 | CLSMBE, 0 /SUBR TO CLOSE OUTPUT FILE IF ONE EXISTS |
| 488 | CDF CIF 10 |
| 489 | TAD I (OUTINH |
| 490 | SNA CLA |
| 491 | JMS I (OUCLOS |
| 492 | CIF 0 /IN CASE WE DIDN'T CLOSE IT |
| 493 | JMP I CLSMBE |
| 494 | \f *7400 /END OF PASS CRAP AND INPUT ROUTINE |
| 495 | P40, 40 |
| 496 | PASEND, ISZ I (PASS /BUMP PASS COUNTER |
| 497 | LSTFLG, JMP SBSYMT /ZERO IF LISTING FILE EXISTS |
| 498 | JMS I (CLSMBE /CLOSE BINARY FILE |
| 499 | CDF CIF 10 |
| 500 | JMS I (TSTNTR /ENTER LISTING FILE |
| 501 | TAD I (FSWITC |
| 502 | SZA CLA |
| 503 | JMP .+4 |
| 504 | TAD (7617 |
| 505 | DCA I (FILPTR /RESET FILE POINTER TO BEGINNING |
| 506 | JMS I (OPENFL /AND OPEN FIRST FILE |
| 507 | /IF CALLED FROM FORTRAN WE DONT HAVE TO DO THIS |
| 508 | /BECAUSE OF THE PECULIAR NATURE OF FORTRAN OUTPUT |
| 509 | JMS I (MOUCOR /KICK MONITOR OUT |
| 510 | CDF CIF 10 |
| 511 | TAD I (MPARAM+1 |
| 512 | P200, AND P40 /MASK OUT "S" SWITCH |
| 513 | DCA I (OUTINH /INTO "OUTPUT INHIBIT" FLAG |
| 514 | JMS I (SYMPRT /PRINT SYMBOL TABLE UNDER CONTROL OF /S |
| 515 | DCA I (OUTINH /ZERO FLAG FOR LISTING |
| 516 | TAD I (MPARAM+1 /SYMPRT RETURNS WITH DATA FIELD=10 |
| 517 | RTL |
| 518 | CIF 10 |
| 519 | SNL CLA /"N" FLAG IS IN THE LINK |
| 520 | JMP I (ENDRSM /HE WANTS A LISTING - GO GET IT |
| 521 | SBREND, CIF 0 |
| 522 | JMS I (CLSMBE /CLOSE OUTPUT FILE |
| 523 | JMP I (DELETE /DELETE FORTRN.TM AND CHAIN OR RETURN |
| 524 | |
| 525 | SBSYMT, TAD (TDUMMY |
| 526 | CDF CIF 10 |
| 527 | DCA I (PUNCH /INHIBIT ALL FUTURE OUTPUT |
| 528 | JMS I (SYMPRT /CHECK SYMTAB FOR UNDEFINEDS |
| 529 | CDF 0 |
| 530 | ISZ I (JSBITS /SET "DON'T CARE ABOUT USR CORE" FLAG |
| 531 | JMP SBREND /NOW GO CLOSE BINARY OUTPUT FILE AND RETURN |
| 532 | |
| 533 | INCHAR, 0 |
| 534 | ISZ INJMP |
| 535 | KSF |
| 536 | JMP .+5 |
| 537 | KRS |
| 538 | TAD (-203 |
| 539 | SNA CLA |
| 540 | JMP I (7600 /EXIT TO MONITOR IF ^C TYPED |
| 541 | ISZ INCHCT |
| 542 | INJMPP, INJMPE |
| 543 | TAD INCNT |
| 544 | INRD, JMS I (INREAD |
| 545 | DCA INCNT /RETURN HERE ON EOF |
| 546 | INRD1, ISZ INCNT /SET TO 0000 IF 2 PAGE HANDLERS FORCE INPT. BUFF. TO 1/2 SIZE |
| 547 | SKP / " " " |
| 548 | TAD (600 |
| 549 | ISZ INCNT |
| 550 | IN7400, 7400 |
| 551 | TAD (-1401 |
| 552 | DCA INCHCT |
| 553 | TAD INJMPP |
| 554 | DCA INJMP |
| 555 | TAD I (INBFPT |
| 556 | DCA INPTR |
| 557 | JMP INCHAR+1 |
| 558 | INJMPE=JMP . |
| 559 | INJMP, INJMPE |
| 560 | JMP INCHA1 |
| 561 | JMP INCHA2 |
| 562 | INCHA3, TAD INJMPP |
| 563 | DCA INJMP |
| 564 | TAD I INPTR |
| 565 | AND IN7400 |
| 566 | CLL RTR |
| 567 | RTR |
| 568 | TAD INTEMP |
| 569 | RTR |
| 570 | RTR |
| 571 | ISZ INPTR |
| 572 | JMP INCOM |
| 573 | INCHA2, TAD I INPTR |
| 574 | AND IN7400 |
| 575 | DCA INTEMP |
| 576 | ISZ INPTR |
| 577 | INCHA1, TAD I INPTR |
| 578 | INCOM, AND (177 |
| 579 | SZA |
| 580 | TAD (-177 |
| 581 | SNA |
| 582 | JMP INCHAR+1 |
| 583 | TAD (145 /CHECK FOR ^Z |
| 584 | SNA |
| 585 | JMP INRD /^Z ON INPUT MEANS GO TO NEXT FILE |
| 586 | TAD (232 |
| 587 | CDF CIF 10 |
| 588 | DCA I (CHR |
| 589 | JMP I INCHAR |
| 590 | INPTR, 0 |
| 591 | INCHCT, 0 |
| 592 | INTEMP, 0 |
| 593 | INCNT, 0 |
| 594 | FIELD 1 |
| 595 | \f *6400 /OUTPUT ROUTINE INTERFACE - CANT GO PAST 6423 |
| 596 | OUCHAR, 0 |
| 597 | DCA I POUTEM |
| 598 | TAD OUTINH |
| 599 | SZA CLA |
| 600 | OUCRET, JMP I OUCHAR /DOUBLES AS OFF-PAGE RETURN |
| 601 | ISZ I POUJMP |
| 602 | ISZ OUCHCT |
| 603 | JMP I POUJMX |
| 604 | JMS OUTDMP |
| 605 | JMP OUCHAR+2 |
| 606 | POUJMP, OUJMP |
| 607 | POUJMX, OUJMX |
| 608 | POUTEM, OUTEMP |
| 609 | OUTINH, 0 |
| 610 | F3ERR, TAD O2100 |
| 611 | F2ERR, TAD O2100 |
| 612 | F1ERR, CDF CIF 0 |
| 613 | JMP I .+1 |
| 614 | ERROR |
| 615 | O2100, 2100 |
| 616 | *6457 /LOADS OVER OLD SABR INITIALIZATION ROUTINE |
| 617 | TSTNTR, 0 /CALLED FROM FIELD 0 |
| 618 | TAD PFILE |
| 619 | TAD C4 |
| 620 | DCA PFILE |
| 621 | TAD I PFILE |
| 622 | ISZ PFILE |
| 623 | DCA ODEVNO |
| 624 | TAD OUHND /THIS LOC. IS SET UP AT INIT. TIME |
| 625 | DCA OUHNDL |
| 626 | CIF 0 |
| 627 | JMS I (MINCOR |
| 628 | JMS I (200 |
| 629 | 13 /RESET OUTPUT DEVICE |
| 630 | TAD ODEVNO /LOAD OUTPUT DEVICE |
| 631 | JMS I (200 |
| 632 | 1 |
| 633 | OUHNDL, 7400 |
| 634 | JMP F2ERR |
| 635 | TAD PFILE |
| 636 | DCA ENAME /POINTS TO FILE NAME |
| 637 | DCA OULNGT /ZERO CLOSING LENGTH |
| 638 | TAD ODEVNO /LOAD DEVICE NUMBER AND REQUESTED LENGTH |
| 639 | JMS I (200 |
| 640 | 3 /ENTER |
| 641 | ENAME, 0 /POINTER INTO COMMAND DECODER AREA GOES HERE |
| 642 | OUCHCT=ENAME |
| 643 | ELENGT, 0 /"0 LENGTH" MEANS AS LARGE A SPACE AS POSSIBLE |
| 644 | JMP F2ERR /COULDN'T ENTER FILE - MAYBE BAD DIRECTORY |
| 645 | TAD ENAME /GET STARTING BLOCK # |
| 646 | DCA OUTREC /STORE IT AWAY |
| 647 | JMS OUSPTR /INITIALIZE OUTPUT ROUTINE |
| 648 | ENTRTN, CDF CIF 0 |
| 649 | JMP I TSTNTR |
| 650 | OUSPTR, 0 |
| 651 | TAD POUBUF |
| 652 | DCA I (OUPTR |
| 653 | TAD (-601 |
| 654 | DCA OUCHCT |
| 655 | TAD (OUJMPE |
| 656 | DCA I POUJMP |
| 657 | JMP I OUSPTR |
| 658 | OUTDMP, 0 |
| 659 | CIF 0 |
| 660 | JMS I OUHNDL |
| 661 | 4200 |
| 662 | POUBUF, 1200 /REMAINDER OF OLD SABR INPUT BUFFER |
| 663 | OUTREC, 0 |
| 664 | JMP F3ERR |
| 665 | ISZ OUTREC |
| 666 | JMS OUSPTR |
| 667 | ISZ OULNGT |
| 668 | ISZ ELENGT |
| 669 | JMP I OUTDMP |
| 670 | JMP F2ERR |
| 671 | OUCLOS, 0 |
| 672 | TAD OUT232 /PUT A ^Z IN THE OUTPUT FILE |
| 673 | JMS OUCHAR |
| 674 | TAD OUCHCT |
| 675 | CMA |
| 676 | SZA CLA |
| 677 | JMP .-4 /FILL REMAINDER OF BUFFER WITH ZEROS |
| 678 | JMS OUTDMP |
| 679 | CIF 0 |
| 680 | JMS I (MINCOR |
| 681 | TAD ODEVNO |
| 682 | JMS I (200 |
| 683 | C4, 4 /CLOSE |
| 684 | PFILE, 7574 |
| 685 | OULNGT, 0 |
| 686 | JMP F2ERR /ERROR ON CLOSE |
| 687 | DCA OULNGT |
| 688 | CIF 0 |
| 689 | JMP I OUCLOS |
| 690 | OUT232, 232 |
| 691 | ODEVNO, 0 |
| 692 | OUHND, 0 /SET UP AT INIT. TIME TO ALLOW 2 PAGE HNDLR |
| 693 | /IF NEEDED |
| 694 | *6610 /OUTPUT ROUTINE - CANT GO PAST 6661 |
| 695 | OUJMX, CDF 0 |
| 696 | OUJMPE=JMP . |
| 697 | OUJMP, OUJMPE |
| 698 | JMP OUCHA1 |
| 699 | JMP OUCHA2 |
| 700 | OUCHA3, TAD OUTEMP |
| 701 | RTL |
| 702 | RTL |
| 703 | DCA OUTEMP |
| 704 | TAD OUJMPP |
| 705 | DCA OUJMP |
| 706 | TAD OUTEMP |
| 707 | AND OU7400 |
| 708 | TAD I OUPOLD |
| 709 | DCA I OUPOLD |
| 710 | TAD OUTEMP |
| 711 | RTL |
| 712 | RTL |
| 713 | AND OU7400 |
| 714 | TAD I OUPTR |
| 715 | DCA I OUPTR |
| 716 | ISZ OUPTR |
| 717 | JMP OUCOM |
| 718 | OUCHA2, TAD OUPTR |
| 719 | DCA OUPOLD |
| 720 | ISZ OUPTR |
| 721 | OUCHA1, TAD OUTEMP |
| 722 | AND OU377 |
| 723 | DCA I OUPTR |
| 724 | OUCOM, CDF 10 |
| 725 | JMP I .+1 |
| 726 | OUCRET |
| 727 | OUPTR, 0 |
| 728 | OUJMPP, OUJMPE |
| 729 | OUPOLD, 0 |
| 730 | OUTEMP, 0 |
| 731 | OU7400, 7400 |
| 732 | OU377, 377 |
| 733 | \f /PATCHES TO SABR TO HOOK INTO THESE WONDERFUL ROUTINES |
| 734 | *4574 /OLD "INITR" ROUTINE AREA - 4 LOCATIONS LONG |
| 735 | SYMPRT, 0 /INTERMEDIATE ROUTINE TO PRINT SYMBOL TABLE |
| 736 | JMS I PRSYMP /CALL SABR'S ROUTINE |
| 737 | CIF 0 |
| 738 | JMP I SYMPRT /BUT RETURN TO FIELD 0 |
| 739 | |
| 740 | *4641 /CODE IN THIS SECTION CAN'T GO PAST 4704 |
| 741 | FETCH, 0 /REPLACES ROUTINE IN SABR OF SAME NAME |
| 742 | CDF CIF 0 |
| 743 | JMS I .+2 |
| 744 | JMP I FETCH |
| 745 | INCHAR |
| 746 | |
| 747 | LDRCT, 7700 /FOR LEADER-TRAILER ROUTINE ON SAME PAGE |
| 748 | |
| 749 | USYMFG, 0 /ROUTINE TO GIVE UNDEFINED SYMBOL MESSAGES WHEN |
| 750 | JMS I CTYPE /NO SYMBOL TABLE IS REQUESTED |
| 751 | SYMXX, JMP I USYMFG /ZEROED IF CHECKING FOR UNDEFINEDS |
| 752 | TAD SYMBOL |
| 753 | DCA I PLLFS /SET UP SABR CELLS SO THAT ERROR ROUTINE WILL |
| 754 | DCA LINE /PRINT THE NAME OF THE UNDEFINED SYMBOL |
| 755 | TAD U2300 /FUDGE FOR "U" ERROR MESSAGE - UNFORTUNATELY, |
| 756 | JMP I .+1 /THIS MESSAGE IS INSTANTLY FATAL - SERVES HIM RIGHT |
| 757 | F1ERR |
| 758 | PLLFS, LLFS /RANDOM LOCATION IN SABR |
| 759 | U2300, 2300 |
| 760 | |
| 761 | TDUMMY, 0 /DUMMY OUTPUT ROUTINE |
| 762 | CLA |
| 763 | JMP I TDUMMY /AS DUMMY AS YOU CAN GET |
| 764 | |
| 765 | *6133 /PATCH TO SYMBOL TABLE PRINTER TO USE ABOVE |
| 766 | JMS I 6177 /THIS REPLACES A "JMS I CTYPE" |
| 767 | *6177 |
| 768 | USYMFG /LUCKILY THERE WAS A LOCATION FREE |
| 769 | |
| 770 | *3665 /REWRITE OF OCTAL TYPEOUT ROUTINE TO |
| 771 | DCA TEM1 /NOT KEEP INFORMATION IN THE LINK ACROSS |
| 772 | TAD M4 /A CALL TO THE OUTPUT ROUTINE |
| 773 | DCA TEM2 |
| 774 | L62A, TAD TEM1 |
| 775 | RTL |
| 776 | RAL |
| 777 | DCA TEM1 |
| 778 | TAD TEM1 |
| 779 | RAL |
| 780 | *3702 |
| 781 | JMP L62A |
| 782 | |
| 783 | *4317 /"PAUSE" PROCESSOR |
| 784 | CLA /REPLACES CLA HLT |
| 785 | CDF CIF 0 |
| 786 | |
| 787 | *4332 /PATCHES TO INITIALIZATION ROUTINE |
| 788 | NOP /DON'T GIVE |
| 789 | NOP /TWO USELESS CARRIAGE RETURN - LINE FEED PAIRS |
| 790 | |
| 791 | *4341 |
| 792 | NOP /DON'T JMS I 4372 'CAUSE WE HAVE CHANGED 4372! |
| 793 | |
| 794 | *4372 /MORE "PAUSE" FUDGE |
| 795 | SPAUSE |
| 796 | |
| 797 | *4715 /ALTER COUNT ON LEADER-TRAILER |
| 798 | TAD LDRCT |
| 799 | |
| 800 | *561 /"END" STMT PROCESSOR |
| 801 | CIF 0 |
| 802 | JMP I PEND /END OF PASS 1 |
| 803 | ENDRSM=. |
| 804 | |
| 805 | *565 /MORE ON "END" |
| 806 | NOP /ELIMINATE HALT AT END OF PASS 1 |
| 807 | |
| 808 | *570 /STILL MORE ON "END" |
| 809 | CDF CIF 0 |
| 810 | JMP I SEND /END OF PASS 2 |
| 811 | |
| 812 | *576 /THERE ARE (WERE) TWO WHOLE FREE LOCATIONS IN THIS PAGE! |
| 813 | SEND, SBREND |
| 814 | PEND, PASEND |
| 815 | |
| 816 | *2761 /FATAL ERROR HALT IN ERROR ROUTINE |
| 817 | CDF CIF 0 |
| 818 | JMP I 166 /166 = LITERAL 7600 |
| 819 | |
| 820 | *4003 /LISTING ROUTINE |
| 821 | SKP CLA /ALWAYS PUT LISTING ON "PUNCH" |
| 822 | |
| 823 | *PUNCH /POINTER TO PUNCH ROUTINE |
| 824 | OUCHAR /POINTER TO MY PUNCH ROUTINE |
| 825 | / |
| 826 | *200 |
| 827 | VERNUM |
| 828 | JMS I .-1 |
| 829 | / |
| 830 | *7000 |
| 831 | VERNUM, 0 |
| 832 | JMS I CRLF |
| 833 | TAD I POINT |
| 834 | JMS I CTYPE |
| 835 | ISZ POINT |
| 836 | ISZ COUNT |
| 837 | JMP .-4 |
| 838 | JMS I CRLF |
| 839 | DCA I TYPE |
| 840 | JMP I VERNUM |
| 841 | / |
| 842 | POINT, TITLE |
| 843 | COUNT, -5 |
| 844 | TITLE, TEXT /SABR V18A / |
| 845 | $ |
| 846 | \f |
| 847 | \r\f |