sw/os8/v3d/sources/system/dectapes/dectape2/SPATCH.PA

   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 
\f